ADD: Load network drive icon in background thread

src/fmain.pas

@@ -744,6 +744,9 @@ type
     procedure UpdateDriveToolbarSelection(DriveToolbar: TKAStoolBar; FileView: TFileView);
     procedure UpdateDriveButtonSelection(DriveButton: TSpeedButton; FileView: TFileView);
     procedure UpdateSelectedDrive(ANoteBook: TFileViewNotebook);
+{$IF DEFINED(MSWINDOWS)}
+    procedure OnDriveIconLoaded(Data: PtrInt);
+{$ENDIF}
     procedure OnDriveWatcherEvent(EventType: TDriveWatcherEvent; const ADrive: PDrive);
     procedure AppActivate(Sender: TObject);
     procedure AppDeActivate(Sender: TObject);
@@ -912,6 +915,9 @@ uses
   {$ELSE}
   , uColumnsFileView
   {$ENDIF}
+{$IFDEF MSWINDOWS}
+  , uNetworkThread
+{$ENDIF}
   ;
 
 const
@@ -4483,13 +4489,28 @@ begin
 
   { Delete drives that in drives black list }
   for I:= DrivesList.Count - 1 downto 0 do
+  begin
+    Drive := DrivesList[I];
+    if (gDriveBlackListUnmounted and not Drive^.IsMounted) or
+       MatchesMaskList(Drive^.Path, gDriveBlackList) or
+       MatchesMaskList(Drive^.DeviceId, gDriveBlackList) then
+      DrivesList.Remove(I);
+  end;
+
+{$IF DEFINED(MSWINDOWS)}
+  if (not (cimDrive in gCustomIcons)) then
+  begin
+    for I:= DrivesList.Count - 1 downto 0 do
     begin
       Drive := DrivesList[I];
-      if (gDriveBlackListUnmounted and not Drive^.IsMounted) or
-         MatchesMaskList(Drive^.Path, gDriveBlackList) or
-         MatchesMaskList(Drive^.DeviceId, gDriveBlackList) then
-        DrivesList.Remove(I);
+      if Drive^.DriveType = dtNetwork then
+      begin
+        with TNetworkDriveLoader.Create(Drive, dskRight.GlyphSize, clBtnFace, @OnDriveIconLoaded) do
+          Start;
+      end;
     end;
+  end;
+{$ENDIF}
 
   UpdateDriveList(DrivesList);
 
@@ -4567,7 +4588,7 @@ begin
       Button := dskPanel.AddButton(ToolItem);
 
       // Set drive icon.
-      BitmapTmp := PixMapManager.GetDriveIcon(Drive, dskPanel.GlyphSize, clBtnFace);
+      BitmapTmp := PixMapManager.GetDriveIcon(Drive, dskPanel.GlyphSize, clBtnFace, False);
       Button.Glyph.Assign(BitmapTmp);
       FreeAndNil(BitmapTmp);
 
@@ -6003,6 +6024,37 @@ begin
   end;
 end;
 
+{$IF DEFINED(MSWINDOWS)}
+procedure TfrmMain.OnDriveIconLoaded(Data: PtrInt);
+var
+  ADrive: TKASDriveItem;
+  AIcon: TDriveIcon absolute Data;
+
+  procedure UpdateDriveIcon(dskPanel: TKASToolBar);
+  var
+    Index: Integer;
+  begin
+    for Index:= 0 to dskPanel.ButtonCount - 1 do
+    begin
+     if dskPanel.Buttons[Index].ToolItem is TKASDriveItem then
+     begin
+       ADrive:= TKASDriveItem(dskPanel.Buttons[Index].ToolItem);
+       if SameText(ADrive.Drive^.Path, AIcon.Drive.Path) then
+       begin
+         dskPanel.Buttons[Index].Glyph.Assign(AIcon.Bitmap);
+         Break;
+       end;
+     end;
+    end;
+  end;
+
+begin
+  UpdateDriveIcon(dskLeft);
+  UpdateDriveIcon(dskRight);
+  AIcon.Free;
+end;
+{$ENDIF}
+
 procedure TfrmMain.UpdateSelectedDrives;
 begin
   if gDriveBar1 then

src/platform/upixmapmanager.pas

@@ -310,7 +310,7 @@ type
     {$ENDIF}
     function GetIconByName(const AIconName: String): PtrInt;
     function GetThemeIcon(const AIconName: String; AIconSize: Integer) : Graphics.TBitmap;
-    function GetDriveIcon(Drive : PDrive; IconSize : Integer; clBackColor : TColor) : Graphics.TBitmap;
+    function GetDriveIcon(Drive : PDrive; IconSize : Integer; clBackColor : TColor; LoadIcon: Boolean = True) : Graphics.TBitmap;
     function GetDefaultDriveIcon(IconSize : Integer; clBackColor : TColor) : Graphics.TBitmap;
     function GetArchiveIcon(IconSize: Integer; clBackColor : TColor) : Graphics.TBitmap;
     function GetFolderIcon(IconSize: Integer; clBackColor : TColor) : Graphics.TBitmap;
@@ -1327,27 +1327,16 @@ begin
 end;
 
 function TPixMapManager.GetSystemArchiveIcon: PtrInt;
-const
-  SIID_ZIPFILE = 105;
 var
   psii: TSHStockIconInfo;
-  SHGetStockIconInfo: function(siid: Int32; uFlags: UINT; var psii: TSHStockIconInfo): HRESULT; stdcall;
 begin
-  Result:= -1;
-  if (Win32MajorVersion > 5) then
-  begin
-    Pointer(SHGetStockIconInfo):= GetProcAddress(GetModuleHandle(Shell32), 'SHGetStockIconInfo');
-    if Assigned(SHGetStockIconInfo) then
-    begin
-      psii.cbSize:= SizeOf(TSHStockIconInfo);
-      if SHGetStockIconInfo(SIID_ZIPFILE, SHGFI_SYSICONINDEX, psii) = S_OK then
-      begin
-        Result:= psii.iSysImageIndex + SystemIconIndexStart;
+  if not SHGetStockIconInfo(SIID_ZIPFILE, SHGFI_SYSICONINDEX, psii) then
+    Result:= -1
+  else begin
+    Result:= psii.iSysImageIndex + SystemIconIndexStart;
 {$IF DEFINED(LCLQT5)}
-        Result := CheckAddSystemIcon(Result);
+    Result := CheckAddSystemIcon(Result);
 {$ENDIF}
-      end;
-    end;
   end;
 end;
 
@@ -2162,13 +2151,14 @@ begin
   end;
 end;
 
-function TPixMapManager.GetDriveIcon(Drive : PDrive; IconSize : Integer; clBackColor : TColor) : Graphics.TBitmap;
+function TPixMapManager.GetDriveIcon(Drive : PDrive; IconSize : Integer; clBackColor : TColor; LoadIcon: Boolean) : Graphics.TBitmap;
 {$IFDEF MSWINDOWS}
 var
   SFI: TSHFileInfoW;
   uFlags: UINT;
   iIconSmall,
   iIconLarge: Integer;
+  psii: TSHStockIconInfo;
 {$ENDIF}
 begin
   if Drive^.DriveType = dtVirtual then
@@ -2181,6 +2171,12 @@ begin
   if ScreenInfo.ColorDepth < 15 then Exit;
   if (not (cimDrive in gCustomIcons)) and (ScreenInfo.ColorDepth > 16) then
     begin
+      if (Win32MajorVersion < 6) and (not LoadIcon) and (Drive^.DriveType = dtNetwork) then
+      begin
+        Result := GetBuiltInDriveIcon(Drive, IconSize, clBackColor);
+        Exit;
+      end;
+
       SFI.hIcon := 0;
       Result := Graphics.TBitMap.Create;
       iIconLarge:= GetSystemMetrics(SM_CXICON);
@@ -2191,19 +2187,22 @@ begin
       else begin
         uFlags := SHGFI_LARGEICON; // Use large icon
       end;
+      uFlags := uFlags or SHGFI_ICON;
 
-      if (SHGetFileInfoW(PWideChar(UTF8Decode(Drive^.Path)), 0, SFI,
-                         SizeOf(SFI), uFlags or SHGFI_ICON) <> 0) then
-      begin
-        if (SFI.hIcon <> 0) then
-        try
-          Result:= BitmapCreateFromHICON(SFI.hIcon);
-          Result.Masked := True; // Need to explicitly set Masked=True, Lazarus issue #0019747
-          if (IconSize <> iIconSmall) and (IconSize <> iIconLarge) then // non standart icon size
-            Result := StretchBitmap(Result, IconSize, clBackColor, True);
-        finally
-          DestroyIcon(SFI.hIcon);
-        end;
+      if (not LoadIcon) and (Drive^.DriveType = dtNetwork) and SHGetStockIconInfo(SIID_DRIVENET, uFlags, psii) then
+        SFI.hIcon:= psii.hIcon
+      else if (SHGetFileInfoW(PWideChar(UTF8Decode(Drive^.Path)), 0, SFI, SizeOf(SFI), uFlags) = 0) then begin
+        SFI.hIcon := 0;
+      end;
+
+      if (SFI.hIcon <> 0) then
+      try
+        Result:= BitmapCreateFromHICON(SFI.hIcon);
+        Result.Masked := True; // Need to explicitly set Masked=True, Lazarus issue #0019747
+        if (IconSize <> iIconSmall) and (IconSize <> iIconLarge) then // non standart icon size
+          Result := StretchBitmap(Result, IconSize, clBackColor, True);
+      finally
+        DestroyIcon(SFI.hIcon);
       end;
     end // not gCustomDriveIcons
   else

src/platform/win/unetworkthread.pas

@@ -5,10 +5,19 @@ unit uNetworkThread;
 interface
 
 uses
-  Classes, SysUtils, SyncObjs, JwaWinNetWk, Windows;
+  Classes, SysUtils, SyncObjs, JwaWinNetWk, Windows, Forms, Graphics, uDrive;
 
 type
 
+  { TDriveIcon }
+
+  TDriveIcon = class
+  public
+    Drive: TDrive;
+    Bitmap: TBitmap;
+    destructor Destroy; override;
+  end;
+
   { TNetworkThread }
 
   TNetworkThread = class(TThread)
@@ -25,10 +34,57 @@ type
     class function Connect(lpLocalName, lpRemoteName: LPWSTR; dwType: DWORD; CheckOperationState: TThreadMethod = nil): Integer;
   end;
 
+  { TNetworkDriveLoader }
+
+  TNetworkDriveLoader = class(TThread)
+  private
+    FDrive: TDrive;
+    FIconSize: Integer;
+    FBackColor: TColor;
+    FCallback: TDataEvent;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(ADrive: PDrive; AIconSize: Integer; ABackColor: TColor; ACallback: TDataEvent); reintroduce;
+  end;
+
 implementation
 
 uses
-  uMyWindows;
+   uMyWindows, uPixMapManager;
+
+{ TDriveIcon }
+
+destructor TDriveIcon.Destroy;
+begin
+  Bitmap.Free;
+  inherited Destroy;
+end;
+
+{ TNetworkDriveLoader }
+
+procedure TNetworkDriveLoader.Execute;
+var
+  AIcon: TDriveIcon;
+  AData: PtrInt absolute AIcon;
+begin
+  AIcon:= TDriveIcon.Create;
+  AIcon.Drive:= FDrive;
+  AIcon.Bitmap:= PixMapManager.GetDriveIcon(@FDrive, FIconSize, FBackColor);
+
+  Application.QueueAsyncCall(FCallback, AData);
+end;
+
+constructor TNetworkDriveLoader.Create(ADrive: PDrive; AIconSize: Integer;
+  ABackColor: TColor; ACallback: TDataEvent);
+begin
+  FDrive:= ADrive^;
+  FIconSize:= AIconSize;
+  FBackColor:= ABackColor;
+  FCallback:= ACallback;
+  inherited Create(True);
+  FreeOnTerminate:= True;
+end;
 
 { TNetworkThread }