The following examples for DPI awareness PM v2 demonstrate how to replace the contents of the manifest file and how to use the native commands of PB.
(Not tested in DPI awareness PM v1 mode.)
Unfortunately, this method is thread-unsafe.
1. Compile the following code to generate the new "porc.exe" file.
2. Rename the "porc.exe" file in the "Compilers" folder to "porc-o.exe".
3. Copy the newly created "porc.exe" file to the "Compilers" folder.
Edit:
Fixed an issue where reading would stop when a blank line appeared.
Code: Select all
DPI_PMv2_2$ = ~" <asmv3:application xmlns:asmv3=\"urn:schemas-microsoft-com:asm.v3\">\n" +
~" <asmv3:windowsSettings>\n" +
~" <dpiAware xmlns=\"http://schemas.microsoft.com/SMI/2005/WindowsSettings\">true/pm</dpiAware>\n" +
~" <dpiAwareness xmlns=\"http://schemas.microsoft.com/SMI/2016/WindowsSettings\">PerMonitorV2, PerMonitor, System</dpiAwareness>\n" +
~" </asmv3:windowsSettings>\n" +
~" </asmv3:application>\n"
Path$ = GetPathPart(ProgramParameter(0))
ManifestFile$ = Path$ + "Manifest"
For i = 0 To CountProgramParameters() - 1
Param$ + ProgramParameter(i) + " "
Next
Param$ = Trim(Param$)
If OpenFile(0, ManifestFile$)
While Eof(0) = 0
Line$ = ReadString(0, #PB_UTF8)
If Line$
If FindString(Line$, "<dpiAware>true</dpiAware>", 20)
NewManifest$ + DPI_PMv2_2$
Else
NewManifest$ + Line$ + #LF$
EndIf
EndIf
Wend
CloseFile(0)
NewManifest$ = Trim(RTrim(NewManifest$, #LF$))
If NewManifest$
DeleteFile(ManifestFile$)
If CreateFile(0, ManifestFile$)
WriteString(0, NewManifest$, #PB_UTF8)
CloseFile(0)
EndIf
EndIf
EndIf
; MessageRequester("" + CountProgramParameters(), Param$)
RunProgram("porc-o.exe", Param$, "", #PB_Program_Hide | #PB_Program_Wait)
Run the code below to verify that it works correctly when the DPI is changed.
Warning: The GetFontDPIAddr function has only been tested in PB v6.30, so problems may occur in other PB versions.
Code: Select all
CompilerIf Not #PB_Compiler_DPIAware
CompilerError "Turn ON the DPI aware option."
CompilerEndIf
Import ""
PB_Desktop_DPIX.l
PB_Desktop_DPIY.l
PB_Desktop_ResolutionX.d
PB_Desktop_ResolutionY.d
PB_Font_Objects.i
EndImport
;- OS Constants.
#STATUS_SUCCESS = 0
; Windows 8.1+
#WM_DPICHANGED = $02E0
; Windows 10 1703+
#WM_GETDPISCALEDSIZE = $02E4
; MONITOR_DPI_TYPE
#MDT_EFFECTIVE_DPI = 0
#MDT_ANGULAR_DPI = 1
#MDT_RAW_DPI = 2
#MDT_DEFAULT = #MDT_EFFECTIVE_DPI
;- App Constants.
#_WIN32_WINNT_VISTA = $0600
#_WIN32_WINNT_WIN7 = $0601
#_WIN32_WINNT_WIN8 = $0602
;#_WIN32_WINNT_WINBLUE = $0603 ; 8.1
#_WIN32_WINNT_WIN81 = $0603
#_WIN32_WINNT_WIN10 = $0A00
#WIN10_BUILD_1607 = $3839 ; 14393 , 1607
#WIN10_BUILD_1703 = $3AD7 ; 15063 , 1703 ;Support for per-monitor DPI awareness v2.
#WIN10_BUILD_1709 = $3FAB ; 16299 , 1709
#WIN10_BUILD_1803 = $42EE ; 17134 , 1803
Enumeration
#Lib_User32
#Lib_Shcore
EndEnumeration
;- OS Structures.
Structure NONCLIENTMETRICS_vista
cbSize.l
iBorderWidth.l
iScrollWidth.l
iScrollHeight.l
iCaptionWidth.l
iCaptionHeight.l
lfCaptionFont.LOGFONT
iSMCaptionWidth.l
iSMCaptionHeight.l
lfSMCaptionFont.LOGFONT
iMenuWidth.l
iMenuHeight.l
lfMenuFont.LOGFONT
lfStatusFont.LOGFONT
lfMessageFont.LOGFONT
iPaddedBorderWidth.l
EndStructure
;- OS APIs (Global var.)
; Windows 8.1+
Prototype.l ptGetDpiForMonitor(hmonitor, dpiType.l, *dpiX, *dpiY)
Global GetDpiForMonitor__.ptGetDpiForMonitor
; Windows 10 1607
Prototype.l ptEnableNonClientDpiScaling(hwnd)
Global EnableNonClientDpiScaling__.ptEnableNonClientDpiScaling
; Windows 10 1607+
Prototype.l ptGetDpiForWindow(hwnd)
Global GetDpiForWindow__.ptGetDpiForWindow
; Windows 10 1607+
Prototype.l ptSystemParametersInfoForDpi(uiAction.l, uiParam.l, *pvParam, fWinIni.l, dpi.l)
Global SystemParametersInfoForDpi__.ptSystemParametersInfoForDpi
;- App Global Variables.
Global g_OSVersion.OSVERSIONINFOEX
Global *g_FontDPI.Long ; Memory address for DPI value of PB default font.
;- App Functions.
Declare.l GetDpiForWindow(hWnd)
Procedure GetOSVersion(*OSVersion.OSVERSIONINFOEX)
Protected Result, LibNtDll = OpenLibrary(#PB_Any, "Ntdll.dll")
If LibNtDll
If *OSVersion
*OSVersion\dwOSVersionInfoSize = SizeOf(OSVERSIONINFOEX)
If CallFunction(LibNtDll, "RtlGetVersion", *OSVersion) = #STATUS_SUCCESS
Result = 1
EndIf
EndIf
CloseLibrary(LibNtDll)
EndIf
ProcedureReturn Result
EndProcedure
Procedure LoadOSFunctions()
If OpenLibrary(#Lib_Shcore, "Shcore.dll")
; Windows 8.1+
GetDpiForMonitor__ = GetFunction(#Lib_Shcore, "GetDpiForMonitor")
EndIf
If OpenLibrary(#Lib_User32, "User32.dll")
; Windows 10 1607
EnableNonClientDpiScaling__ = GetFunction(#Lib_User32, "EnableNonClientDpiScaling")
; Windows 10 1607+
GetDpiForWindow__ = GetFunction(#Lib_User32, "GetDpiForWindow")
; Windows 10 1607+
SystemParametersInfoForDpi__ = GetFunction(#Lib_User32, "SystemParametersInfoForDpi")
EndIf
; This function must always be callable without failure.
If GetDpiForWindow__ = 0
GetDpiForWindow__ = @GetDpiForWindow()
Debug "GetDpiForWindow__ : Using the app's function."
EndIf
EndProcedure
Procedure.l GetSystemDPI()
Protected hDC = CreateDC_("DISPLAY", 0, 0, 0)
Protected DpiX.l
If hDC
DpiX = GetDeviceCaps_(hDC, #LOGPIXELSX)
DeleteDC_(hDC)
EndIf
ProcedureReturn DpiX
EndProcedure
Procedure.l GetDpiForWindow(hWnd)
Protected hMonitor = MonitorFromWindow_(hWnd, #MONITOR_DEFAULTTONEAREST)
Protected DpiX.l, DpiY.l
If hMonitor
; Windows 8.1+
If GetDpiForMonitor__
If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK
ProcedureReturn DpiX
EndIf
EndIf
EndIf
DpiX = GetSystemDPI()
If DpiX = 0 : DpiX = 96 : EndIf
ProcedureReturn DpiX
EndProcedure
Procedure LoadSystemDefaultFont(dpi.l)
Protected Font, Height.l, SystemDPI.l, Prev_FontDPI.l, ncm.NONCLIENTMETRICS_vista
If SystemParametersInfoForDpi__
ncm\cbSize = SizeOf(NONCLIENTMETRICS_vista)
If SystemParametersInfoForDpi__(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS_vista), @ncm, 0, dpi)
Debug #PB_Compiler_Procedure + " - OK: SystemParametersInfoForDpi"
EndIf
Else
SystemDPI = GetSystemDPI()
ncm\cbSize = SizeOf(NONCLIENTMETRICS)
If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
Debug #PB_Compiler_Procedure + " - OK: SystemParametersInfo"
ncm\lfMessageFont\lfHeight = ncm\lfMessageFont\lfHeight * dpi / SystemDPI
EndIf
EndIf
If ncm\lfMessageFont\lfHeight < 0
Height = MulDiv_(-ncm\lfMessageFont\lfHeight, 72, dpi)
Else
Height = ncm\lfMessageFont\lfHeight
EndIf
Debug #PB_Compiler_Procedure + " - Font height: " + Height + " (DPI: " + dpi + " )"
If *g_FontDPI
Prev_FontDPI = *g_FontDPI\l
*g_FontDPI\l = dpi
EndIf
Font = LoadFont(#PB_Any, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height)
If *g_FontDPI
*g_FontDPI\l = Prev_FontDPI
EndIf
ProcedureReturn Font
EndProcedure
Procedure GetFontDPIAddr()
If Defined(PB_Font_Objects, #PB_Variable)
ProcedureReturn @PB_Font_Objects + SizeOf(Integer)
EndIf
ProcedureReturn 0
EndProcedure
Procedure WinCallback_DPI(hWnd, uMsg, wParam, lParam)
If uMsg = #WM_NCCREATE
If GetAncestor_(hWnd, #GA_ROOT) = hWnd
If EnableNonClientDpiScaling__
EnableNonClientDpiScaling__(hWnd)
EndIf
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure StartDPIAction(dpi.l)
Static Prev_PB_Desktop_DPIX.l, Prev_PB_Desktop_DPIY.l
Static Prev_PB_Desktop_ResolutionX.d, Prev_PB_Desktop_ResolutionY.d
Static Prev_FontDPI.l
If dpi < 0
; for StopDPIAction()
If Prev_PB_Desktop_DPIX > 0
PB_Desktop_DPIX = Prev_PB_Desktop_DPIX
Else
PB_Desktop_DPIX = GetSystemDPI()
EndIf
If Prev_PB_Desktop_DPIY > 0
PB_Desktop_DPIY = Prev_PB_Desktop_DPIY
Else
;PB_Desktop_DPIY = GetSystemDPI()
PB_Desktop_DPIY = PB_Desktop_DPIX
EndIf
If *g_FontDPI
If Prev_FontDPI > 0
*g_FontDPI\l = Prev_FontDPI
Else
*g_FontDPI\l = PB_Desktop_DPIX
EndIf
EndIf
Prev_PB_Desktop_DPIX = 0
Prev_PB_Desktop_DPIY = 0
Prev_PB_Desktop_ResolutionX = 0
Prev_PB_Desktop_ResolutionY = 0
Prev_FontDPI = 0
Else
If dpi = 0
dpi = GetSystemDPI()
EndIf
Prev_PB_Desktop_DPIX = PB_Desktop_DPIX
Prev_PB_Desktop_DPIY = PB_Desktop_DPIY
Prev_PB_Desktop_ResolutionX = PB_Desktop_ResolutionX
Prev_PB_Desktop_ResolutionY = PB_Desktop_ResolutionY
PB_Desktop_DPIX = dpi
PB_Desktop_DPIY = dpi
PB_Desktop_ResolutionX = dpi / 96
PB_Desktop_ResolutionY = dpi / 96
If *g_FontDPI
Prev_FontDPI = *g_FontDPI\l
*g_FontDPI\l = dpi
EndIf
EndIf
EndProcedure
Macro StopDPIAction()
StartDPIAction(-1)
EndMacro
;- App startup.
LoadOSFunctions()
GetOSVersion(@g_OSVersion)
*g_FontDPI = GetFontDPIAddr()
; To receive the #WM_NCCREATE message, the callback must be set before any window is created.
If g_OSVersion\dwMajorVersion = 10 And (g_OSVersion\dwBuildNumber >= #WIN10_BUILD_1607 And g_OSVersion\dwBuildNumber < #WIN10_BUILD_1703)
SetWindowCallback(@WinCallback_DPI())
EndIf
;- GUI
#WindowWidth = 390
#WindowHeight = 350
Procedure ResizeChildren(dpi.l)
Static PrevFont
Protected hFont
Protected Font = LoadSystemDefaultFont(dpi)
If Font = 0
ProcedureReturn 0
EndIf
hFont = FontID(Font)
StartDPIAction(dpi)
Top = 10
GadgetHeight = 24
ResizeGadget(40, 10, Top, 370, 290)
SetGadgetFont(40, hFont)
Top+20
ResizeGadget(0, 20, Top, 200, GadgetHeight)
ResizeGadget(1, 223, Top, 72, GadgetHeight)
ResizeGadget(2, 295, Top, 72, GadgetHeight)
SetGadgetFont(0, hFont)
SetGadgetFont(1, hFont)
SetGadgetFont(2, hFont)
Top+35
ResizeGadget(3, 20, Top, #WindowWidth-50, #WindowHeight-Top-60)
SetGadgetFont(3, hFont)
ResizeGadget(4, 6, 10, 230, 148)
SetGadgetFont(4, hFont)
ResizeGadget(5, 250, 10, 80, GadgetHeight)
ResizeGadget(6, 250, 38, 80, GadgetHeight)
ResizeGadget(7, 250, 66, 80, GadgetHeight)
SetGadgetFont(5, hFont)
SetGadgetFont(6, hFont)
SetGadgetFont(7, hFont)
ResizeGadget(17, 10, 168, 310, 25)
Top = 10
ResizeGadget(10, 10, Top, 250, GadgetHeight)
SetGadgetFont(10, hFont)
Top+30
ResizeGadget(11, 10, Top, 250, GadgetHeight)
SetGadgetFont(11, hFont)
Top+30
ResizeGadget(12, 10, Top, 250, 21)
SetGadgetFont(12, hFont)
Top+30
ResizeGadget(13, 10, Top, 80, GadgetHeight)
SetGadgetFont(13, hFont)
Top+20
ResizeGadget(14, 10, Top, 80, GadgetHeight)
SetGadgetFont(14, hFont)
Top+20
ResizeGadget(15, 10, Top, 80, GadgetHeight)
SetGadgetFont(15, hFont)
ResizeGadget(16, 150, Top, 80, GadgetHeight)
SetGadgetFont(16, hFont)
ResizeGadget(9, 10, #WindowHeight-30, 250, 24)
SetGadgetFont(9, hFont)
ResizeGadget(8, #WindowWidth-100, #WindowHeight-36, 80, 24)
SetGadgetFont(8, hFont)
StopDPIAction()
If PrevFont And IsFont(PrevFont)
FreeFont(PrevFont)
EndIf
PrevFont = Font
EndProcedure
Procedure WinCallback(hWnd, uMsg, wParam, lParam)
If uMsg = #WM_EXITSIZEMOVE
Debug "WM_EXITSIZEMOVE"
StartDPIAction(GetDpiForWindow__(hWnd))
Debug "Window W,H = " + WindowWidth(0) + " , " + WindowHeight(0)
StopDPIAction()
EndIf
; Windows 10 1703+
If uMsg = #WM_GETDPISCALEDSIZE
Debug "WM_GETDPISCALEDSIZE"
EndIf
; Windows 8.1+
If uMsg = #WM_DPICHANGED
Debug "WM_DPICHANGED"
Protected *rt.RECT
*rt = lParam
If *rt
With *rt
; Change the window size.
SetWindowPos_(hWnd, 0, \left, \top, \right - \left, \bottom - \top, #SWP_NOZORDER | #SWP_NOACTIVATE)
EndWith
; Change the size of all child gadgets.
ResizeChildren(wParam & $FFFF)
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)
FrameGadget(40, 0, 0, 0, 0, "Player...")
StringGadget(0, 0, 0, 0, 0, "")
ButtonGadget(1, 0, 0, 0, 0, "Play")
ButtonGadget(2, 0, 0, 0, 0, "Stop")
DisableGadget(2,1)
GadgetToolTip(1,"Play the current song")
PanelGadget(3, 0, 0, 0, 0)
AddGadgetItem(3, 0, "MP3 PlayList")
ListViewGadget(4, 0, 0, 0, 0)
For k=0 To 30
AddGadgetItem(4, -1, "Music Song #"+Str(k))
Next
ButtonGadget(5, 0, 0, 0, 0, "Add")
ButtonGadget(6, 0, 0, 0, 0, "Remove")
ButtonGadget(7, 0, 0, 0, 0, "Select")
GadgetToolTip(7, "Select the current song")
TrackBarGadget(17, 0, 0, 0, 0, 0, 100)
AddGadgetItem(3, 1, "Options")
Top = 10
CheckBoxGadget(10, 0, 0, 0, 0, "Enable low-pass filter")
CheckBoxGadget(11, 0, 0, 0, 0, "Enable visual plug-in")
ComboBoxGadget(12, 0, 0, 0, 0)
AddGadgetItem(12, -1, "FireWorks")
AddGadgetItem(12, -1, "OpenGL spectrum")
AddGadgetItem(12, -1, "Bump bass")
SetGadgetState(12,0)
DisableGadget(12,1)
OptionGadget(13, 0, 0, 0, 0, "640*480")
OptionGadget(14, 0, 0, 0, 0, "800*600")
OptionGadget(15, 0, 0, 0, 0, "1024*768")
SetGadgetState(13, 1)
ButtonGadget(16, 0, 0, 0, 0, "Info")
CloseGadgetList()
TextGadget (9, 0, 0, 0, 0, "PureBasic - Gadget demonstration")
ButtonGadget(8, 0, 0, 0, 0, "Quit")
SetGadgetState(3, 0)
; Change the size of all child gadgets.
ResizeChildren(GetDpiForWindow__(WindowID(0)))
SetWindowCallback(@WinCallback(), 0)
Debug "Window W,H (init) = " + WindowWidth(0) + " , " + WindowHeight(0)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case 1 ; Play
DisableGadget(2,0) ; Enable the 'Stop' gadget
DisableGadget(1,1) ; Disable the 'Play' Gadget
Case 2 ; Stop
DisableGadget(1,0) ; Enable the 'Play' gadget
DisableGadget(2,1) ; Disable the 'Stop' Gadget
Case 4
If EventType() = 2
SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
EndIf
Case 5 ; Add
AddGadgetItem(4, -1, "New Item Added...")
Case 6 ; Remove
RemoveGadgetItem(4, GetGadgetState(4)) ; Remove the current element of the ListView
Case 7 ; Select
SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
Case 8 ; Quit...
Event = #PB_Event_CloseWindow
Case 11 ; Enable PlugIn..
DisableGadget(12, 1-GetGadgetState(11))
Case 16 ;
If GetGadgetState(13) : Result$ = GetGadgetText(13) : EndIf
If GetGadgetState(14) : Result$ = GetGadgetText(14) : EndIf
If GetGadgetState(15) : Result$ = GetGadgetText(15) : EndIf
MessageRequester("Info", "Selected screen mode: "+Result$, 0)
Case 17
SetGadgetText(0, Str(GetGadgetState(17)))
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
Code: Select all
CompilerIf Not #PB_Compiler_DPIAware
CompilerError "Turn ON the DPI aware option."
CompilerEndIf
Import ""
PB_Desktop_DPIX.l
PB_Desktop_DPIY.l
PB_Desktop_ResolutionX.d
PB_Desktop_ResolutionY.d
PB_Font_Objects.i
EndImport
;- OS Constants.
#STATUS_SUCCESS = 0
; Windows 8.1+
#WM_DPICHANGED = $02E0
; Windows 10 1703+
#WM_GETDPISCALEDSIZE = $02E4
; MONITOR_DPI_TYPE
#MDT_EFFECTIVE_DPI = 0
#MDT_ANGULAR_DPI = 1
#MDT_RAW_DPI = 2
#MDT_DEFAULT = #MDT_EFFECTIVE_DPI
;- App Constants.
#_WIN32_WINNT_VISTA = $0600
#_WIN32_WINNT_WIN7 = $0601
#_WIN32_WINNT_WIN8 = $0602
;#_WIN32_WINNT_WINBLUE = $0603 ; 8.1
#_WIN32_WINNT_WIN81 = $0603
#_WIN32_WINNT_WIN10 = $0A00
#WIN10_BUILD_1607 = $3839 ; 14393 , 1607
#WIN10_BUILD_1703 = $3AD7 ; 15063 , 1703 ;Support for per-monitor DPI awareness v2.
#WIN10_BUILD_1709 = $3FAB ; 16299 , 1709
#WIN10_BUILD_1803 = $42EE ; 17134 , 1803
Enumeration
#Lib_User32
#Lib_Shcore
EndEnumeration
;- OS Structures.
Structure NONCLIENTMETRICS_vista
cbSize.l
iBorderWidth.l
iScrollWidth.l
iScrollHeight.l
iCaptionWidth.l
iCaptionHeight.l
lfCaptionFont.LOGFONT
iSMCaptionWidth.l
iSMCaptionHeight.l
lfSMCaptionFont.LOGFONT
iMenuWidth.l
iMenuHeight.l
lfMenuFont.LOGFONT
lfStatusFont.LOGFONT
lfMessageFont.LOGFONT
iPaddedBorderWidth.l
EndStructure
;- OS APIs (Global var.)
; Windows 8.1+
Prototype.l ptGetDpiForMonitor(hmonitor, dpiType.l, *dpiX, *dpiY)
Global GetDpiForMonitor__.ptGetDpiForMonitor
; Windows 10 1607
Prototype.l ptEnableNonClientDpiScaling(hwnd)
Global EnableNonClientDpiScaling__.ptEnableNonClientDpiScaling
; Windows 10 1607+
Prototype.l ptGetDpiForWindow(hwnd)
Global GetDpiForWindow__.ptGetDpiForWindow
; Windows 10 1607+
Prototype.l ptSystemParametersInfoForDpi(uiAction.l, uiParam.l, *pvParam, fWinIni.l, dpi.l)
Global SystemParametersInfoForDpi__.ptSystemParametersInfoForDpi
;- App Global Variables.
Global g_OSVersion.OSVERSIONINFOEX
Global *g_FontDPI.Long ; Memory address for DPI value of PB default font.
;- App Functions.
Declare.l GetDpiForWindow(hWnd)
Procedure GetOSVersion(*OSVersion.OSVERSIONINFOEX)
Protected Result, LibNtDll = OpenLibrary(#PB_Any, "Ntdll.dll")
If LibNtDll
If *OSVersion
*OSVersion\dwOSVersionInfoSize = SizeOf(OSVERSIONINFOEX)
If CallFunction(LibNtDll, "RtlGetVersion", *OSVersion) = #STATUS_SUCCESS
Result = 1
EndIf
EndIf
CloseLibrary(LibNtDll)
EndIf
ProcedureReturn Result
EndProcedure
Procedure LoadOSFunctions()
If OpenLibrary(#Lib_Shcore, "Shcore.dll")
; Windows 8.1+
GetDpiForMonitor__ = GetFunction(#Lib_Shcore, "GetDpiForMonitor")
EndIf
If OpenLibrary(#Lib_User32, "User32.dll")
; Windows 10 1607
EnableNonClientDpiScaling__ = GetFunction(#Lib_User32, "EnableNonClientDpiScaling")
; Windows 10 1607+
GetDpiForWindow__ = GetFunction(#Lib_User32, "GetDpiForWindow")
; Windows 10 1607+
SystemParametersInfoForDpi__ = GetFunction(#Lib_User32, "SystemParametersInfoForDpi")
EndIf
; This function must always be callable without failure.
If GetDpiForWindow__ = 0
GetDpiForWindow__ = @GetDpiForWindow()
Debug "GetDpiForWindow__ : Using the app's function."
EndIf
EndProcedure
Procedure.l GetSystemDPI()
Protected hDC = CreateDC_("DISPLAY", 0, 0, 0)
Protected DpiX.l
If hDC
DpiX = GetDeviceCaps_(hDC, #LOGPIXELSX)
DeleteDC_(hDC)
EndIf
ProcedureReturn DpiX
EndProcedure
Procedure.l GetDpiForWindow(hWnd)
Protected hMonitor = MonitorFromWindow_(hWnd, #MONITOR_DEFAULTTONEAREST)
Protected DpiX.l, DpiY.l
If hMonitor
; Windows 8.1+
If GetDpiForMonitor__
If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK
ProcedureReturn DpiX
EndIf
EndIf
EndIf
DpiX = GetSystemDPI()
If DpiX = 0 : DpiX = 96 : EndIf
ProcedureReturn DpiX
EndProcedure
Procedure LoadSystemDefaultFont(dpi.l)
Protected Font, Height.l, SystemDPI.l, Prev_FontDPI.l, ncm.NONCLIENTMETRICS_vista
If SystemParametersInfoForDpi__
ncm\cbSize = SizeOf(NONCLIENTMETRICS_vista)
If SystemParametersInfoForDpi__(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS_vista), @ncm, 0, dpi)
Debug #PB_Compiler_Procedure + " - OK: SystemParametersInfoForDpi"
EndIf
Else
SystemDPI = GetSystemDPI()
ncm\cbSize = SizeOf(NONCLIENTMETRICS)
If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
Debug #PB_Compiler_Procedure + " - OK: SystemParametersInfo"
ncm\lfMessageFont\lfHeight = ncm\lfMessageFont\lfHeight * dpi / SystemDPI
EndIf
EndIf
If ncm\lfMessageFont\lfHeight < 0
Height = MulDiv_(-ncm\lfMessageFont\lfHeight, 72, dpi)
Else
Height = ncm\lfMessageFont\lfHeight
EndIf
Debug #PB_Compiler_Procedure + " - Font height: " + Height + " (DPI: " + dpi + " )"
If *g_FontDPI
Prev_FontDPI = *g_FontDPI\l
*g_FontDPI\l = dpi
EndIf
Font = LoadFont(#PB_Any, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height)
If *g_FontDPI
*g_FontDPI\l = Prev_FontDPI
EndIf
ProcedureReturn Font
EndProcedure
Procedure GetFontDPIAddr()
If Defined(PB_Font_Objects, #PB_Variable)
ProcedureReturn @PB_Font_Objects + SizeOf(Integer)
EndIf
ProcedureReturn 0
EndProcedure
Procedure WinCallback_DPI(hWnd, uMsg, wParam, lParam)
If uMsg = #WM_NCCREATE
If GetAncestor_(hWnd, #GA_ROOT) = hWnd
If EnableNonClientDpiScaling__
EnableNonClientDpiScaling__(hWnd)
EndIf
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure StartDPIAction(dpi.l)
Static Prev_PB_Desktop_DPIX.l, Prev_PB_Desktop_DPIY.l
Static Prev_PB_Desktop_ResolutionX.d, Prev_PB_Desktop_ResolutionY.d
Static Prev_FontDPI.l
If dpi < 0
; for StopDPIAction()
If Prev_PB_Desktop_DPIX > 0
PB_Desktop_DPIX = Prev_PB_Desktop_DPIX
Else
PB_Desktop_DPIX = GetSystemDPI()
EndIf
If Prev_PB_Desktop_DPIY > 0
PB_Desktop_DPIY = Prev_PB_Desktop_DPIY
Else
;PB_Desktop_DPIY = GetSystemDPI()
PB_Desktop_DPIY = PB_Desktop_DPIX
EndIf
If *g_FontDPI
If Prev_FontDPI > 0
*g_FontDPI\l = Prev_FontDPI
Else
*g_FontDPI\l = PB_Desktop_DPIX
EndIf
EndIf
Prev_PB_Desktop_DPIX = 0
Prev_PB_Desktop_DPIY = 0
Prev_PB_Desktop_ResolutionX = 0
Prev_PB_Desktop_ResolutionY = 0
Prev_FontDPI = 0
Else
If dpi = 0
dpi = GetSystemDPI()
EndIf
Prev_PB_Desktop_DPIX = PB_Desktop_DPIX
Prev_PB_Desktop_DPIY = PB_Desktop_DPIY
Prev_PB_Desktop_ResolutionX = PB_Desktop_ResolutionX
Prev_PB_Desktop_ResolutionY = PB_Desktop_ResolutionY
PB_Desktop_DPIX = dpi
PB_Desktop_DPIY = dpi
PB_Desktop_ResolutionX = dpi / 96
PB_Desktop_ResolutionY = dpi / 96
If *g_FontDPI
Prev_FontDPI = *g_FontDPI\l
*g_FontDPI\l = dpi
EndIf
EndIf
EndProcedure
Macro StopDPIAction()
StartDPIAction(-1)
EndMacro
;- App startup.
LoadOSFunctions()
GetOSVersion(@g_OSVersion)
*g_FontDPI = GetFontDPIAddr()
; To receive the #WM_NCCREATE message, the callback must be set before any window is created.
If g_OSVersion\dwMajorVersion = 10 And (g_OSVersion\dwBuildNumber >= #WIN10_BUILD_1607 And g_OSVersion\dwBuildNumber < #WIN10_BUILD_1703)
SetWindowCallback(@WinCallback_DPI())
EndIf
;- GUI
#wndMain = 0
#wndMain_Font0 = 0
Procedure ResizeChildren(dpi.l)
Static PrevFont
Protected hFont
Protected Font = LoadSystemDefaultFont(dpi)
If Font = 0
ProcedureReturn 0
EndIf
hFont = FontID(Font)
StartDPIAction(dpi)
; If a font applied to a gadget is not the system default font, it must be loaded between the StartDPIAction and StopDPIAction blocks.
; And the font loaded here must not be applied to gadgets in other windows.
LoadFont(#wndMain_Font0, "arial", 13, #PB_Font_Italic)
ResizeGadget(0, 10, 10, 390, 220)
SetGadgetAttribute(0, #PB_ScrollArea_InnerWidth, 575)
SetGadgetAttribute(0, #PB_ScrollArea_InnerHeight, 555)
ResizeGadget(1, 10, 10, 230, 40)
ResizeGadget(2, 50, 50, 230, 30)
ResizeGadget(3, 90, 90, 230, 30)
ResizeGadget(4,130,130, 230, 20)
SetGadgetFont(1, FontID(0))
SetGadgetFont(2, hFont)
SetGadgetFont(3, hFont)
SetGadgetFont(4, hFont)
StopDPIAction()
If PrevFont And IsFont(PrevFont)
FreeFont(PrevFont)
EndIf
PrevFont = Font
EndProcedure
Procedure WinCallback(hWnd, uMsg, wParam, lParam)
If uMsg = #WM_EXITSIZEMOVE
Debug "WM_EXITSIZEMOVE"
StartDPIAction(GetDpiForWindow__(hWnd))
Debug "Window W,H = " + WindowWidth(#wndMain) + " , " + WindowHeight(#wndMain)
StopDPIAction()
EndIf
; Windows 10 1703+
If uMsg = #WM_GETDPISCALEDSIZE
Debug "WM_GETDPISCALEDSIZE"
EndIf
; Windows 8.1+
If uMsg = #WM_DPICHANGED
Debug "WM_DPICHANGED"
Protected *rt.RECT
*rt = lParam
If *rt
With *rt
; Change the window size.
SetWindowPos_(hWnd, 0, \left, \top, \right - \left, \bottom - \top, #SWP_NOZORDER | #SWP_NOACTIVATE)
EndWith
; Change the size of all child gadgets.
ResizeChildren(wParam & $FFFF)
EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
If OpenWindow(#wndMain, 0, 0, 405, 240, "ScrollAreaGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ScrollAreaGadget(0, 10, 10, 390,220, 575, 555, 30)
ButtonGadget (1, 10, 10, 230, 30,"Button 1")
ButtonGadget (2, 50, 50, 230, 30,"Button 2")
ButtonGadget (3, 90, 90, 230, 30,"Button 3")
TextGadget (4,130,130, 230, 20,"This is the content of a ScrollAreaGadget!",#PB_Text_Right)
CloseGadgetList()
; Change the size of all child gadgets.
ResizeChildren(GetDpiForWindow__(WindowID(#wndMain)))
SetWindowCallback(@WinCallback(), #wndMain)
Debug "Window W,H (init) = " + WindowWidth(#wndMain) + " , " + WindowHeight(#wndMain)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf