LCL: TThemeServices.GetStockImage overload with Width&Height

lcl/interfaces/win32/win32int.pp

@@ -30,7 +30,7 @@ interface
 }
 uses
   Windows, // keep as first
-  Classes, SysUtils, RtlConsts, ActiveX, MultiMon, CommCtrl,
+  Classes, SysUtils, RtlConsts, ActiveX, MultiMon, CommCtrl, ctypes,
   {$IF FPC_FULLVERSION>=30000}
   character,
   {$ENDIF}
@@ -264,6 +264,7 @@ function GetSystemMetricsForDpi(nIndex: Integer; dpi: UINT): Integer;
 function GetDpiForWindow(hwnd: HWND): UINT;
 function AdjustWindowRectExForDpi(const lpRect: LPRECT; dwStyle: DWORD; bMenu: BOOL; dwExStyle: DWORD; dpi: UINT): BOOL;
 function GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT;
+function LoadIconWithScaleDown(hinst:HINST; pszName:LPCWStr;cx:cint;cy:cint;var phico: HICON ):HRESULT;
 
 implementation
 
@@ -311,12 +312,14 @@ type
   TGetDpiForWindow = function(hwnd: HWND): UINT; stdcall;
   TAdjustWindowRectExForDpi = function(const lpRect: LPRECT; dwStyle: DWORD; bMenu: BOOL; dwExStyle: DWORD; dpi: UINT): BOOL; stdcall;
   TGetSystemMetricsForDpi = function (nIndex: Integer; dpi: UINT): Integer; stdcall;
+  TLoadIconWithScaleDown = function ( hinst:HINST; pszName:LPCWStr;cx:cint;cy:cint;var phico: HICON ):HRESULT; stdcall;
 
 var
   g_GetDpiForMonitor: TGetDpiForMonitor = nil;
   g_GetDpiForWindow: TGetDpiForWindow = nil;
   g_AdjustWindowRectExForDpi: TAdjustWindowRectExForDpi = nil;
   g_GetSystemMetricsForDpi: TGetSystemMetricsForDpi = nil;
+  g_LoadIconWithScaleDown: TLoadIconWithScaleDown = nil;
   g_HighDPIAPIDone: Boolean = False;
 
 procedure InitHighDPIAPI;
@@ -338,6 +341,10 @@ begin
     Pointer(g_GetSystemMetricsForDpi) := GetProcAddress(lib, 'GetSystemMetricsForDpi');
   end;
 
+  lib := LoadLibrary(comctl32);
+  if lib<>0 then
+    Pointer(g_LoadIconWithScaleDown) := GetProcAddress(lib, 'LoadIconWithScaleDown');
+
   g_HighDPIAPIDone := True;
 end;
 
@@ -382,6 +389,15 @@ begin
   end;
 end;
 
+function LoadIconWithScaleDown(hinst:HINST; pszName:LPCWStr;cx:cint;cy:cint;var phico: HICON ):HRESULT;
+begin
+  InitHighDPIAPI;
+  if Assigned(g_LoadIconWithScaleDown) then
+    Result := g_LoadIconWithScaleDown(hinst, pszName, cx, cy, phico)
+  else
+    Result := S_FALSE;
+end;
+
 {$I win32listsl.inc}
 {$I win32callback.inc}
 {$I win32object.inc}

lcl/interfaces/win32/win32themes.pas

@@ -7,11 +7,11 @@ interface
 
 uses
   // os
-  Windows, UxTheme, Win32Proc, Win32Extra,
+  Windows, UxTheme, Win32Proc, Win32Extra, Win32Int,
   // rtl
   Classes, SysUtils,
   // lcl
-  Controls, Graphics, Themes, LCLType, LazUTF8;
+  Controls, Graphics, Themes, LCLType, InterfaceBase, LazUTF8;
   
 type
 
@@ -30,12 +30,15 @@ type
     
     function InternalColorToRGB(Details: TThemedElementDetails; Color: TColor): COLORREF; override;
     procedure InternalDrawParentBackground(Window: HWND; Target: HDC; Bounds: PRect); override;
+
+    function GetImageAndMaskFromIcon(const Icon: HICON; out Image, Mask: HBITMAP): Boolean;
   public
     destructor Destroy; override;
 
     function GetDetailSize(Details: TThemedElementDetails): TSize; override;
     function GetDetailRegion(DC: HDC; Details: TThemedElementDetails; const R: TRect): HRGN; override;
     function GetStockImage(StockID: LongInt; out Image, Mask: HBitmap): Boolean; override;
+    function GetStockImage(StockID: LongInt; const AWidth, AHeight: Integer; out Image, Mask: HBitmap): Boolean; override;
     function GetOption(AOption: TThemeOption): Integer; override;
     function GetTextExtent(DC: HDC; Details: TThemedElementDetails; const S: String; Flags: Cardinal; BoundingRect: PRect): TRect; override;
 
@@ -129,6 +132,7 @@ const
   IDI_EXCLAMATION = System.MakeIntResource(32515);
   IDI_ASTERISK    = System.MakeIntResource(32516);
   IDI_WINLOGO     = System.MakeIntResource(32517); // XP only
+  IDI_SHIELD      = System.MakeIntResource(32518);
 
   IDI_WARNING     = IDI_EXCLAMATION;
   IDI_ERROR       = IDI_HAND;
@@ -185,19 +189,8 @@ begin
     Result := inherited GetDetailSize(Details);
 end;
 
-function TWin32ThemeServices.GetDetailRegion(DC: HDC;
+function TWin32ThemeServices.GetImageAndMaskFromIcon(const Icon: HICON; out Image, Mask: HBITMAP): Boolean;
-  Details: TThemedElementDetails; const R: TRect): HRGN;
-begin
-  Result := 0;
-  if ThemesEnabled then
-    GetThemeBackgroundRegion(GetTheme(Details.Element), DC, Details.Part, Details.State, R, Result)
-  else
-    Result := inherited;
-end;
-
-function TWin32ThemeServices.GetStockImage(StockID: LongInt; out Image, Mask: HBitmap): Boolean;
 var
-  IconHandle: HIcon;
   IconInfo: TIconInfo;
   Bitmap: Windows.TBitmap;
   x, y: Integer;
@@ -205,38 +198,9 @@ var
   Pixel: PRGBAQuad;
   SHIconInfo: TSHSTOCKICONINFO;
 begin
-  case StockID of
+  Result := GetIconInfo(Icon, @IconInfo);
-    idDialogWarning: IconHandle := LoadImage(0, IDI_WARNING, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
-    idDialogError  : IconHandle := LoadImage(0, IDI_ERROR, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
-    idDialogInfo   : IconHandle := LoadImage(0, IDI_INFORMATION, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
-    idDialogConfirm: IconHandle := LoadImage(0, IDI_QUESTION, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
-    idDialogShield:
-      begin
-        SHIconInfo := Default(TSHSTOCKICONINFO);
-        SHIconInfo.cbSize := SizeOf(SHIconInfo);
-        if (SHGetStockIconInfo(SIID_SHIELD, SHGFI_ICON or SHGFI_LARGEICON, @SHIconInfo) = S_OK) then
-          IconHandle := SHIconInfo.hIcon
-        else
-          IconHandle := 0;
-      end;
-    idButtonShield:
-      begin
-        SHIconInfo := Default(TSHSTOCKICONINFO);
-        SHIconInfo.cbSize := SizeOf(SHIconInfo);
-        if (SHGetStockIconInfo(SIID_SHIELD, SHGFI_ICON or SHGFI_SMALLICON, @SHIconInfo) = S_OK) then
-          IconHandle := SHIconInfo.hIcon
-        else
-          IconHandle := 0;
-      end;
-  else
-    IconHandle := 0;
-  end;
-  Result := (IconHandle <> 0) and GetIconInfo(IconHandle, @IconInfo);
   if not Result then
-  begin
-    Result := inherited GetStockImage(StockID, Image, Mask);
     Exit;
-  end;
 
   Image := IconInfo.hbmColor;
   Mask := IconInfo.hbmMask;
@@ -272,6 +236,75 @@ begin
   end;
 end;
 
+function TWin32ThemeServices.GetDetailRegion(DC: HDC;
+  Details: TThemedElementDetails; const R: TRect): HRGN;
+begin
+  Result := 0;
+  if ThemesEnabled then
+    GetThemeBackgroundRegion(GetTheme(Details.Element), DC, Details.Part, Details.State, R, Result)
+  else
+    Result := inherited;
+end;
+
+function TWin32ThemeServices.GetStockImage(StockID: LongInt; out Image, Mask: HBitmap): Boolean;
+var
+  IconHandle: HIcon;
+  SHIconInfo: TSHSTOCKICONINFO;
+begin
+  case StockID of
+    idDialogWarning: IconHandle := LoadImage(0, IDI_WARNING, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
+    idDialogError  : IconHandle := LoadImage(0, IDI_ERROR, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
+    idDialogInfo   : IconHandle := LoadImage(0, IDI_INFORMATION, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
+    idDialogConfirm: IconHandle := LoadImage(0, IDI_QUESTION, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE or LR_SHARED);
+    idDialogShield:
+      begin
+        SHIconInfo := Default(TSHSTOCKICONINFO);
+        SHIconInfo.cbSize := SizeOf(SHIconInfo);
+        if (SHGetStockIconInfo(SIID_SHIELD, SHGFI_ICON or SHGFI_LARGEICON, @SHIconInfo) = S_OK) then
+          IconHandle := SHIconInfo.hIcon
+        else
+          IconHandle := 0;
+      end;
+    idButtonShield:
+      begin
+        SHIconInfo := Default(TSHSTOCKICONINFO);
+        SHIconInfo.cbSize := SizeOf(SHIconInfo);
+        if (SHGetStockIconInfo(SIID_SHIELD, SHGFI_ICON or SHGFI_SMALLICON, @SHIconInfo) = S_OK) then
+          IconHandle := SHIconInfo.hIcon
+        else
+          IconHandle := 0;
+      end;
+  else
+    IconHandle := 0;
+  end;
+  Result := (IconHandle <> 0) and GetImageAndMaskFromIcon(IconHandle, Image, Mask);
+  if not Result then
+  begin
+    Result := inherited GetStockImage(StockID, Image, Mask);
+    Exit;
+  end;
+end;
+
+function TWin32ThemeServices.GetStockImage(StockID: LongInt; const AWidth, AHeight: Integer; out Image,
+  Mask: HBitmap): Boolean;
+const
+  WIN_ICONS: array[idDialogWarning..idDialogShield] of PWideChar = (IDI_WARNING, IDI_ERROR, IDI_INFORMATION, IDI_QUESTION, IDI_SHIELD);
+var
+  IconHandle: HICON;
+  Ico: TIcon;
+begin
+  IconHandle := 0;
+  Result := (StockID>=Low(WIN_ICONS)) and (StockID<=High(WIN_ICONS)) and (WIN_ICONS[StockID]<>nil)
+    and (LoadIconWithScaleDown(0, WIN_ICONS[StockID], AWidth, AHeight, IconHandle)=S_OK);
+
+  Result := (IconHandle <> 0) and GetImageAndMaskFromIcon(IconHandle, Image, Mask);
+  if not Result then
+  begin
+    Result := inherited GetStockImage(StockID, Image, Mask);
+    Exit;
+  end;
+end;
+
 function TWin32ThemeServices.GetOption(AOption: TThemeOption): Integer;
 begin
   case AOption of

lcl/themes.pas

@@ -480,6 +480,7 @@ type
     function GetDetailSize(Details: TThemedElementDetails): TSize; virtual;
     function GetDetailRegion(DC: HDC; Details: TThemedElementDetails; const R: TRect): HRGN; virtual;
     function GetStockImage(StockID: LongInt; out Image, Mask: HBitmap): Boolean; virtual;
+    function GetStockImage(StockID: LongInt; const AWidth, AHeight: Integer; out Image, Mask: HBitmap): Boolean; virtual;
     function GetOption(AOption: TThemeOption): Integer; virtual;
     function GetTextExtent(DC: HDC; Details: TThemedElementDetails; const S: String; Flags: Cardinal; BoundingRect: PRect): TRect; virtual;
 
@@ -1920,6 +1921,12 @@ begin
   Result := False;
 end;
 
+function TThemeServices.GetStockImage(StockID: LongInt; const AWidth, AHeight: Integer; out Image,
+  Mask: HBitmap): Boolean;
+begin
+  Result := False;
+end;
+
 function TThemeServices.GetOption(AOption: TThemeOption): Integer;
 begin
   case AOption of