PB 5.60 (x64) running under Windows 10 1703 on a Dell portable with a High DPI screen.
I've used Little John's code (
read his post here) as an include file and tested it mercilessly. I've found it to work perfectly every single time
when I compile my program. However, I kept coming across a font problem when running my code from within the IDE : often
(not every time, which, in itself, is baffling... 
) the font would be too large, even though it turned out to be OK in the compiled output.
Using lots of
Debug statements everywhere, I finally spotted the problem: when
DPI awareness is inherited from the parent, the font size gets scaled accordingly, which works fine for the compiled result, but displays wrongly when running the code from within the IDE.
So I added a test for inheritance
(that's what I called it; you may disagree 
), allowing the font size to be scaled or not, depending on whether the code is compiled or run from the IDE.
Rather than posting a heavily modified file or pointing out every single line where I've made changes, I simply reproduce below Little John's entire code, carefully marking 10 lines as either
"Added" or "
Modified":
Code: Select all
; successfully tested with all combinations of
; - Windows XP, 7, 10 Creators update
; - DPI 125%, 150%
; - PB 5.31, 5.44 LTS, 5.60
; modified by Blue (10 lines are marked 'added' or 'modified')
; so that running from inside the IDE displays the same as the compiled output
DeclareModule Std
; [...]
Declare.f FactorDPIx()
Declare.f FactorDPIy()
EndDeclareModule
Module Std
EnableExplicit
; [...]
CompilerIf #PB_Compiler_Version < 540
Structure RTL_OSVERSIONINFOEXW
dwOSVersionInfoSize.l
dwMajorVersion.l
dwMinorVersion.l
dwBuildNumber.l
dwPlatformId.l
szCSDVersion.u[128]
wServicePackMajor.w
wServicePackMinor.w
wSuiteMask.w
wProductType.b
wReserved.b
EndStructure
Prototype.i pRtlGetVersion (*ver.RTL_OSVERSIONINFOEXW)
#STATUS_SUCCESS = 0
Procedure.i _IsWindows81OrNewer()
; In PB 5.31, OSVersion() returns e.g. 90 on Windows 8 and also
; on Windows 10. So with older PB versions that function can't
; be used to check the current Windows version reliably.
; Therefore in order to check whether the current OS is Windows
; 8.1 or newer, this self-written procedure is used here.
;
; out: #True if the currently running OS is Windows 8.1 or newer,
; #False otherwise
Protected ver.RTL_OSVERSIONINFOEXW
Protected RtlGetVersion.pRtlGetVersion
Protected hDLL.i
ver\dwOSVersionInfoSize = SizeOf(ver)
hDLL = OpenLibrary(#PB_Any, "ntdll.dll")
If hDLL
RtlGetVersion = GetFunction(hDLL, "RtlGetVersion")
CloseLibrary(hDLL)
EndIf
If RtlGetVersion = 0 Or RtlGetVersion(@ ver) <> #STATUS_SUCCESS
ProcedureReturn #False
EndIf
If ver\dwPlatformId <> #VER_PLATFORM_WIN32_NT
ProcedureReturn #False
EndIf
If (ver\dwMajorVersion = 6 And ver\dwMinorVersion = 3) Or
ver\dwMajorVersion > 6
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
CompilerEndIf
Prototype.i pIsProcessDPIAware()
Prototype.i pSetProcessDPIAware()
Define s_InitDPI.i=#False, s_ScaleDPIx.f=1.0, s_ScaleDPIy.f=1.0
;-
Procedure _InitScaleDPI()
; Windows 5.0 or higher needed for minimum functionality of this procedure
; [modified after <http://www.purebasic.fr/english/viewtopic.php?f=12&t=40507>, 2010-01-02
; see also <http://msdn.microsoft.com/en-us/library/windows/desktop/dd464660%28v=vs.85%29.aspx>
; <http://blogs.msdn.com/b/oldnewthing/archive/2004/07/14/182971.aspx>
; <http://www.purebasic.fr/english/viewtopic.php?p=462177#p462177>
; <http://www.purebasic.fr/english/viewtopic.php?f=13&t=62043>]
Shared s_InitDPI, s_ScaleDPIx, s_ScaleDPIy
Protected IsProcessDPIAware.pIsProcessDPIAware
Protected SetProcessDPIAware.pSetProcessDPIAware
Protected.i user32, hdc, dlgFont, dpiaware=#False
Protected inherited=#False, dlgFontsize.f = 9.0 ;- . <<< Added
CompilerIf #PB_Compiler_ExecutableFormat = #PB_Compiler_Executable
; Only use this in EXEs, as DLLs inherit DPI from the calling process.
; This part is Windows 6.x+ only (Vista and newer) and must be done before using
; GetDeviceCaps().
user32 = OpenLibrary(#PB_Any, "user32.dll")
If user32
IsProcessDPIAware = GetFunction(user32, "IsProcessDPIAware")
If IsProcessDPIAware
dpiaware = IsProcessDPIAware()
EndIf
CompilerIf #PB_Compiler_IsMainFile
Debug "DPI-aware: " + dpiaware
CompilerEndIf
; If the exe is allready DPI aware (like through a manifest), then we skip using
; the set DPI aware function.
If dpiaware = #False
SetProcessDPIAware = GetFunction(user32, "SetProcessDPIAware")
If SetProcessDPIAware
If SetProcessDPIAware()
CompilerIf #PB_Compiler_IsMainFile
Debug "Set DPI: OK"
CompilerEndIf
EndIf
EndIf
Else ; <<< Added
inherited= #True ;- . <<< Added
EndIf ; <<< Added
CloseLibrary(user32)
EndIf
CompilerEndIf
hdc = GetDC_(#Null) ; get handle to the device context for the entire screen
If hdc
s_ScaleDPIx = GetDeviceCaps_(hdc, #LOGPIXELSX) / 96.0 ; 96 is the default DPI value on Windows.
s_ScaleDPIy = GetDeviceCaps_(hdc, #LOGPIXELSY) / 96.0
ReleaseDC_(#Null, hdc)
EndIf
CompilerIf #PB_Compiler_Version < 540
If _IsWindows81OrNewer()
CompilerIf #PB_Compiler_IsMainFile
Debug "Windows 8.1 or newer"
CompilerEndIf
; Here the font sizes are adjusted automatically.
dlgFont = LoadFont(#PB_Any, "Segoe UI", dlgFontsize, #PB_Font_HighQuality) ;- . <<< Modified
If dlgFont
SetGadgetFont(#PB_Default, FontID(dlgFont))
EndIf
EndIf
CompilerElse
If OSVersion() >= #PB_OS_Windows_8_1
CompilerIf #PB_Compiler_IsMainFile
Debug "Windows 8.1 or newer"
CompilerEndIf
; Here the font sizes are not adjusted automatically.
If Not inherited ; <<< Added
dlgFontsize = 9.0*s_ScaleDPIy ;- . <<< Added
EndIf ; <<< Added
dlgFont = LoadFont(#PB_Any, "Segoe UI", dlgFontsize, #PB_Font_HighQuality) ;- . <<< Modified
If dlgFont
SetGadgetFont(#PB_Default, FontID(dlgFont))
Debug "; " + #PB_Compiler_Line +": font size set to " + dlgFontsize ;- . <<< Added
EndIf
EndIf
CompilerEndIf
s_InitDPI = #True
EndProcedure
;-
Procedure.f FactorDPIx()
Shared s_InitDPI, s_ScaleDPIx
If s_InitDPI = #False
_InitScaleDPI()
EndIf
ProcedureReturn s_ScaleDPIx
EndProcedure
Procedure.f FactorDPIy()
Shared s_InitDPI, s_ScaleDPIy
If s_InitDPI = #False
_InitScaleDPI()
EndIf
ProcedureReturn s_ScaleDPIy
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
; -- Demo
EnableExplicit
Global g_ScaleDPIx.f, g_ScaleDPIy.f
g_ScaleDPIx = Std::FactorDPIx()
g_ScaleDPIy = Std::FactorDPIy()
Macro DPIx (_x_)
(_x_) * g_ScaleDPIx
EndMacro
Macro DPIy (_y_)
(_y_) * g_ScaleDPIy
EndMacro
If OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, DPIx(120), DPIy(70), "" ) = 0
MessageRequester("Fatal error", "Can't open main window.")
End
EndIf
TextGadget(#PB_Any, DPIx(30), DPIy(20), DPIx(60), DPIy(20), "DPI: " + StrF(100*g_ScaleDPIy,0) + " %", #PB_Text_Border)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
CompilerEndIf
On my system, I've reworded the code to my liking, and made it into an include file, which has worked for me without fail ever since I started using it. I've tested th solution on a different machine with a regular 96.0 DPI screen and it also works well there. I've not been able, however, to test it for all the combinations that Little John looked into.
This is only a slight enhancement/correction to Little John's code.
I'm very grateful to him for a smart, simple and effective solution to the DPI problem.
