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

git-svn-id: trunk@64575 -

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;

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 := GetImageSize;
-      ImageSize := Images.SizeForPPI[ImagesWidth, Font.PixelsPerInch];
     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

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;