mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-11 04:08:21 +02:00
LCL: TThemeServices.GetStockImage overload with Width&Height
This commit is contained in:
Ondrej Pokorny
parent
dd3cb67d40
commit
7e92650038
@ -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}
|
||||
|
||||
@ -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;
|
||||
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;
|
||||
function TWin32ThemeServices.GetImageAndMaskFromIcon(const Icon: HICON; 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
|
||||
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);
|
||||
Result := GetIconInfo(Icon, @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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user