PureBasic Forums - English

http://www.purebasic.com
http://forums.purebasic.com/english/

[Module] DPI Awareness

http://forums.purebasic.com/english/viewtopic.php?t=69379

Page 1 of 2

[Module] DPI Awareness

Posted: Tue Oct 10, 2017 10:49 pm
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

Re: DPI Awareness Module

Posted: Wed Oct 11, 2017 4:00 am
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

;}

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 2:20 pm
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

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 2:49 pm
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.

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 2:54 pm
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

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 3:09 pm
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:

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 3:20 pm
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

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 3:24 pm
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?

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 3:29 pm
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

Re: DPI Awareness Module

Posted: Fri Oct 13, 2017 3:37 pm
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:

Re: [Module] DPI Awareness

Posted: Wed Oct 18, 2017 3:18 am
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:

Re: [Module] DPI Awareness

Posted: Sat Oct 21, 2017 5:54 pm
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.

Re: [Module] DPI Awareness

Posted: Sun Nov 05, 2017 6:50 pm
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

Re: [Module] DPI Awareness

Posted: Sun Nov 05, 2017 10:32 pm
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.

Re: [Module] DPI Awareness

Posted: Sun Nov 05, 2017 10:53 pm
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 ).
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited