paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 13:28:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

ShellCtrls: subclass TListItem, so we can store a TSearchRec in the list items of a TShellListView.

Browse Source
This commit is contained in:
Bart 2023-03-15 17:23:21 +01:00
parent e54924787c
commit 6a85abf640
1 changed files with 28 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
lcl/shellctrls.pas
View File

@ -236,6 +236,16 @@ type
TCSLVFileAddedEvent = procedure(Sender: TObject; Item: TListItem) of object;
{ TShellListItem }
TShellListItem = class(TListItem)
private
FFileInfo: TSearchRec;
public
function isFolder: Boolean;
property FileInfo: TSearchRec read FFileInfo write FFileInfo;
end;
TCustomShellListView = class(TCustomListView)
private
FAutoSizeColumns: Boolean;
@ -258,6 +268,7 @@ type
class procedure WSRegisterClass; override;
procedure AdjustColWidths;
procedure CreateHandle; override;
function CreateListItem: TListItem; override;
procedure PopulateWithRoot();
procedure DoOnResize; override;
procedure SetAutoSizeColumns(const Value: Boolean); virtual;
@ -441,6 +452,13 @@ begin
Result := (A.Code = B.Code) and (A.Data = B.Data);
end;
{ TShellListItem }
function TShellListItem.isFolder: Boolean;
begin
Result := (FFileInfo.Attr and faDirectory) = faDirectory;
end;
{ TFileItem : internal helper class used for temporarily storing info in an internal TStrings component}
constructor TFileItem.Create(const DirInfo:TSearchRec; ABasePath: String);
@ -1676,6 +1694,8 @@ begin
if CanAdd then
begin
NewItem := Items.Add;
if (NewItem is TShellListItem) then
TShellListItem(NewItem).FileInfo := TFileItem(Files.Objects[i]).FileInfo;
CurFileName := Files.Strings[i];
CurFilePath := IncludeTrailingPathDelimiter(FRoot) + CurFileName;
// First column - Name
@ -1751,6 +1771,14 @@ begin
end;
end;
function TCustomShellListView.CreateListItem: TListItem;
begin
if Assigned(OnCreateItemClass) then
Result := inherited CreateListItem
else
Result := TShellListItem.Create(Items);
end;
procedure TCustomShellListView.DoOnResize;
begin
inherited;