[Module] DPI Awareness

Share your advanced PureBasic knowledge/code with the community.
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

[Module] DPI Awareness

Post by Thunder93 »

Those who aren't that familiar with DPI Awareness, here's the quick rundown;

"Writing a DPI–aware application is the key to making a UI look consistently good across a wide variety of high-DPI display settings. Applications that are not DPI–aware but are running on a high-DPI display setting can suffer from many visual artifacts, including incorrect scaling of UI elements, clipped text, and blurry images. By adding support in your application for DPI awareness, you ensure that the presentation of your application's UI is more predictable, making it more visually appealing to users. This gives the user the best possible experience on any display."

Setting the DPI Awareness with the Set functions isn't recommended. What is, declaring the DPI Awareness via application manifest. Also DLLs inherit DPI from the calling process, so DPI awareness Set functions shouldn't ever be used anyways, from a DLL.


Per-Monitor DPI Awareness

Code: Select all

; ==== Per-Monitor_DPIAwareness_Module.pbi ====
;
;- Per-Monitor DPI Awareness [ Module ] v1.2 [Windows_OS-Specific]
;    By Thunder93, Posted on 2017-10-20, Updated Last: 2017-10-22
;       http://www.purebasic.fr/english/viewtopic.php?f=12&t=69379
;

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  CompilerError "Error: Windows Only"
  End
CompilerEndIf

;- Std:DeclareModule
DeclareModule Std
  Define.f g_ScaleDPIx = 1.0, g_ScaleDPIy = 1.0
  Define.b _InheritedFont = #False, _FontName$, _FontSize = 9, _OldFontSize, ErrLog$

  Declare.b GetDPIScaleFactor()
  Declare.l _EnableNonClientDpiScaling(hWnd.i)
EndDeclareModule

Module Std

  Define.b g_InitDPI=#False
  Define.l _OSVer, _OSBuild

  ;- Std:Constants
  #_WIN32_WINNT_VISTA    = $0600
  #_WIN32_WINNT_WIN8     = $0602
  #_WIN32_WINNT_WINBLUE  = $0603
  #_WIN32_WINNT_WIN10    = $0A00

  #_WIN10_BUILD_ANNIVERSARY         = $3839
  #_WIN10_BUILD_CREATORS_UPDATE     = $3AD7
  #_WIN10_BUILD_FALLCREATORS_UPDATE = $3FAB

  #PROCESS_PER_MONITOR_DPI_AWARE              =  2
  #DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 = 18

  #USER_DEFAULT_SCREEN_DPI = 96

  ;- Std:Prototypes

  ; Windows 10 Creators Update & Higher
  Prototype.l SetProcessDpiAwarenessContext(dpiFlags.l)

  ; Windows 8.1 & Higher
  Prototype.l GetDpiForMonitor(hMonitor.i, dpiType.l, *dpiX.Long, *dpiY.Long)
  Prototype.l SetProcessDpiAwareness(PROCESS_DPI_AWARENESS.l)

  ; Vista & Higher
  Prototype.l IsProcessDPIAware()
  Prototype.l SetProcessDPIAware()

  ; Win2000 & Higher
  Prototype.l RtlGetVersion(*OSVer.OSVERSIONINFOEX)


  ;- Std:Procedures
  Procedure _GetDpiForMonitor() : EndProcedure
  Procedure _SetProcessDpiAwarenessContext() : EndProcedure

  Procedure.l _EnableNonClientDpiScaling(hWnd.i)
    Protected.i _hUSER32, pRetr.b = #False
    Shared _OSVer, _OSBuild

    If _OSVer = #_WIN32_WINNT_WIN10 And _OSBuild = #_WIN10_BUILD_ANNIVERSARY

      _hUSER32 = OpenLibrary(#PB_Any, "user32.dll")
      If _hUSER32 = 0
        ErrLog$ = "OpenLibrary failed: Target: user32.dll"
        ProcedureReturn 0
      EndIf

      *EnableNonClientDpiScaling = GetFunction(_hUSER32, "EnableNonClientDpiScaling")
      If Not *EnableNonClientDpiScaling = 0
        pRetr = CallFunctionFast(*EnableNonClientDpiScaling, hWnd)
      EndIf

      CloseLibrary(_hUSER32)
    EndIf

    ProcedureReturn pRetr
  EndProcedure


  Procedure.b GetDPI_PerMonitor()
    Protected.i _hSHCORE, pRetr.b = #False

    If OSVersion() < #PB_OS_Windows_8_1
      ErrLog$ = "GetDPI_PerMonitor func failed. Requires Windows 8.1 or Higher"
      ProcedureReturn pRetr
    EndIf

    _hSHCORE = OpenLibrary(#PB_Any, "SHCore.dll")
    If _hSHCORE = 0
      ErrLog$ = "OpenLibrary failed: Target: SHCore.dll"
      ProcedureReturn pRetr
    EndIf

    Protected GetDpiForMonitor.GetDpiForMonitor = GetFunction(_hSHCORE, "GetDpiForMonitor")

    If GetDpiForMonitor = 0
      GetDpiForMonitor = @_GetDpiForMonitor()
      ErrLog$ = "GetDpiForMonitor function doesn't exist in SHCore.DLL."+#CRLF$
      pRetr = #False
    EndIf


    Protected.i hDC, hMonitor, pt.Point
    Shared.l _LOGPIXELSX, _LOGPIXELSY

    If GetCursorPos_(@pt)
      hMonitor = MonitorFromPoint_(PeekQ(@pt), #MONITOR_DEFAULTTONEAREST)

      If hMonitor And GetDpiForMonitor(hMonitor, #MDT_DEFAULT, @_LOGPIXELSX, @_LOGPIXELSY) = #S_OK
        pRetr = #True
      EndIf

    EndIf

    CloseLibrary(_hSHCORE)

    ProcedureReturn pRetr
  EndProcedure


  Procedure.b _SetProcessDpiAwareness()
    Shared _hSHCORE, _InheritedFont, ErrLog$

    Protected SetProcessDpiAwareness.SetProcessDpiAwareness = GetFunction(_hSHCORE, "SetProcessDpiAwareness")
    Protected.b pRetr = #True

    Select SetProcessDpiAwareness(#PROCESS_PER_MONITOR_DPI_AWARE)
      Case #E_ACCESSDENIED
        _InheritedFont = #True

      Case #E_INVALIDARG
        ErrLog$ = "SetProcessDpiAwareness failed (GetLastError: "+Str(GetLastError_())+")"
        pRetr = #False
    EndSelect

    ProcedureReturn pRetr
  EndProcedure


  Procedure.b Init_DPIAware()
    Shared _InheritedFont, ErrLog$
    Shared.i _hNTDLL, _hSHCORE, _hUSER32
    Protected pRetr.b = #True

    _hNTDLL = OpenLibrary(#PB_Any, "ntdll.dll")
    If Not _hNTDLL = 0
      Protected RtlGetVersion.RtlGetVersion = GetFunction(_hNTDLL, "RtlGetVersion")
    Else
      ErrLog$ + "OpenLibrary failed: Target: ntdll.dll"+#CRLF$
      ProcedureReturn 0
    EndIf

    _hUSER32 = OpenLibrary(#PB_Any, "user32.dll")
    If _hUSER32 = 0
      ErrLog$ + "OpenLibrary failed: Target: user32.dll"+#CRLF$

      CloseLibrary(_hNTDLL)
      ProcedureReturn 0
    EndIf

    If OSVersion() >= #PB_OS_Windows_8_1
      _hSHCORE = OpenLibrary(#PB_Any, "SHCore.dll")
      If _hSHCORE = 0
        ErrLog$ + "OpenLibrary failed: Target: SHCore.dll"+#CRLF$

        CloseLibrary(_hNTDLL)
        CloseLibrary(_hUSER32)
        ProcedureReturn 0
      EndIf
    EndIf


    Protected OSVer.OSVERSIONINFOEX : OSVer\dwOSVersionInfoSize = SizeOf(OSVer)

    If RtlGetVersion(@OSVer) = #S_OK And OSVer\dwMajorVersion <> 0

      Shared _OSVer, _OSBuild
      _OSVer = (OSVer\dwMajorVersion << 8) | OSVer\dwMinorVersion
      _OSBuild = OSVer\dwBuildNumber

      SetLastError_(0)

      Select _OSVer
        Case #_WIN32_WINNT_WIN10

          If _OSBuild >= #_WIN10_BUILD_CREATORS_UPDATE
            Protected SetProcessDpiAwarenessContext.SetProcessDpiAwarenessContext = GetFunction(_hUSER32, "SetProcessDpiAwarenessContext")

            If SetProcessDpiAwarenessContext = 0
              SetProcessDpiAwarenessContext = @_SetProcessDpiAwarenessContext()
              ErrLog$ + "SetProcessDpiAwarenessContext function doesn't exist in USER32.DLL."+#CRLF$
            EndIf

            If Not SetProcessDpiAwarenessContext(#DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2) = #True

              Select GetLastError_()
                Case #ERROR_ACCESS_DENIED
                  _InheritedFont = #True

                Default
                  ErrLog$ + "SetProcessDpiAwarenessContext failed (GetLastError: "+Str(GetLastError_())+")"
                  pRetr = #False
              EndSelect
            EndIf

          Else
            _SetProcessDpiAwareness()
          EndIf


        Case #_WIN32_WINNT_WINBLUE
          _SetProcessDpiAwareness()


        Case #_WIN32_WINNT_VISTA To #_WIN32_WINNT_WIN8

          Protected SetProcessDPIAware.SetProcessDPIAware = GetFunction(_hUSER32, "SetProcessDPIAware")
          Protected IsProcessDPIAware.IsProcessDPIAware = GetFunction(_hUSER32, "IsProcessDPIAware")

          If IsProcessDPIAware() = #False

            If SetProcessDPIAware() = 0
              ErrLog$ = "SetProcessDPIAware failed (GetLastError: "+GetLastError_()+")"
              pRetr = #False
            EndIf

          Else
            _InheritedFont = #True
          EndIf

      EndSelect

      CloseLibrary(_hNTDLL)
      CloseLibrary(_hUSER32)
      CloseLibrary(_hSHCORE)
    EndIf

    ProcedureReturn pRetr
  EndProcedure


  Procedure.b GetDPIScaleFactor()
    Shared g_InitDPI, _InheritedFont, ErrLog$
    Shared _LOGPIXELSX, _LOGPIXELSY
    Protected IsScreenDPI.b

    If g_InitDPI = #False

      CompilerIf #PB_Compiler_ExecutableFormat = #PB_Compiler_Executable

        If Not Init_DPIAware() = 1
          Debug ErrLog$
        EndIf

      CompilerElse
        _InheritedFont = #True
      CompilerEndIf

      IsScreenDPI = GetDPI_PerMonitor()

      Shared g_ScaleDPIx, g_ScaleDPIy
      Protected.i hDC

      If Not IsScreenDPI = #True
        hDC = GetDC_(#Null)
        If hDC
          _LOGPIXELSX = GetDeviceCaps_(hDC, #LOGPIXELSX)
          _LOGPIXELSY = GetDeviceCaps_(hDC, #LOGPIXELSY)
          ReleaseDC_(#Null, hDC)

          g_ScaleDPIx = _LOGPIXELSX / #USER_DEFAULT_SCREEN_DPI
          g_ScaleDPIy = _LOGPIXELSY / #USER_DEFAULT_SCREEN_DPI
        EndIf

      Else
        g_ScaleDPIx = _LOGPIXELSX / #USER_DEFAULT_SCREEN_DPI
        g_ScaleDPIy = _LOGPIXELSY / #USER_DEFAULT_SCREEN_DPI
      EndIf

      Shared _FontName$, _FontSize, _OldFontSize
      Protected ncm.NONCLIENTMETRICS

      ncm\cbSize = SizeOf(NONCLIENTMETRICS)
      If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), ncm, #Null)
        _FontName$ = PeekS(@ncm\lfMessageFont\lfFaceName)
        _FontSize = PeekL(@ncm\lfMessageFont\lfHeight)
        _OldFontSize = _FontSize
        _FontSize = -(12.0 * (_LOGPIXELSX / #USER_DEFAULT_SCREEN_DPI))
      EndIf

      If _InheritedFont = #True
        _OldFontSize = _FontSize
        _FontSize / g_ScaleDPIy
      EndIf

      g_InitDPI = #True
    EndIf
  EndProcedure
EndModule

;-
;- Macros (PUBLIC)
Macro DPIx (_x_) : (_x_) * g_ScaleDPIx : EndMacro
Macro DPIy (_y_) : (_y_) * g_ScaleDPIy : EndMacro

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit

  ;- Constants (PUBLIC)
  #USER_DEFAULT_SCREEN_DPI = 96

  #WM_DPICHANGED = $02E0

  #WindowWidth  = 390
  #WindowHeight = 350

  Enumeration Windows
    #Main_Wnd
  EndEnumeration

  Enumeration Gadgets
    #FrameGadget = 1

    #StringGadget

    #ButtonGadget_1
    #ButtonGadget_2
    #ButtonGadget_3
    #ButtonGadget_4
    #ButtonGadget_5
    #ButtonGadget_6
    #ButtonGadget_7

    #PanelGadget

    #ListViewGadget

    #TrackBarGadget

    #CheckBoxGadget_1
    #CheckBoxGadget_2

    #ComboBoxGadget

    #OptionGadget_1
    #OptionGadget_2
    #OptionGadget_3

    #TextGadget
  EndEnumeration

  ;-
  ;- Structures
  Structure GadgetList
    Gadget.l
    X.l
    Y.l
    Width.l
    Height.l

    Scaled_X.l
    Scaled_Y.l
    Scaled_Width.l
    Scaled_Height.l
  EndStructure : Global NewList Gadget.GadgetList()

  ;-
  ;- Procedures (PUBLIC)
  Procedure.b SetGadgetsDetails()
    Global.f g_ScaleDPIx, g_ScaleDPIy

    AddElement(Gadget())
    Gadget()\Gadget = #FrameGadget
    Gadget()\X = 10
    Gadget()\Y = 10
    Gadget()\Width = #WindowWidth-20
    Gadget()\Height = 296

    AddElement(Gadget())
    Gadget()\Gadget = #StringGadget
    Gadget()\X = 20
    Gadget()\Y = 35
    Gadget()\Width = 200
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_1
    Gadget()\X = 223
    Gadget()\Y = 35
    Gadget()\Width = 72
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_2
    Gadget()\X = 295
    Gadget()\Y = 35
    Gadget()\Width = 72
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #PanelGadget
    Gadget()\X = 20
    Gadget()\Y = 65
    Gadget()\Width = #WindowWidth-50
    Gadget()\Height = #WindowHeight-60-60

    AddElement(Gadget())
    Gadget()\Gadget = #ListViewGadget
    Gadget()\X = 6
    Gadget()\Y = 10
    Gadget()\Width = 230
    Gadget()\Height = 148

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_3
    Gadget()\X = 250
    Gadget()\Y = 10
    Gadget()\Width = 80
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_4
    Gadget()\X = 250
    Gadget()\Y = 38
    Gadget()\Width = 80
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_5
    Gadget()\X = 250
    Gadget()\Y = 66
    Gadget()\Width = 80
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #TrackBarGadget
    Gadget()\X = 10
    Gadget()\Y = 166
    Gadget()\Width = 310
    Gadget()\Height = 25

    AddElement(Gadget())
    Gadget()\Gadget = #CheckBoxGadget_1
    Gadget()\X = 10
    Gadget()\Y = 10
    Gadget()\Width = 250
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #CheckBoxGadget_2
    Gadget()\X = 10
    Gadget()\Y = 40
    Gadget()\Width = 250
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ComboBoxGadget
    Gadget()\X = 10
    Gadget()\Y = 70
    Gadget()\Width = 250
    Gadget()\Height = 21

    AddElement(Gadget())
    Gadget()\Gadget = #OptionGadget_1
    Gadget()\X = 10
    Gadget()\Y = 100
    Gadget()\Width = 81
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #OptionGadget_2
    Gadget()\X = 10
    Gadget()\Y = 125
    Gadget()\Width = 81
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #OptionGadget_3
    Gadget()\X = 10
    Gadget()\Y = 150
    Gadget()\Width = 81
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_6
    Gadget()\X = 150
    Gadget()\Y = 140
    Gadget()\Width = 80
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #TextGadget
    Gadget()\X = 10
    Gadget()\Y = #WindowHeight-30
    Gadget()\Width = 250
    Gadget()\Height = 24

    AddElement(Gadget())
    Gadget()\Gadget = #ButtonGadget_7
    Gadget()\X = #WindowWidth-100
    Gadget()\Y = #WindowHeight-36
    Gadget()\Width = 80
    Gadget()\Height = 24


    ForEach Gadget()
      Gadget()\Scaled_X = DPIx(Gadget()\X)
      Gadget()\Scaled_Y = DPIy(Gadget()\Y)
      Gadget()\Scaled_Width = DPIx(Gadget()\Width)
      Gadget()\Scaled_Height = DPIy(Gadget()\Height)
    Next
  EndProcedure


  Procedure LocGadget(Gadget.l)
    ForEach Gadget()
      If Gadget()\Gadget = Gadget
        Break
      EndIf
    Next
  EndProcedure


  Procedure PerMonitorDPIWindow(hWnd, uMsg, wParam, lParam)

    If uMsg = #WM_NCCREATE
      Std::_EnableNonClientDpiScaling(hWnd)

    ElseIf uMsg = #WM_DPICHANGED
      Protected *lprNewRect.RECT, g_dpiX.c, g_dpiY.c
      Protected.i hDC, _Font, _FontSize.b
      Global.f g_ScaleDPIx, g_ScaleDPIy
      Global _FontName$
      
      g_dpiX = wParam>>16 & $FFFF
      g_dpiY = wParam & $FFFF

      g_ScaleDPIx = g_dpiX / #USER_DEFAULT_SCREEN_DPI
      g_ScaleDPIy = g_dpiY / #USER_DEFAULT_SCREEN_DPI

      *lprNewRect.RECT = lParam

      ;
      ;       SetWindowPos_(hWnd, #Null,
      ;                     *lprNewRect\left,
      ;                     *lprNewRect\top,
      ;                     *lprNewRect\right - *lprNewRect\left,
      ;                     *lprNewRect\bottom - *lprNewRect\top, #SWP_NOZORDER | #SWP_NOACTIVATE)

      ;ResizeWindow(#Main_Wnd, #PB_Ignore, #PB_Ignore, DPIx(#WindowWidth), DPIy(#WindowHeight))

      SetWindowPos_(hWnd, #Null, *lprNewRect\left, *lprNewRect\top, DPIx(#WindowWidth)+6, DPIy(#WindowHeight)+40, #SWP_NOZORDER | #SWP_NOACTIVATE)

      _FontSize = -(12.0 * (g_dpiX / #USER_DEFAULT_SCREEN_DPI))

      _Font = LoadFont(#PB_Any, _FontName$, _FontSize, #PB_Font_HighQuality)

      ForEach Gadget()
        Gadget()\Scaled_X = DPIx(Gadget()\X)
        Gadget()\Scaled_Y = DPIy(Gadget()\Y)
        Gadget()\Scaled_Width = DPIx(Gadget()\Width)
        Gadget()\Scaled_Height = DPIy(Gadget()\Height)

        ResizeGadget(Gadget()\Gadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height)

        If _Font
          SetGadgetFont(Gadget()\Gadget, FontID(_Font))
        EndIf
      Next

    EndIf

    ProcedureReturn #PB_ProcessPureBasicEvents
  EndProcedure


  Procedure.b DPIAwareness()
    Std::GetDPIScaleFactor()
    Global.f g_ScaleDPIx = Std::g_ScaleDPIx, g_ScaleDPIy = Std::g_ScaleDPIy
    Global.b _InheritedFont = Std::_InheritedFont, _FontSize = Std::_FontSize,
          _OldFontSize = Std::_OldFontSize, _FontName$ = Std::_FontName$
  EndProcedure


  DPIAwareness()

  Define.l DsktopCount.b, DesktopWidth, DesktopHeight, DesktopWidth2, DesktopHeight2,
        String$, _Font.i, Image1ID.i, Top, GadgetHeight, k, EventID, Result$

  DsktopCount = ExamineDesktops()
  If DsktopCount
    DesktopWidth = DesktopWidth(0)
    DesktopHeight = DesktopHeight(0)
  EndIf

  DesktopWidth2 = GetSystemMetrics_(#SM_CXSCREEN)
  DesktopHeight2 = GetSystemMetrics_(#SM_CYSCREEN)

  Debug "Desktop Resolution"+#CRLF$+"   PB_Native: "+ Str(DesktopWidth) + "x" + Str(DesktopHeight)+#CRLF$+
        "   Win_API: "+ Str(DesktopWidth2) + "x" + Str(DesktopHeight2)+#CRLF$

  SetGadgetsDetails()

  If OpenWindow(#Main_Wnd, DPIx(100), DPIy(200), DPIx(#WindowWidth), DPIy(#WindowHeight), "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)
    SetWindowCallback(@PerMonitorDPIWindow())

    Debug "Window Width: "+WindowWidth(0)
    Debug "Window Height: "+WindowHeight(0)
    Debug "X Scaling Factor (ScaleDPIx): " +StrF(g_ScaleDPIx, 2)+" ( "+StrF(g_ScaleDPIx * 100)+"% )"
    Debug "Y Scaling Factor (ScaleDPIy): " +StrF(g_ScaleDPIy, 2)+" ( "+StrF(g_ScaleDPIy * 100)+"% )"+#CRLF$

    _Font = LoadFont(#PB_Any, _FontName$, _FontSize, #PB_Font_HighQuality)
    If _Font
      SetGadgetFont(#PB_Default, FontID(_Font))
    EndIf

    If _InheritedFont
      Debug "Inherited Font"
    EndIf

    Debug "Font name: "+_FontName$
    Debug "Font size: "+Str(_FontSize)


    LocGadget(#FrameGadget)
    FrameGadget(#FrameGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Player...")

    LocGadget(#StringGadget)
    StringGadget(#StringGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "")

    LocGadget(#ButtonGadget_1)
    ButtonGadget(#ButtonGadget_1, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Play")

    NextElement(Gadget())
    ButtonGadget(#ButtonGadget_2, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Stop")
    DisableGadget(#ButtonGadget_2, 1)

    GadgetToolTip(#ButtonGadget_1, "Play the current song")

    LocGadget(#PanelGadget)
    PanelGadget(#PanelGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height)
    AddGadgetItem(#PanelGadget, 0, "MP3 PlayList")

    LocGadget(#ListViewGadget)
    ListViewGadget(#ListViewGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height)

    For k=0 To 30
      AddGadgetItem(#ListViewGadget, -1, "Music Song n° "+Str(k))
    Next

    LocGadget(#ButtonGadget_3)
    ButtonGadget(#ButtonGadget_3, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Add")

    NextElement(Gadget())
    ButtonGadget(#ButtonGadget_4, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Remove")

    NextElement(Gadget())
    ButtonGadget(#ButtonGadget_5, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Select")
    GadgetToolTip(#ButtonGadget_5, "Select the current song")

    LocGadget(#TrackBarGadget)
    TrackBarGadget(#TrackBarGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, 0, 100)

    AddGadgetItem(#PanelGadget, 1, "Options")

    LocGadget(#CheckBoxGadget_1)
    CheckBoxGadget(#CheckBoxGadget_1, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Enable low-pass filter")
    NextElement(Gadget())
    CheckBoxGadget(#CheckBoxGadget_2, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Enable visual plug-in")

    LocGadget(#ComboBoxGadget)
    ComboBoxGadget(#ComboBoxGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height)

    AddGadgetItem(#ComboBoxGadget, -1, "FireWorks")
    AddGadgetItem(#ComboBoxGadget, -1, "OpenGL spectrum")
    AddGadgetItem(#ComboBoxGadget, -1, "Bump bass")
    SetGadgetState(#ComboBoxGadget, 0)
    DisableGadget(#ComboBoxGadget, 1)

    LocGadget(#OptionGadget_1)
    OptionGadget(#OptionGadget_1, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "640*480")

    NextElement(Gadget())
    OptionGadget(#OptionGadget_2, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "800*600")

    NextElement(Gadget())
    OptionGadget(#OptionGadget_3, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "1024*768")
    SetGadgetState(#OptionGadget_3, 1)

    LocGadget(#ButtonGadget_6)
    ButtonGadget(#ButtonGadget_6, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Info")
    CloseGadgetList()

    LocGadget(#TextGadget)
    TextGadget(#TextGadget, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "PureBasic - Gadget demonstration")

    LocGadget(#ButtonGadget_7)
    ButtonGadget(#ButtonGadget_7, Gadget()\Scaled_X, Gadget()\Scaled_Y, Gadget()\Scaled_Width, Gadget()\Scaled_Height, "Quit")

    SetGadgetState(#PanelGadget, 0)


    Repeat
      EventID = WaitWindowEvent()

      If EventID = #PB_Event_Gadget

        Select EventGadget()

          Case #ButtonGadget_1
            DisableGadget(#ButtonGadget_2,0)
            DisableGadget(#ButtonGadget_1,1)

          Case #ButtonGadget_2
            DisableGadget(#ButtonGadget_1,0)
            DisableGadget(#ButtonGadget_2,1)

          Case #ListViewGadget
            If EventType() = 2
              SetGadgetText(#StringGadget, GetGadgetText(#ListViewGadget))
            EndIf

          Case #ButtonGadget_3
            AddGadgetItem(#ListViewGadget, -1, "New Item Added...")

          Case #ButtonGadget_4
            RemoveGadgetItem(#ListViewGadget, GetGadgetState(#ListViewGadget))

          Case #ButtonGadget_5
            SetGadgetText(#StringGadget, GetGadgetText(#ListViewGadget))

          Case #ButtonGadget_7
            EventID = #PB_Event_CloseWindow

          Case #CheckBoxGadget_2
            DisableGadget(#ComboBoxGadget, 1-GetGadgetState(#CheckBoxGadget_2))

          Case #ButtonGadget_6
            If GetGadgetState(#OptionGadget_1) : Result$ = GetGadgetText(#OptionGadget_1) : EndIf
            If GetGadgetState(#OptionGadget_2) : Result$ = GetGadgetText(#OptionGadget_2) : EndIf
            If GetGadgetState(#OptionGadget_3) : Result$ = GetGadgetText(#OptionGadget_3) : EndIf

            MessageRequester("Info", "Selected screen mode: "+Result$, 0)

          Case #TrackBarGadget
            SetGadgetText(#StringGadget, Str(GetGadgetState(#TrackBarGadget)))

        EndSelect

      EndIf

    Until EventID = #PB_Event_CloseWindow
  EndIf
  End
CompilerEndIf

System DPI Awareness

Code: Select all

; ==== System_DPIAwareness_Module.pbi ====
;
;- System DPI Awareness [ Module ] v1.4 [Windows_OS-Specific]
;    By Thunder93, Posted on 2017-10-10, Updated Last: 2017-10-21
;       http://www.purebasic.fr/english/viewtopic.php?f=12&t=69379
;

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  CompilerError "Error: Windows Only"
  End
CompilerEndIf

;- Std:DeclareModule
DeclareModule Std
  Define.f g_ScaleDPIx = 1.0, g_ScaleDPIy = 1.0
  Define.b _InheritedFont = #False, _FontName$, _FontSize = 9, _OldFontSize, ErrLog$

  Declare.b GetDPIScaleFactor()
EndDeclareModule

Module Std

  Define.b g_InitDPI=#False
  Define.l _OSVer, _OSBuild

  ;- Std:Constants
  #_WIN32_WINNT_VISTA    = $0600
  #_WIN32_WINNT_WIN8     = $0602
  #_WIN32_WINNT_WINBLUE  = $0603
  #_WIN32_WINNT_WIN10    = $0A00

  #_WIN10_BUILD_ANNIVERSARY         = $3839
  #_WIN10_BUILD_CREATORS_UPDATE     = $3AD7
  #_WIN10_BUILD_FALLCREATORS_UPDATE = $3FAB

  #PROCESS_SYSTEM_DPI_AWARE           =  1
  #DPI_AWARENESS_CONTEXT_SYSTEM_AWARE = 17

  #USER_DEFAULT_SCREEN_DPI = 96

  ;- Std:Prototypes

  ; Windows 10 Creators Update & Higher
  Prototype.l SetProcessDpiAwarenessContext(dpiFlags.l)

  ; Windows 8.1 & Higher
  Prototype.l SetProcessDpiAwareness(PROCESS_DPI_AWARENESS.l)

  ; Vista & Higher
  Prototype.l IsProcessDPIAware()
  Prototype.l SetProcessDPIAware()

  ; Win2000 & Higher
  Prototype.l RtlGetVersion(*OSVer.OSVERSIONINFOEX)


  ;- Std:Procedures
  Procedure _SetProcessDpiAwarenessContext() : EndProcedure


  Procedure.b _SetProcessDpiAwareness()
    Shared _hSHCORE, _InheritedFont, ErrLog$

    Protected SetProcessDpiAwareness.SetProcessDpiAwareness = GetFunction(_hSHCORE, "SetProcessDpiAwareness")
    Protected.b pRetr = #True

    Select SetProcessDpiAwareness(#PROCESS_SYSTEM_DPI_AWARE)
      Case #E_ACCESSDENIED
        _InheritedFont = #True

      Case #E_INVALIDARG
        ErrLog$ = "SetProcessDpiAwareness failed (GetLastError: "+Str(GetLastError_())+")"
        pRetr = #False
    EndSelect

    ProcedureReturn pRetr
  EndProcedure


  Procedure.b Init_DPIAware()
    Shared _InheritedFont, ErrLog$
    Shared.i _hNTDLL, _hSHCORE, _hUSER32
    Protected pRetr.b = #True

    _hNTDLL = OpenLibrary(#PB_Any, "ntdll.dll")
    If Not _hNTDLL = 0
      Protected RtlGetVersion.RtlGetVersion = GetFunction(_hNTDLL, "RtlGetVersion")
    Else
      ErrLog$ + "OpenLibrary failed: Target: ntdll.dll"+#CRLF$
      ProcedureReturn 0
    EndIf

    _hUSER32 = OpenLibrary(#PB_Any, "user32.dll")
    If _hUSER32 = 0
      ErrLog$ + "OpenLibrary failed: Target: user32.dll"+#CRLF$

      CloseLibrary(_hNTDLL)
      ProcedureReturn 0
    EndIf

    If OSVersion() >= #PB_OS_Windows_8_1
      _hSHCORE = OpenLibrary(#PB_Any, "SHCore.dll")
      If _hSHCORE = 0
        ErrLog$ + "OpenLibrary failed: Target: SHCore.dll"+#CRLF$

        CloseLibrary(_hNTDLL)
        CloseLibrary(_hUSER32)
        ProcedureReturn 0
      EndIf
    EndIf


    Protected OSVer.OSVERSIONINFOEX : OSVer\dwOSVersionInfoSize = SizeOf(OSVer)

    If RtlGetVersion(@OSVer) = #S_OK And OSVer\dwMajorVersion <> 0

      Shared _OSVer, _OSBuild
      _OSVer = (OSVer\dwMajorVersion << 8) | OSVer\dwMinorVersion
      _OSBuild = OSVer\dwBuildNumber

      _OSVer = #_WIN32_WINNT_WIN10
      _OSBuild = #_WIN10_BUILD_ANNIVERSARY

      SetLastError_(0)

      Select _OSVer
        Case #_WIN32_WINNT_WIN10

          If _OSBuild >= #_WIN10_BUILD_CREATORS_UPDATE
            Protected SetProcessDpiAwarenessContext.SetProcessDpiAwarenessContext = GetFunction(_hUSER32, "SetProcessDpiAwarenessContext")

            If SetProcessDpiAwarenessContext = 0
              SetProcessDpiAwarenessContext = @_SetProcessDpiAwarenessContext()
              ErrLog$ + "SetProcessDpiAwarenessContext function doesn't exist in USER32.DLL."+#CRLF$
            EndIf

            If Not SetProcessDpiAwarenessContext(#DPI_AWARENESS_CONTEXT_SYSTEM_AWARE) = #True

              Select GetLastError_()
                Case #ERROR_ACCESS_DENIED
                  _InheritedFont = #True

                Default
                  ErrLog$ + "SetProcessDpiAwarenessContext failed (GetLastError: "+Str(GetLastError_())+")"
                  pRetr = #False
              EndSelect
            EndIf

          Else
            _SetProcessDpiAwareness()
          EndIf


        Case #_WIN32_WINNT_WINBLUE
          _SetProcessDpiAwareness()


        Case #_WIN32_WINNT_VISTA To #_WIN32_WINNT_WIN8

          Protected SetProcessDPIAware.SetProcessDPIAware = GetFunction(_hUSER32, "SetProcessDPIAware")
          Protected IsProcessDPIAware.IsProcessDPIAware = GetFunction(_hUSER32, "IsProcessDPIAware")

          If IsProcessDPIAware() = #False

            If SetProcessDPIAware() = 0
              ErrLog$ = "SetProcessDPIAware failed (GetLastError: "+GetLastError_()+")"
              pRetr = #False
            EndIf

          Else
            _InheritedFont = #True
          EndIf

      EndSelect

      CloseLibrary(_hNTDLL)
      CloseLibrary(_hUSER32)
      CloseLibrary(_hSHCORE)
    EndIf

    ProcedureReturn pRetr
  EndProcedure


  Procedure.b GetDPIScaleFactor()
    Shared g_InitDPI, _InheritedFont, ErrLog$

    If g_InitDPI = #False

      CompilerIf #PB_Compiler_ExecutableFormat = #PB_Compiler_Executable

        If Not Init_DPIAware() = 1
          Debug ErrLog$
        EndIf

      CompilerElse
        _InheritedFont = #True
      CompilerEndIf
      
      
      Shared g_ScaleDPIx, g_ScaleDPIy
      Protected.i hDC
      Protected.l _LOGPIXELSX, _LOGPIXELSY

      hDC = GetDC_(#Null)
      If hDC
        _LOGPIXELSX = GetDeviceCaps_(hDC, #LOGPIXELSX)
        _LOGPIXELSY = GetDeviceCaps_(hDC, #LOGPIXELSY)
        ReleaseDC_(#Null, hDC)

        g_ScaleDPIx = _LOGPIXELSX / #USER_DEFAULT_SCREEN_DPI
        g_ScaleDPIy = _LOGPIXELSY / #USER_DEFAULT_SCREEN_DPI
      EndIf

      Shared _FontName$, _FontSize, _OldFontSize
      Protected ncm.NONCLIENTMETRICS

      ncm\cbSize = SizeOf(NONCLIENTMETRICS)
      If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), ncm, #Null)
        _FontName$ = PeekS(@ncm\lfMessageFont\lfFaceName)
        _FontSize = PeekL(@ncm\lfMessageFont\lfHeight)
        _OldFontSize = _FontSize
      EndIf

      If _InheritedFont = #True
        _OldFontSize = _FontSize
        _FontSize / g_ScaleDPIy
      EndIf

      g_InitDPI = #True
    EndIf
  EndProcedure
EndModule

;-
;- Macros (PUBLIC)
Macro DPIx (_x_) : (_x_) * g_ScaleDPIx : EndMacro
Macro DPIy (_y_) : (_y_) * g_ScaleDPIy : EndMacro

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit

  ;-
  ;- Constants (PUBLIC)
  #WindowWidth  = 390
  #WindowHeight = 350

  Enumeration Windows
    #Main_Wnd
  EndEnumeration

  Enumeration Gadgets
    #FrameGadget = 1

    #StringGadget

    #ButtonGadget_1
    #ButtonGadget_2
    #ButtonGadget_3
    #ButtonGadget_4
    #ButtonGadget_5
    #ButtonGadget_6
    #ButtonGadget_7

    #PanelGadget

    #ListViewGadget

    #TrackBarGadget

    #CheckBoxGadget_1
    #CheckBoxGadget_2

    #ComboBoxGadget

    #OptionGadget_1
    #OptionGadget_2
    #OptionGadget_3

    #TextGadget
  EndEnumeration

  ;-
  ;- Procedures (PUBLIC)
  Procedure.b DPIAwareness()
    Std::GetDPIScaleFactor()
    Global.f g_ScaleDPIx = Std::g_ScaleDPIx, g_ScaleDPIy = Std::g_ScaleDPIy
    Global.b _InheritedFont = Std::_InheritedFont, _FontSize = Std::_FontSize,
          _OldFontSize = Std::_OldFontSize, _FontName$ = Std::_FontName$
  EndProcedure


  DPIAwareness()

  Define.l DsktopCount.b, DesktopWidth, DesktopHeight, DesktopWidth2, DesktopHeight2,
        String$, _Font.i, Top, GadgetHeight, k, EventID, Result$

  DsktopCount = ExamineDesktops()
  If DsktopCount
    DesktopWidth = DesktopWidth(0)
    DesktopHeight = DesktopHeight(0)
  EndIf

  DesktopWidth2 = GetSystemMetrics_(#SM_CXSCREEN)
  DesktopHeight2 = GetSystemMetrics_(#SM_CYSCREEN)

  Debug "Desktop Resolution"+#CRLF$+"   PB_Native: "+ Str(DesktopWidth) + "x" + Str(DesktopHeight)+#CRLF$+
        "   Win_API: "+ Str(DesktopWidth2) + "x" + Str(DesktopHeight2)+#CRLF$

  If OpenWindow(#Main_Wnd, DPIx(100), DPIy(200), DPIx(#WindowWidth), DPIy(#WindowHeight), "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)

    Debug "Window Width: "+WindowWidth(0)
    Debug "Window Height: "+WindowHeight(0)
    Debug "X Scaling Factor (ScaleDPIx): " +StrF(g_ScaleDPIx, 2)+" ( "+StrF(g_ScaleDPIx * 100)+"% )"
    Debug "Y Scaling Factor (ScaleDPIy): " +StrF(g_ScaleDPIy, 2)+" ( "+StrF(g_ScaleDPIy * 100)+"% )"+#CRLF$

    _Font = LoadFont(#PB_Any, _FontName$, _FontSize, #PB_Font_HighQuality)
    If _Font
      SetGadgetFont(#PB_Default, FontID(_Font))
    EndIf

    If _InheritedFont
      Debug "Inherited Font"
    EndIf

    Debug "Font name: "+_FontName$
    Debug "Font size: "+Str(_FontSize)

    Top = 10
    GadgetHeight = 24

    FrameGadget(#FrameGadget, DPIx(10), DPIy(Top), DPIx(370), DPIy(290), "Player...") : Top+25

    StringGadget(#StringGadget, DPIx(20), DPIy(Top), DPIx(200), DPIy(GadgetHeight), "")
    ButtonGadget(#ButtonGadget_1, DPIx(223), DPIy(Top),  DPIx(72), DPIy(GadgetHeight), "Play")
    ButtonGadget(#ButtonGadget_2, DPIx(295), DPIy(Top),  DPIx(72), DPIy(GadgetHeight), "Stop")  : Top+35
    DisableGadget(#ButtonGadget_2, 1)

    GadgetToolTip(#ButtonGadget_2, "Play the current song")

    PanelGadget(#PanelGadget, DPIx(20), DPIy(Top), DPIx(#WindowWidth-50), DPIy(#WindowHeight-Top-55))
    AddGadgetItem(#PanelGadget, 0, "MP3 PlayList")
    ListViewGadget(#ListViewGadget, DPIx(6), DPIy(10), DPIx(230), DPIy(148))

    For k=0 To 30
      AddGadgetItem(#ListViewGadget, -1, "Music Song n° "+Str(k))
    Next

    ButtonGadget(#ButtonGadget_3,  DPIx(250), DPIy(10), DPIx(80), DPIy(GadgetHeight), "Add")
    ButtonGadget(#ButtonGadget_4,  DPIx(250), DPIy(38), DPIx(80), DPIy(GadgetHeight), "Remove")
    ButtonGadget(#ButtonGadget_5,  DPIx(250), DPIy(66), DPIx(80), DPIy(GadgetHeight), "Select")
    GadgetToolTip(#ButtonGadget_5, "Select the current song")

    TrackBarGadget(#TrackBarGadget, DPIx(10), DPIy(168), DPIx(310), DPIy(30), 0, 100)

    AddGadgetItem(#PanelGadget, 1, "Options")
    Top = 10
    CheckBoxGadget(#CheckBoxGadget_1, DPIx(10), DPIy(Top), DPIx(250), DPIy(GadgetHeight), "Enable low-pass filter") : Top+30
    CheckBoxGadget(#CheckBoxGadget_2, DPIx(10), DPIy(Top), DPIx(250), DPIy(GadgetHeight), "Enable visual plug-in")  : Top+30
    ComboBoxGadget(#ComboBoxGadget, DPIx(10), DPIy(Top), DPIx(250), DPIy(30)) : Top+30
    AddGadgetItem(#ComboBoxGadget, -1, "FireWorks")
    AddGadgetItem(#ComboBoxGadget, -1, "OpenGL spectrum")
    AddGadgetItem(#ComboBoxGadget, -1, "Bump bass")
    SetGadgetState(#ComboBoxGadget, 0)
    DisableGadget(#ComboBoxGadget, 1)

    OptionGadget(#OptionGadget_1, DPIx(10), DPIy(Top), DPIx(81), DPIy(GadgetHeight), "640*480") : Top+20
    OptionGadget(#OptionGadget_2, DPIx(10), DPIy(Top), DPIx(81), DPIy(GadgetHeight), "800*600") : Top+20
    OptionGadget(#OptionGadget_3, DPIx(10), DPIy(Top), DPIx(81), DPIy(GadgetHeight), "1024*768")
    SetGadgetState(#OptionGadget_3, 1)

    ButtonGadget(#ButtonGadget_6, DPIx(150), DPIy(Top), DPIx(80), DPIy(GadgetHeight), "Info")
    CloseGadgetList()

    TextGadget(#TextGadget, DPIx(10), DPIy(#WindowHeight-30), DPIx(250), DPIy(24), "PureBasic - Gadget demonstration")
    ButtonGadget(#ButtonGadget_7, DPIx(#WindowWidth-100), DPIy(#WindowHeight-36), DPIx(80), DPIy(24), "Quit")

    SetGadgetState(#PanelGadget, 0)


    Repeat
      EventID = WaitWindowEvent()

      If EventID = #PB_Event_Gadget

        Select EventGadget()
          Case #StringGadget
            If EventType() = #PB_EventType_ReturnKey
              MessageRequester("Info", "Return key pressed", 0)
              SetActiveGadget(#StringGadget)
            EndIf

          Case #ButtonGadget_1
            DisableGadget(#ButtonGadget_2,0)
            DisableGadget(#ButtonGadget_1,1)

          Case #ButtonGadget_2
            DisableGadget(#ButtonGadget_1,0)
            DisableGadget(#ButtonGadget_2,1)

          Case #ListViewGadget
            If EventType() = 2
              SetGadgetText(#StringGadget, GetGadgetText(#ListViewGadget))
            EndIf

          Case #ButtonGadget_3
            AddGadgetItem(#ListViewGadget, -1, "New Item Added...")

          Case #ButtonGadget_4
            RemoveGadgetItem(#ListViewGadget, GetGadgetState(#ListViewGadget))

          Case #ButtonGadget_5
            SetGadgetText(#StringGadget, GetGadgetText(#ListViewGadget))

          Case #ButtonGadget_7
            EventID = #PB_Event_CloseWindow

          Case #CheckBoxGadget_2
            DisableGadget(#ComboBoxGadget, 1-GetGadgetState(#CheckBoxGadget_2))

          Case #ButtonGadget_6
            If GetGadgetState(#OptionGadget_1) : Result$ = GetGadgetText(#OptionGadget_1) : EndIf
            If GetGadgetState(#OptionGadget_2) : Result$ = GetGadgetText(#OptionGadget_2) : EndIf
            If GetGadgetState(#OptionGadget_3) : Result$ = GetGadgetText(#OptionGadget_3) : EndIf

            MessageRequester("Info", "Selected screen mode: "+Result$, 0)

          Case #TrackBarGadget
            SetGadgetText(#StringGadget, Str(GetGadgetState(#TrackBarGadget)))

        EndSelect

      EndIf

    Until EventID = #PB_Event_CloseWindow
  EndIf
  End
CompilerEndIf
Last edited by Thunder93 on Mon Oct 23, 2017 1:38 am, edited 8 times in total.
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: DPI Awareness Module

Post by Lunasole »

Hi. I didn't get, for what most of that code is needed? Windows 10 made things foolishly complicated one more time?

I'm using only following + manifest file.
Then scaling UI values (like window or controls width/height/X/Y) using ScaleX/ScaleY macro, while leaving font sizes as is (Windows scales them: XP, Vista and newer).
That works fine for XP and higher, or at least I didn't had any problems yet ^^

Code: Select all

;{ DPI scaling }
	
	; Don't forget related manifest file or SetDPIAware() API call!

	; Gets scale factors for X and Y for current windows settings
	; RETURN:		none
	Global.f DPIXScale = 1.0, DPIYScale = 1.0
	Procedure InitScaleDPI()
		Protected lpx, lpy, DC = GetDC_(#Null)
		If DC
			lpx = GetDeviceCaps_(DC, #LOGPIXELSX) : lpy = GetDeviceCaps_(DC, #LOGPIXELSY)
			If lpx : DPIXScale = lpx / 96.0 : EndIf
			If lpy : DPIYScale = lpy / 96.0 : EndIf
			ReleaseDC_(#Null, DC)
		EndIf
	EndProcedure
	InitScaleDPI()
	; Use macro to scale your values
	Macro ScaleX (x) : 	((x) * DPIXScale) :	EndMacro
	Macro ScaleY (y) :	((y) * DPIYScale) :	EndMacro

;}
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: DPI Awareness Module

Post by ts-soft »

@Thunder93

I get a ima with windows 10 Version 1709 (Build 16299.15) (x86 and x64)! Fall Creators Update

Code: Select all

135:   RetrVal = GetProcessDpiAwareness(#Null, @DPI_UNAWARE)
All other windows version running without a error.

greetings
Thomas
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: DPI Awareness Module

Post by Thunder93 »

@Lunasole: Yes.. That's Microsoft. People really should be using an application manifest file. However using the Set functions properly, it won't make difference.

@ts-soft: Thanks, It should be correct now. Thanks for the feedback.
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
nco2k
Addict
Addict
Posts: 1344
Joined: Mon Sep 15, 2003 5:55 am

Re: DPI Awareness Module

Post by nco2k »

@ts-soft
i only took a quick look, you probably have to rename _SHCORE to _hSHCORE.

also Thunder93, you arent checking any of your GetFunction() results! you cant just assume that everything went fine. maybe it failed, or maybe the function doesnt even exist on the users os (win7 for example). other than that, i have to agree with Lunasole. i would rather get the resolution and dpi and use my own ScaleX/Y macro, which will works on every os and not just on win8+.

Code: Select all

Protected GetProcessDpiAwareness.GetProcessDpiAwareness = GetFunction(_SHCORE, "GetProcessDpiAwareness")
If GetProcessDpiAwareness
  Debug "OK"
Else
  Debug "ERROR"
EndIf
c ya,
nco2k
If OSVersion() = #PB_OS_Windows_ME : End : EndIf
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: DPI Awareness Module

Post by Thunder93 »

Hi nco2k. Thanks for the feedback. The issue wasn't with the variable not being case sensitive, It doesn't have to be.

Also you don't have to worry about calling the wrong function on whatever Windows is being used.. because of how I have it.

Also Vista+, and if using older the ScaleX/Y macros still will be working. :wink:
Last edited by Thunder93 on Fri Oct 13, 2017 3:22 pm, edited 1 time in total.
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
nco2k
Addict
Addict
Posts: 1344
Joined: Mon Sep 15, 2003 5:55 am

Re: DPI Awareness Module

Post by nco2k »

>> The issue wasn't with the variable not being case sensitive, It doesn't have to be.
who said anything about case senstive? _shcore -> _hshcore.

>> Also you don't have to worry about calling the wrong function on whatever Windows is being used..
that was just an example. are you really trying to justify the fact, that you are not checking the result of GetFunction() and blindly use the prototype?

c ya,
nco2k
If OSVersion() = #PB_OS_Windows_ME : End : EndIf
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: DPI Awareness Module

Post by Thunder93 »

nco2k wrote:>> The issue wasn't with the variable not being case sensitive, It doesn't have to be.
who said anything about case senstive? _shcore -> _hshcore.
There wasn't no variable naming incorrectness. What you talking about then?
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
nco2k
Addict
Addict
Posts: 1344
Joined: Mon Sep 15, 2003 5:55 am

Re: DPI Awareness Module

Post by nco2k »

rofl. yes, now that you changed it. from your code 30 minutes ago:

Code: Select all

Protected GetProcessDpiAwareness.GetProcessDpiAwareness = GetFunction(_SHCORE, "GetProcessDpiAwareness")
Protected SetProcessDpiAwareness.SetProcessDpiAwareness = GetFunction(_SHCORE, "SetProcessDpiAwareness")
...
CloseLibrary(_SHCORE)
which was the reason for ts-softs IMA.

c ya,
nco2k
If OSVersion() = #PB_OS_Windows_ME : End : EndIf
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: DPI Awareness Module

Post by Thunder93 »

Apologies nco2k, you are right, there was. But that wasn't the code real problem though .. under at least Windows 10 Fall Creators Update + :wink:
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: [Module] DPI Awareness

Post by Thunder93 »

Hi nco2k. Just had little time to spare and looked over the code again. I have taking your advice with adding a couple of GetFunction checks. Under where it looks for Windows 10 Creators Update or newer, because as you know it, the function could cease to exist at some point down the road.

I believe having GetFunction checks elsewhere is irrelevant since the functions will definitely exist. :wink:
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: [Module] DPI Awareness

Post by Thunder93 »

Added Per-Monitor Awareness version.

Updated also the System DPI Awareness version.

Any ideas on improving, questions or problems.. please don't hesitate to poster.
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
MarkOtt
User
User
Posts: 28
Joined: Sat Feb 11, 2017 8:33 pm
Location: Switzerland

Re: [Module] DPI Awareness

Post by MarkOtt »

Thank you very much for your code.

Unfotunately it did not always work for me in some situations (Win10 1607 if set DPI by manual user scaling).

But I tried a more simple approach which seems to work in any situation.
I opened a new topic for discussion and refinement: http://www.purebasic.fr/english/viewtop ... 12&t=69570

Thank you very much for verifying if you have some time.

Best regards. Markus
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: [Module] DPI Awareness

Post by Thunder93 »

You weren't really clear on some details. There's also two codes posted for two different methods.

You are anyways missing the point with the extra work. Your "simple approach" version just won't cut it.
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
MarkOtt
User
User
Posts: 28
Joined: Sat Feb 11, 2017 8:33 pm
Location: Switzerland

Re: [Module] DPI Awareness

Post by MarkOtt »

You are right. The code does not free of scaling the values in the gadgets.

But it is capable of finding the correct scaling in Win7 and newer, separated for fonts and gui elements, as fonts must not be scaled in every situation. Depending on the Windows version and choosen 'Windows scaling settings' sometimes the fonts have to be scaled, sometimes not. But the GUI elements have to be scaled everytime.

In my programs I use a "scale" function for all size values of gadgets and fonts. For a full automatic version something like your code would be needed..... ;-)

Regards. Markus

Edit (to clarify a little bit):
Using PB up to version 5.24 the fonts were scaled automatically correct without scaling them in the program. It was just enough to scale the other GUI elements.
Using PB version 5.45 (and 5.61) the things got more complicated:
Eg. in Windows 10, if I set 125% in the "fixed scaling dialog" (where I can choose 100%, 125%, 150%) then the fonts are not scaled automaticall by Windows, so I have to also scale the fonts in my program.
But Windows 10 scales the fonts automatically correct if I set 125% in the "user scaling dialog" (where it is possible to scale continuously). So Windows 10 font scaling is not behaving consistently, it depends on how it is set by the user. This is what my approach seems to solve (and it works also for Win 7 and 8 ).
Post Reply