That DPI problem is really pain in the ass (especially for some my old programs).
Here I've made some expanded version of your code, planning to wrap all PB UI functions into scaling macro.
However it is just for testing now [and not all functions related to UI wrapped - only OpenWindow and Gadgets creation], and maybe it would be better to just scale fonts sizes down, instead of scaling every property of every UI control up ^^
Code: Select all
EnableExplicit
;{ DPI-related procs and macross }
; This one is not needed if already set in manifest file [which is preffered])
; It must be called on startup, before any window created
; and SHOULD NOT be called from DLL
; RETURN: none
Procedure SetDPIAware()
Protected hLib = OpenLibrary(#PB_Any, "User32.dll")
If IsLibrary(hLib)
If Not CallFunction(hLib, "IsProcessDPIAware") ; if process has not already DPIAware setting (using following API or manifest file)
If CallFunction(hLib, "SetProcessDPIAware")
; now process is "DPI-aware"
EndIf
EndIf
CloseLibrary(hLib)
EndIf
EndProcedure
; Placed in the Public Domain by Roger Hågensen.
; This one calculates DPI scaling values
; which you must apply to any pixel values etc when drawing UI.
; Fonts are scaled by window automatically, so another way
; can be using lesser font sizes (basing on those values), instead of scaling whole UI
; RETURN: _ScaleDPI_X_, _ScaleDPI_Y_ global variables updated on success
Global.f _ScaleDPI_X_ = 1.0, _ScaleDPI_Y_ = 1.0
#DefaultDPIX=96.0 ;Different platforms might have different default DPI, Windows is 96 DPI.
#DefaultDPIY=96.0
Procedure InitScaleDPI()
Protected dc, lpx, lpy
dc=GetDC_(#Null)
If dc
lpx=GetDeviceCaps_(dc,#LOGPIXELSX)
lpy=GetDeviceCaps_(dc,#LOGPIXELSY)
If lpx>0
_ScaleDPI_X_=lpx/#DefaultDPIX
EndIf
If lpy>0
_ScaleDPI_Y_=lpy/#DefaultDPIY
EndIf
ReleaseDC_(#Null,dc)
EndIf
EndProcedure
; scaling macros
Macro ScaleDPIx(x)
(x)*_ScaleDPI_X_
EndMacro
Macro ScaleDPIy(y)
(y)*_ScaleDPI_Y_
EndMacro
;}
;{ PB UI-related functions wrappers }
Procedure _OpenWindow (Window, x, y, InnerWidth, InnerHeight, Title$ = "", Flags = #Null, ParentID = #Null)
Debug ScaleDPIx (x)
Debug x
ProcedureReturn OpenWindow (Window, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (InnerWidth), ScaleDPIy (InnerHeight), Title$, Flags, ParentID)
EndProcedure
Procedure _ButtonGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
ProcedureReturn ButtonGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
EndProcedure
Procedure _ButtonImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
ProcedureReturn ButtonImageGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), ImageID, Flags)
EndProcedure
Procedure _CalendarGadget (Gadget, x, y, Width, Height, Date = #Null, Flags = #Null)
ProcedureReturn CalendarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Date, Flags)
EndProcedure
Procedure _CanvasGadget (Gadget, x, y, Width, Height, Flags = #Null)
ProcedureReturn CanvasGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
EndProcedure
Procedure _CheckBoxGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
ProcedureReturn CheckBoxGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
EndProcedure
Procedure _ComboBoxGadget (Gadget, x, y, Width, Height, Flags = #Null)
ProcedureReturn ComboBoxGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
EndProcedure
Procedure _EditorGadget (Gadget, x, y, Width, Height, Flags = #Null)
ProcedureReturn EditorGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
EndProcedure
Procedure _DateGadget (Gadget, x, y, Width, Height, Mask$ = "", Date = #Null, Flags = #Null)
ProcedureReturn DateGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Mask$, Date, Flags)
EndProcedure
Procedure _ExplorerComboGadget (Gadget, x, y, Width, Height, Directory$, Flags = #Null)
ProcedureReturn ExplorerComboGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Directory$, Flags)
EndProcedure
Procedure _ExplorerListGadget (Gadget, x, y, Width, Height, Directory$, Flags = #Null)
ProcedureReturn ExplorerListGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Directory$, Flags)
EndProcedure
Procedure _ExplorerTreeGadget (Gadget, x, y, Width, Height, Directory$, Flags = #Null)
ProcedureReturn ExplorerTreeGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Directory$, Flags)
EndProcedure
Procedure _FrameGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
ProcedureReturn FrameGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
EndProcedure
Procedure _HyperLinkGadget (Gadget, x, y, Width, Height, Text$, Color, Flags = #Null)
ProcedureReturn HyperLinkGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Color, Flags)
EndProcedure
Procedure _ImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
ProcedureReturn ImageGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), ImageID, Flags)
EndProcedure
Procedure _IPAddressGadget (Gadget, x, y, Width, Height)
ProcedureReturn IPAddressGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height))
EndProcedure
Procedure _ListIconGadget (Gadget, x, y, Width, Height, FirstColumnTitle$, FirstColumnWidth, Flags = #Null)
ProcedureReturn ListIconGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), FirstColumnTitle$, FirstColumnWidth, Flags)
EndProcedure
Procedure _ListViewGadget (Gadget, x, y, Width, Height, Flags = #Null)
ProcedureReturn ListViewGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
EndProcedure
Procedure _OpenGLGadget (Gadget, x, y, Width, Height, Flags = #Null)
ProcedureReturn OpenGLGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
EndProcedure
Procedure _OptionGadget (Gadget, x, y, Width, Height, Text$)
ProcedureReturn OptionGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$)
EndProcedure
Procedure _PanelGadget (Gadget, x, y, Width, Height)
ProcedureReturn PanelGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height))
EndProcedure
Procedure _ProgressBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
ProcedureReturn ProgressBarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Minimum, Maximum, Flags)
EndProcedure
Procedure _ScintillaGadget (Gadget, x, y, Width, Height, Callback)
ProcedureReturn ScintillaGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Callback)
EndProcedure
Procedure _ScrollAreaGadget (Gadget, x, y, Width, Height, ScrollAreaWidth, ScrollAreaHeight, ScrollStep = #Null, Flags = #Null)
ProcedureReturn ScrollAreaGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), ScrollAreaWidth, ScrollAreaHeight, ScrollStep, Flags)
EndProcedure
Procedure _ScrollBarGadget (Gadget, x, y, Width, Height, Min, Max, PageLength, Flags = #Null)
ProcedureReturn ScrollBarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Min, Max, PageLength, Flags)
EndProcedure
Procedure _SpinGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
ProcedureReturn SpinGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Minimum, Maximum, Flags)
EndProcedure
Procedure _StringGadget (Gadget, x, y, Width, Height, Content$, Flags = #Null)
ProcedureReturn StringGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Content$, Flags)
EndProcedure
Procedure _TextGadget (Gadget, x, y, Width, Height, Text$, Flags = #Null)
ProcedureReturn TextGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Text$, Flags)
EndProcedure
Procedure _TrackBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
ProcedureReturn TrackBarGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Minimum, Maximum, Flags)
EndProcedure
Procedure _TreeGadget (Gadget, x, y, Width, Height, Flags = #Null)
ProcedureReturn TreeGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), Flags)
EndProcedure
Procedure _WebGadget (Gadget, x, y, Width, Height, URL$)
ProcedureReturn WebGadget (Gadget, ScaleDPIx (x), ScaleDPIy (y), ScaleDPIx (Width), ScaleDPIy (Height), URL$)
EndProcedure
;}
;{ And macross to use wrappers }
Macro OpenWindow (Window, x, y, InnerWidth, InnerHeight, Title = "", Flags = #Null, ParentID = #Null)
_OpenWindow (Window, x, y, InnerWidth, InnerHeight, Title, Flags, ParentID)
EndMacro
Macro ButtonGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
_ButtonGadget (Gadget, x, y, Width, Height, Text, Flags)
EndMacro
Macro ButtonImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
_ButtonImageGadget (Gadget, x, y, Width, Height, ImageID, Flags)
EndMacro
Macro CalendarGadget (Gadget, x, y, Width, Height, Date = #Null, Flags = #Null)
_CalendarGadget (Gadget, x, y, Width, Height, Date, Flags)
EndMacro
Macro CanvasGadget (Gadget, x, y, Width, Height, Flags = #Null)
_CanvasGadget (Gadget, x, y, Width, Height, Flags)
EndMacro
Macro CheckBoxGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
_CheckBoxGadget (Gadget, x, y, Width, Height, Text, Flags)
EndMacro
Macro ComboBoxGadget (Gadget, x, y, Width, Height, Flags = #Null)
_ComboBoxGadget (Gadget, x, y, Width, Height, Flags)
EndMacro
Macro EditorGadget (Gadget, x, y, Width, Height, Flags = #Null)
_EditorGadget (Gadget, x, y, Width, Height, Flags)
EndMacro
Macro DateGadget (Gadget, x, y, Width, Height, Mask = #Null, Date = #Null, Flags = #Null)
_DateGadget (Gadget, x, y, Width, Height, Mask, Date, Flags)
EndMacro
Macro ExplorerComboGadget (Gadget, x, y, Width, Height, Directory, Flags = #Null)
_ExplorerComboGadget (Gadget, x, y, Width, Height, Directory, Flags)
EndMacro
Macro ExplorerListGadget (Gadget, x, y, Width, Height, Directory, Flags = #Null)
_ExplorerListGadget (Gadget, x, y, Width, Height, Directory, Flags)
EndMacro
Macro ExplorerTreeGadget (Gadget, x, y, Width, Height, Directory, Flags = #Null)
_ExplorerTreeGadget (Gadget, x, y, Width, Height, Directory, Flags)
EndMacro
Macro FrameGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
_FrameGadget (Gadget, x, y, Width, Height, Text, Flags)
EndMacro
Macro HyperLinkGadget (Gadget, x, y, Width, Height, Text, Color, Flags = #Null)
_HyperLinkGadget (Gadget, x, y, Width, Height, Text, Color, Flags)
EndMacro
Macro ImageGadget (Gadget, x, y, Width, Height, ImageID, Flags = #Null)
_ImageGadget (Gadget, x, y, Width, Height, ImageID, Flags)
EndMacro
Macro IPAddressGadget (Gadget, x, y, Width, Height)
_IPAddressGadget (Gadget, x, y, Width, Height)
EndMacro
Macro ListIconGadget (Gadget, x, y, Width, Height, FirstColumnTitle, FirstColumnWidth, Flags = #Null)
_ListIconGadget (Gadget, x, y, Width, Height, FirstColumnTitle, FirstColumnWidth, Flags)
EndMacro
Macro ListViewGadget (Gadget, x, y, Width, Height, Flags = #Null)
_ListViewGadget (Gadget, x, y, Width, Height, Flags)
EndMacro
Macro OpenGLGadget (Gadget, x, y, Width, Height, Flags = #Null)
_OpenGLGadget (Gadget, x, y, Width, Height, Flags)
EndMacro
Macro OptionGadget (Gadget, x, y, Width, Height, Text)
_OptionGadget (Gadget, x, y, Width, Height, Text)
EndMacro
Macro PanelGadget (Gadget, x, y, Width, Height)
_PanelGadget (Gadget, x, y, Width, Height)
EndMacro
Macro ProgressBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
_ProgressBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags)
EndMacro
Macro ScintillaGadget (Gadget, x, y, Width, Height, Callback)
_ScintillaGadget (Gadget, x, y, Width, Height, Callback)
EndMacro
Macro ScrollAreaGadget (Gadget, x, y, Width, Height, ScrollAreaWidth, ScrollAreaHeight, ScrollStep = #Null, Flags = #Null)
_ScrollAreaGadget (Gadget, x, y, Width, Height, ScrollAreaWidth, ScrollAreaHeight, ScrollStep, Flags)
EndMacro
Macro ScrollBarGadget (Gadget, x, y, Width, Height, Min, Max, PageLength, Flags = #Null)
_ScrollBarGadget (Gadget, x, y, Width, Height, Min, Max, PageLength, Flags)
EndMacro
Macro SpinGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
_SpinGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags)
EndMacro
Macro StringGadget (Gadget, x, y, Width, Height, Content, Flags = #Null)
_StringGadget (Gadget, x, y, Width, Height, Content, Flags)
EndMacro
Macro TextGadget (Gadget, x, y, Width, Height, Text, Flags = #Null)
_TextGadget (Gadget, x, y, Width, Height, Text, Flags)
EndMacro
Macro TrackBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags = #Null)
_TrackBarGadget (Gadget, x, y, Width, Height, Minimum, Maximum, Flags)
EndMacro
Macro TreeGadget (Gadget, x, y, Width, Height, Flags = #Null)
_TreeGadget (Gadget, x, y, Width, Height, Flags)
EndMacro
Macro WebGadget (Gadget, x, y, Width, Height, URL)
_WebGadget (Gadget, x, y, Width, Height, URL)
EndMacro
;}
; Use DPI scaling
SetDPIAware()
InitScaleDPI()
; After this can start creating windows, drawing UI, etc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Some Example
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
DisableExplicit
#WindowWidth = 390
#WindowHeight = 350
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)
Top = 10
GadgetHeight = 24
FrameGadget(#PB_Any, 10, Top, 370, 290, "Player...") : Top+20
StringGadget(0, 20, Top, 200, GadgetHeight, "")
ButtonGadget(1, 223, Top, 72, GadgetHeight, "Play")
ButtonGadget(2, 295, Top, 72, GadgetHeight, "Stop") : Top+35
DisableGadget(2,1)
GadgetToolTip(1,"Play the current song")
PanelGadget(3, 20, Top, #WindowWidth-50, #WindowHeight-Top-60)
AddGadgetItem(3, 0, "MP3 PlayList")
ListViewGadget(4, 6, 10, 230, 148)
For k=0 To 30
AddGadgetItem(4, -1, "Music Song n° "+Str(k))
Next
ButtonGadget(5, 250, 10, 80, GadgetHeight, "Add")
ButtonGadget(6, 250, 38, 80, GadgetHeight, "Remove")
ButtonGadget(7, 250, 66, 80, GadgetHeight, "Select")
GadgetToolTip(7, "Select the current song")
TrackBarGadget(17, 10, 168, 310, 25, 0, 100)
AddGadgetItem(3, 1, "Options")
Top = 10
CheckBoxGadget(10, 10, Top, 250, GadgetHeight, "Enable low-pass filter") : Top+30
CheckBoxGadget(11, 10, Top, 250, GadgetHeight, "Enable visual plug-in") : Top+30
ComboBoxGadget(12, 10, Top, 250, 21) : Top+30
AddGadgetItem(12, -1, "FireWorks")
AddGadgetItem(12, -1, "OpenGL spectrum")
AddGadgetItem(12, -1, "Bump bass")
SetGadgetState(12,0)
DisableGadget(12,1)
OptionGadget(13, 10, Top, 80, GadgetHeight, "640*480") : Top+20
OptionGadget(14, 10, Top, 80, GadgetHeight, "800*600") : Top+20
OptionGadget(15, 10, Top, 80, GadgetHeight, "1024*768")
SetGadgetState(13, 1)
ButtonGadget(16, 150, Top, 80, GadgetHeight, "Info")
CloseGadgetList()
TextGadget (9, 10, #WindowHeight-30, 250, 24, "PureBasic - Gadget demonstration")
ButtonGadget(8, #WindowWidth-100, #WindowHeight-36, 80, 24, "Quit")
SetGadgetState(3, 0)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case 0
If EventType() = #PB_EventType_ReturnKey
MessageRequester("Info", "Return key pressed", 0)
SetActiveGadget(0)
EndIf
Case 1 ; Play
DisableGadget(2,0) ; Enable the 'Stop' gadget
DisableGadget(1,1) ; Disable the 'Play' Gadget
Case 2 ; Stop
DisableGadget(1,0) ; Enable the 'Play' gadget
DisableGadget(2,1) ; Disable the 'Stop' Gadget
Case 4
If EventType() = 2
SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
EndIf
Case 5 ; Add
AddGadgetItem(4, -1, "New Item Added...")
Case 6 ; Remove
RemoveGadgetItem(4, GetGadgetState(4)) ; Remove the current element of the ListView
Case 7 ; Select
SetGadgetText(0, GetGadgetText(4)) ; Get the current item from the ListView..
Case 8 ; Quit...
Event = #PB_Event_CloseWindow
Case 11 ; Enable PlugIn..
DisableGadget(12, 1-GetGadgetState(11))
Case 16 ;
If GetGadgetState(13) : Result$ = GetGadgetText(13) : EndIf
If GetGadgetState(14) : Result$ = GetGadgetText(14) : EndIf
If GetGadgetState(15) : Result$ = GetGadgetText(15) : EndIf
MessageRequester("Info", "Selected screen mode: "+Result$, 0)
Case 17
SetGadgetText(0, Str(GetGadgetState(17)))
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
End