paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 02:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

WS, win32: add GetDpiForMonitor

Browse Source 
git-svn-id: trunk@53686 -
This commit is contained in:
ondrej 2016-12-15 08:16:09 +00:00
parent 4245e9efae
commit c52584ecb0
7 changed files with 67 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/include/intfbasewinapi.inc
View File

@ -1034,6 +1034,11 @@ begin
Result := False;
end;
function TWidgetset.GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT;
begin
Result := S_FALSE;
end;
function TWidgetSet.GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
begin
Result := 0;

5
lcl/include/winapi.inc
View File

@ -433,6 +433,11 @@ begin
Result := Widgetset.GetMonitorInfo(hMonitor, lpmi);
end;
function GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT;
begin
Result := Widgetset.GetDpiForMonitor(hmonitor, dpiType, dpiX, dpiY);
end;
function GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
begin
Result := WidgetSet.GetObject(GDIObject, BufSize, Buf);

1
lcl/include/winapih.inc
View File

@ -130,6 +130,7 @@ function GetIconInfo(AIcon: HICON; AIconInfo: PIconInfo): Boolean; {$IFDEF IF_BA
function GetKeyState(nVirtKey: Integer): Smallint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetMapMode(DC: HDC): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetObject(GDIObject: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT;
var PaletteEntries): UINT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

40
lcl/interfaces/win32/win32int.pp
View File

@ -282,6 +282,44 @@ var
MessageStackDepth: string = '';
{$endif}
// Multi Dpi support (not yet in FCL); ToDo: move to FCL
type
TGetDpiForMonitor = function(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT; stdcall;
var
GetDpiForMonitor: TGetDpiForMonitor;
g_pfnGetDpiForMonitor: TGetDpiForMonitor = nil;
g_fShellScalingInitDone: Boolean = False;
function InitShellScalingStubs: Boolean;
var
hShcore: Windows.HMODULE;
begin
if g_fShellScalingInitDone then
Exit(@g_pfnGetDpiForMonitor <> nil);
hShcore := GetModuleHandle('Shcore');
if hShcore<>0 then
begin
Pointer(g_pfnGetDpiForMonitor) := GetProcAddress(hShcore, 'GetDpiForMonitor');
g_fShellScalingInitDone := True;
end else
begin
Pointer(g_pfnGetDpiForMonitor) := nil;
end;
end;
function xGetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType;
out dpiX: UINT; out dpiY: UINT): HRESULT; stdcall;
begin
if InitShellScalingStubs then
Exit(g_pfnGetDpiForMonitor(hmonitor, dpiType, dpiX, dpiY));
dpiX := 0;
dpiY := 0;
Result := S_FALSE;
end;
{$I win32listsl.inc}
{$I win32callback.inc}
{$I win32object.inc}
@ -290,6 +328,8 @@ var
initialization
Pointer(GetDpiForMonitor) := @xGetDpiForMonitor;
SystemCharSetIsUTF8:=true;
MMenuItemInfoSize := sizeof(MENUITEMINFO);

7
lcl/interfaces/win32/win32winapi.inc
View File

@ -1874,6 +1874,13 @@ begin
Result := MultiMon.GetMonitorInfo(hMonitor, LPMonitorInfo(lpmi));
end;
function TWin32WidgetSet.GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType; out dpiX: UINT; out dpiY: UINT): HRESULT;
begin
if WindowsVersion >= wv8_1 then
Result := Win32Int.GetDpiForMonitor(hmonitor, dpiType, dpiX, dpiY)
else
Result := S_FALSE;
end;
{------------------------------------------------------------------------------
Method: GetObject
Params: GDIObj - handle to graphics object of interest

2
lcl/interfaces/win32/win32winapih.inc
View File

@ -111,6 +111,8 @@ function GetIconInfo(AIcon: HICON; AIconInfo: PIconInfo): Boolean; override;
function GetKeyState(NVirtKey: Integer): SmallInt; override;
function GetMapMode(DC: HDC): Integer; override;
function GetMonitorInfo(hMonitor: HMONITOR; lpmi: LCLType.PMonitorInfo): Boolean; override;
function GetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType;
out dpiX: UINT; out dpiY: UINT): HRESULT; override;
function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;
function GetParent(Handle: HWND): HWND; override;
function GetProp(Handle: HWND; Str: PChar): Pointer; override;

7
lcl/lcltype.pp
View File

@ -1113,6 +1113,13 @@ type
PMonitorInfoExW = ^TMonitorInfoExW;
TMonitorInfoExW = tagMonitorInfoExW;
MONITOR_DPI_TYPE = (
MDT_EFFECTIVE_DPI = 0,
MDT_ANGULAR_DPI = 1,
MDT_RAW_DPI = 2,
MDT_DEFAULT = MDT_EFFECTIVE_DPI);
TMonitorDpiType = MONITOR_DPI_TYPE;
{painting stuff}
PDrawItemStruct = ^TDrawItemStruct;