Voici un exemple de l'utilisation de la base de registre pour connaitre la vraie valeur DPI a un instant T dans une application PB
Code : Tout sélectionner
EnableExplicit
CompilerSelect #PB_Compiler_DPIAware
CompilerCase #True : Debug "The DPI awareness for the app is set by option!"
CompilerCase #False : Debug "The DPI awareness for the app is not set by option!"
CompilerEndSelect
Enumeration Windows
#WIN
EndEnumeration
Enumeration Gadgets
#BTN0
#BTN1
#BTN2
#BTN3
#BTN4
#BTN5
#BTN6
#SBAR
EndEnumeration
Enumeration Fonts
#FontDefault
EndEnumeration
#DPI_AWARENESS_INVALID = -1
#DPI_AWARENESS_UNAWARE = 0
#DPI_AWARENESS_SYSTEM_AWARE = 1
#DPI_AWARENESS_PER_MONITOR_AWARE = 2
Define SHCORE, RESULT
SHCORE = OpenLibrary(#PB_Any, "Shcore.dll")
If SHCORE
If GetFunction(SHCORE, "SetProcessDpiAwareness")
;CallFunction(SHCORE, "SetProcessDpiAwareness",#DPI_AWARENESS_PER_MONITOR_AWARE)
RESULT = CallFunction(SHCORE, "SetProcessDpiAwareness",#DPI_AWARENESS_SYSTEM_AWARE)
Select RESULT
Case #S_OK : Debug "The DPI awareness for the app was set successfully!"
Case #E_INVALIDARG : Debug "The value passed in is not valid!"
Case #E_ACCESSDENIED : Debug "The DPI awareness is already set, either by calling this API previously or through the application (.exe) manifest!"
Default : Debug "Erreur inconnue!"
EndSelect
Else
Debug "La fonction n'existe pas!"
EndIf
CloseLibrary(SHCORE)
Else
Debug "Une erreur est survenue lors de l'ouverture de la librairie!"
EndIf
;;; Noms des clés racines par ordre d'affichage dans RegEdit
;;;
;;; CLÉS RACINES - [ HKCR | HKCU | HKLM | HKU | HKCC ]
;;;
#HKCR=#HKEY_CLASSES_ROOT
#HKCC=#HKEY_CURRENT_CONFIG
#HKCU=#HKEY_CURRENT_USER
#HKLM=#HKEY_LOCAL_MACHINE
#HKU =#HKEY_USERS
Structure Key
Monitor.s
DpiValue.i
EndStructure
Global NewMap Monitors.Key()
Structure Dpi
Scale.s
Value.d
EndStructure
Global NewMap DPI.Dpi()
Define Index, Value
For Index = 0 To 16
Value = 100+Index*25
With DPI(Str(Index))
\Scale = Str(Value)+"%"
\Value = Value/100
EndWith
Next
ForEach DPI()
Debug DPI()\Scale+" "+DPI()\Value
Next
Global DpiSystem.s, DpiWindow.s, hWindow
ImportC "User32.lib"
GetDpiForSystem()
GetDpiForWindow(WindowID)
EndImport
Define OldDPI.d, NewDPI.d
Global DPI.d, LibDPI$, RegDPI, RegDPI$
Procedure.a RegEnumKey(rootKey, subKey$)
; https://www.purebasic.fr/french/viewtopic.php?t=1223
Protected Enum, hKey, iSubkey
Protected lpcchName, lpszName$, lpftLastWrite
Protected nbKeys=0
If RegOpenKeyEx_(rootKey, subKey$ + "\", 0, #KEY_ENUMERATE_SUB_KEYS, @hKey) = #ERROR_SUCCESS
; iSubkey = 0 ; compteur utilisé par RegEnumKeyEx pour énumérer les SubKey
; incémenté de 1 à chaque tour de boucle
lpcchName = 256 ; variable indiquant la taille max de la chaine
lpszName$ = Space(lpcchName) ; initialisation de la chaine qui récupère la SubKey
Enum = RegEnumKeyEx_(hKey, iSubkey, @lpszName$, @lpcchName, 0, 0, 0, @lpftLastWrite)
While Enum <> #ERROR_NO_MORE_ITEMS
iSubkey + 1 ; on incrémente le compteur d'énumération
Protected B$= subKey$ + "\" + lpszName$
;Debug B$
nbKeys + 1
;ReDim Monitors(nbKeys)
;Monitors(nbKeys) = lpszName$
Monitors(Str(nbKeys))\Monitor = lpszName$
Monitors(Str(nbKeys))\DpiValue = -1
RegEnumKey(rootKey, B$) ; appel récursif de la procédure)
Enum = RegEnumKeyEx_(hKey, iSubkey, lpszName$, @lpcchName, 0, 0, 0, @lpftLastWrite)
Wend
RegCloseKey_(hKey)
;If nbKeys = 1
; ProcedureReturn lpszName$
;Else
; ProcedureReturn ""
;EndIf
ProcedureReturn nbKeys
EndIf
EndProcedure
Procedure.l RegReadDWord(rootKey, subKey$, key$)
Protected value=-1, datasize.l=4 ; 4 bytes = 32 bits (long).
Protected hKey
If RegOpenKeyEx_(rootKey,subKey$,0,#KEY_READ,@hKey)=#ERROR_SUCCESS
If RegQueryValueEx_(hKey,key$,0,0,@value,@datasize)<>#ERROR_SUCCESS
value=-1
EndIf
RegCloseKey_(hKey)
EndIf
ProcedureReturn value
EndProcedure
Procedure.a GetRegDPI()
Protected index, nbKeys, value, key$
;
;Protected rootKey = #HKLM
;Protected subKey$ = "System\CurrentControlSet\Control\GraphicsDrivers\ScaleFactors"
;
Protected rootKey = #HKCU
Protected subKey$ = "Control Panel\Desktop\PerMonitorSettings"
Protected hKey
If RegOpenKeyEx_(rootKey, subKey$,0,#KEY_READ,@hKey) = #ERROR_SUCCESS
nbKeys = RegEnumKey(rootKey, subKey$)
EndIf
If nbKeys
For index = 1 To nbKeys
key$ = subKey$ + "\" + Monitors(Str(index))\Monitor
value = RegReadDWord(rootKey,Key$,"DpiValue")
value = value & $ffff
Monitors(Str(index))\DpiValue = value
Next
RegDPI = Monitors("1")\DpiValue
DPI = DPI(Str(RegDPI))\Value
RegDPI$ = DPI(Str(RegDPI))\Scale
ProcedureReturn RegDPI
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.s GetLibDPI()
Debug #LF$+"Nouvelle requête GetLibDPI()"+#FF$
;Debug ""
DpiSystem = Str(GetDpiForSystem() * 100 / 96)+"%"
DpiWindow = Str(GetDpiForWindow(hWindow) * 100 / 96)+"%"
Debug "DpiSystem : " + DpiSystem + " soit ppp = " + GetDpiForSystem()
Debug "DpiWindow : " + DpiWindow + " soit ppp = " + GetDpiForWindow(hWindow)
Debug ""
StatusBarText(#SBAR, 0, "Lib DPI : " + DpiSystem, #PB_StatusBar_Center)
StatusBarText(#SBAR, 1, "Reg DPI : " + RegDPI$ , #PB_StatusBar_Center)
LibDPI$ = DpiSystem
ProcedureReturn LibDPI$
EndProcedure
Global W=300, H=200
Procedure CreateGUI()
SetGadgetFont(#PB_Default , #PB_Default)
Protected FontSize.d = Round(10/DPI, #PB_Round_Up) : Debug "FontSize = " + FontSize
If DPI > 1
If LoadFont(#FontDefault, "Segoe UI", FontSize,#PB_Font_HighQuality)
;If LoadFont(#FontDefault, "Consolas", FontSize,#PB_Font_HighQuality)
SetGadgetFont(#PB_Default , FontID(#FontDefault))
EndIf
EndIf
ResizeWindow(#WIN, #PB_Ignore, #PB_Ignore, W/DPI, H/DPI)
ButtonGadget(#BTN0, 15/DPI, 15/DPI, 270/DPI, 25/DPI, "Get Lib DPI")
ButtonGadget(#BTN1, 15/DPI, 55/DPI, 270/DPI, 25/DPI, "Get Reg DPI")
ButtonGadget(#BTN2, 15/DPI, 95/DPI, 50/DPI, 25/DPI, "DPI 100")
ButtonGadget(#BTN3, 70/DPI, 95/DPI, 50/DPI, 25/DPI, "DPI 125")
ButtonGadget(#BTN4, 125/DPI, 95/DPI, 50/DPI, 25/DPI, "DPI 150")
ButtonGadget(#BTN5, 180/DPI, 95/DPI, 50/DPI, 25/DPI, "DPI 175")
ButtonGadget(#BTN6, 235/DPI, 95/DPI, 50/DPI, 25/DPI, "DPI 200")
EndProcedure
OldDPI = GetRegDPI()
If OpenWindow(#WIN, 0, 0, W/DPI, H/DPI, "GetDPI", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
hWindow = WindowID(#WIN)
SetWindowColor(#WIN, #Gray)
SmartWindowRefresh(#WIN, #True)
CreateGUI()
CreateStatusBar(#SBAR, hWindow)
AddStatusBarField(#PB_Ignore)
AddStatusBarField(#PB_Ignore)
Debug "LibDPI = " + GetLibDPI()+#LF$
Define Event, indexGadget
Repeat
Event = WaitWindowEvent(50)
NewDPI = GetRegDPI()
If NewDPI <> OldDPI
CreateGUI()
OldDPI = NewDPI
StatusBarText(#SBAR, 1, "Reg DPI : " + RegDPI$ , #PB_StatusBar_Center)
EndIf
Select Event
Case #PB_Event_Gadget
indexGadget = EventGadget()
Select indexGadget
Case #BTN0 : Debug "LibDPI = " + GetLibDPI()+#LF$
Case #BTN1 : Debug "RegDPI = " + GetRegDPI()+" soit RegDPI = " + RegDPI$+#LF$
Case #BTN2 : RunProgram("SetDPI.exe", "100", "") : CreateGUI()
Case #BTN3 : RunProgram("SetDPI.exe", "125", "") : CreateGUI()
Case #BTN4 : RunProgram("SetDPI.exe", "150", "") : CreateGUI()
Case #BTN5 : RunProgram("SetDPI.exe", "175", "") : CreateGUI()
Case #BTN6 : RunProgram("SetDPI.exe", "200", "") : CreateGUI()
EndSelect
Case #PB_Event_CloseWindow : Break
EndSelect
ForEver
EndIf
RunProgram("SetDPI.exe", "100", "")
End
;https://github.com/imniko/SetDPI
;https://github.com/imniko/SetDPI/releases/
Le changement rapide du facteur d'échelle se fait a partir de l'application grace a un utilitaire SetDPI.exe trouvé sur github
L'interface graphique de l'application reste la même quelque soit le DPI utilisé.
Seule la barre de titre et la barre de status changent de hauteur.
Si vous avez une idée de comment faire pour que la hauteur des 2 barres ne change pas quand on change le DPI, merci de partager.
J'ai quand même un problème avec la taille de la police utilisée, l'affichage est loin d'être parfait.
Si vous avez des idées pour parfaire le code, n'hésitez pas, toute critique sera la bienvenue.
j'ai hâte de voir ton code, cela m’intéresse beaucoup. 
. l'évènement #PB_Event_Repaint devrait pouvoir détecter le changement de DPI d'une application active.