LCL/ShellCtrls: Display default shell icons in TShellListView. Issue #18247.

git-svn-id: trunk@64764 -

lcl/interfaces/carbon/carbonwsfactory.pas

@@ -101,6 +101,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -547,6 +548,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/cocoa/cocoawsfactory.pas

@@ -108,6 +108,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -556,6 +557,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/customdrawn/customdrawnwsfactory.pas

@@ -97,6 +97,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -556,6 +557,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/fpgui/fpguiwsfactory.pas

@@ -96,6 +96,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -549,6 +550,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/gtk/gtkwsfactory.pas

@@ -97,6 +97,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -621,6 +622,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   Result := False;

lcl/interfaces/gtk2/gtk2wsfactory.pas

@@ -101,6 +101,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -626,6 +627,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/gtk3/gtk3wsfactory.pas

@@ -111,6 +111,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -627,6 +628,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/nogui/noguiwsfactory.pas

@@ -95,6 +95,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -496,6 +497,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/qt/qtwsfactory.pas

@@ -96,6 +96,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -561,6 +562,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/qt5/qtwsfactory.pas

@@ -96,6 +96,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -561,6 +562,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/win32/win32wsfactory.pas

@@ -96,6 +96,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -566,6 +567,12 @@ begin
   Result := True;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  RegisterWSComponent(TCustomShellListView, TWin32WSCustomShellListView);
+  Result := True;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/win32/win32wsshellctrls.pp

@@ -41,6 +41,12 @@ type
     class function GetBuiltinIconSize: TSize; override;
   end;
 
+  { TWin32WSCustomShellListView }
+  TWin32WSCustomShellListView = class(TWSCustomShellListView)
+  published
+    class function GetBuiltInImageIndex(AListView: TCustomShellListView;
+      const AFileName: String; ALargeImage: Boolean): Integer; override;
+  end;
 
 implementation
 
@@ -102,4 +108,40 @@ begin
 end;
 
 
+{ TWin32WSCustomShellListView }
+
+class function TWin32WSCustomShellListView.GetBuiltInImageIndex(
+  AListView: TCustomShellListView; const AFileName: String;
+  ALargeImage: Boolean): Integer;
+var
+  fullName: WideString;
+  info: TSHFILEINFOW;
+  sysImageHandle: DWORD_PTR;
+  listHandle: HWND;
+  flags: DWord;
+  lvsil: LongInt;
+begin
+  Result := -1;
+  fullName := WideString(AFileName);
+  if ALargeImage then begin
+    flags := SHGFI_LARGEICON or SHGFI_SYSICONINDEX;
+    lvsil := LVSIL_NORMAL;
+  end else
+  begin
+    flags := SHGFI_SMALLICON or SHGFI_SYSICONINDEX;
+    lvsil := LVSIL_SMALL;
+  end;
+  sysImageHandle := SHGetFileInfoW(PWideChar(fullName), 0, info, SizeOf(info), flags);
+  if sysImageHandle = 0 then
+    Exit;
+  listHandle := AListView.Handle;
+  if ListView_GetImageList(ListHandle, lvsil) = 0 then
+  begin
+    SetWindowLong(listHandle, GWL_STYLE,
+      GetWindowLong(listHandle, GWL_STYLE) or LVS_SHAREIMAGELISTS);
+    ListView_SetImageList(listHandle, sysImageHandle, lvsil);
+  end;
+  Result := info.iIcon;
+end;
+
 end.

lcl/interfaces/wince/wincewsfactory.pas

@@ -96,6 +96,7 @@ function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
 // ShellCtrls
 function RegisterCustomShellTreeView: Boolean;
+function RegisterCustomShellListView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -551,6 +552,11 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellListView: Boolean; alias : 'WSRegisterCustomShellListView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/shellctrls.pas

@@ -213,6 +213,7 @@ type
     FObjectTypes: TObjectTypes;
     FRoot: string;
     FShellTreeView: TCustomShellTreeView;
+    FUseBuiltInIcons: Boolean;
     FOnAddItem: TAddItemEvent;
     FOnFileAdded: TCSLVFileAddedEvent;
     { Setters and getters }
@@ -222,9 +223,11 @@ type
     procedure SetRoot(const Value: string);
   protected
     { Methods specific to Lazarus }
+    class procedure WSRegisterClass; override;
     procedure PopulateWithRoot();
     procedure Resize; override;
     procedure DoAddItem(const ABasePath: String; const AFileInfo: TSearchRec; var CanAdd: Boolean);
+    function GetBuiltinImageIndex(const AFileName: String; ALargeImage: Boolean): Integer;
     property OnFileAdded: TCSLVFileAddedEvent read FOnFileAdded write FOnFileAdded;
   public
     { Basic methods }
@@ -238,6 +241,7 @@ type
     property ObjectTypes: TObjectTypes read FObjectTypes write FObjectTypes;
     property Root: string read FRoot write SetRoot;
     property ShellTreeView: TCustomShellTreeView read FShellTreeView write SetShellTreeView;
+    property UseBuiltInIcons: Boolean read FUseBuiltinIcons write FUseBuiltInIcons default true;
     property OnAddItem: TAddItemEvent read FOnAddItem write FOnAddItem;
     { Protected properties which users may want to access, see bug 15374 }
     property Items;
@@ -1457,6 +1461,8 @@ constructor TCustomShellListView.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
 
+  FUseBuiltInIcons := true;
+
   // Initial property values
   ViewStyle := vsReport;
   ObjectTypes := [otNonFolders];
@@ -1478,6 +1484,14 @@ begin
   inherited Destroy;
 end;
 
+function TCustomShellListView.GetBuiltinImageIndex(const AFileName: String;
+  ALargeImage: Boolean): Integer;
+begin
+  Result := TWSCustomShellListViewClass(WidgetsetClass).GetBuiltInImageIndex(
+    self, AFileName, ALargeImage
+  );
+end;
+
 procedure TCustomShellListView.PopulateWithRoot();
 var
   i: Integer;
@@ -1522,6 +1536,14 @@ begin
           NewItem.SubItems.Add(Format(sShellCtrlsMB, [IntToStr(CurFileSize div (1024 * 1024))]));
         // Third column - Type
         NewItem.SubItems.Add(ExtractFileExt(CurFileName));
+        // Image index
+        if FUseBuiltInIcons then
+        begin
+          if (ViewStyle = vsIcon) and (LargeImages = nil) then
+            NewItem.ImageIndex := GetBuiltInImageIndex(CurFilePath, true)
+          else if (ViewStyle <> vsIcon) and (SmallImages = nil) then
+            NewItem.ImageIndex := GetBuiltinImageIndex(CurFilePath, false);
+        end;
         if Assigned(FOnFileAdded) then FOnFileAdded(Self,NewItem);
       end;
     end;
@@ -1579,6 +1601,12 @@ begin
   Result := IncludeTrailingPathDelimiter(FRoot) + ANode.Caption;
 end;
 
+class procedure TCustomShellListView.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+  RegisterCustomShellListView;
+end;
+
 procedure Register;
 begin
   RegisterComponents('Misc',[TShellTreeView, TShellListView]);

lcl/widgetset/wsfactory.pas

@@ -124,6 +124,7 @@ function WSRegisterCustomFloatSpinEdit: Boolean;external name 'WSRegisterCustomF
 function WSRegisterCustomRubberBand: Boolean;   external name 'WSRegisterCustomRubberBand';
 // ShellCtrls
 function WSRegisterCustomShellTreeView: Boolean; external name 'WSRegisterCustomShellTreeView';
+function WSRegisterCustomShellListView: Boolean; external name 'WSRegisterCustomShellListView';
 // LazDeviceAPIs
 function WSRegisterLazDeviceAPIs: Boolean;   external name 'WSRegisterLazDeviceAPIs';
 

lcl/widgetset/wsshellctrls.pp

@@ -42,13 +42,13 @@ uses
 ////////////////////////////////////////////////////
   ShellCtrls, ComCtrls,
 ////////////////////////////////////////////////////
-  WSControls, WSFactory, WSLCLClasses;
+  WSControls, WSFactory, WSLCLClasses, WSComCtrls;
 
 type
 
   { TWSCustomShellTreeView }
 
-  TWSCustomShellTreeView = class(TWSCustomControl)
+  TWSCustomShellTreeView = class(TWSCustomTreeView)
   published
     class function DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
       ANode: TTreeNode; ARect: TRect): TSize; virtual;
@@ -56,7 +56,18 @@ type
   end;
   TWSCustomShellTreeViewClass = class of TWSCustomShellTreeView;
 
+  { TWSCustomShellListView }
+
+  TWSCustomShellListView = class(TWSCustomListView)
+  published
+    class function GetBuiltInImageIndex(AListView: TCustomShellListView;
+      const AFileName: String; ALargeImage: Boolean): Integer; virtual;
+  end;
+  TWSCustomShellListViewClass = class of TWSCustomShellListView;
+
 procedure RegisterCustomShellTreeView;
+procedure RegisterCustomShellListView;
+
 
 implementation
 
@@ -78,14 +89,39 @@ begin
   Result.CY := 0;
 end;
 
+
+{ TWSCustomShellListView }
+
+class function TWSCustomShellListView.GetBuiltInImageIndex(
+  AListView: TCustomShellListView; const AFileName: String;
+  ALargeImage: Boolean): Integer;
+begin
+  Result := -1;
+end;
+
+
+{ Registration }
+
 procedure RegisterCustomShellTreeView;
 const
   Done: Boolean = False;
 begin
   if Done then exit;
+  //WSRegisterCustomShellTreeView;
   if not WSRegisterCustomShellTreeView then
     RegisterWSComponent(TCustomShellTreeView, TWSCustomShellTreeView);
   Done := True;
 end;
 
+procedure RegisterCustomShellListView;
+const
+  Done: Boolean = False;
+begin
+  if Done then exit;
+//  WSRegisterCustomShellListView;
+  if not WSRegisterCustomShellListView then
+    RegisterWSComponent(TCustomShellListView, TWSCustomShellListView);
+  Done := True;
+end;
+
 end.