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

LCL/ShellCtrls: On Windows automatically show shell icons in TShellTreeView when no imagelist is attached.

Browse Source 
git-svn-id: trunk@64575 -
This commit is contained in:
wp 2021-02-13 22:11:24 +00:00
parent fcff9d8ea7
commit e32b62e6b4
3 changed files with 121 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/comctrls.pp
View File

@ -3511,7 +3511,9 @@ type
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
function ExpandSignSizeIsStored: Boolean;
function GetBuiltinIconSize: TSize; virtual;
function GetDragImages: TDragImageList; override;
function GetImageSize: TSize;
function GetMaxLvl: integer;
function GetMaxScrollLeft: integer;
function GetMaxScrollTop: integer;
@ -3545,6 +3547,7 @@ type
procedure DoStartDrag(var DragObject: TDragObject); override;
procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState;
var Accept: Boolean); override;
function DrawBuiltinIcon(ANode: TTreeNode; ARect: TRect): TSize; virtual;
procedure EndEditing(Cancel: boolean = false); virtual;
procedure EnsureNodeIsVisible(ANode: TTreeNode);
procedure Expand(Node: TTreeNode); virtual;

45
lcl/include/treeview.inc
View File

@ -1754,16 +1754,24 @@ function TTreeNode.DisplayTextLeft: integer;
var
TV: TCustomTreeView;
ImgIndex: TImageIndex;
sz: TSize;
begin
Result := DisplayIconLeft;
TV := TreeView;
if (TV = nil) or (TV.Images = nil) then Exit;
if TV = nil then
exit;
sz := TV.GetImageSize;
if (TV.Images = nil) then
begin
inc(Result, sz.CX);
exit;
end;
if (TV.Selected = Self) then
ImgIndex:=SelectedIndex
else
ImgIndex:=ImageIndex;
if (ImgIndex<0) or (ImgIndex>=TV.Images.Count) then Exit;
Inc(Result, TV.Images.WidthForPPI[TV.StateImagesWidth, TV.Font.PixelsPerInch] + TV.FDefItemSpace);
Inc(Result, sz.CX + TV.FDefItemSpace);
end;
function TTreeNode.DisplayTextRight: integer;
@ -3667,12 +3675,11 @@ begin
if (tvoAutoItemHeight in FOptions)
and HandleAllocated and Canvas.HandleAllocated then begin
NewDefItemHeight:=Canvas.TextHeight(TVAutoHeightString)+FDefItemSpace;
if Assigned(FImages) then
ImageSize := Images.SizeForPPI[ImagesWidth, Font.PixelsPerInch];
ImageSize := GetImageSize;
if Assigned(FStateImages) then
StateImageSize := StateImages.SizeForPPI[StateImagesWidth, Font.PixelsPerInch];
if NewDefItemHeight<FDefItemSpace then NewDefItemHeight:=FDefItemSpace;
if (Images<>nil) and (ImageSize.cy+FDefItemSpace>NewDefItemHeight) then
if (ImageSize.cy > 0) and (ImageSize.cy + FDefItemSpace > NewDefItemHeight) then
NewDefItemHeight:=ImageSize.cy+FDefItemSpace;
if (StateImages<>nil) and (StateImageSize.cy+FDefItemSpace>NewDefItemHeight) then
NewDefItemHeight:=StateImageSize.cy+FDefItemSpace;
@ -4704,6 +4711,20 @@ begin
Result := nil;
end;
function TCustomTreeView.GetBuiltinIconSize: TSize;
begin
Result := Types.Size(0, 0);
end;
function TCustomTreeView.GetImageSize: TSize;
begin
if FImages <> nil then
begin
Result := Images.SizeForPPI[ImagesWidth, Font.PixelsPerInch]
end else
Result := GetBuiltinIconSize;
end;
procedure TCustomTreeView.UpdateInsertMark(X,Y: integer);
begin
if (tvoAutoInsertMark in Options) and (not (csDesigning in ComponentState))
@ -5339,7 +5360,7 @@ var
var
x, ImgIndex: integer;
CurTextRect: TRect;
CurTextRect, ImgRect: TRect;
DrawState: TCustomDrawState;
PaintImages: boolean;
OverlayIndex: Integer;
@ -5404,7 +5425,12 @@ begin
end;
// draw icon
if (Images <> nil) then
if (Images = nil) then
begin
imgRect := NodeRect;
imgRect.Left := x+1;
inc(x, DrawBuiltinIcon(Node, imgRect).CX + FDefItemSpace);
end else
begin
if FSelectedNode <> Node then
begin
@ -5479,6 +5505,11 @@ begin
end;
end;
function TCustomTreeView.DrawBuiltinIcon(ANode: TTreeNode; ARect: TRect): TSize;
begin
Result := Size(0, 0);
end;
procedure TCustomTreeView.GetImageIndex(Node: TTreeNode);
begin
if Assigned(FOnGetImageIndex) then

86
lcl/shellctrls.pas
View File

@ -24,7 +24,7 @@ interface
uses
Classes, SysUtils, Laz_AVL_Tree,
// LCL
Forms, Graphics, ComCtrls, LCLProc, LCLStrConsts,
Forms, Graphics, ComCtrls, LCLProc, LCLType, LCLStrConsts, Types,
// LazUtils
FileUtil, LazFileUtils, LazUTF8, Masks;
@ -64,6 +64,7 @@ type
FShellListView: TCustomShellListView;
FFileSortType: TFileSortType;
FInitialRoot: String;
FUseBuiltinIcons: Boolean;
FOnAddItem: TAddItemEvent;
{ Setters and getters }
function GetPath: string;
@ -72,6 +73,7 @@ type
procedure SetPath(AValue: string);
procedure SetRoot(const AValue: string);
procedure SetShellListView(const Value: TCustomShellListView);
procedure SetUseBuiltinIcons(const AValue: Boolean);
protected
procedure DoCreateNodeClass(var NewNodeClass: TTreeNodeClass); override;
procedure Loaded; override;
@ -82,6 +84,15 @@ type
procedure DoSelectionChanged; override;
procedure DoAddItem(const ABasePath: String; const AFileInfo: TSearchRec; var CanAdd: Boolean);
function CanExpand(Node: TTreeNode): Boolean; override;
{$ifdef mswindows}
private
FBuiltinIconSize: TSize;
protected
function DrawBuiltInIcon(ANode: TTreeNode; ARect: TRect): TSize; override;
function GetBuiltinIconSize: TSize; override;
{$endif}
public
{ Basic methods }
constructor Create(AOwner: TComponent); override;
@ -97,6 +108,7 @@ type
function GetPathFromNode(ANode: TTreeNode): string;
procedure PopulateWithBaseFiles;
procedure Refresh(ANode: TTreeNode); overload;
property UseBuiltinIcons: Boolean read FUseBuiltinIcons write SetUseBuiltinIcons default true;
{ Properties }
property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes;
@ -365,7 +377,7 @@ procedure Register;
implementation
{$ifdef windows}
uses Windows;
uses Windows, ShellApi;
{$endif}
const
@ -411,7 +423,6 @@ begin
end;
{ TShellTreeNode }
procedure TShellTreeNode.SetBasePath(ABasePath: String);
@ -470,6 +481,12 @@ begin
Value.ShellTreeView := Self;
end;
procedure TCustomShellTreeView.SetUseBuiltinIcons(const AValue: Boolean);
begin
if FUseBuiltinIcons = AValue then exit;
FUseBuiltinIcons := AValue;
Invalidate;
end;
procedure TCustomShellTreeView.DoCreateNodeClass(
var NewNodeClass: TTreeNodeClass);
@ -608,6 +625,7 @@ constructor TCustomShellTreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FInitialRoot := '';
FUseBuiltinIcons := true;
// Initial property values
FObjectTypes:= [otFolders];
@ -984,6 +1002,65 @@ begin
FOnAddItem(Self, ABasePath, AFileInfo, CanAdd);
end;
{$ifdef mswindows}
{ Extracts the windows shell icon of the specified file. }
function GetShellIcon(const AFileName: WideString): TIcon;
var
FileInfo: TSHFileInfoW;
imgHandle: DWORD_PTR;
begin
imgHandle := SHGetFileInfoW(PWideChar(AFileName), 0, FileInfo, SizeOf(FileInfo),
SHGFI_ICON + SHGFI_SMALLICON + SHGFI_SYSICONINDEX);
if imgHandle <> 0 then
begin
Result := TIcon.Create;
Result.Handle := FileInfo.hIcon;
end else
Result := nil;
end;
function TCustomShellTreeView.DrawBuiltinIcon(ANode: TTreeNode; ARect: TRect): TSize;
var
filename: widestring;
ico: TIcon;
begin
if FUseBuiltinIcons then
begin
fileName := widestring(GetPathFromNode(ANode));
ico := GetShellIcon(fileName);
try
Canvas.Draw(ARect.Left, (ARect.Top + ARect.Bottom - ico.Height) div 2, ico);
Result := Types.Size(ico.Width, ico.Height);
finally
ico.Free;
end;
end else
Result := Types.Size(0, 0);
end;
function TCustomShellTreeView.GetBuiltinIconSize: TSize;
var
ico: TIcon;
begin
if FUseBuiltinIcons then
begin
if (FBuiltinIconSize.CX > 0) and (FBuiltinIconSize.CY > 0) then
Result := FBuiltinIconSize
else
begin
ico := GetShellIcon(WideString('C:'));
try
Result := Types.Size(ico.Width, ico.Height);
FBuiltinIconSize := Result;
finally
ico.Free;
end;
end;
end else
Result := Types.Size(0, 0);
end;
{$endif}
function TCustomShellTreeView.GetPathFromNode(ANode: TTreeNode): string;
begin
if Assigned(ANode) then
@ -998,7 +1075,6 @@ begin
Result := '';
end;
procedure TCustomShellTreeView.Refresh(ANode: TTreeNode);
//nil will refresh root
var
@ -1271,8 +1347,6 @@ begin
for i := 0 to sl.Count - 1 do debugln(['sl[',i,']="',sl[i],'"']);
{$endif}
BeginUpdate;
try
Node := Items.GetFirstVisibleNode;