paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-07 09:16:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: fix GetDpiForMonitor SIGSEGV if Shcore is not available (e.g. on MS Windows Server 2012 R2)

Browse Source 
git-svn-id: trunk@56180 -
This commit is contained in:
ondrej 2017-10-24 20:45:16 +00:00
parent a8df3d1f7d
commit 9823f61682
1 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -296,19 +296,18 @@ function InitShellScalingStubs: Boolean;
var
hShcore: Windows.HMODULE;
begin
if g_fShellScalingInitDone then
Exit(@g_pfnGetDpiForMonitor <> nil);
hShcore := GetModuleHandle('Shcore');
if hShcore<>0 then
if not g_fShellScalingInitDone then
begin
Pointer(g_pfnGetDpiForMonitor) := GetProcAddress(hShcore, 'GetDpiForMonitor');
hShcore := GetModuleHandle('Shcore');
if hShcore<>0 then
Pointer(g_pfnGetDpiForMonitor) := GetProcAddress(hShcore, 'GetDpiForMonitor')
else
Pointer(g_pfnGetDpiForMonitor) := nil;
g_fShellScalingInitDone := True;
end else
begin
Pointer(g_pfnGetDpiForMonitor) := nil;
end;
Result := (Pointer(g_pfnGetDpiForMonitor)<>nil) and (@g_pfnGetDpiForMonitor <> nil);
end;
function xGetDpiForMonitor(hmonitor: HMONITOR; dpiType: TMonitorDpiType;