(Ce serait bien que la team se penche sur une solution native et automatique d'ailleurs).
Voilà une solution trouvée sur le forum anglais qui marche plutôt bien.
J'ai testé avec ce code de Micoute ça marche au poil.
http://www.purebasic.fr/french/viewtopi ... =3&t=16554
---edit---
Solution beaucoup aisée pour gérer la taille des font
Code : Tout sélectionner
Procedure.f AjustFontSize(lSize.l)
;
Define.i iimage
Static.f fPpp
If fPpp = 0
iimage = CreateImage(#PB_Any,1,1)
If IsImage(iimage)
If StartVectorDrawing(ImageVectorOutput(iimage))
fPpp = VectorResolutionX()
StopVectorDrawing()
EndIf
FreeImage(iimage)
EndIf
EndIf
ProcedureReturn (lSize * 96) / fPpp
EndProcedure
;exemple
LoadFont(#FontGrid, "Arial", AjustFontSize(8))
Code : Tout sélectionner
;;;;; DPI-Aware Application ;;;;;
; Posted by Rescator on Sat Jan 02, 2010 - http://forums.purebasic.com/english/viewtopic.php?f=12&t=40507
; Platforms: Windows Only
; Modifié par Thunder93
;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.f _ScaleDPI_X_ = 1.0, _ScaleDPI_Y_ = 1.0, Font$, FontSize.b = 9
#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.i dc, lpx, lpy, IsUser32DLL, *SetProcessDPIAware, *IsProcessDPIAware, DPIAware.l = #False , ncm.NONCLIENTMETRICS, Font;, Font$, FontSize.b = 9
;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 DLLs is allready dpi aware (like through a manifest),
;then we skip using the the set dpi aware function, a DLLs should never use the set function, but it should check if the process id dpi aware
;and apply the proper modifiers where appropriate obviously.
IsUser32DLL = OpenLibrary(#PB_Any, "user32.dll")
If IsUser32DLL
*IsProcessDPIAware = GetFunction(IsUser32DLL, "IsProcessDPIAware")
If *IsProcessDPIAware
DPIAware = CallFunctionFast(*IsProcessDPIAware)
EndIf
If Not DPIAware
*SetProcessDPIAware = GetFunction(IsUser32DLL, "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)
If OSVersion() < #PB_OS_Windows_Vista : FontSize = 8 : EndIf
FontSize = IntQ(FontSize*_ScaleDPI_Y_) ;: Debug FontSize
; scaleFactorY = MulDiv_(lpy, 100, 96) ; Actual Scale factor (g.e. 150%)
Font = LoadFont(#PB_Any, Font$, FontSize, #PB_Font_HighQuality)
If Font
SetGadgetFont(#PB_Default, FontID(Font))
EndIf
EndIf
EndProcedure : InitScaleDPI()
Macro Dx(x) : (x)*_ScaleDPI_X_ : EndMacro
Macro Dy(y) : (y)*_ScaleDPI_Y_ : EndMacro
Macro pDx(x) : Int((x)/_ScaleDPI_X_) : EndMacro
Macro pDy(y) : Int((y)/_ScaleDPI_Y_) : EndMacro
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;-> Procedures for Macros associates
Procedure _OpenWindow(WindowID.l, x.l, y.l, Width.l, Height.l, Title$, Flags.l, ParentWinID.l)
ProcedureReturn OpenWindow(WindowID, x, y, Width, Height, Title$, Flags, ParentWinID)
EndProcedure
Procedure _StringGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Text$, Flags.l)
ProcedureReturn StringGadget(GadgetID, x, y, Width, Height, Text$, Flags)
EndProcedure
Procedure _ButtonGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Text$, Flags.l)
ProcedureReturn ButtonGadget(GadgetID, x, y, Width, Height, Text$, Flags)
EndProcedure
Procedure _FrameGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Text$, Flags.l)
ProcedureReturn FrameGadget(GadgetID, x, y, Width, Height, Text$, Flags)
EndProcedure
Procedure _PanelGadget(GadgetID.l, x.l, y.l, Width.l, Height.l)
ProcedureReturn PanelGadget(GadgetID, x, y, Width, Height)
EndProcedure
Procedure _TrackBarGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Minimum, Maximum, Flags)
ProcedureReturn TrackBarGadget(GadgetID, x, y, Width, Height, Minimum, Maximum, Flags)
EndProcedure
Procedure _CheckBoxGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Text$, Flags.l)
ProcedureReturn CheckBoxGadget(GadgetID, x, y, Width, Height, Text$, Flags)
EndProcedure
Procedure _ComboBoxGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Flags.l)
ProcedureReturn ComboBoxGadget(GadgetID, x, y, Width, Height, Flags)
EndProcedure
Procedure _OptionGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Text$)
ProcedureReturn OptionGadget(GadgetID, x, y, Width, Height, Text$)
EndProcedure
Procedure _TextGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Text$, Flags.l)
ProcedureReturn TextGadget(GadgetID, x, y, Width, Height, Text$, Flags)
EndProcedure
Procedure _ListIconGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Title$, TitleWidth.l, Flags.l)
ProcedureReturn ListIconGadget(GadgetID, x, y, Width, Height, Title$, TitleWidth, Flags)
EndProcedure
Procedure _ListViewGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Flags.l)
ProcedureReturn ListViewGadget(GadgetID, x, y, Width, Height, Flags)
EndProcedure
Procedure _EditorGadget(GadgetID.l, x.l, y.l, Width.l, Height.l, Flags.l)
ProcedureReturn EditorGadget(GadgetID, x, y, Width, Height, Flags)
EndProcedure
; Procedure _WindowBound(WindowID.l, MinimumWidth.l, MinimumHeight.l, MaximumWidth.l, MaximumHeight.l)
; ProcedureReturn WindowBounds(WindowID, MinimumWidth, MinimumHeight, MaximumWidth, MaximumHeight)
; EndProcedure
;-> Macros for Procedures associates
Macro OpenWindow(WindowID, x, y, Width, Height, Title, Flags = #PB_Window_SystemMenu, ParentWinID = 0)
_OpenWindow(WindowID, Dx(x), Dy(y), Dx(Width), Dy(Height), Title, Flags, ParentWinID)
EndMacro
Macro StringGadget(GadgetID, x, y, Width, Height, Text, Flags = 0)
_StringGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Text, Flags)
EndMacro
Macro ButtonGadget(GadgetID, x, y, Width, Height, Text, Flags = 0)
_ButtonGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Text, Flags)
EndMacro
Macro FrameGadget(GadgetID, x, y, Width, Height, Text, Flags = 0)
_FrameGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Text, Flags)
EndMacro
Macro PanelGadget(GadgetID, x, y, Width, Height)
_PanelGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height))
EndMacro
Macro TrackBarGadget(GadgetID, x, y, Width, Height, Minimum, Maximum, Flags = 0)
_TrackBarGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Minimum, Maximum, Flags)
EndMacro
Macro CheckBoxGadget(GadgetID, x, y, Width, Height, Text, Flags = 0)
_CheckBoxGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Text, Flags)
EndMacro
Macro ComboBoxGadget(GadgetID, x, y, Width, Height, Flags = 0)
_ComboBoxGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Flags)
EndMacro
Macro OptionGadget(GadgetID, x, y, Width, Height, Text)
_OptionGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Text)
EndMacro
Macro TextGadget(GadgetID, x, y, Width, Height, Text, Flags = 0)
_TextGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Text, Flags)
EndMacro
Macro ListIconGadget(GadgetID, x, y, Width, Height, Title, TitleWidth, Flags = 0)
_ListIconGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Title, Dx(TitleWidth), Flags)
EndMacro
Macro ListViewGadget(GadgetID, x, y, Width, Height, Flags = 0)
_ListViewGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Flags)
EndMacro
Macro EditorGadget(GadgetID, x, y, Width, Height, Flags)
_EditorGadget(GadgetID, Dx(x), Dy(y), Dx(Width), Dy(Height), Flags)
EndMacro
; Macro WindowBound(WindowID, MinimumWidth, MinimumHeight, MaximumWidth, MaximumHeight)
; _WindowBound(WindowID, Dx(MinimumWidth), Dy(MinimumHeight), Dx(MaximumWidth), Dy(MaximumHeight))
; EndMacro
CompilerIf #PB_Compiler_IsMainFile
; VOTRE CODE ICI
CompilerEndIf