LCL/ShellTreeView: Add ShellCtrls to widgetsets. Widgetset-based solution for automatic shell icons in TShellTreeView (implemented for win32 only).

git-svn-id: trunk@64747 -

.gitattributes

@@ -11079,6 +11079,7 @@ lcl/interfaces/win32/win32wsgrids.pp svneol=native#text/pascal
 lcl/interfaces/win32/win32wsimglist.pp svneol=native#text/pascal
 lcl/interfaces/win32/win32wsmenus.pp svneol=native#text/pascal
 lcl/interfaces/win32/win32wspairsplitter.pp svneol=native#text/pascal
+lcl/interfaces/win32/win32wsshellctrls.pp svneol=native#text/pascal
 lcl/interfaces/win32/win32wsspin.pp svneol=native#text/pascal
 lcl/interfaces/win32/win32wsstdctrls.pp svneol=native#text/pascal
 lcl/interfaces/win32/win32wstoolwin.pp svneol=native#text/pascal
@@ -11255,6 +11256,7 @@ lcl/widgetset/wsmenus.pp svneol=native#text/pascal
 lcl/widgetset/wspairsplitter.pp svneol=native#text/pascal
 lcl/widgetset/wsproc.pp svneol=native#text/pascal
 lcl/widgetset/wsreferences.pp svneol=native#text/pascal
+lcl/widgetset/wsshellctrls.pp svneol=native#text/pascal
 lcl/widgetset/wsspin.pp svneol=native#text/pascal
 lcl/widgetset/wsstdctrls.pp svneol=native#text/pascal
 lcl/widgetset/wstoolwin.pp svneol=native#text/pascal

lcl/interfaces/carbon/carbonwsfactory.pas

@@ -99,6 +99,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -539,6 +541,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/cocoa/cocoawsfactory.pas

@@ -106,6 +106,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -548,6 +550,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/customdrawn/customdrawnwsfactory.pas

@@ -95,6 +95,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -548,6 +550,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/fpgui/fpguiwsfactory.pas

@@ -94,6 +94,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -541,6 +543,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/fpmake.pp

@@ -203,6 +203,7 @@ begin
     t.Dependencies.AddUnit('win32wsimglist');
     t.Dependencies.AddUnit('win32wsmenus');
     t.Dependencies.AddUnit('win32wspairsplitter');
+    t.Dependencies.AddUnit('win32wsshellctlrs');
     t.Dependencies.AddUnit('win32wsspin');
     t.Dependencies.AddUnit('win32wsstdctrls');
     t.Dependencies.AddUnit('win32wstoolwin');
@@ -535,6 +536,7 @@ begin
     P.Targets.AddImplicitUnit('win32/win32wsmenus.pp');
     P.Targets.AddImplicitUnit('win32/win32wspairsplitter.pp');
     P.Targets.AddImplicitUnit('win32/win32wsspin.pp');
+    P.Targets.AddImplicitUnit('win32/win32wsshellctrls.pp');
     P.Targets.AddImplicitUnit('win32/win32wsstdctrls.pp');
     P.Targets.AddImplicitUnit('win32/win32wstoolwin.pp');
     P.Targets.AddImplicitUnit('wince/interfaces.pp');

lcl/interfaces/gtk/gtkwsfactory.pas

@@ -95,6 +95,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -613,6 +615,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   Result := False;

lcl/interfaces/gtk2/gtk2wsfactory.pas

@@ -99,6 +99,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -618,6 +620,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/gtk3/gtk3wsfactory.pas

@@ -109,6 +109,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -619,6 +621,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/lcl.lpk

@@ -13,79 +13,79 @@
         <UnitOutputDirectory Value="../units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
       </SearchPaths>
       <Conditionals Value="// LCLWidgetType
-if LCLWidgetType+''='' then begin
+if LCLWidgetType+&apos;&apos;=&apos;&apos; then begin
-  if GetIDEValue('OS')=TargetOS then begin
+  if GetIDEValue(&apos;OS&apos;)=TargetOS then begin
     // use the same widgettype as the IDE
-    LCLWidgetType := GetIDEValue('LCLWidgetType');
+    LCLWidgetType := GetIDEValue(&apos;LCLWidgetType&apos;);
-    if LCLWidgetType='nogui' then
+    if LCLWidgetType=&apos;nogui&apos; then
-      LCLWidgetType:='';
+      LCLWidgetType:=&apos;&apos;;
   end;
-  if LCLWidgetType+''='' then begin
+  if LCLWidgetType+&apos;&apos;=&apos;&apos; then begin
-    if (TargetOS='win32') or (TargetOS='win64') then
+    if (TargetOS=&apos;win32&apos;) or (TargetOS=&apos;win64&apos;) then
-      LCLWidgetType := 'win32'
+      LCLWidgetType := &apos;win32&apos;
-    else if TargetOS='wince' then
+    else if TargetOS=&apos;wince&apos; then
-      LCLWidgetType := 'wince'
+      LCLWidgetType := &apos;wince&apos;
-    else if TargetOS='darwin' then
+    else if TargetOS=&apos;darwin&apos; then
-      LCLWidgetType := 'carbon'
+      LCLWidgetType := &apos;carbon&apos;
-    else if (TargetOS='amiga') or (TargetOS='aros') or (TargetOS='morphos') then
+    else if (TargetOS=&apos;amiga&apos;) or (TargetOS=&apos;aros&apos;) or (TargetOS=&apos;morphos&apos;) then
-      LCLWidgetType := 'mui'
+      LCLWidgetType := &apos;mui&apos;
     else
-      LCLWidgetType:='gtk2';
+      LCLWidgetType:=&apos;gtk2&apos;;
   end;
 end;
 
 // widget set specific options
-base := LCLWidgetType+'/';
+base := LCLWidgetType+&apos;/&apos;;
-if LCLWidgetType='gtk3' then
+if LCLWidgetType=&apos;gtk3&apos; then
 begin
-  CustomOptions := '-dgtk3';
+  CustomOptions := &apos;-dgtk3&apos;;
-  UnitPath := base + 'gtk3bindings';
+  UnitPath := base + &apos;gtk3bindings&apos;;
 end else
-if LCLWidgetType='gtk' then
+if LCLWidgetType=&apos;gtk&apos; then
-  CustomOptions := '-dgtk1'
+  CustomOptions := &apos;-dgtk1&apos;
-else if LCLWidgetType='carbon' then begin
+else if LCLWidgetType=&apos;carbon&apos; then begin
-  CustomOptions := '-dcarbon';
+  CustomOptions := &apos;-dcarbon&apos;;
-  UnitPath := base+'objc;'
+  UnitPath := base+&apos;objc;&apos;
-             +base+'pascocoa/appkit;'
+             +base+&apos;pascocoa/appkit;&apos;
-             +base+'pascocoa/foundation';
+             +base+&apos;pascocoa/foundation&apos;;
   IncPath := UnitPath;
-end else if LCLWidgetType='cocoa' then begin
+end else if LCLWidgetType=&apos;cocoa&apos; then begin
-  CustomOptions := '-dcocoa';
+  CustomOptions := &apos;-dcocoa&apos;;
-  if TargetCPU&lt;>'i386' then
+  if TargetCPU&lt;>&apos;i386&apos; then
-    CustomOptions += ' -dNoCarbon';
+    CustomOptions += &apos; -dNoCarbon&apos;;
-end else if LCLWidgetType='wince' then begin
+end else if LCLWidgetType=&apos;wince&apos; then begin
-  CustomOptions := '-dDisableChecks';
+  CustomOptions := &apos;-dDisableChecks&apos;;
-end else if LCLWidgetType='fpgui' then begin
+end else if LCLWidgetType=&apos;fpgui&apos; then begin
   if undefined(fpGUIPlatform) then begin
-    if TargetOS='win32' then
+    if TargetOS=&apos;win32&apos; then
-      fpGUIPlatform := 'gdi'
+      fpGUIPlatform := &apos;gdi&apos;
     else
-      fpGUIPlatform := 'x11';
+      fpGUIPlatform := &apos;x11&apos;;
   end;
-  CustomOptions := ' -dfpgui'+fpGUIPlatform;
+  CustomOptions := &apos; -dfpgui&apos;+fpGUIPlatform;
-  UnitPath := base+'src/gui;'
+  UnitPath := base+&apos;src/gui;&apos;
-             +base+'src/corelib;'
+             +base+&apos;src/corelib;&apos;
-             +base+'src/corelib/'+fpGUIPlatform+';'
+             +base+&apos;src/corelib/&apos;+fpGUIPlatform+&apos;;&apos;
-             +base+'src/corelib/reportengine;';
+             +base+&apos;src/corelib/reportengine;&apos;;
-  IncPath := UnitPath+base+'src;';
+  IncPath := UnitPath+base+&apos;src;&apos;;
-end else if LCLWidgetType='customdrawn' then begin
+end else if LCLWidgetType=&apos;customdrawn&apos; then begin
-  UnitPath := base+'android;';
+  UnitPath := base+&apos;android;&apos;;
 end;
 
 // linker options
-if TargetOS='darwin' then begin
+if TargetOS=&apos;darwin&apos; then begin
-  if LCLWidgetType='gtk' then
+  if LCLWidgetType=&apos;gtk&apos; then
-    UsageLibraryPath := '/usr/X11R6/lib;/sw/lib'
+    UsageLibraryPath := &apos;/usr/X11R6/lib;/sw/lib&apos;
-  else if LCLWidgetType='gtk2' then
+  else if LCLWidgetType=&apos;gtk2&apos; then
-    UsageLibraryPath := '/usr/X11R6/lib;/sw/lib;/sw/lib/pango-ft219/lib'
+    UsageLibraryPath := &apos;/usr/X11R6/lib;/sw/lib;/sw/lib/pango-ft219/lib&apos;
-  else if LCLWidgetType='carbon' then begin
+  else if LCLWidgetType=&apos;carbon&apos; then begin
-    UsageLinkerOptions := '-framework Carbon'
+    UsageLinkerOptions := &apos;-framework Carbon&apos;
-      +' -framework OpenGL'
+      +&apos; -framework OpenGL&apos;
-      +' ''-dylib_file'' ''/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib''';
+      +&apos; &apos;&apos;-dylib_file&apos;&apos; &apos;&apos;/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib&apos;&apos;&apos;;
-  end else if LCLWidgetType='cocoa' then
+  end else if LCLWidgetType=&apos;cocoa&apos; then
-    UsageLinkerOptions := '-framework Cocoa';
+    UsageLinkerOptions := &apos;-framework Cocoa&apos;;
-end else if TargetOS='solaris' then begin
+end else if TargetOS=&apos;solaris&apos; then begin
-  UsageLibraryPath:='/usr/X11R6/lib';
+  UsageLibraryPath:=&apos;/usr/X11R6/lib&apos;;
 end;"/>
       <BuildMacros>
         <Count Value="2"/>
@@ -130,7 +130,7 @@ end;"/>
     <License Value="modified LGPL-2
 "/>
     <Version Major="2" Minor="1"/>
-    <Files Count="487">
+    <Files Count="488">
       <Item1>
         <Filename Value="carbon/agl.pp"/>
         <AddToUsesPkgSection Value="False"/>
@@ -2413,7 +2413,13 @@ end;"/>
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="CocoaWSCheckLst"/>
       </Item487>
+      <Item488>
+        <Filename Value="win32/win32wsshellctrls.pp"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="win32wsshellctrls"/>
+      </Item488>
     </Files>
+    <CompatibilityMode Value="True"/>
     <LazDoc Paths="../../docs/xml/lcl"/>
     <i18n>
       <EnableI18N Value="True"/>
@@ -2439,28 +2445,28 @@ end;"/>
           <_Value Value="case Defaults.OS of"/>
         </_CustomCodeItem1>
         <_CustomCodeItem2 Items="Value">
-          <_Value Value="  darwin        : LCLWidgetTypeVariant.DefaultPackageVariantName:='carbon';"/>
+          <_Value Value="  darwin        : LCLWidgetTypeVariant.DefaultPackageVariantName:=&apos;carbon&apos;;"/>
         </_CustomCodeItem2>
         <_CustomCodeItem3 Items="Value">
-          <_Value Value="  win32, win64  : LCLWidgetTypeVariant.DefaultPackageVariantName:='win32';"/>
+          <_Value Value="  win32, win64  : LCLWidgetTypeVariant.DefaultPackageVariantName:=&apos;win32&apos;;"/>
         </_CustomCodeItem3>
         <_CustomCodeItem4 Items="Value">
-          <_Value Value="  wince         : LCLWidgetTypeVariant.DefaultPackageVariantName:='wince';"/>
+          <_Value Value="  wince         : LCLWidgetTypeVariant.DefaultPackageVariantName:=&apos;wince&apos;;"/>
         </_CustomCodeItem4>
         <_CustomCodeItem5 Items="Value">
           <_Value Value="else"/>
         </_CustomCodeItem5>
         <_CustomCodeItem6 Items="Value">
-          <_Value Value="  LCLWidgetTypeVariant.DefaultPackageVariantName:='gtk2';"/>
+          <_Value Value="  LCLWidgetTypeVariant.DefaultPackageVariantName:=&apos;gtk2&apos;;"/>
         </_CustomCodeItem6>
         <_CustomCodeItem7 Items="Value">
           <_Value Value="end;"/>
         </_CustomCodeItem7>
         <_CustomCodeItem8 Items="Value">
-          <_Value Value="P.Dependencies.Add('gtk2', AllUnixOSes+[Win32,Win64]-[darwin,iphonesim,Android]);"/>
+          <_Value Value="P.Dependencies.Add(&apos;gtk2&apos;, AllUnixOSes+[Win32,Win64]-[darwin,iphonesim,Android]);"/>
         </_CustomCodeItem8>
         <_CustomCodeItem9 Items="Value">
-          <_Value Value="gtk3VariantItem.IncludePath.add('gtk3/gtk3bindings');"/>
+          <_Value Value="gtk3VariantItem.IncludePath.add(&apos;gtk3/gtk3bindings&apos;);"/>
         </_CustomCodeItem9>
         <_PackageVariants Items="Items">
           <_Items Items="Count/Item1">

lcl/interfaces/mui/muiwsfactory.pas

@@ -99,6 +99,10 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
+// LazDeviceAPIs
+function RegisterLazDeviceAPIs: Boolean;
 
 implementation
 
@@ -531,6 +535,16 @@ begin
   Result := False;
 end;
 
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
+function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
+begin
+  Reult := False;
+end;
+
 
 end.
 

lcl/interfaces/nogui/noguiwsfactory.pas

@@ -93,6 +93,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -488,6 +490,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/qt/qtwsfactory.pas

@@ -94,6 +94,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -553,6 +555,12 @@ begin
   Result := True;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/qt5/qtwsfactory.pas

@@ -94,6 +94,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -553,6 +555,12 @@ begin
   Result := True;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/win32/win32wsfactory.pas

@@ -5,7 +5,7 @@ unit Win32WSFactory;
 interface
 uses
   Classes, Controls, ComCtrls, ImgList, Calendar, StdCtrls, Spin,
-  Dialogs, ExtCtrls, ExtDlgs, Buttons, CheckLst, Forms, Grids, Menus,
+  Dialogs, ExtCtrls, ExtDlgs, Buttons, CheckLst, Forms, Grids, Menus, ShellCtrls,
   WSLCLClasses;
 
 // imglist
@@ -94,6 +94,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -111,6 +113,7 @@ uses
   Win32WSGrids,
   Win32WSImgList,
   Win32WSMenus,
+  Win32WSShellCtrls,
   Win32WSSpin,
   Win32WSStdCtrls;
 
@@ -556,6 +559,13 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  RegisterWSComponent(TCustomShellTreeView, TWin32WSCustomShellTreeView);
+  Result := True;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/interfaces/win32/win32wsshellctrls.pp

@@ -0,0 +1,105 @@
+{
+ *****************************************************************************
+ *                              WSShellCtrls.pp                              * 
+ *                              -------------                                * 
+ *                                                                           *
+ *                                                                           *
+ *****************************************************************************
+
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+unit win32wsshellctrls;
+
+{$mode objfpc}{$H+}
+{$I win32defines.inc}
+
+interface
+
+uses
+  Classes, ComCtrls, ShelLCtrls, Types,
+////////////////////////////////////////////////////
+// To get as little as posible circles,
+// uncomment only when needed for registration
+////////////////////////////////////////////////////
+//  Graphics, ImgList, Controls, ShellCtrls,
+////////////////////////////////////////////////////
+  WSShellCtrls;
+
+type
+
+  { TWin32WSCustomShellTreeView }
+
+  TWin32WSCustomShellTreeView = class(TWSCustomShellTreeView)
+  published
+    class function DrawBuiltInIcon(ATreeView: TCustomShellTreeView; ANode: TTreeNode;
+      ARect: TRect): TSize; override;
+    class function GetBuiltinIconSize: TSize; override;
+  end;
+
+
+implementation
+
+uses
+  windows, shellapi, graphics;
+
+var
+  ShellIconSize: TSize = (CX: -1; CY: -1);
+
+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;
+
+
+{ TWin32WSCustomShellTreeView }
+
+class function TWin32WSCustomShellTreeView.DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+  ANode: TTreeNode; ARect: TRect): TSize;
+var
+  filename: WideString;
+  ico: TIcon;
+begin
+  fileName := ATreeView.GetPathFromNode(ANode);
+  ico := GetShellIcon(fileName);
+  try
+    ATreeView.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;
+
+class function TWin32WSCustomShellTreeView.GetBuiltinIconSize: TSize;
+var
+  ico: TIcon;
+begin
+  if (ShellIconSize.CX = -1) and (ShellIconSize.CY = -1) then
+  begin
+    ico := GetShellIcon(WideString('C:'));
+    try
+      Result := Types.Size(ico.Width, ico.Height);
+      ShellIconSize := Result;
+    finally
+      ico.Free;
+    end;
+  end else
+    Result := ShellIconSize;
+end;
+
+
+end.

lcl/interfaces/wince/wincewsfactory.pas

@@ -94,6 +94,8 @@ function RegisterPairSplitterSide: Boolean;
 function RegisterCustomPairSplitter: Boolean;
 function RegisterCustomFloatSpinEdit: Boolean;
 function RegisterCustomRubberBand: Boolean;
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean;
 // LazDeviceAPIs
 function RegisterLazDeviceAPIs: Boolean;
 
@@ -543,6 +545,12 @@ begin
   Result := False;
 end;
 
+// ShellCtrls
+function RegisterCustomShellTreeView: Boolean; alias : 'WSRegisterCustomShellTreeView';
+begin
+  Result := False;
+end;
+
 function RegisterLazDeviceAPIs: Boolean; alias : 'WSRegisterLazDeviceAPIs';
 begin
   //RegisterWSLazDeviceAPIs(TCDWSLazDeviceAPIs);

lcl/lclbase.lpk

@@ -27,7 +27,7 @@
     <License Value="modified LGPL-2
 "/>
     <Version Major="2" Minor="1"/>
-    <Files Count="286">
+    <Files Count="287">
       <Item1>
         <Filename Value="checklst.pas"/>
         <UnitName Value="CheckLst"/>
@@ -1176,6 +1176,11 @@
         <Filename Value="lclexceptionstacktrace.pas"/>
         <UnitName Value="LCLExceptionStackTrace"/>
       </Item286>
+      <Item287>
+        <Filename Value="widgetset/wsshellctrls.pp"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="WSShellCtrls"/>
+      </Item287>
     </Files>
     <CompatibilityMode Value="True"/>
     <LazDoc Paths="../docs/xml/lcl"/>

lcl/shellctrls.pas

@@ -75,6 +75,7 @@ type
     procedure SetShellListView(const Value: TCustomShellListView);
     procedure SetUseBuiltinIcons(const AValue: Boolean);
   protected
+    class procedure WSRegisterClass; override;
     procedure DoCreateNodeClass(var NewNodeClass: TTreeNodeClass); override;
     procedure Loaded; override;
     function CreateNode: TTreeNode; override;
@@ -84,16 +85,8 @@ 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;
@@ -375,10 +368,10 @@ procedure Register;
 
 implementation
 
+uses WSShellCtrls
 {$ifdef windows}
-//uses Windows, ShellApi;
+  ,Windows, ShellApi
-uses Windows;
+{$endif};
-{$endif}
 
 const
   //no need to localize, it's a message for the programmer
@@ -998,66 +991,21 @@ 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
+    Result := TWSCustomShellTreeViewClass(WidgetSetClass).DrawBuiltinIcon(Self, ANode, ARect)
-    fileName := widestring(GetPathFromNode(ANode));
+  else
-    ico := GetShellIcon(fileName);
+    Result := inherited;
-    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
+    Result := TWSCustomShellTreeViewClass(WidgetsetClass).GetBuiltinIconSize
-    if (FBuiltinIconSize.CX > 0) and (FBuiltinIconSize.CY > 0) then
-      Result := FBuiltinIconSize
   else
-    begin
+    Result := inherited;
-      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
@@ -1407,6 +1355,12 @@ begin
   end;
 end;
 
+class procedure TCustomShellTreeView.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+  RegisterCustomShellTreeView;
+end;
+
 
 { TCustomShellListView }
 

lcl/widgetset/wsfactory.pas

@@ -122,6 +122,8 @@ function WSRegisterCustomPairSplitter: Boolean; external name 'WSRegisterCustomP
 function WSRegisterCustomFloatSpinEdit: Boolean;external name 'WSRegisterCustomFloatSpinEdit';
 // RubberBand
 function WSRegisterCustomRubberBand: Boolean;   external name 'WSRegisterCustomRubberBand';
+// ShellCtrls
+function WSRegisterCustomShellTreeView: Boolean; external name 'WSRegisterCustomShellTreeView';
 // LazDeviceAPIs
 function WSRegisterLazDeviceAPIs: Boolean;   external name 'WSRegisterLazDeviceAPIs';
 

lcl/widgetset/wsshellctrls.pp

@@ -0,0 +1,91 @@
+{
+ *****************************************************************************
+ *                              WSShellCtrls.pp                              * 
+ *                              -------------                                * 
+ *                                                                           *
+ *                                                                           *
+ *****************************************************************************
+
+ *****************************************************************************
+  This file is part of the Lazarus Component Library (LCL)
+
+  See the file COPYING.modifiedLGPL.txt, included in this distribution,
+  for details about the license.
+ *****************************************************************************
+}
+unit WSShellCtrls;
+
+{$mode objfpc}{$H+}
+{$I lcl_defines.inc}
+
+interface
+
+////////////////////////////////////////////////////
+// I M P O R T A N T                                
+////////////////////////////////////////////////////
+// 1) Only class methods allowed
+// 2) Class methods have to be published and virtual
+// 3) To get as little as posible circles, the uses
+//    clause should contain only those LCL units 
+//    needed for registration. WSxxx units are OK
+// 4) To improve speed, register only classes in the 
+//    initialization section which actually 
+//    implement something
+// 5) To enable your XXX widgetset units, look at
+//    the uses clause of the XXXintf.pp
+////////////////////////////////////////////////////
+uses
+  Classes, Types,
+////////////////////////////////////////////////////
+// To get as little as posible circles,
+// uncomment only when needed for registration
+////////////////////////////////////////////////////
+  ShellCtrls, ComCtrls,
+////////////////////////////////////////////////////
+  WSControls, WSFactory, WSLCLClasses;
+
+type
+
+  { TWSCustomShellTreeView }
+
+  TWSCustomShellTreeView = class(TWSCustomControl)
+  published
+    class function DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+      ANode: TTreeNode; ARect: TRect): TSize; virtual;
+    class function GetBuiltinIconSize: TSize; virtual;
+  end;
+  TWSCustomShellTreeViewClass = class of TWSCustomShellTreeView;
+
+procedure RegisterCustomShellTreeView;
+
+implementation
+
+uses
+  LResources;
+
+{ TWSCustomShellTreeView }
+
+class function TWSCustomShellTreeView.DrawBuiltInIcon(ATreeView: TCustomShellTreeView;
+  ANode: TTreeNode; ARect: TRect): TSize;
+begin
+  Result.CX := 0;
+  Result.CY := 0;
+end;
+
+class function TWSCustomShellTreeView.GetBuiltinIconSize: TSize;
+begin
+  Result.CX := 0;
+  Result.CY := 0;
+end;
+
+procedure RegisterCustomShellTreeView;
+const
+  Done: Boolean = False;
+begin
+  if Done then exit;
+  if not WSRegisterCustomShellTreeView then
+    RegisterWSComponent(TCustomShellTreeView, TWSCustomShellTreeView);
+  Done := True;
+end;
+
+end.