"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