[Windows] DPI awareness Per Monitor v2

Share your advanced PureBasic knowledge/code with the community.
Post Reply
breeze4me
Enthusiast
Enthusiast
Posts: 665
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: 665
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.)

Code: Select all

DeclareModule DPIAwareness
  Prototype.l ptGetDpiForWindow(hwnd)
  Global GetDpiForWindow.ptGetDpiForWindow
  
  Declare LoadSystemDefaultFont(FontNumber = #PB_Any, dpi.l = #PB_Default)
  Declare SetDPICallback(Window, *Procedure)
  Declare StartDPIAction(dpi.l)
  
  Macro StopDPIAction()
    StartDPIAction(-1)
  EndMacro
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.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"
  
  ;- 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
  
  ;- Module Global Variables.
  Global *g_FontDPI.Long          ; Memory address for DPI value of PB font.
  Global NewMap *g_DPICallback()
  
  ;- Module Local Variables.
  Define OSVersion.OSVERSIONINFOEX
  
  ;- Module Functions.
  
  Declare.l APPGetDpiForWindow(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()
    Protected Lib_Shcore, Lib_User32
    
    Lib_Shcore = OpenLibrary(#PB_Any, "Shcore.dll")
    If Lib_Shcore
      ; Windows 8.1+
      GetDpiForMonitor__ = GetFunction(Lib_Shcore, "GetDpiForMonitor")
      
    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.l GetSystemDPI()
    Protected pt.q
    Protected hMonitor = MonitorFromPoint_(pt, #MONITOR_DEFAULTTOPRIMARY)
    Protected hDC, DpiX.l, DpiY.l
    
    If hMonitor
      ; Windows 8.1+
      If GetDpiForMonitor__
        If GetDpiForMonitor__(hMonitor, #MDT_EFFECTIVE_DPI, @DpiX, @DpiY) <> #S_OK
          DpiX = 0
        EndIf
      EndIf
    EndIf
    
    If DpiX = 0
      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 = 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(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
    
    ;Font = LoadFont(FontNumber, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height, FontStyle)
    Font = LoadFont(FontNumber, PeekS(@ncm\lfMessageFont\lfFaceName[0]), Height)
    
    If *g_FontDPI
      *g_FontDPI\l = Prev_FontDPI
    EndIf
    
    ProcedureReturn Font
  EndProcedure
  
  Procedure GetFontDPIAddr()
    CompilerIf Defined(PB_Font_Objects, #PB_Variable)
      ProcedureReturn @PB_Font_Objects + SizeOf(Integer)
    CompilerElse
      ProcedureReturn 0
    CompilerEndIf
  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 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
        If FindMapElement(*g_DPICallback(), Str(hWnd))
          If *g_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.
            CallFunctionFast(*g_DPICallback(), (wParam & $FFFF))
          EndIf
        EndIf
      EndIf
      
    EndIf 
    
    If uMsg = #WM_NCDESTROY
      RemoveProp_(hWnd, #PrevWndProc$)
    EndIf
    
    ;ProcedureReturn #PB_ProcessPureBasicEvents
    ProcedureReturn CallWindowProc_(PrevWndProc, hWnd, uMsg, wParam, lParam)
  EndProcedure
  
  Procedure SetDPICallback(Window, *Procedure)
    Protected Result, hWnd
    If IsWindow(Window) And *Procedure
      hWnd = WindowID(Window)
      If Not FindMapElement(*g_DPICallback(), Str(hWnd))
        If AddMapElement(*g_DPICallback(), Str(hWnd))
          *g_DPICallback() = *Procedure
          ;SetWindowCallback(@WinCallback(), Window)
          ;Result = 1
          Result = SetProp_(hWnd, #PrevWndProc$, SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, @WinCallback()))
        EndIf
      Else
        *g_DPICallback() = *Procedure
        Result = 1
      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
  
  ;- Module startup.
  
  LoadOSFunctions()
  
  GetOSVersion(@OSVersion)
  
  *g_FontDPI = GetFontDPIAddr()
  
  SetSystemDPI()
  
  Debug #PB_Compiler_Module + " :: Main -   *g_FontDPI=" + *g_FontDPI + "   DPI=" + *g_FontDPI\l
  
  ; 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()
  
  ;- End of Module - DPIAwareness
EndModule

Code: Select all

UseModule DPIAwareness

;- 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 Fri Feb 06, 2026 3:01 pm, edited 1 time in total.
Top
User avatar
idle
Always Here
Always Here
Posts: 6191
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
Post Reply

Return to “Tricks 'n' Tips”