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

LCL/ShellCtrls: Update ShellListview when ObjectTypes changes.

Browse Source
This commit is contained in:
wp_xyz 2023-11-12 17:24:06 +01:00
parent 222117e473
commit 6fd30d194f
1 changed files with 25 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
lcl/shellctrls.pas
View File

@ -131,9 +131,9 @@ type
property UseBuiltinIcons: Boolean read FUseBuiltinIcons write SetUseBuiltinIcons default true; property UseBuiltinIcons: Boolean read FUseBuiltinIcons write SetUseBuiltinIcons default true;
{ Properties } { Properties }
property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes; property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes default [otFolders];
property ShellListView: TCustomShellListView read FShellListView write SetShellListView; property ShellListView: TCustomShellListView read FShellListView write SetShellListView;
property FileSortType: TFileSortType read FFileSortType write SetFileSortType; property FileSortType: TFileSortType read FFileSortType write SetFileSortType default fstNone;
property Root: string read FRoot write SetRoot; property Root: string read FRoot write SetRoot;
property Path: string read GetPath write SetPath; property Path: string read GetPath write SetPath;
property OnAddItem: TAddItemEvent read FOnAddItem write FOnAddItem; property OnAddItem: TAddItemEvent read FOnAddItem write FOnAddItem;
@ -268,6 +268,7 @@ type
procedure SetMaskCaseSensitivity(AValue: TMaskCaseSensitivity); procedure SetMaskCaseSensitivity(AValue: TMaskCaseSensitivity);
procedure SetShellTreeView(const Value: TCustomShellTreeView); procedure SetShellTreeView(const Value: TCustomShellTreeView);
procedure SetRoot(const Value: string); procedure SetRoot(const Value: string);
procedure SetObjectTypes(const Value: TObjectTypes);
protected protected
{ Methods specific to Lazarus } { Methods specific to Lazarus }
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
@ -291,7 +292,7 @@ type
property AutoSizeColumns: Boolean read FAutoSizeColumns write SetAutoSizeColumns default true; property AutoSizeColumns: Boolean read FAutoSizeColumns write SetAutoSizeColumns default true;
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 MaskCaseSensitivity: TMaskCaseSensitivity read FMaskCaseSensitivity write SetMaskCaseSensitivity default mcsPlatformDefault; property MaskCaseSensitivity: TMaskCaseSensitivity read FMaskCaseSensitivity write SetMaskCaseSensitivity default mcsPlatformDefault;
property ObjectTypes: TObjectTypes read FObjectTypes write FObjectTypes; property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes default [otNonFolders];
property Root: string read FRoot write SetRoot; property Root: string read FRoot write SetRoot;
property ShellTreeView: TCustomShellTreeView read FShellTreeView write SetShellTreeView; property ShellTreeView: TCustomShellTreeView read FShellTreeView write SetShellTreeView;
property UseBuiltInIcons: Boolean read FUseBuiltinIcons write FUseBuiltInIcons default true; property UseBuiltInIcons: Boolean read FUseBuiltinIcons write FUseBuiltInIcons default true;
@ -1701,6 +1702,27 @@ begin
end; end;
end; end;
procedure TCustomShellListView.SetObjectTypes(const Value: TObjectTypes);
var
sel: String = '';
begin
if FObjectTypes = Value then Exit;
FObjectTypes := Value;
if (csLoading in ComponentState) then Exit;
BeginUpdate;
try
if Assigned(Selected) then
sel := Selected.Caption;
Clear;
PopulateWithRoot();
if Sel <> '' then
Selected := FindCaption(0, sel, false, true, false);
finally
EndUpdate;
end;
end;
procedure TCustomShellListView.SetRoot(const Value: string); procedure TCustomShellListView.SetRoot(const Value: string);
begin begin
if FRoot <> Value then if FRoot <> Value then