paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 21:12:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

TSheeTreeView, TShellListView: fixed using overrides instead of events

Browse Source 
git-svn-id: trunk@21270 -
This commit is contained in:
mattias 2009-08-17 20:13:51 +00:00
parent e390c989eb
commit 20ea2c5116
2 changed files with 24 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
ideintf/frmselectprops.pas
View File

@ -93,23 +93,11 @@ begin
end;
procedure TSelectPropertiesForm.LBPropertiesClick(Sender: TObject);
//var
//I: Integer;
begin
//writeln('TSelectPropertiesForm.LBPropertiesClick START ');
//For I:=LBProperties.Items.Count-1 downto 0 do if LBProperties.Selected[i] then writeln(i);
//writeln('');
//writeln('TSelectPropertiesForm.LBPropertiesClick END ');
end;
procedure TSelectPropertiesForm.LBPropertiesDblClick(Sender: TObject);
//var
//I: Integer;
begin
//writeln('TSelectPropertiesForm.LBPropertiesDblClick START ');
//For I:=LBProperties.Items.Count-1 downto 0 do if LBProperties.Selected[i] then writeln(i);
//writeln('');
//writeln('TSelectPropertiesForm.LBPropertiesDblClick END ');
AddSelectedProperties;
end;

58
lcl/shellctrls.pas
View File

@ -50,11 +50,11 @@ type
FShellListView: TCustomShellListView;
{ Setters and getters }
procedure SetShellListView(const Value: TCustomShellListView);
{ Other internal methods }
procedure HandleOnExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
procedure HandleSelectionChanged(Sender: TObject);
protected
{ Other methods specific to Lazarus }
{ Other internal methods }
function CanExpand(Node: TTreeNode): Boolean; override;
procedure DoSelectionChanged; override;
function PopulateTreeNodeWithFiles(
ANode: TTreeNode; ANodePath: string): Boolean;
procedure PopulateWithBaseFiles;
@ -67,7 +67,6 @@ type
class function GetBasePath: string;
class procedure GetFilesInDir(const ABaseDir: string;
AMask: string; AObjectTypes: TObjectTypes; AResult: TStrings);
{ Other methods specific to Lazarus }
function GetPathFromNode(ANode: TTreeNode): string;
{ Properties }
@ -141,22 +140,17 @@ type
FObjectTypes: TObjectTypes;
FRoot: string;
FShellTreeView: TCustomShellTreeView;
{ Setters and getters }
procedure SetMask(const AValue: string);
procedure SetShellTreeView(const Value: TCustomShellTreeView);
procedure SetRoot(const Value: string);
{ Other internal methods }
procedure HandleResize(Sender: TObject);
protected
{ Methods specific to Lazarus }
procedure PopulateWithRoot();
procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer); override;
procedure PopulateWithRoot;
public
{ Basic methods }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Methods specific to Lazarus }
function GetPathFromItem(ANode: TListItem): string;
{ Properties }
public
property Mask: string read FMask write SetMask; // Can be used to conect to other controls
property ObjectTypes: TObjectTypes read FObjectTypes write FObjectTypes;
property Root: string read FRoot write SetRoot;
@ -304,15 +298,17 @@ begin
Value.ShellTreeView := Self;
end;
procedure TCustomShellTreeView.HandleOnExpanding(Sender: TObject;
Node: TTreeNode; var AllowExpansion: Boolean);
function TCustomShellTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
Node.DeleteChildren;
AllowExpansion := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
Result:=inherited CanExpand(Node);
if Result then
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
end;
procedure TCustomShellTreeView.HandleSelectionChanged(Sender: TObject);
procedure TCustomShellTreeView.DoSelectionChanged;
begin
inherited DoSelectionChanged;
if Assigned(FShellListView) then
begin
FShellListView.Root := GetPathFromNode(Selected);
@ -328,11 +324,6 @@ begin
ObjectTypes:= [otFolders];
// Necessary event handlers
OnExpanding := @HandleOnExpanding;
OnSelectionChanged := @HandleSelectionChanged;
// Populates the base dirs
PopulateWithBaseFiles();
@ -543,10 +534,12 @@ begin
end;
end;
procedure TCustomShellListView.HandleResize(Sender: TObject);
procedure TCustomShellListView.ChangeBounds(ALeft, ATop,
AWidth, AHeight: integer);
begin
inherited ChangeBounds(ALeft,ATop,AWidth,AHeight);
{$ifdef DEBUG_SHELLCTRLS}
WriteLn(':>TCustomShellListView.HandleResize');
debugLn([':>TCustomShellListView.HandleResize']);
{$endif}
// The correct check is with count,
@ -554,14 +547,14 @@ begin
// will raise an exception
if Self.Columns.Count < 3 then Exit;
Column[0].Width := (70 * Width) div 100;
Column[1].Width := (15 * Width) div 100;
Column[2].Width := (15 * Width) div 100;
Column[0].Width := (70 * AWidth) div 100;
Column[1].Width := (15 * AWidth) div 100;
Column[2].Width := (15 * AWidth) div 100;
{$ifdef DEBUG_SHELLCTRLS}
WriteLn(':<TCustomShellListView.HandleResize C0.Width=',
debugLn([':<TCustomShellListView.HandleResize C0.Width=',
Column[0].Width, ' C1.Width=', Column[1].Width,
' C2.Width=', Column[2].Width);
' C2.Width=', Column[2].Width]);
{$endif}
end;
@ -580,10 +573,7 @@ begin
Self.Column[1].Caption := 'Size';
Self.Column[2].Caption := 'Type';
// Initial sizes, necessary under Windows CE
HandleResize(Self);
// Internal event handlers
OnResize := @HandleResize;
ChangeBounds(Left,Top,Width,Height);
end;
destructor TCustomShellListView.Destroy;
@ -592,7 +582,7 @@ begin
inherited Destroy;
end;
procedure TCustomShellListView.PopulateWithRoot();
procedure TCustomShellListView.PopulateWithRoot;
var
i: Integer;
Files: TStringList;