DPI Aware Application
Posted: Sat Jan 02, 2010 2:39 pm
Here is a example on how to make your app DPI aware and auto scalable based on DPI.
There are some tiny quirks though, and this source only works properly on Windows 6.x+
On XP there will be no change.
This example uses SetProcessDPIAware() the "proper" way is to use a DPI aware manifest,
follow the urls in the source comments for more details.
Below the source are two images, these where taken from Windows 7 (which allows changing DPI by only loging out/in instead of restarting).
Ideally PureBasic would have a DPI Aware option and do this internally etc. Maybe PureBasic 5.0 ?
I believe OSX has a similar feature, not sure about all the Linux variants though.
96 DPI (default)

192 DPI (200%, custom)

There are some tiny quirks though, and this source only works properly on Windows 6.x+
On XP there will be no change.
This example uses SetProcessDPIAware() the "proper" way is to use a DPI aware manifest,
follow the urls in the source comments for more details.
Below the source are two images, these where taken from Windows 7 (which allows changing DPI by only loging out/in instead of restarting).
Ideally PureBasic would have a DPI Aware option and do this internally etc. Maybe PureBasic 5.0 ?

I believe OSX has a similar feature, not sure about all the Linux variants though.
Code: Select all
;Placed in the Public Domain by Roger Hågensen.
#PB_Compiler_Exe=#True ;This does not exist (yet?)
;http://msdn.microsoft.com/en-us/library/dd464660%28VS.85%29.aspx
Global _ScaleDPI_X_.f=1.0,_ScaleDPI_Y_.f=1.0
#DefaultDPIX=96.0 ;Different platforms might have different default DPI, Windows is 96 DPI.
#DefaultDPIY=96.0
Procedure InitScaleDPI() ;Windows 5.0 or higher needed for minimum functionality of this procedure.
Protected dpiaware.l=#False,dc.i,lpx.i,lpy.i,dll.i,*SetProcessDPIAware,*IsProcessDPIAware,ncm.NONCLIENTMETRICS,font$,font.i
;This part is Windows 6.x+ only (Vista etc.) and must be done before we use devcaps.
;http://msdn.microsoft.com/en-us/library/dd464660%28VS.85%29.aspx#declaring_dpi_awareness
;You really should use the DPI aware manifest instead of SetProcessDPIAware() when possible.
;On Windows 2000 and XP the manifest has no effect and set dpi aware is not available,
;however Devicecaps still returns usefull info that can be used.
;Note! If the dpi aware manifest is missing on Vista and Win7 then the OS will lie on devicecaps and will autoscale the entire app window.
CompilerIf #PB_Compiler_Exe ;Only use this in exes, as dlls inherit DPI from the calling process.
;If the exe or the calling exe in case of this being a dll is allready dpi aware (like through a manifest),
;then we skip using the the set dpi aware function, a dll should never use the set function, but it should check if the process id dpi aware
;and apply the proper modifiers where appropriate obviously.
dll=OpenLibrary(#PB_Any,"user32.dll")
If dll
*IsProcessDPIAware=GetFunction(dll,"IsProcessDPIAware")
If *IsProcessDPIAware
dpiaware=CallFunctionFast(*IsProcessDPIAware)
EndIf
If Not dpiaware
*SetProcessDPIAware=GetFunction(dll,"SetProcessDPIAware")
If *SetProcessDPIAware
CallFunctionFast(*SetProcessDPIAware)
EndIf
EndIf
EndIf
CompilerEndIf
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
;Get the system font for message boxes etc.
;We default to a size of 9, which is also the Vista and Win7 default size.
;The OS will automatically (Vista and Win7 at least) scale the font per the current user's DPI setting.
ncm\cbSize=SizeOf(NONCLIENTMETRICS)
If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,SizeOf(NONCLIENTMETRICS),ncm,#Null)
font$=PeekS(@ncm\lfMessageFont\lfFaceName)
font=LoadFont(#PB_Any,font$,9,#PB_Font_HighQuality)
If font
SetGadgetFont(#PB_Default,FontID(font))
EndIf
EndIf
EndProcedure
InitScaleDPI()
Macro ScaleDPIx(x)
(x)*_ScaleDPI_X_
EndMacro
Macro ScaleDPIy(y)
(y)*_ScaleDPI_Y_
EndMacro
;The Gadget example from PureBasic manual.
#WindowWidth = 390
#WindowHeight = 350
If OpenWindow(0, ScaleDPIx(100), ScaleDPIy(200), ScaleDPIx(#WindowWidth), ScaleDPIy(#WindowHeight), "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget)
Top = 10
GadgetHeight = 24
Frame3DGadget(#PB_Any, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(370), ScaleDPIy(290), "Player...") : Top+20
StringGadget(0, ScaleDPIx(20), ScaleDPIy(Top), ScaleDPIx(200), ScaleDPIy(GadgetHeight), "")
ButtonGadget(1, ScaleDPIx(223), ScaleDPIy(Top), ScaleDPIx(72), ScaleDPIy(GadgetHeight), "Play")
ButtonGadget(2, ScaleDPIx(295), ScaleDPIy(Top), ScaleDPIx(72), ScaleDPIy(GadgetHeight), "Stop") : Top+35
DisableGadget(2,1)
GadgetToolTip(1,"Play the current song")
PanelGadget(3, ScaleDPIx(20), ScaleDPIy(Top), ScaleDPIx(#WindowWidth-50), ScaleDPIy(#WindowHeight-Top-60))
AddGadgetItem(3, 0, "MP3 PlayList")
ListViewGadget(4, ScaleDPIx(6), ScaleDPIy(10), ScaleDPIx(230), ScaleDPIy(148))
For k=0 To 30
AddGadgetItem(4, -1, "Music Song n° "+Str(k))
Next
ButtonGadget(5, ScaleDPIx(250), ScaleDPIy(10), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Add")
ButtonGadget(6, ScaleDPIx(250), ScaleDPIy(38), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Remove")
ButtonGadget(7, ScaleDPIx(250), ScaleDPIy(66), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Select")
GadgetToolTip(7, "Select the current song")
TrackBarGadget(17, ScaleDPIx(10), ScaleDPIy(168), ScaleDPIx(310), ScaleDPIy(25), 0, 100)
AddGadgetItem(3, 1, "Options")
Top = 10
CheckBoxGadget(10, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(250), ScaleDPIy(GadgetHeight), "Enable low-pass filter") : Top+30
CheckBoxGadget(11, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(250), ScaleDPIy(GadgetHeight), "Enable visual plug-in") : Top+30
ComboBoxGadget(12, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(250), ScaleDPIy(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, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "640*480") : Top+20
OptionGadget(14, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "800*600") : Top+20
OptionGadget(15, ScaleDPIx(10), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "1024*768")
SetGadgetState(13, 1)
ButtonGadget(16, ScaleDPIx(150), ScaleDPIy(Top), ScaleDPIx(80), ScaleDPIy(GadgetHeight), "Info")
CloseGadgetList()
TextGadget (9, ScaleDPIx(10), ScaleDPIy(#WindowHeight-30), ScaleDPIx(250), ScaleDPIy(24), "PureBasic - Gadget demonstration")
ButtonGadget(8, ScaleDPIx(#WindowWidth-100), ScaleDPIy(#WindowHeight-36), ScaleDPIx(80), ScaleDPIy(24), "Quit")
SetGadgetState(3, 0)
Repeat
EventID = WaitWindowEvent()
If EventID = #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...
EventID = #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 EventID = #PB_Event_CloseWindow
EndIf
End

192 DPI (200%, custom)
