diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index a28b185abc..a2992ddc8d 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -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; diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index a3de8d05c7..51fb57e78a 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -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 NewDefItemHeightnil) 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 diff --git a/lcl/shellctrls.pas b/lcl/shellctrls.pas index d0e59a0638..45bab4da8b 100644 --- a/lcl/shellctrls.pas +++ b/lcl/shellctrls.pas @@ -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;