paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-16 09:48:14 +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; end;
procedure TSelectPropertiesForm.LBPropertiesClick(Sender: TObject); procedure TSelectPropertiesForm.LBPropertiesClick(Sender: TObject);
//var
//I: Integer;
begin 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; end;
procedure TSelectPropertiesForm.LBPropertiesDblClick(Sender: TObject); procedure TSelectPropertiesForm.LBPropertiesDblClick(Sender: TObject);
//var
//I: Integer;
begin 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; AddSelectedProperties;
end; end;

58
lcl/shellctrls.pas
View File

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