[Windows] DPI awareness Per Monitor v2

Share your advanced PureBasic knowledge/code with the community.
Post Reply
breeze4me
Enthusiast
Enthusiast
Posts: 672
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

[Windows] DPI awareness Per Monitor v2

Post by breeze4me »

https://learn.microsoft.com/en-us/windo ... -a-process

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)
We are now ready to apply DPI awareness PM v2.

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
Font handling example for a gadget.

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(#wndMain_Font0))
  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
ImageGadget example.

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

Enumeration
  #Img_01_100
  #Img_01_125
  #Img_01_150
  #Img_01_175
  #Img_01_200
  ; ...
  
  #Img_02_100
  #Img_02_125
  #Img_02_150
  #Img_02_175
  #Img_02_200
  ; ...
  
  #Img_01_Copy
  #Img_02_Copy
  ; ...
EndEnumeration

Procedure ResizeChildren(dpi.l)
  
;   Static PrevFont
;   Protected hFont
;   Protected Font = LoadSystemDefaultFont(dpi)
;   
;   If Font = 0
;     ProcedureReturn 0
;   EndIf
;   hFont = FontID(Font)
  
  
  Protected img
  
  StartDPIAction(dpi)
  
  
  ; The best approach is to prepare separate images for each screen scale and assign them accordingly.
;   Select (dpi * 100 / 96)
;     Case 100
;       img = #Img_01_100
;     Case 125
;       img = #Img_01_125
;     Case 150
;       img = #Img_01_150
;     Case 175
;       img = #Img_01_175
;     Case 200
;       img = #Img_01_200
;     Default
;       ; Image for 100% scale is resized to match the new dpi.
;       img = -1
;       If CopyImage(#Img_01_100, #Img_01_Copy)
;         ResizeImage(#Img_01_Copy, ImageWidth(#Img_01_100) * dpi / 96, ImageHeight(#Img_01_100) * dpi / 96, #PB_Image_Smooth)
;         img = #Img_01_Copy
;       EndIf
;   EndSelect
  
  ; Image for 100% scale is resized to match the new dpi.
  img = -1
  If CopyImage(#Img_01_100, #Img_01_Copy)
    ResizeImage(#Img_01_Copy, ImageWidth(#Img_01_100) * dpi / 96, ImageHeight(#Img_01_100) * dpi / 96, #PB_Image_Smooth)
    Debug "New img W,H: " + Str(ImageWidth(#Img_01_100) * dpi / 96) + " , " + Str(ImageHeight(#Img_01_100) * dpi / 96)
    img = #Img_01_Copy
  EndIf
  
  If IsImage(img)
    SetGadgetState(0, ImageID(img))
  EndIf
  ResizeGadget(0, WindowWidth(#wndMain) - 120, 10, #PB_Ignore, #PB_Ignore)
  
  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 LoadImage(#Img_01_100, #PB_Compiler_Home + "examples/sources/Data/Map.bmp")
  If OpenWindow(#wndMain, 0, 0, 200, 200, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    ImageGadget(0, 0, 0, 0, 0, 0)
    
    ; 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
  
Else
  Debug "The image file not found."
EndIf
Top
breeze4me
Enthusiast
Enthusiast
Posts: 672
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: [Windows] DPI awareness Per Monitor v2

Post by breeze4me »

CAUTION: StartDPIAction and StopDPIAction calls must be paired.

As a side note:
I tested using the PostEvent() and BindEvent() functions, but the custom event only fired when the mouse button was released, making it impossible to change the size of gadgets in real time.

I discovered that when the DPI of the primary monitor changes, using the GetDeviceCaps function returns the initial DPI (immediately after the app starts) rather than the changed DPI.
The behavior was the same for the GetDpiForSystem and GetSystemDpiForProcess functions.
Only the GetDpiForMonitor function returned the changed value correctly.
I have only tested this on Windows 10, but using the GetSystemDPI() function in my code on Windows 8 or earlier may produce incorrect result.


Update 1:
Updated some functions. And changed to module.

Update 2:
Windows without a callback function set will not resize even if the DPI changes.

Update 3:
Added feature to detect DPI changes on the primary monitor and update PB variables.
Added an example of handling a resizable window. (#PB_Window_SizeGadget)

Update 4:
Fixed an issue that caused the execution of the SetWindowCallback(@Procedure(), #Window) command to override the DPI callback when a DPI callback function was specified.

Update 5:
Added two missing lines to the StartDPIAction function.(Restoring PB_Desktop_ResolutionX/Y Values)

Update 6:
Fixed a bug. (The first parameter of MonitorFromPoint is a quad.)

Update 7:
Changed to use a window's property instead of PB map for storing DPI callback address.
Some functions changed. (e.g., GetSystemDPI)
Added a global variable reflecting whether module initialization succeeded.

Update 8:
Added functions that mimic PB's DesktopXXX() functions. (The difference is that they have a dpi parameter.)
Modified: If initialization of the module fails, the SetDPICallback, StartDPIAction, and StopDPIAction functions will not work.

Update 9:
Added functions and macros to replace the OpenWindow() function. See the code for details.

Code: Select all

DeclareModule DPIAwareness
  ;- DeclareModule - DPIAwareness
  Prototype.l ptGetDpiForWindow(hwnd)
  Global GetDpiForWindow.ptGetDpiForWindow
  
  Global g_DPIAwarenessInitSuccess
  
  Declare LoadSystemDefaultFont(FontNumber = #PB_Any, dpi.l = #PB_Default)
  Declare SetDPICallback(Window, *Procedure)
  Declare StartDPIAction(dpi.l)
  
  Macro StopDPIAction()
    StartDPIAction(-1)
  EndMacro
  
  ; Functions that can be used regardless of the StartDPIAction/StopDPIAction block. Available both inside and outside the block.
  
  ; If the dpi value is 0,
  ; it returns the value calculated based on the dpi set in the StartDPIAction/StopDPIAction block.
  ; Outside the block, it returns the same value as PB's DesktopXXX() functions.
  Declare.l DPIScaledX(Value.l, dpi.l = 0)
  Declare.l DPIScaledY(Value.l, dpi.l = 0)
  Declare.l DPIUnscaledX(Value.l, dpi.l = 0)
  Declare.l DPIUnscaledY(Value.l, dpi.l = 0)
  Declare.d DPIResolutionX(dpi.l = 0)
  Declare.d DPIResolutionY(dpi.l = 0)
  
  ; 1. Adjust the x,y values to match the DPI of the monitor where the values are located. (The x and y parameters of the OpenWindow() function are not in pixels, which complicates matters.)
  ; 2. When a window is opened across the boundaries of two or more monitors with different DPI values, various issues can occur. This is a function designed to solve such issues.
  Macro OpenWindow(Window, x, y, InnerWidth, InnerHeight, Title, Flags = #PB_Window_SystemMenu, ParentID = 0)
    APPOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title, Flags, ParentID)
  EndMacro
  Declare APPOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title$, Flags = #PB_Window_SystemMenu, ParentID = 0)
  
EndDeclareModule

Module DPIAwareness
  ;- Module - DPIAwareness
  
  CompilerIf Not #PB_Compiler_DPIAware
    CompilerError "Turn ON the DPI aware option."
  CompilerEndIf
  
  EnableExplicit
  
  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+
  #DEVICE_PRIMARY = 0
  #DEVICE_IMMERSIVE = 1
  
  ; 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
  
  ;- Module 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 DPI awareness per-monitor v2.
  #WIN10_BUILD_1709 = $3FAB ; 16299 , 1709
  #WIN10_BUILD_1803 = $42EE ; 17134 , 1803
  
  #PrevWndProc$ = "DPI_PrevWndProc"
  #DPICallback$ = "DPI_Callback"
  
  ;- 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
  
  ;- Module Structures.
  
  Structure tagMonitor
    x.l
    y.l
    PixelX.l
    PixelY.l
  EndStructure
  
  ;- OS APIs (Global var.)
  
  ; Windows 8+
  Prototype ptGetScaleFactorForDevice(deviceType)
  Global GetScaleFactorForDevice__.ptGetScaleFactorForDevice
  
  ; 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
  
  ;- Module Global Variables.
  Global *g_FontDPI.Long          ; Memory address for DPI value of PB font.
  Global g_IsInitSuccess
  Global g_PBOSVersion
  
  
  Macro PBOpenWindow
    OpenWindow
  EndMacro
  
  ;- Module Functions.
  
  Declare.l APPGetDpiForWindow(hWnd)
  
  Procedure.l DPIScaledX(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    ProcedureReturn MulDiv_(Value, dpi, 96)
  EndProcedure
  
  Procedure.l DPIScaledY(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIY
    EndIf
    ProcedureReturn MulDiv_(Value, dpi, 96)
  EndProcedure
  
  Procedure.l DPIUnscaledX(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    Protected Resolution.d = dpi / 96
    ProcedureReturn (Value / Resolution)
  EndProcedure
  
  Procedure.l DPIUnscaledY(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIY
    EndIf
    Protected Resolution.d = dpi / 96
    ProcedureReturn (Value / Resolution)
  EndProcedure
  
  Procedure.d DPIResolutionX(dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    ProcedureReturn (dpi / 96)
  EndProcedure
  
  Procedure.d DPIResolutionY(dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIY
    EndIf
    ProcedureReturn (dpi / 96)
  EndProcedure
  
  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()
    Protected Lib_Shcore, Lib_User32
    
    Lib_Shcore = OpenLibrary(#PB_Any, "Shcore.dll")
    If Lib_Shcore
      ; Windows 8.1+
      GetDpiForMonitor__ = GetFunction(Lib_Shcore, "GetDpiForMonitor")
      
      ; Windows 8+
      GetScaleFactorForDevice__ = GetFunction(Lib_Shcore, "GetScaleFactorForDevice")
      
    EndIf
    
    Lib_User32 = OpenLibrary(#PB_Any, "User32.dll")
    If Lib_User32
      
      ; 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 = @APPGetDpiForWindow()
      Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - GetDpiForWindow: Using the app's function."
    EndIf
    
  EndProcedure
  
  Procedure GetFontDPIAddr()
    CompilerIf Defined(PB_Font_Objects, #PB_Variable)
      ProcedureReturn @PB_Font_Objects + SizeOf(Integer)
    CompilerElse
      ProcedureReturn 0
    CompilerEndIf
  EndProcedure
  
  Procedure.l GetSystemDPI()
    Protected pt.q, hMonitor, hDC, DpiX.l, DpiY.l
    
    ; Windows 8.1+
    If GetDpiForMonitor__
      hMonitor = MonitorFromPoint_(pt, #MONITOR_DEFAULTTOPRIMARY)
      If hMonitor
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK And DpiX > 0
          ProcedureReturn DpiX
        EndIf
        DpiX = 0
      EndIf
    EndIf
    
    ; Windows 8+
    If GetScaleFactorForDevice__
      DpiX = GetScaleFactorForDevice__(#DEVICE_PRIMARY) * 96 / 100
      If DpiX > 0
        ProcedureReturn DpiX
      EndIf
      DpiX = 0
    EndIf
    
    ; Note:
    ; Very slow. The GetDpiForWindow API is the fastest, and the methods above are the next fastest.
    ; This method does not reflect changes to the DPI of the primary monitor. Only the DPI value immediately after the app starts is returned.
    If DpiX = 0
      hDC = GetDC_(0)
      If hDC
        DpiX = GetDeviceCaps_(hDC, #LOGPIXELSX)
        ReleaseDC_(0, hDC)
      EndIf
      
      ;hDC = CreateDC_("DISPLAY", 0, 0, 0)
      ;If hDC
      ;  DpiX = GetDeviceCaps_(hDC, #LOGPIXELSX)
      ;  DeleteDC_(hDC)
      ;EndIf
    EndIf
    
    ProcedureReturn DpiX
  EndProcedure
  
  Procedure SetSystemDPI()
    Static PrevDPI.l
    Protected Result, DpiX.l = GetSystemDPI()
    
    If DpiX > 0 And PrevDPI <> DpiX
      Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - DPI: " + DpiX
      
      PB_Desktop_DPIX = DpiX
      PB_Desktop_DPIY = DpiX
      
      PB_Desktop_ResolutionX = DpiX / 96
      PB_Desktop_ResolutionY = DpiX / 96
      
      If *g_FontDPI
        *g_FontDPI\l = DpiX
      EndIf
      
      PrevDPI = DpiX
      
      Result = 1
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure.l APPGetDpiForWindow(hWnd)
    Protected hMonitor, DpiX.l, DpiY.l
    
    ; Windows 8.1+
    If GetDpiForMonitor__
      hMonitor = MonitorFromWindow_(hWnd, #MONITOR_DEFAULTTONEAREST)
      If hMonitor
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK And DpiX > 0
          ProcedureReturn DpiX
        EndIf
      EndIf
    EndIf
    
    DpiX = GetSystemDPI()
    If DpiX = 0 : DpiX = 96 : EndIf
    
    ProcedureReturn DpiX
  EndProcedure
  
  Procedure LoadSystemDefaultFont(FontNumber = #PB_Any, dpi.l = #PB_Default)
    Protected Font, Height.l, SystemDPI.l, Prev_FontDPI.l, ncm.NONCLIENTMETRICS_vista
    
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    
    If SystemParametersInfoForDpi__
      ncm\cbSize = SizeOf(NONCLIENTMETRICS_vista)
      If SystemParametersInfoForDpi__(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS_vista), @ncm, 0, dpi)
        Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - OK: SystemParametersInfoForDpi"
      EndIf
    Else
      SystemDPI = GetSystemDPI()
      ncm\cbSize = SizeOf(NONCLIENTMETRICS)
      If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
        Debug #PB_Compiler_Module +  " :: " + #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
      If ncm\lfMessageFont\lfHeight = 0
        Height = 9
      Else
        Height = ncm\lfMessageFont\lfHeight
      EndIf
    EndIf
    
    Protected FontStyle.l
    If ncm\lfMessageFont\lfWeight = 700 : FontStyle | #PB_Font_Bold : EndIf
    If ncm\lfMessageFont\lfItalic : FontStyle | #PB_Font_Italic : EndIf
    If ncm\lfMessageFont\lfStrikeOut : FontStyle | #PB_Font_StrikeOut: EndIf
    If ncm\lfMessageFont\lfUnderline : FontStyle | #PB_Font_Underline: EndIf
    
    Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - Font height: " + Height + " (DPI: " + dpi + " )"
    
    If *g_FontDPI
      Prev_FontDPI = *g_FontDPI\l
      *g_FontDPI\l = dpi
    EndIf
    
    If FontStyle
      Font = LoadFont(FontNumber, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height, FontStyle)
    Else
      Font = LoadFont(FontNumber, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height)
    EndIf
    
    If *g_FontDPI
      *g_FontDPI\l = Prev_FontDPI
    EndIf
    
    ProcedureReturn Font
  EndProcedure
  
  Procedure.l MonitorEnumProc(hMonitor, hdcMonitor, *lprcMonitor.RECT, *dwData.tagMonitor)
    Protected DpiX.l, DpiY.l
    Protected UnscaledRect.RECT
    
    If *dwData And *lprcMonitor
      ; Windows 8.1+
      If GetDpiForMonitor__
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK
          ; Unscale the RECT values of the monitor and check whether the x and y coordinates fall within the RECT range.
          UnscaledRect\left = DPIUnscaledX(*lprcMonitor\left, DpiX)
          UnscaledRect\top = DPIUnscaledY(*lprcMonitor\top, DpiX)
          UnscaledRect\right = DPIUnscaledX(*lprcMonitor\right, DpiX)
          UnscaledRect\bottom = DPIUnscaledY(*lprcMonitor\bottom, DpiX)
          
          If PtInRect_(@UnscaledRect, (*dwData\y << 32) | (*dwData\x & $FFFFFFFF))
            *dwData\PixelX = DPIScaledX(*dwData\x, DpiX)
            *dwData\PixelY = DPIScaledY(*dwData\y, DpiX)
            
            *dwData\x = UnscaledRect\left
            *dwData\y = UnscaledRect\top
          EndIf
          
        EndIf
      EndIf
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure.l CallWndProc(nCode.l, wParam, *lParam.CWPSTRUCT)
    If *lParam
      If *lParam\message = #WM_DPICHANGED
        Debug "WH_CALLWNDPROC - WM_DPICHANGED " ;+ GetAncestor_(*lParam\hwnd, #GA_ROOT) + " " + *lParam\hwnd
        
        Protected *rt.RECT
        
        *rt = *lParam\lParam
        If *rt
          With *rt
            SetWindowPos_(*lParam\hwnd, 0, \left, \top, \right - \left, \bottom - \top, #SWP_NOZORDER | #SWP_NOACTIVATE)
          EndWith
        EndIf
      EndIf
    EndIf
    ProcedureReturn CallNextHookEx_(0, nCode, wParam, *lParam)
  EndProcedure
  
  ; 1. Adjust the x,y values to match the DPI of the monitor where the values are located. (The x and y parameters of the OpenWindow() function are not in pixels, which complicates matters.)
  ; 2. When a window is opened across the boundaries of two or more monitors with different DPI values, various issues can occur. This is a function designed to solve such issues.
  Procedure APPOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title$, Flags = #PB_Window_SystemMenu, ParentID = 0)
    Protected Result, TempInvisible, hHook
    Protected Monitor.tagMonitor
    
    Debug #PB_Compiler_Module + " :: " + #PB_Compiler_Procedure
    
    If g_PBOSVersion >= #PB_OS_Windows_8_1 And x <> #PB_Ignore And y <> #PB_Ignore And (Flags & #PB_Window_ScreenCentered = 0 And Flags & #PB_Window_WindowCentered = 0)
      
      If Flags & #PB_Window_Invisible <> #PB_Window_Invisible
        Flags | #PB_Window_Invisible
        TempInvisible = 1
      EndIf
      
      Monitor\x = x
      Monitor\y = y
      
      ; The DPI of each monitor can change, so the relevant values must be recalculated each time.
      ; Alternatively, detect when the DPI of each monitor changes and cache that values.(Not implemented here.)
      If EnumDisplayMonitors_(0, 0, @MonitorEnumProc(), @Monitor)
        
        hHook = SetWindowsHookEx_(#WH_CALLWNDPROC, @CallWndProc(), GetModuleHandle_(0), GetCurrentThreadId_())
        If hHook
          ; After opening a window on the primary monitor, move the window to a specific location based on its x and y coordinates.
          Result = PBOpenWindow(Window, 0, 0, InnerWidth, InnerHeight, Title$, Flags, ParentID)
          If Result
            If Window = #PB_Any
              Window = Result
            EndIf
            
            ; If the window's DPI changes due to its movement, the hook procedure detects this and adjusts the window size.
            SetWindowPos_(WindowID(Window), 0, Monitor\PixelX, Monitor\PixelY, 0, 0, #SWP_FRAMECHANGED | #SWP_NOSIZE | #SWP_NOZORDER | #SWP_NOOWNERZORDER)
          EndIf
          
          UnhookWindowsHookEx_(hHook)
        EndIf
      EndIf
      
      If TempInvisible
        HideWindow(Window, 0)
      EndIf
      
    Else
      Result = PBOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title$, Flags, ParentID)
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure WinCallback_DPI(hWnd, uMsg, wParam, lParam)
    If uMsg = #WM_NCCREATE
      If GetAncestor_(hWnd, #GA_ROOT) = hWnd
        If EnableNonClientDpiScaling__
          EnableNonClientDpiScaling__(hWnd)
          Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - EnableNonClientDpiScaling"
        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 g_IsInitSuccess = 0 : ProcedureReturn 1 : EndIf
    
    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
      
      PB_Desktop_ResolutionX = Prev_PB_Desktop_ResolutionX
      PB_Desktop_ResolutionY = Prev_PB_Desktop_ResolutionY
      
      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
  
  Procedure WinCallback(hWnd, uMsg, wParam, lParam)
    Protected PrevWndProc = GetProp_(hWnd, #PrevWndProc$)
    
    CompilerIf #PB_Compiler_Debugger
      Protected Window = GetProp_(hWnd, "PB_WindowID") - 1
    CompilerEndIf
    
    CompilerIf #PB_Compiler_Debugger
      If uMsg = #WM_EXITSIZEMOVE
        StartDPIAction(GetDpiForWindow(hWnd))
        Debug "Win " + Window + " - WM_EXITSIZEMOVE,   Window W,H = " + WindowWidth(Window) + " , " + WindowHeight(Window)
        StopDPIAction()
      EndIf
    CompilerEndIf
    
    ; Windows 10 1703+
    If uMsg = #WM_GETDPISCALEDSIZE
      CompilerIf #PB_Compiler_Debugger
        Debug "Win " + Window + " - WM_GETDPISCALEDSIZE"
      CompilerEndIf
    EndIf
    
    ; Windows 8.1+
    If uMsg = #WM_DPICHANGED
      CompilerIf #PB_Compiler_Debugger
        Debug "Win " + Window + " - WM_DPICHANGED"
      CompilerEndIf
      
      Protected *rt.RECT
      
      *rt = lParam
      If *rt
        Protected *DPICallback = GetProp_(hWnd, #DPICallback$)
        If *DPICallback
          
          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. Or set only properties that change based on the DPI of child gadgets. (e.g., fonts, images, etc.)
          CallFunctionFast(*DPICallback, (wParam & $FFFF))
        EndIf
      EndIf
      
    EndIf 
    
    If uMsg = #WM_NCDESTROY
      CompilerIf #PB_Compiler_Debugger
        Debug "Win " + Window + " - WM_NCDESTROY"
      CompilerEndIf
      
      RemoveProp_(hWnd, #PrevWndProc$)
      RemoveProp_(hWnd, #DPICallback$)
    EndIf
    
    ProcedureReturn CallWindowProc_(PrevWndProc, hWnd, uMsg, wParam, lParam)
  EndProcedure
  
  Procedure.l PropEnumProc(hWnd, *PropStringOrAtom, unnamedParam3)
    If *PropStringOrAtom & -65536
      Protected PropString.s = PeekS(*PropStringOrAtom)
      If PropString = #DPICallback$
        ProcedureReturn #False
      EndIf
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure SetDPICallback(Window, *Procedure)
    Protected Result.l, hWnd
    
    If g_IsInitSuccess = 0 : ProcedureReturn 0 : EndIf
    
    If IsWindow(Window) And *Procedure
      hWnd = WindowID(Window)
      If hWnd
        If EnumProps_(hWnd, @PropEnumProc()) = #True
          Result = SetProp_(hWnd, #PrevWndProc$, SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, @WinCallback()))
        Else
          Result = 1
        EndIf
        If Result
          Result = SetProp_(hWnd, #DPICallback$, *Procedure)
        EndIf
      EndIf
    EndIf
    ProcedureReturn Result
  EndProcedure
  
  Procedure WinCallback_SystemDPIDetectionWindow(hWnd, uMsg, wParam, lParam)
    If uMsg = #WM_DISPLAYCHANGE
      ; Note: It is necessary to check whether it works on Windows 8 and earlier versions.
      If SetSystemDPI()
        Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - WM_DISPLAYCHANGE : The DPI or resolution of the primary monitor has changed. (New DPI: " + PB_Desktop_DPIX + ")"
      EndIf
    EndIf
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndProcedure
  
  Procedure OpenSystemDPIDetectionWindow()
    Protected Window = OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_BorderLess | #PB_Window_Invisible | #PB_Window_NoGadgets | #PB_Window_NoActivate)
    If Window
      SetWindowCallback(@WinCallback_SystemDPIDetectionWindow(), Window)
    EndIf
  EndProcedure
  
  Procedure InitModule()
    Protected Result
    Protected OSVersion.OSVERSIONINFOEX
    
    g_PBOSVersion = OSVersion()
    GetOSVersion(@OSVersion)
    LoadOSFunctions()
    
    *g_FontDPI = GetFontDPIAddr()
    
    If *g_FontDPI And (*g_FontDPI\l > 0 And *g_FontDPI\l < 10000)
      If SetSystemDPI()
        
        Debug #PB_Compiler_Module + " :: Main -   *g_FontDPI=" + *g_FontDPI + "   DPI=" + *g_FontDPI\l
        
        ; Note:
        ; If there are calls elsewhere in the form of "SetWindowCallback(@ProcedureName())", the function call below will also be overridden, so another approach is needed.
        ; For example, SetWindowsHookEx_(#WH_CALLWNDPROC, ...)
        
        ; To receive the #WM_NCCREATE message, the callback must be set before any window is created.
        If OSVersion\dwMajorVersion = 10 And (OSVersion\dwBuildNumber >= #WIN10_BUILD_1607 And OSVersion\dwBuildNumber < #WIN10_BUILD_1703)
          SetWindowCallback(@WinCallback_DPI())
        EndIf
        
        OpenSystemDPIDetectionWindow()
        
        Result = 1
      EndIf
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  ;- Module startup.
  g_IsInitSuccess = InitModule()
  g_DPIAwarenessInitSuccess = g_IsInitSuccess
  
  ;- End of Module - DPIAwareness
EndModule

Code: Select all

UseModule DPIAwareness

If Not g_DPIAwarenessInitSuccess
  Debug "-----------------------------------------------------------------"
  Debug "DPIAwareness module startup failed."
  Debug "-----------------------------------------------------------------"
EndIf

;- GUI

Enumeration 
  #wndMain
  #wndSub1
  #wndSub2
  #wndResizableExample
EndEnumeration

Enumeration 
  #wndMain_DefaultFont
  
  #wndSub1_DefaultFont
  #wndSub1_Font0
  
  #wndResizableExample_DefaultFont
EndEnumeration

Enumeration 60
  #wndSub1_g0
  #wndSub1_g1
  #wndSub1_g2
  #wndSub1_g3
  #wndSub1_g4
  
  #wndSub2_g0
  
  #wndResizableExample_g0
  #wndResizableExample_g1
  #wndResizableExample_g2
  #wndResizableExample_g3
EndEnumeration


Enumeration
  #Img_01_100
  #Img_01_125
  #Img_01_150
  #Img_01_175
  #Img_01_200
  ; ...
  
  #Img_02_100
  #Img_02_125
  #Img_02_150
  #Img_02_175
  #Img_02_200
  ; ...
  
  #Img_01_Copy
  #Img_02_Copy
  ; ...
EndEnumeration



#WindowWidth  = 390
#WindowHeight = 350


Procedure ResizeChildren_wndMain(dpi.l)
  Protected hFont
  
  StartDPIAction(dpi)
  
  hFont = LoadSystemDefaultFont(#wndMain_DefaultFont)
  ;hFont = LoadSystemDefaultFont(#wndMain_DefaultFont, dpi)
  
  If hFont = 0
    StopDPIAction()
    ProcedureReturn 0
  EndIf
  
  
  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()
  
EndProcedure

Procedure ResizeChildren_wndSub1(dpi.l)
  Protected hFont
  
  StartDPIAction(dpi)
  
  ; Fonts must be loaded between StartDPIAction and StopDPIAction.
  ; And the font loaded here must not be applied to gadgets in other windows.
  
  hFont = LoadSystemDefaultFont(#wndSub1_DefaultFont)
  ;hFont = LoadSystemDefaultFont(#wndSub1_DefaultFont, dpi)
  
  If hFont = 0
    StopDPIAction()
    ProcedureReturn 0
  EndIf
  
  LoadFont(#wndSub1_Font0, "arial", 13, #PB_Font_Italic)
  
  ResizeGadget(#wndSub1_g0, 10, 10, 390, 220)
  SetGadgetAttribute(#wndSub1_g0, #PB_ScrollArea_InnerWidth, 575)
  SetGadgetAttribute(#wndSub1_g0, #PB_ScrollArea_InnerHeight, 555)
  
  ResizeGadget(#wndSub1_g1, 100, 10, 230, 40)
  ResizeGadget(#wndSub1_g2, 50, 50, 230, 30)
  ResizeGadget(#wndSub1_g3, 90, 90, 230, 30)
  ResizeGadget(#wndSub1_g4,130,130, 230, 20)
  
  SetGadgetFont(#wndSub1_g1, FontID(#wndSub1_Font0))
  SetGadgetFont(#wndSub1_g2, hFont)
  SetGadgetFont(#wndSub1_g3, hFont)
  SetGadgetFont(#wndSub1_g4, hFont)
  
  StopDPIAction()
  
EndProcedure


Procedure Event_SizeWindow_ResizeChildren_wndResizableExample()
  Protected dpi.l = GetDpiForWindow(WindowID(#wndResizableExample))
  
  ; The resizing of child gadgets within a resizable window is handled in the #PB_Event_SizeWindow event handler.
  
  If dpi
    StartDPIAction(dpi)
    
    WinW = WindowWidth(#wndResizableExample)
    WinH = WindowHeight(#wndResizableExample)
    
    ResizeGadget(#wndResizableExample_g0, 10, 10, 60, 24)
    ResizeGadget(#wndResizableExample_g1, WinW - 70, 10, 60, 24)
    ResizeGadget(#wndResizableExample_g2, 10, WinH - 34, 60, 24)
    ResizeGadget(#wndResizableExample_g3, WinW - 70, WinH - 34, 60, 24)
    
    StopDPIAction()
  EndIf
  
EndProcedure

Procedure ResizeChildren_wndResizableExample(dpi.l)
  Protected hFont
  
  StartDPIAction(dpi)
  
  ; Fonts must be loaded between StartDPIAction and StopDPIAction.
  ; And the font loaded here must not be applied to gadgets in other windows.
  
  hFont = LoadSystemDefaultFont(#wndResizableExample_DefaultFont)
  ;hFont = LoadSystemDefaultFont(#wndSub1_DefaultFont, dpi)
  
  If hFont = 0
    StopDPIAction()
    ProcedureReturn 0
  EndIf
  
  SetGadgetFont(#wndResizableExample_g0, hFont)
  SetGadgetFont(#wndResizableExample_g1, hFont)
  SetGadgetFont(#wndResizableExample_g2, hFont)
  SetGadgetFont(#wndResizableExample_g3, hFont)
  
  StopDPIAction()
  
EndProcedure

Procedure ResizeChildren_wndSub2(dpi.l)
  Protected img
  
  StartDPIAction(dpi)
  
  
  ; The best approach is to prepare separate images for each screen scale and assign them accordingly.
  ;   Select (dpi * 100 / 96)
  ;     Case 100
  ;       img = #Img_01_100
  ;     Case 125
  ;       img = #Img_01_125
  ;     Case 150
  ;       img = #Img_01_150
  ;     Case 175
  ;       img = #Img_01_175
  ;     Case 200
  ;       img = #Img_01_200
  ;     Default
  ;       ; Image for 100% scale is resized to match the new dpi.
  ;       img = -1
  ;       If CopyImage(#Img_01_100, #Img_01_Copy)
  ;         ResizeImage(#Img_01_Copy, ImageWidth(#Img_01_100) * dpi / 96, ImageHeight(#Img_01_100) * dpi / 96, #PB_Image_Smooth)
  ;         img = #Img_01_Copy
  ;       EndIf
  ;   EndSelect
  
  ; Image for 100% scale is resized to match the new dpi.
  img = -1
  If CopyImage(#Img_01_100, #Img_01_Copy)
    ResizeImage(#Img_01_Copy, ImageWidth(#Img_01_100) * dpi / 96, ImageHeight(#Img_01_100) * dpi / 96, #PB_Image_Smooth)
    Debug "New img W,H: " + Str(ImageWidth(#Img_01_100) * dpi / 96) + " , " + Str(ImageHeight(#Img_01_100) * dpi / 96)
    img = #Img_01_Copy
  EndIf
  
  If IsImage(img)
    SetGadgetState(#wndSub2_g0, ImageID(img))
  EndIf
  ResizeGadget(#wndSub2_g0, WindowWidth(#wndSub2) - 120, 10, #PB_Ignore, #PB_Ignore)
  
  StopDPIAction()
  
EndProcedure

If OpenWindow(#wndSub1, 0, 0, 405, 240, "ScrollAreaGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ScrollAreaGadget(#wndSub1_g0, 10, 10, 390,220, 575, 555, 30)
    ButtonGadget  (#wndSub1_g1, 100, 10, 230, 30,"Button 1")
    ButtonGadget  (#wndSub1_g2, 50, 50, 230, 30,"Button 2")
    ButtonGadget  (#wndSub1_g3, 90, 90, 230, 30,"Button 3")
    TextGadget    (#wndSub1_g4,130,130, 230, 20,"This is the content of a ScrollAreaGadget!",#PB_Text_Right)
  CloseGadgetList()
  
  ; Change the size of all child gadgets.
  dpi = GetDpiForWindow(WindowID(#wndSub1))
  ResizeChildren_wndSub1(dpi)
  SetDPICallback(#wndSub1, @ResizeChildren_wndSub1())
  
  StartDPIAction(dpi)
  Debug "Window #wndSub1 W,H (init) = " + WindowWidth(#wndSub1) + " , " + WindowHeight(#wndSub1)
  StopDPIAction()
  
EndIf

If OpenWindow(#wndResizableExample, 100, 100, 405, 240, "Resizable window example", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
  
  ButtonGadget(#wndResizableExample_g0, 0, 0, 0, 0, "Button 1")
  ButtonGadget(#wndResizableExample_g1, 0, 0, 0, 0, "Button 2")
  ButtonGadget(#wndResizableExample_g2, 0, 0, 0, 0, "Button 3")
  ButtonGadget(#wndResizableExample_g3, 0, 0, 0, 0, "Button 4")
  
  ; Change the size of all child gadgets.
  dpi = GetDpiForWindow(WindowID(#wndResizableExample))
  ResizeChildren_wndResizableExample(dpi)
  SetDPICallback(#wndResizableExample, @ResizeChildren_wndResizableExample())
  
  ; The resizing of child gadgets within a resizable window is handled in the #PB_Event_SizeWindow event handler.
  Event_SizeWindow_ResizeChildren_wndResizableExample()
  BindEvent(#PB_Event_SizeWindow, @Event_SizeWindow_ResizeChildren_wndResizableExample(), #wndResizableExample)
  
  StartDPIAction(dpi)
  Debug "Window #wndResizableExample W,H (init) = " + WindowWidth(#wndResizableExample) + " , " + WindowHeight(#wndResizableExample)
  StopDPIAction()
  
EndIf


If LoadImage(#Img_01_100, #PB_Compiler_Home + "examples/sources/Data/Map.bmp")
  If OpenWindow(#wndSub2, 0, 0, 200, 200, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    ImageGadget(#wndSub2_g0, 0, 0, 0, 0, 0)
    
    ; Change the size of all child gadgets.
    dpi = GetDpiForWindow(WindowID(#wndSub2))
    ResizeChildren_wndSub2(dpi)
    SetDPICallback(#wndSub2, @ResizeChildren_wndSub2())
    
    StartDPIAction(dpi)
    Debug "Window #wndSub2 W,H (init) = " + WindowWidth(#wndSub2) + " , " + WindowHeight(#wndSub2)
    StopDPIAction()
    
  EndIf
  
Else
  Debug "The image file not found."
EndIf

If OpenWindow(#wndMain, 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.
  dpi = GetDpiForWindow(WindowID(#wndMain))
  ResizeChildren_wndMain(dpi)
  SetDPICallback(#wndMain, @ResizeChildren_wndMain())
  
  StartDPIAction(dpi)
  Debug "Window #wndMain W,H (init) = " + WindowWidth(#wndMain) + " , " + WindowHeight(#wndMain)
  StopDPIAction()
  
EndIf

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
Last edited by breeze4me on Sat Feb 21, 2026 11:30 am, edited 5 times in total.
Top
User avatar
idle
Always Here
Always Here
Posts: 6209
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: [Windows] DPI awareness Per Monitor v2

Post by idle »

I didn't really think about having different scaling on different monitors
This will be very useful thanks
Top
breeze4me
Enthusiast
Enthusiast
Posts: 672
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: [Windows] DPI awareness Per Monitor v2

Post by breeze4me »

This is prototype code for thread-safe.

Compared to thread-unsafe code, it has limitations.
It can only be compiled in PB 6.1x or later versions, and in future PB versions, the code may need to be modified to work.
The MS Detours library is required.

The PB's DesktopScaled/DesktopUnscaled functions are hooked, and the call code to the MulDiv() function inside the PB_LoadFont2 function is modified.

Most operations on internal DPI variables of PB are read-only.
Only when using the SetSystemDPI() function, the values are written to the internal DPI variables of PB. In other cases, it does not write values to PB internal variables.

Update 1:
Added functions and macros to replace the OpenWindow() function. See the code for details.

Code: Select all

DeclareModule DPIAwareness
  ;- DeclareModule - DPIAwareness
  
  Prototype.l ptGetDpiForWindow(hwnd)
  Global GetDpiForWindow.ptGetDpiForWindow
  
  Global g_DPIAwarenessInitSuccess
  
  Declare LoadSystemDefaultFont(FontNumber = #PB_Any, dpi.l = #PB_Default)
  Declare SetDPICallback(Window, *Procedure)
  Declare StartDPIAction(dpi.l)
  Declare StopDPIAction()
  
  ; Functions that can be used regardless of the StartDPIAction/StopDPIAction block. Available both inside and outside the block.
  ; If the dpi value is 0, it returns the same value as PB's DesktopXXX() functions.
  Declare.l DPIScaledX(Value.l, dpi.l = 0)
  Declare.l DPIScaledY(Value.l, dpi.l = 0)
  Declare.l DPIUnscaledX(Value.l, dpi.l = 0)
  Declare.l DPIUnscaledY(Value.l, dpi.l = 0)
  Declare.d DPIResolutionX(dpi.l = 0)
  Declare.d DPIResolutionY(dpi.l = 0)
  
  ; 1. Adjust the x,y values to match the DPI of the monitor where the values are located. (The x and y parameters of the OpenWindow() function are not in pixels, which complicates matters.)
  ; 2. When a window is opened across the boundaries of two or more monitors with different DPI values, various issues can occur. This is a function designed to solve such issues.
  Macro OpenWindow(Window, x, y, InnerWidth, InnerHeight, Title, Flags = #PB_Window_SystemMenu, ParentID = 0)
    APPOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title, Flags, ParentID)
  EndMacro
  Declare APPOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title$, Flags = #PB_Window_SystemMenu, ParentID = 0)
  
EndDeclareModule

Module DPIAwareness
  ;- Module - DPIAwareness
  
  CompilerIf Not #PB_Compiler_DPIAware
    CompilerError "Turn ON the DPI aware option."
  CompilerEndIf
  
  EnableExplicit
  
  Import ""
    PB_Desktop_DPIX.l
    PB_Desktop_DPIY.l
    PB_Desktop_ResolutionX.d
    PB_Desktop_ResolutionY.d
    
    PB_Font_Objects.i
  EndImport
  
  Import "Detours.lib"
    DetourTransactionBegin.l()
    DetourTransactionCommit.l()
    DetourUpdateThread.l(hThread)
    DetourAttach.l(*ppPointer, pDetour)
    DetourDetach.l(*ppPointer, pDetour)
  EndImport
  
  ;- OS Constants.
  
  #STATUS_SUCCESS = 0
  
  ; Windows 8+
  #DEVICE_PRIMARY = 0
  #DEVICE_IMMERSIVE = 1
  
  ; 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
  
  ;- Module 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 DPI awareness per-monitor v2.
  #WIN10_BUILD_1709 = $3FAB ; 16299 , 1709
  #WIN10_BUILD_1803 = $42EE ; 17134 , 1803
  
  #PrevWndProc$ = "DPI_PrevWndProc"
  #DPICallback$ = "DPI_Callback"
  
  ;- 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+
  Prototype ptGetScaleFactorForDevice(deviceType)
  Global GetScaleFactorForDevice__.ptGetScaleFactorForDevice
  
  ; 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 ptSystemParametersInfoForDpi(uiAction.l, uiParam.l, *pvParam, fWinIni.l, dpi.l)
  Global SystemParametersInfoForDpi__.ptSystemParametersInfoForDpi
  
;   ; Windows 10 1607+
;   Prototype.l ptGetDpiForSystem()
;   Global GetDpiForSystem__.ptGetDpiForSystem
;   
;   ; Windows 10 1803+
;   Prototype.l ptGetSystemDpiForProcess(hProcess)  
;   Global GetSystemDpiForProcess__.ptGetSystemDpiForProcess
  
  
  ;- Module Structures.
  Structure AsciiArr
    a.a[0]
  EndStructure
  
  Structure tagMonitor
    x.l
    y.l
    PixelX.l
    PixelY.l
  EndStructure
  
  ;- Module Declares.
  Declare.l APPGetDpiForWindow(hWnd)
  Declare.l MulDiv_InLoadFont2(nNumber.l, nNumerator.l, nDenominator.l)
  
  ;- Module Global Variables.
  Global *g_FontDPI.Long          ; Memory address for DPI value of PB font.
  Global g_IsInitSuccess
  Global g_PBOSVersion
  
  Prototype.l ptDesktopScaled(Value.l)
  
  Global APP_DesktopScaledX.ptDesktopScaled
  Global APP_DesktopScaledY.ptDesktopScaled
  Global APP_DesktopUnscaledX.ptDesktopScaled
  Global APP_DesktopUnscaledY.ptDesktopScaled
  
  Global *g_MulDiv_InLoadFont2 = @MulDiv_InLoadFont2()
  
  ; For thread-safe.
  Threaded g_IsDPIActionMode
  Threaded g_DPI.l
  Threaded g_Resolution.d
  
  
  Macro PBOpenWindow
    OpenWindow
  EndMacro
  
  ;- Module Functions.
  
  Procedure.l MulDiv_InLoadFont2(nNumber.l, nNumerator.l, nDenominator.l)
    
    Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - ThreadID: " + GetCurrentThreadId_() + " , g_IsDPIActionMode: " + g_IsDPIActionMode + " , g_DPI: " + g_DPI
    
    If g_IsDPIActionMode
      If g_DPI > 0
        nNumerator = g_DPI
      EndIf
    EndIf
    
    ProcedureReturn MulDiv_(nNumber, nNumerator, nDenominator)
  EndProcedure
  
  Procedure.l DPIScaledX(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    ProcedureReturn MulDiv_(Value, dpi, 96)
  EndProcedure
  
  Procedure.l DPIScaledY(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIY
    EndIf
    ProcedureReturn MulDiv_(Value, dpi, 96)
  EndProcedure
  
  Procedure.l DPIUnscaledX(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    Protected Resolution.d = dpi / 96
    ProcedureReturn (Value / Resolution)
  EndProcedure
  
  Procedure.l DPIUnscaledY(Value.l, dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIY
    EndIf
    Protected Resolution.d = dpi / 96
    ProcedureReturn (Value / Resolution)
  EndProcedure
  
  Procedure.d DPIResolutionX(dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIX
    EndIf
    ProcedureReturn (dpi / 96)
  EndProcedure
  
  Procedure.d DPIResolutionY(dpi.l = 0)
    If dpi <= 0
      dpi = PB_Desktop_DPIY
    EndIf
    ProcedureReturn (dpi / 96)
  EndProcedure
  
  Procedure.l New_DesktopScaledX(Value.l)
    ;Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure
    
    If g_IsDPIActionMode
      If g_DPI > 0
        ProcedureReturn MulDiv_(Value, g_DPI, 96)
      EndIf
    EndIf
    
    ProcedureReturn APP_DesktopScaledX(Value)
  EndProcedure
  
  Procedure.l New_DesktopScaledY(Value.l)
    ;Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure
    
    If g_IsDPIActionMode
      If g_DPI > 0
        ProcedureReturn MulDiv_(Value, g_DPI, 96)
      EndIf
    EndIf
    
    ProcedureReturn APP_DesktopScaledY(Value)
  EndProcedure
  
  Procedure.l New_DesktopUnscaledX(Value.l)
    ;Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " -  g_DPI = " + g_DPI
    
    If g_IsDPIActionMode
      If g_DPI > 0
        Protected Resolution.d = g_DPI / 96
        ProcedureReturn (Value / Resolution)
      EndIf
    EndIf
    
    ProcedureReturn APP_DesktopUnscaledX(Value)
  EndProcedure
  
  Procedure.l New_DesktopUnscaledY(Value.l)
    ;Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " -  g_DPI = " + g_DPI
    
    If g_IsDPIActionMode
      If g_DPI > 0
        Protected Resolution.d = g_DPI / 96
        ProcedureReturn (Value / Resolution)
      EndIf
    EndIf
    
    ProcedureReturn APP_DesktopUnscaledY(Value)
  EndProcedure
  
  ; Note:
  ; The following functions must be modified whenever the PB_LoadFont2 function changes.
  ; Currently, it is only valid for PB version 6.1x and later.
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
    ; x86 _PB_LoadFont2@16
    
    ; $55                                      ; 00CB1DF9 push ebp
    ; ......
    ; $6A, $48                                 ; 00CB1E61 push 0x48                  ; Binary sequence to find.
    ; $FF, $35, $1C, $0E, $D3, $00             ; 00CB1E63 push dword [0xd30e1c]
    ; $FF, $75, $10                            ; 00CB1E69 push dword [ebp+0x10]
    ; $FF, $15, $F0, $0F, $D2, $00             ; 00CB1E6C call dword [0xd20ff0]      ; MulDiv(FontSize, FontDPI, 72)
    ; $F7, $D8                                 ; 00CB1E72 neg eax
    ; ......
    
    Procedure Replace_MulDiv_InLoadFont2()
      Protected Result, i, *Byte.AsciiArr
      
      CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm
        *Byte = PeekI(?_PB_LoadFont2)
      CompilerElse
        !p_byte = &PB_LoadFont2;
      CompilerEndIf
      
      For i = 0 To 150
        If *Byte\a[0] = $6a And *Byte\a[1] = $48
          If *Byte\a[11] = $FF And *Byte\a[12] = $15
            
            Protected *CallAddr = *Byte + 13
            Protected *Buffer = @*g_MulDiv_InLoadFont2
            
            Protected PrevProtect
            Protected hProcess = GetCurrentProcess_()
            
            If hProcess
              If VirtualProtectEx_(hProcess, *CallAddr, SizeOf(Long), #PAGE_EXECUTE_READWRITE, @PrevProtect)
                If WriteProcessMemory_(hProcess, *CallAddr, @*Buffer, SizeOf(Long), 0)
                  If VirtualProtectEx_(hProcess, *CallAddr, SizeOf(Long), PrevProtect, @PrevProtect)
                    Result = FlushInstructionCache_(hProcess, *CallAddr, SizeOf(Long))
                  EndIf
                EndIf
              EndIf
            EndIf
            
            Break
          EndIf
        EndIf
        *Byte + 1
      Next
      
      ProcedureReturn Result
    EndProcedure
    
  CompilerElseIf #PB_Compiler_Processor = #PB_Processor_x64
    ; x64 PB_LoadFont2
    
    ; $48, $89, $5C, $24, $08                   ; 00007FF6E01C2418 mov [rsp+0x8], rbx
    ; ......
    ; $41, $B8, $48, $00, $00, $00              ; 00007FF6E01C2493 mov r8d, 0x48             ; Binary sequence to find.
    ; $41, $F7, $DD                             ; 00007FF6E01C2499 neg r13d
    ; $1B, $DB                                  ; 00007FF6E01C249C sbb ebx, ebx
    ; $81, $E3, $2C, $01, $00, $00              ; 00007FF6E01C249E and ebx, 0x12c
    ; $81, $C3, $90, $01, $00, $00              ; 00007FF6E01C24A4 add ebx, 0x190
    ; $FF, $15, $B8, $F6, $07, $00              ; 00007FF6E01C24AA call qword [rip+0x7f6b8]  ; MulDiv(FontSize, FontDPI, 72)
    ; $48, $8B, $8C, $24, $B8, $00, $00, $00    ; 00007FF6E01C24B0 mov rcx, [rsp+0xb8]
    ; ......
    
    Procedure Replace_MulDiv_InLoadFont2()
      Protected Result, i, *Byte.AsciiArr
      
      CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm
        *Byte = PeekI(?_PB_LoadFont2)
      CompilerElse
        !p_byte = &PB_LoadFont2;
      CompilerEndIf
      
      For i = 0 To 150
        If *Byte\a[0] = $41 And *Byte\a[1] = $b8 And *Byte\a[2] = $48
          If *Byte\a[23] = $FF And *Byte\a[24] = $15
            
            Protected *RIP = *Byte + 29
            Protected *CallAddr = *RIP - 4
            Protected Diff.l = @*g_MulDiv_InLoadFont2 - *RIP
            
            Protected PrevProtect
            Protected hProcess = GetCurrentProcess_()
            
            If hProcess
              If VirtualProtectEx_(hProcess, *CallAddr, SizeOf(Long), #PAGE_EXECUTE_READWRITE, @PrevProtect)
                If WriteProcessMemory_(hProcess, *CallAddr, @Diff, SizeOf(Long), 0)
                  If VirtualProtectEx_(hProcess, *CallAddr, SizeOf(Long), PrevProtect, @PrevProtect)
                    Result = FlushInstructionCache_(hProcess, *CallAddr, SizeOf(Long))
                  EndIf
                EndIf
              EndIf
            EndIf
            
            Break
          EndIf
        EndIf
        *Byte + 1
      Next
      
      ProcedureReturn Result
    EndProcedure
    
  CompilerElse
    CompilerError "NOT supported processor !"
  CompilerEndIf
  
  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()
    Protected Lib_Shcore, Lib_User32
    
    Lib_Shcore = OpenLibrary(#PB_Any, "Shcore.dll")
    If Lib_Shcore
      ; Windows 8.1+
      GetDpiForMonitor__ = GetFunction(Lib_Shcore, "GetDpiForMonitor")
      
      ; Windows 8+
      GetScaleFactorForDevice__ = GetFunction(Lib_Shcore, "GetScaleFactorForDevice")
      
    EndIf
    
    Lib_User32 = OpenLibrary(#PB_Any, "User32.dll")
    If Lib_User32
      
      ; Windows 10 1607
      EnableNonClientDpiScaling__ = GetFunction(Lib_User32, "EnableNonClientDpiScaling")
      
      ; Windows 10 1607+
      GetDpiForWindow = GetFunction(Lib_User32, "GetDpiForWindow")
      
      ; Windows 10 1607+
      SystemParametersInfoForDpi__ = GetFunction(Lib_User32, "SystemParametersInfoForDpi")
      
;       ; Windows 10 1607+
;       GetDpiForSystem__ = GetFunction(Lib_User32, "GetDpiForSystem")
;       
;       ; Windows 10 1803+
;       GetSystemDpiForProcess__ = GetFunction(Lib_User32, "GetSystemDpiForProcess")
      
    EndIf
    
    ; This function must always be callable without failure.
    If GetDpiForWindow = 0
      GetDpiForWindow = @APPGetDpiForWindow()
      Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - GetDpiForWindow: Using the app's function."
    EndIf
    
  EndProcedure
  
  Procedure GetFontDPIAddr()
    CompilerIf Defined(PB_Font_Objects, #PB_Variable)
      ProcedureReturn @PB_Font_Objects + SizeOf(Integer)
    CompilerElse
      ProcedureReturn 0
    CompilerEndIf
  EndProcedure
  
  Procedure.l GetSystemDPI()
    Protected pt.q, hMonitor, hDC, DpiX.l, DpiY.l
    
    ; Windows 8.1+
    If GetDpiForMonitor__
      hMonitor = MonitorFromPoint_(pt, #MONITOR_DEFAULTTOPRIMARY)
      If hMonitor
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK And DpiX > 0
          ProcedureReturn DpiX
        EndIf
        DpiX = 0
      EndIf
    EndIf
    
    ; Windows 8+
    If GetScaleFactorForDevice__
      DpiX = GetScaleFactorForDevice__(#DEVICE_PRIMARY) * 96 / 100
      If DpiX > 0
        ProcedureReturn DpiX
      EndIf
      DpiX = 0
    EndIf
    
    ; Note:
    ; Very slow. The GetDpiForWindow API is the fastest, and the methods above are the next fastest.
    ; This method does not reflect changes to the DPI of the primary monitor. Only the DPI value immediately after the app starts is returned.
    If DpiX = 0
      hDC = GetDC_(0)
      If hDC
        DpiX = GetDeviceCaps_(hDC, #LOGPIXELSX)
        ReleaseDC_(0, hDC)
      EndIf
      
      ;hDC = CreateDC_("DISPLAY", 0, 0, 0)
      ;If hDC
      ;  DpiX = GetDeviceCaps_(hDC, #LOGPIXELSX)
      ;  DeleteDC_(hDC)
      ;EndIf
    EndIf
    
    ProcedureReturn DpiX
  EndProcedure
  
  Procedure SetSystemDPI()
    Static PrevDPI.l
    Protected Result, DpiX.l = GetSystemDPI()
    
    If DpiX > 0 And PrevDPI <> DpiX
      Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - DPI: " + DpiX
      
      PB_Desktop_DPIX = DpiX
      PB_Desktop_DPIY = DpiX
      
      PB_Desktop_ResolutionX = DpiX / 96
      PB_Desktop_ResolutionY = DpiX / 96
      
      If *g_FontDPI
        *g_FontDPI\l = DpiX
      EndIf
      
      PrevDPI = DpiX
      
      Result = 1
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure.l APPGetDpiForWindow(hWnd)
    Protected hMonitor, DpiX.l, DpiY.l
    
    ; Windows 8.1+
    If GetDpiForMonitor__
      hMonitor = MonitorFromWindow_(hWnd, #MONITOR_DEFAULTTONEAREST)
      If hMonitor
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK And DpiX > 0
          ProcedureReturn DpiX
        EndIf
      EndIf
    EndIf
    
    DpiX = GetSystemDPI()
    If DpiX = 0 : DpiX = 96 : EndIf
    
    ProcedureReturn DpiX
  EndProcedure
  
  Procedure LoadSystemDefaultFont(FontNumber = #PB_Any, dpi.l = #PB_Default)
    Protected Font, Height.l, SystemDPI.l, ncm.NONCLIENTMETRICS_vista
    Protected TempHook
    
    If dpi <= 0
      If g_DPI > 0
        dpi = g_DPI
      Else
        dpi = PB_Desktop_DPIX
      EndIf
    EndIf
    
    If SystemParametersInfoForDpi__
      ncm\cbSize = SizeOf(NONCLIENTMETRICS_vista)
      If SystemParametersInfoForDpi__(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS_vista), @ncm, 0, dpi)
        Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - OK: SystemParametersInfoForDpi"
      EndIf
    Else
      SystemDPI = GetSystemDPI()
      ncm\cbSize = SizeOf(NONCLIENTMETRICS)
      If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
        Debug #PB_Compiler_Module +  " :: " + #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
      If ncm\lfMessageFont\lfHeight = 0
        Height = 9
      Else
        Height = ncm\lfMessageFont\lfHeight
      EndIf
    EndIf
    
    Protected FontStyle.l
    If ncm\lfMessageFont\lfWeight = 700 : FontStyle | #PB_Font_Bold : EndIf
    If ncm\lfMessageFont\lfItalic : FontStyle | #PB_Font_Italic : EndIf
    If ncm\lfMessageFont\lfStrikeOut : FontStyle | #PB_Font_StrikeOut: EndIf
    If ncm\lfMessageFont\lfUnderline : FontStyle | #PB_Font_Underline: EndIf
    
    Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - Font height: " + Height + " (DPI: " + dpi + " )"
    
    If dpi <> PB_Desktop_DPIX And g_IsDPIActionMode = 0
      g_DPI = dpi
      ;g_Resolution = dpi / 96
      g_IsDPIActionMode = 1
      TempHook = 1
    EndIf
    
    If FontStyle
      Font = LoadFont(FontNumber, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height, FontStyle)
    Else
      Font = LoadFont(FontNumber, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height)
    EndIf
    
    If TempHook
      g_IsDPIActionMode = 0
      ;g_Resolution = 0
      g_DPI = 0
    EndIf
    
    ProcedureReturn Font
  EndProcedure
  
  Procedure StartDPIAction(dpi.l)
    If g_IsInitSuccess = 0 : ProcedureReturn 1 : EndIf
    
    If g_IsDPIActionMode
      ProcedureReturn 0
    EndIf
    
    If dpi <= 0
      dpi = GetSystemDPI()
    EndIf
    
    g_DPI = dpi
    g_Resolution = dpi / 96
    g_IsDPIActionMode = 1
    
    ProcedureReturn 1
  EndProcedure
  
  Procedure StopDPIAction()
    If g_IsInitSuccess = 0 : ProcedureReturn 1 : EndIf
    g_IsDPIActionMode = 0
    g_Resolution = 0
    g_DPI = 0
    ProcedureReturn 1
  EndProcedure
  
  Procedure.l MonitorEnumProc(hMonitor, hdcMonitor, *lprcMonitor.RECT, *dwData.tagMonitor)
    Protected DpiX.l, DpiY.l
    Protected UnscaledRect.RECT
    
    If *dwData And *lprcMonitor
      ; Windows 8.1+
      If GetDpiForMonitor__
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) = #S_OK
          ; Unscale the RECT values of the monitor and check whether the x and y coordinates fall within the RECT range.
          UnscaledRect\left = DPIUnscaledX(*lprcMonitor\left, DpiX)
          UnscaledRect\top = DPIUnscaledY(*lprcMonitor\top, DpiX)
          UnscaledRect\right = DPIUnscaledX(*lprcMonitor\right, DpiX)
          UnscaledRect\bottom = DPIUnscaledY(*lprcMonitor\bottom, DpiX)
          
          If PtInRect_(@UnscaledRect, (*dwData\y << 32) | (*dwData\x & $FFFFFFFF))
            *dwData\PixelX = DPIScaledX(*dwData\x, DpiX)
            *dwData\PixelY = DPIScaledY(*dwData\y, DpiX)
            
            *dwData\x = UnscaledRect\left
            *dwData\y = UnscaledRect\top
          EndIf
          
        EndIf
      EndIf
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure.l CallWndProc(nCode.l, wParam, *lParam.CWPSTRUCT)
    If *lParam
      If *lParam\message = #WM_DPICHANGED
        Debug "WH_CALLWNDPROC - WM_DPICHANGED " ;+ GetAncestor_(*lParam\hwnd, #GA_ROOT) + " " + *lParam\hwnd
        
        Protected *rt.RECT
        
        *rt = *lParam\lParam
        If *rt
          With *rt
            SetWindowPos_(*lParam\hwnd, 0, \left, \top, \right - \left, \bottom - \top, #SWP_NOZORDER | #SWP_NOACTIVATE)
          EndWith
        EndIf
      EndIf
    EndIf
    ProcedureReturn CallNextHookEx_(0, nCode, wParam, *lParam)
  EndProcedure
  
  ; 1. Adjust the x,y values to match the DPI of the monitor where the values are located. (The x and y parameters of the OpenWindow() function are not in pixels, which complicates matters.)
  ; 2. When a window is opened across the boundaries of two or more monitors with different DPI values, various issues can occur. This is a function designed to solve such issues.
  Procedure APPOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title$, Flags = #PB_Window_SystemMenu, ParentID = 0)
    Protected Result, TempInvisible, hHook
    Protected Monitor.tagMonitor
    
    Debug #PB_Compiler_Module + " :: " + #PB_Compiler_Procedure
    
    If g_PBOSVersion >= #PB_OS_Windows_8_1 And x <> #PB_Ignore And y <> #PB_Ignore And (Flags & #PB_Window_ScreenCentered = 0 And Flags & #PB_Window_WindowCentered = 0)
      
      If Flags & #PB_Window_Invisible <> #PB_Window_Invisible
        Flags | #PB_Window_Invisible
        TempInvisible = 1
      EndIf
      
      Monitor\x = x
      Monitor\y = y
      
      ; The DPI of each monitor can change, so the relevant values must be recalculated each time.
      ; Alternatively, detect when the DPI of each monitor changes and cache that values.(Not implemented here.)
      If EnumDisplayMonitors_(0, 0, @MonitorEnumProc(), @Monitor)
        
        hHook = SetWindowsHookEx_(#WH_CALLWNDPROC, @CallWndProc(), GetModuleHandle_(0), GetCurrentThreadId_())
        If hHook
          ; After opening a window on the primary monitor, move the window to a specific location based on its x and y coordinates.
          Result = PBOpenWindow(Window, 0, 0, InnerWidth, InnerHeight, Title$, Flags, ParentID)
          If Result
            If Window = #PB_Any
              Window = Result
            EndIf
            
            ; If the window's DPI changes due to its movement, the hook procedure detects this and adjusts the window size.
            SetWindowPos_(WindowID(Window), 0, Monitor\PixelX, Monitor\PixelY, 0, 0, #SWP_FRAMECHANGED | #SWP_NOSIZE | #SWP_NOZORDER | #SWP_NOOWNERZORDER)
          EndIf
          
          UnhookWindowsHookEx_(hHook)
        EndIf
      EndIf
      
      If TempInvisible
        HideWindow(Window, 0)
      EndIf
      
    Else
      Result = PBOpenWindow(Window, x, y, InnerWidth, InnerHeight, Title$, Flags, ParentID)
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure WinCallback_DPI(hWnd, uMsg, wParam, lParam)
    If uMsg = #WM_NCCREATE
      If GetAncestor_(hWnd, #GA_ROOT) = hWnd
        If EnableNonClientDpiScaling__
          EnableNonClientDpiScaling__(hWnd)
          Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - EnableNonClientDpiScaling"
        EndIf
      EndIf
    EndIf
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndProcedure
  
  Procedure WinCallback(hWnd, uMsg, wParam, lParam)
    Protected PrevWndProc = GetProp_(hWnd, #PrevWndProc$)
    
    CompilerIf #PB_Compiler_Debugger
      Protected Window = GetProp_(hWnd, "PB_WindowID") - 1
    CompilerEndIf
    
    CompilerIf #PB_Compiler_Debugger
      If uMsg = #WM_EXITSIZEMOVE
        If StartDPIAction(GetDpiForWindow(hWnd))
          Debug "Win " + Window + " - WM_EXITSIZEMOVE,   Window W,H = " + WindowWidth(Window) + " , " + WindowHeight(Window)
          StopDPIAction()
        EndIf
      EndIf
    CompilerEndIf
    
    ; Windows 10 1703+
    If uMsg = #WM_GETDPISCALEDSIZE
      CompilerIf #PB_Compiler_Debugger
        Debug "Win " + Window + " - WM_GETDPISCALEDSIZE"
      CompilerEndIf
    EndIf
    
    ; Windows 8.1+
    If uMsg = #WM_DPICHANGED
      CompilerIf #PB_Compiler_Debugger
        Debug "Win " + Window + " - WM_DPICHANGED   " + GetCurrentThreadId_()
      CompilerEndIf
      
      Protected *rt.RECT
      
      *rt = lParam
      If *rt
        Protected *DPICallback = GetProp_(hWnd, #DPICallback$)
        If *DPICallback
          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. Or set only properties that change based on the DPI of child gadgets. (e.g., fonts, images, etc.)
          CallFunctionFast(*DPICallback, (wParam & $FFFF))
        EndIf
      EndIf
      
    EndIf 
    
    If uMsg = #WM_NCDESTROY
      CompilerIf #PB_Compiler_Debugger
        Debug "Win " + Window + " - WM_NCDESTROY"
      CompilerEndIf
      
      RemoveProp_(hWnd, #PrevWndProc$)
      RemoveProp_(hWnd, #DPICallback$)
    EndIf
    
    ProcedureReturn CallWindowProc_(PrevWndProc, hWnd, uMsg, wParam, lParam)
  EndProcedure
  
  Procedure.l PropEnumProc(hWnd, *PropStringOrAtom, unnamedParam3)
    If *PropStringOrAtom & -65536
      Protected PropString.s = PeekS(*PropStringOrAtom)
      If PropString = #DPICallback$
        ProcedureReturn #False
      EndIf
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure SetDPICallback(Window, *Procedure)
    Protected Result.l, hWnd
    
    If g_IsInitSuccess = 0 : ProcedureReturn 0 : EndIf
    
    If IsWindow(Window) And *Procedure
      hWnd = WindowID(Window)
      If hWnd
        If EnumProps_(hWnd, @PropEnumProc()) = #True
          Result = SetProp_(hWnd, #PrevWndProc$, SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, @WinCallback()))
        Else
          Result = 1
        EndIf
        If Result
          Result = SetProp_(hWnd, #DPICallback$, *Procedure)
        EndIf
      EndIf
    EndIf
    ProcedureReturn Result
  EndProcedure
  
  Procedure WinCallback_SystemDPIDetectionWindow(hWnd, uMsg, wParam, lParam)
    If uMsg = #WM_DISPLAYCHANGE
      ; Note: It is necessary to check whether it works on Windows 8 and earlier versions.
      If SetSystemDPI()
        Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " - WM_DISPLAYCHANGE : The DPI or resolution of the primary monitor has changed. (New DPI: " + PB_Desktop_DPIX + ")"
      EndIf
    EndIf
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndProcedure
  
  Procedure OpenSystemDPIDetectionWindow()
    Protected Window = OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_BorderLess | #PB_Window_Invisible | #PB_Window_NoGadgets | #PB_Window_NoActivate)
    If Window
      SetWindowCallback(@WinCallback_SystemDPIDetectionWindow(), Window)
    EndIf
  EndProcedure
  
  Procedure HookFunctions()
    Protected Result
    
    If APP_DesktopScaledX = 0 Or APP_DesktopScaledY = 0 Or APP_DesktopUnscaledX = 0 Or APP_DesktopUnscaledY = 0
      ProcedureReturn 0
    EndIf
    
    If DetourTransactionBegin() <> #NO_ERROR
      ProcedureReturn 0
    EndIf
    
    If DetourUpdateThread(GetCurrentThread_()) <> #NO_ERROR
      ProcedureReturn 0
    EndIf
    
    If DetourAttach(@APP_DesktopScaledX, @New_DesktopScaledX()) <> #NO_ERROR
      Debug "Detours Error: DesktopScaledX"
      
      Result - 1
      
      CompilerIf #PB_Compiler_Debugger
      Else
        Debug "Detour Attach: DesktopScaledX OK"
      CompilerEndIf
    EndIf
    
    If DetourAttach(@APP_DesktopScaledY, @New_DesktopScaledY()) <> #NO_ERROR
      Debug "Detours Error: DesktopScaledY"
      
      Result - 1
      
      CompilerIf #PB_Compiler_Debugger
      Else
        Debug "Detour Attach: DesktopScaledY OK"
      CompilerEndIf
    EndIf
    
    If DetourAttach(@APP_DesktopUnscaledX, @New_DesktopUnscaledX()) <> #NO_ERROR
      Debug "Detours Error: DesktopUnscaledX"
      
      Result - 1
      
      CompilerIf #PB_Compiler_Debugger
      Else
        Debug "Detour Attach: DesktopUnscaledX OK"
      CompilerEndIf
    EndIf
    
    If DetourAttach(@APP_DesktopUnscaledY, @New_DesktopUnscaledY()) <> #NO_ERROR
      Debug "Detours Error: DesktopUnscaledY"
      
      Result - 1
      
      CompilerIf #PB_Compiler_Debugger
      Else
        Debug "Detour Attach: DesktopUnscaledY OK"
      CompilerEndIf
    EndIf
    
    Debug "-----------------------------------------------"
    
    If DetourTransactionCommit() <> #NO_ERROR
      Result - 1
    EndIf
    
    If Result <> 0
      If DetourTransactionBegin() = #NO_ERROR
        If DetourUpdateThread(GetCurrentThread_()) = #NO_ERROR
          If DetourDetach(@APP_DesktopScaledX, @New_DesktopScaledX()) <> #NO_ERROR
            Debug "Detours Error: DesktopScaledX"
            
            CompilerIf #PB_Compiler_Debugger
            Else
              Debug "Detour Detach: DesktopScaledX OK"
            CompilerEndIf
          EndIf
          
          If DetourDetach(@APP_DesktopScaledY, @New_DesktopScaledY()) <> #NO_ERROR
            Debug "Detours Error: DesktopScaledY"
            
            CompilerIf #PB_Compiler_Debugger
            Else
              Debug "Detour Detach: DesktopScaledY OK"
            CompilerEndIf
          EndIf
          
          If DetourDetach(@APP_DesktopUnscaledX, @New_DesktopUnscaledX()) <> #NO_ERROR
            Debug "Detours Error: DesktopUnscaledX"
            
            CompilerIf #PB_Compiler_Debugger
            Else
              Debug "Detour Detach: DesktopUnscaledX OK"
            CompilerEndIf
          EndIf
          
          If DetourDetach(@APP_DesktopUnscaledY, @New_DesktopUnscaledY()) <> #NO_ERROR
            Debug "Detours Error: DesktopUnscaledY"
            
            CompilerIf #PB_Compiler_Debugger
            Else
              Debug "Detour Detach: DesktopUnscaledY OK"
            CompilerEndIf
          EndIf
          
          DetourTransactionCommit()
        EndIf
      EndIf
    EndIf
    
    ProcedureReturn Bool(Result = 0)
  EndProcedure
  
  Procedure InitModule()
    Protected Result, *Temp, OSVersion.OSVERSIONINFOEX
    
    g_PBOSVersion = OSVersion()
    GetOSVersion(@OSVersion)
    LoadOSFunctions()
    
    If Replace_MulDiv_InLoadFont2()
      
      CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm
        APP_DesktopScaledX = PeekI(?_PB_DesktopScaledX)
        APP_DesktopScaledY = PeekI(?_PB_DesktopScaledY)
        
        APP_DesktopUnscaledX = PeekI(?_PB_DesktopUnscaledX)
        APP_DesktopUnscaledY = PeekI(?_PB_DesktopUnscaledY)
      CompilerElse
        !dpiawarenessXg_app_desktopscaledx = &PB_DesktopScaledX;
        !dpiawarenessXg_app_desktopscaledy = &PB_DesktopScaledY;
        
        !dpiawarenessXg_app_desktopunscaledx = &PB_DesktopUnscaledX;
        !dpiawarenessXg_app_desktopunscaledy = &PB_DesktopUnscaledY;
      CompilerEndIf
      
      *Temp = DesktopScaledX(0)
      *Temp = DesktopScaledY(0)
      *Temp = DesktopUnscaledX(0)
      *Temp = DesktopUnscaledY(0)
      
      If HookFunctions()
        *g_FontDPI = GetFontDPIAddr()
        
        If *g_FontDPI And (*g_FontDPI\l > 0 And *g_FontDPI\l < 10000)
          If SetSystemDPI()
            
            Debug #PB_Compiler_Module +  " :: " + #PB_Compiler_Procedure + " -   *g_FontDPI=" + *g_FontDPI + "   DPI=" + *g_FontDPI\l
            
            ; Note:
            ; If there are calls elsewhere in the form of "SetWindowCallback(@ProcedureName())", the function call below will also be overridden, so another approach is needed.
            ; For example, SetWindowsHookEx_(#WH_CALLWNDPROC, ...)
            
            ; To receive the #WM_NCCREATE message, the callback must be set before any window is created.
            If OSVersion\dwMajorVersion = 10 And (OSVersion\dwBuildNumber >= #WIN10_BUILD_1607 And OSVersion\dwBuildNumber < #WIN10_BUILD_1703)
              SetWindowCallback(@WinCallback_DPI())
            EndIf
            
            OpenSystemDPIDetectionWindow()
            
            Result = 1
          EndIf
        EndIf
      EndIf
      
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  ;- Module startup.
  g_IsInitSuccess = InitModule()
  g_DPIAwarenessInitSuccess = g_IsInitSuccess
  
  CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      DataSection
        _PB_DesktopScaledX:
        !dd _PB_DesktopScaledX@4
        
        _PB_DesktopScaledY:
        !dd _PB_DesktopScaledY@4
        
        _PB_DesktopUnscaledX:
        !dd _PB_DesktopUnscaledX@4
        
        _PB_DesktopUnscaledY:
        !dd _PB_DesktopUnscaledY@4
        
        _PB_LoadFont2:
        !dd _PB_LoadFont2@16
        
      EndDataSection
    CompilerElseIf #PB_Compiler_Processor = #PB_Processor_x64
      DataSection
        _PB_DesktopScaledX:
        !dq PB_DesktopScaledX
        
        _PB_DesktopScaledY:
        !dq PB_DesktopScaledY
        
        _PB_DesktopUnscaledX:
        !dq PB_DesktopUnscaledX
        
        _PB_DesktopUnscaledY:
        !dq PB_DesktopUnscaledY
        
        _PB_LoadFont2:
        !dq PB_LoadFont2
        
      EndDataSection
    CompilerEndIf
  CompilerEndIf
  
  ;- End of Module - DPIAwareness
EndModule
Last edited by breeze4me on Sat Feb 21, 2026 12:53 pm, edited 1 time in total.
Top
breeze4me
Enthusiast
Enthusiast
Posts: 672
Joined: Thu Mar 09, 2006 9:24 am
Location: S. Kor

Re: [Windows] DPI awareness Per Monitor v2

Post by breeze4me »

This is a workaround module for DPI issues encountered by each requester.
For more details, see the comments in the code.

Update 1:
Minor changes.

Code: Select all

DeclareModule DPIAwarenessRequester
  ;- DeclareModule - DPIAwarenessRequester
  
  ;- Issues for each requester due to DPI changes. Moving a requester from a low-DPI monitor to a high-DPI monitor, or vice versa, causes various issues.
  ; ColorRequester()    ; Changing the DPI messes up the layout of the color tables.
  ; FontRequester()     ; Issue where controls and fonts do not match.(mainly when moving from a low-DPI monitor to a high-DPI monitor) Preview issue.
  ; InputRequester()    ; Size issue.
  ; MessageRequester()  ; DPI scaling is not applied. It seems only the system DPI is applied.
  ; PathRequester()     ; Child controls are misaligned.
  ; OpenFileRequester(), SaveFileRequester()  ; OK.
  
  ; Due to the issues described above, this module works around them by prohibiting the requesters from moving or resizing to monitors with different DPI values.
  
  ; Set the effect that occurs when the requester's moving (or resizing) to a monitor with a different DPI is canceled.
  ; Mode: 0, 1, 2, 1|2
  ; 0 = Quiet mode.
  ; 1 = MessageBeep_() (Default)
  ; 2 = Change the title text of the requester.
  Declare SetRequesterDPICancelMode(Mode, TitleText$ = "")
  
  ; It is strongly recommended to specify the ParentID in all cases.
  Declare.l DPIColorRequesterEx(CurrentColor.l = -1, ParentID = 0)
  Declare.l DPIColorRequester(CurrentColor.l = -1, ParentID = 0)
  Declare DPIFontRequester(FontName$, FontSize.l, Flags, Color = 0, Style = 0, ParentID = 0)
  Declare.s DPIPathRequester(Title$, InitialPath$, ParentID = 0)
  
EndDeclareModule

Module DPIAwarenessRequester
  ;- Module - DPIAwarenessRequester
  
  CompilerIf Not #PB_Compiler_DPIAware
    CompilerError "Turn ON the DPI aware option."
  CompilerEndIf
  
  EnableExplicit
  
  ;- Module Constants.
  
  #UOI_TIMERPROC_EXCEPTION_SUPPRESSION = 7
  
  ; Windows 8.1+
  #WM_DPICHANGED = $02E0
  
  ; MONITOR_DPI_TYPE
  #MDT_EFFECTIVE_DPI = 0
  #MDT_ANGULAR_DPI = 1
  #MDT_RAW_DPI = 2
  #MDT_DEFAULT = #MDT_EFFECTIVE_DPI
  
  #DialogBoxPrevWndProc$ = "DPI_PrevDialogBoxWndProc"
  #TimerID = 1
  
  ;- Mudule Global Vars.
  
  ; Windows 8.1+
  Prototype.l ptGetDpiForMonitor(hmonitor, dpiType.l, *dpiX, *dpiY)
  Global GetDpiForMonitor__.ptGetDpiForMonitor
  
  Global g_PBOSVersion
  Global g_DialogBoxCancelMode
  Global g_DialogBoxCancelText$
  Global g_DialogBoxTitle${64}
  Global g_DPIChangedReopenDialogBox
  Global g_hHook
  
  ; https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-settimer
  ; https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setuserobjectinformationw
  ; Before using SetTimer or other timer-related functions, it is recommended to set the UOI_TIMERPROC_EXCEPTION_SUPPRESSION flag to false through the SetUserObjectInformationW function,
  ; otherwise the application could behave unpredictably and could be vulnerable to security exploits.
  ; For more info, see SetUserObjectInformationW.
  Procedure SetUserObjectInformation()
    Protected Bool.l
    ProcedureReturn SetUserObjectInformation_(GetCurrentProcess_(), #UOI_TIMERPROC_EXCEPTION_SUPPRESSION, @Bool, SizeOf(Long))
  EndProcedure
  
  ; Set the effect that occurs when the requester's moving (or resizing) to a monitor with a different DPI is canceled.
  ; Mode: 0, 1, 2, 1|2
  ; 0 = Quiet mode.
  ; 1 = MessageBeep_() (Default)
  ; 2 = Change the title text of the requester.
  Procedure SetRequesterDPICancelMode(Mode, TitleText$ = "")
    If TitleText$ = ""
      TitleText$ = "Can't be moved/sized to a different monitor."
    EndIf
    g_DialogBoxCancelMode = Mode
    g_DialogBoxCancelText$ = TitleText$
  EndProcedure
  
  Procedure KillTimerForDialogBox(hWnd)
    KillTimer_(hWnd, #TimerID)
    SetWindowText_(hWnd, g_DialogBoxTitle$)
  EndProcedure
  
  Procedure IsDifferentDPI(hMon1, hMon2)
    Protected Result, DpiX1, DpiY1, DpiX2, DpiY2
    If GetDpiForMonitor__
      If hMon1 And hMon2
        If GetDpiForMonitor__(hMon1, #MDT_EFFECTIVE_DPI, @DpiX1, @DpiY1) = #S_OK
          If GetDpiForMonitor__(hMon2, #MDT_EFFECTIVE_DPI, @DpiX2, @DpiY2) = #S_OK
            If DpiX1 <> DpiX2
              Result = 1
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
    ProcedureReturn Result
  EndProcedure
  
  Procedure WndProcDialogBox(hWnd, uMsg, wParam, lParam)
    Protected PrevWndProc = GetProp_(hWnd, #DialogBoxPrevWndProc$)
    Protected rt.RECT, *wp.WINDOWPOS, hMon, hMonNew
    
    Static IsSizeMoveMode
    
    Select uMsg
      Case #WM_DPICHANGED
        ;Debug "WM_DPICHANGED"
        
        g_DPIChangedReopenDialogBox = 1
        
        ShowWindow_(hWnd, #SW_HIDE)
        ;SetWindowPos_(hWnd, 0, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_HIDEWINDOW  | #SWP_NOSENDCHANGING)
        
        PostMessage_(hWnd, #WM_COMMAND, #IDCANCEL, 0)
        
        ProcedureReturn 0
        
      Case #WM_ACTIVATE
        ;Debug "WM_ACTIVATE"
        If wParam & $FFFF = #WA_INACTIVE
          If IsSizeMoveMode
            IsSizeMoveMode = 0
          EndIf
        EndIf
        
      Case #WM_ENTERSIZEMOVE
        IsSizeMoveMode = 1
        
      Case #WM_EXITSIZEMOVE
        ;Debug "WM_EXITSIZEMOVE"
        If IsSizeMoveMode
          IsSizeMoveMode = 0
        EndIf
        
      Case #WM_WINDOWPOSCHANGING
        If IsSizeMoveMode
          If lParam
            ;Debug "WM_WINDOWPOSCHANGING"
            *wp = lParam
            hMon = MonitorFromWindow_(hWnd, #MONITOR_DEFAULTTONEAREST)
            If hMon
              rt\left = *wp\x
              rt\top = *wp\y
              rt\right = *wp\x + *wp\cx
              rt\bottom = *wp\y + *wp\cy
              
              hMonNew = MonitorFromRect_(rt, #MONITOR_DEFAULTTONEAREST)
              If hMonNew <> hMon And IsDifferentDPI(hMon, hMonNew)
                *wp\flags | #SWP_NOMOVE | #SWP_NOSIZE
                
                SendMessage_(hWnd, #WM_CANCELMODE, 0, 0)
                
                If g_DialogBoxCancelMode & 1
                  MessageBeep_(#MB_ICONWARNING)
                EndIf
                If g_DialogBoxCancelMode & 2 And g_DialogBoxCancelText$
                  If SetTimer_(hWnd, #TimerID, 3000, 0)
                    SetWindowText_(hWnd, g_DialogBoxTitle$ + " - " + g_DialogBoxCancelText$)
                  EndIf
                EndIf
                
              EndIf
            EndIf
          EndIf
        EndIf
        
      Case #WM_TIMER
        ;Debug "WM_TIMER"
        If wParam = #TimerID
          KillTimerForDialogBox(hWnd)
        EndIf
        
      Case #WM_NCDESTROY
        ;Debug "WM_NCDESTROY"
        IsSizeMoveMode = 0
        KillTimerForDialogBox(hWnd)
        RemoveProp_(hWnd, #DialogBoxPrevWndProc$)
    EndSelect
    
    ProcedureReturn CallWindowProc_(PrevWndProc, hWnd, uMsg, wParam, lParam)
  EndProcedure
  
  Procedure.l CallWndProcForDialogBox(nCode.l, wParam, *lParam.CWPSTRUCT)
    If *lParam
      If *lParam\message = #WM_INITDIALOG
        ;Debug "WM_INITDIALOG"
        
        UnhookWindowsHookEx_(g_hHook)
        
        ; Note:
        ; In a hook procedure, subclassing is required because the flag value is not changed in the #WM_WINDOWPOSCHANGING message.
        SetProp_(*lParam\hwnd, #DialogBoxPrevWndProc$, SetWindowLongPtr_(*lParam\hwnd, #GWLP_WNDPROC, @WndProcDialogBox()))
        If g_DialogBoxCancelMode & 2
          GetWindowText_(*lParam\hwnd, @g_DialogBoxTitle$, 62)
        EndIf
      EndIf
    EndIf
    ProcedureReturn CallNextHookEx_(0, nCode, wParam, *lParam)
  EndProcedure
  
  Procedure.l DPIColorRequesterEx(CurrentColor.l = -1, ParentID = 0)
    Protected Result.l = -1
    Protected cc.CHOOSECOLOR
    
    Static *ColorArray
    
    If *ColorArray = 0
      *ColorArray = AllocateMemory(4 * 16)
      If *ColorArray
        FillMemory(*ColorArray, 4 * 16, $FFFFFF, #PB_Long)
      Else
        ProcedureReturn Result
      EndIf
    EndIf
    
    If CurrentColor <> -1
      cc\rgbResult = CurrentColor
      cc\Flags | #CC_RGBINIT
    EndIf
    
    If ParentID And IsWindow_(ParentID)
      cc\hwndOwner = ParentID
    EndIf
    
    cc\lStructSize = SizeOf(CHOOSECOLOR)
    cc\lpCustColors = *ColorArray
    cc\Flags | #CC_ANYCOLOR | #CC_FULLOPEN
    
    If g_PBOSVersion >= #PB_OS_Windows_8_1
      g_DPIChangedReopenDialogBox = 0
      Repeat
        g_hHook = SetWindowsHookEx_(#WH_CALLWNDPROC, @CallWndProcForDialogBox(), GetModuleHandle_(0), GetCurrentThreadId_())
        If g_hHook = 0
          Break
        EndIf
        
        ; If the dialog box closes due to a DPI change, reopen it.
        Repeat
          g_DPIChangedReopenDialogBox = 0
          If ChooseColor_(cc)
            Result = cc\rgbResult
          EndIf
        Until g_DPIChangedReopenDialogBox = 0
        
        ProcedureReturn Result
      ForEver
    EndIf
    
    If ChooseColor_(cc)
      Result = cc\rgbResult
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure.l DPIColorRequester(CurrentColor.l = -1, ParentID = 0)
    Protected Result.l = -1
    
    If g_PBOSVersion >= #PB_OS_Windows_8_1
      g_DPIChangedReopenDialogBox = 0
      Repeat
        g_hHook = SetWindowsHookEx_(#WH_CALLWNDPROC, @CallWndProcForDialogBox(), GetModuleHandle_(0), GetCurrentThreadId_())
        If g_hHook = 0
          Break
        EndIf
        
        ; If the dialog box closes due to a DPI change, reopen it.
        Repeat
          g_DPIChangedReopenDialogBox = 0
          Result = ColorRequester(CurrentColor, ParentID)
        Until g_DPIChangedReopenDialogBox = 0
        
        ProcedureReturn Result
      ForEver
    EndIf
    
    ProcedureReturn ColorRequester(CurrentColor, ParentID)
  EndProcedure
  
  Procedure DPIFontRequester(FontName$, FontSize.l, Flags, Color = 0, Style = 0, ParentID = 0)
    Protected Result
    
    If g_PBOSVersion >= #PB_OS_Windows_8_1
      g_DPIChangedReopenDialogBox = 0
      Repeat
        g_hHook = SetWindowsHookEx_(#WH_CALLWNDPROC, @CallWndProcForDialogBox(), GetModuleHandle_(0), GetCurrentThreadId_())
        If g_hHook = 0
          Break
        EndIf
        
        ; If the dialog box closes due to a DPI change, reopen it.
        Repeat
          g_DPIChangedReopenDialogBox = 0
          Result = FontRequester(FontName$, FontSize, Flags, Color, Style, ParentID)
        Until g_DPIChangedReopenDialogBox = 0
        
        ProcedureReturn Result
      ForEver
    EndIf
    
    ProcedureReturn FontRequester(FontName$, FontSize, Flags, Color, Style, ParentID)
  EndProcedure
  
  Procedure.s DPIPathRequester(Title$, InitialPath$, ParentID = 0)
    Protected Result.s
    
    If g_PBOSVersion >= #PB_OS_Windows_8_1
      g_DPIChangedReopenDialogBox = 0
      Repeat
        g_hHook = SetWindowsHookEx_(#WH_CALLWNDPROC, @CallWndProcForDialogBox(), GetModuleHandle_(0), GetCurrentThreadId_())
        If g_hHook = 0
          Break
        EndIf
        
        ; If the dialog box closes due to a DPI change, reopen it.
        Repeat
          g_DPIChangedReopenDialogBox = 0
          Result = PathRequester(Title$, InitialPath$, ParentID)
        Until g_DPIChangedReopenDialogBox = 0
        
        ProcedureReturn Result
      ForEver
    EndIf
    
    ProcedureReturn PathRequester(Title$, InitialPath$, ParentID)
  EndProcedure
  
  Procedure InitModule()
    Protected Lib_Shcore = OpenLibrary(#PB_Any, "Shcore.dll")
    
    g_PBOSVersion = OSVersion()
    SetUserObjectInformation()
    SetRequesterDPICancelMode(1)
    
    If Lib_Shcore
      ; Windows 8.1+
      GetDpiForMonitor__ = GetFunction(Lib_Shcore, "GetDpiForMonitor")
    EndIf
    
  EndProcedure
  
  ;- Module startup.
  InitModule()
  
  ;- End of Module - DPIAwarenessRequester
EndModule

Test code:

Code: Select all

UseModule DPIAwarenessRequester

; Note:
; Test by opening a window at coordinates other than the primary monitor.

If OpenWindow(0, -300, 0, 222, 200, "", #PB_Window_SystemMenu)
  
  Define FontName$ = "Arial"
  Define FontSize  = 14
  Define Result = DPIFontRequester(FontName$, FontSize, 0, 0, 0, WindowID(0))
  If Result
    Define Message$ = "You have selected following font:"  + #LF$ 
    Message$ + "Name:  " + SelectedFontName()       + #LF$
    Message$ + "Size:  " + Str(SelectedFontSize())  + #LF$
    Message$ + "Color: " + Str(SelectedFontColor()) + #LF$
    If SelectedFontStyle() & #PB_Font_Bold
      Message$ + "Bold" + #LF$
    EndIf
    If SelectedFontStyle() & #PB_Font_StrikeOut
      Message$ + "StrikeOut" + #LF$
    EndIf
    If SelectedFontStyle() & #PB_Font_Underline
      Message$ + "Underline" + #LF$
    EndIf
  Else 
    Message$ = "The requester was canceled."
  EndIf
  
  Debug Message$
  
  Define InitialPath$ = "C:\"
  Define Path$ = DPIPathRequester("Please choose your path", InitialPath$, WindowID(0))
  If Path$
    Debug "You have selected following path:"+Chr(10)+Path$
  Else
    Debug "The requester was canceled."
  EndIf
  
  Debug DPIColorRequester(#Red, WindowID(0))
  Debug DPIColorRequesterEx(#Blue, WindowID(0))
  
  Repeat
    Define e = WaitWindowEvent()
  Until e = #PB_Event_CloseWindow
EndIf
Top
Post Reply

Return to “Tricks 'n' Tips”