[ok]Affichage des interfaces graphiques selon DPi windows

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

[ok]Affichage des interfaces graphiques selon DPi windows

Message par Ar-S »

En affichage > 100% sous windows, les interfaces graphiques et Fonts de PB posent problème.
(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
    
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: Affichage des interfaces graphiques selon DPi windows

Message par Mesa »

En affichage > 100% sous windows, les interfaces graphiques et Fonts de PB posent problème.
(Ce serait bien que la team se penche sur une solution native et automatique d'ailleurs).
En fait, Fred l'a déjà fait (mais c'est pas automatique) avec la bibliothèque "Dialog" qui malheureusement n'a pas un grand succès. Il faudrait que cette bibliothèque soit gérée par le form designer.
En attendant, on peut utiliser ce module là:
http://www.purebasic.fr/english/viewtop ... 12&t=65330

Pour rappel, j'avais proposé une solution avec les layouts ici http://www.purebasic.fr/french/viewtopi ... 21&t=12865

M.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Affichage des interfaces graphiques selon DPi windows

Message par falsam »

j'utilise

Code : Tout sélectionner

Procedure.f AjustFontSize(Size.l)
  Define lPpp.l = GetDeviceCaps_(GetDC_(#Null), #LOGPIXELSX)
  ProcedureReturn (Size * 96) / lPpp
EndProcedure
exemple

Code : Tout sélectionner

LoadFont(#FontGrid, "Arial", AjustFontSize(8))
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Re: Affichage des interfaces graphiques selon DPi windows

Message par nico »

C'est dommage, parce que je me rend compte de plus en plus souvent que les topics créés ici ne servent à rien, toujours des références sur des topics anglais.

Concernant l'exemple de Falsam par exemple, on peut faire la même chose sans api depuis la version 5.40.

Je ne sais pas ce que vaut les autres exemples (avec api) mais elles semblent être complexes alors que celle donnée par Falsam est tellement simple a mettre en oeuvre.

AR-S, pourrais tu nous expliquer les raisons pour lesquelles, l'exemple donné par Falsam ne suffit pas ou ne convient pas ?
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Affichage des interfaces graphiques selon DPi windows

Message par Ar-S »

Il servent pour les non anglophones, sinon ce forum n'auraient pas lieu d'être.
Sinon le code de Falsam me convient tout à fait. Si je peux arriver au même résultat avec ces 3 lignes de codes plutôt qu'avec le pavé que j'ai posté je ne vais pas me priver.
Je l'ajoute au 1er topic ce sera plus aisé pour de futurs recherches.
@Mesa, merci pour la piqure de rappel.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par Mesa »

Pour conclure, comme le dit Nico, on peut le faire sans api à condition d'ouvrir une fenêtre ou de créer (ouvrir) une image.

Pour rappel:

Code : Tout sélectionner

Procedure.f AjustFontSize(Size.l) 
	Protected fPpp.f, im 
	im = CreateImage(#PB_Any,1,1)
	StartVectorDrawing( ImageVectorOutput(im));WindowVectorOutput() demande l'ouverture d'une fenêtre au préalable
	fPpp = VectorResolutionY()
	StopVectorDrawing()
	FreeImage(im)
	ProcedureReturn fPpp*Size/96
EndProcedure

Debug AjustFontSize(8)



Procedure.f AjustFontSizeW(Window.l, Size.l) 
	Protected fPpp.f 
	
	StartVectorDrawing(WindowVectorOutput(Window)); demande l'ouverture d'une fenêtre au préalable
	fPpp = VectorResolutionY()
	StopVectorDrawing()
	
	ProcedureReturn fPpp*Size/96
EndProcedure


OpenWindow(0,0,0,100,100, "adjustfontsize",#PB_Window_SystemMenu)
Debug AjustFontSizeW(0, 8)

[Edition] oops, correction bug

M.
Dernière modification par Mesa le lun. 13/mars/2017 14:58, modifié 2 fois.
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par GallyHC »

Bonjour

Mesa > merci pour cette exemple et je me suis permit de faire une version plus complète (tu n'as pas de retours de la taille) :

Code : Tout sélectionner

Global.f fPpp = -1

Procedure.f AjustFontSize(lSize.l) 
;
;
;
  Define.i iwindow, iimage
  
  If fPpp < 0
    iwindow = OpenWindow(#PB_Any, 0, 0, 100, 100, "", #PB_Window_Invisible)
    If IsWindow(iwindow)
      iimage = CreateImage(#PB_Any,1,1)
      If IsImage(iimage)
        If StartVectorDrawing(ImageVectorOutput(iimage))
          fPpp = VectorResolutionX()
          StopVectorDrawing()
        EndIf
        FreeImage(iimage)
      EndIf
      CloseWindow(iwindow)
    EndIf
  EndIf
  ProcedureReturn (lSize * 96) / fPpp
  
EndProcedure
Cordialement,
GallyHC
Dernière modification par GallyHC le sam. 11/mars/2017 10:18, modifié 2 fois.
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par djes »

Faut réinventer MUI pour Windows. Ou faire une interface graphique basée sur du Postscript comme sur NeXT... Euh... Bon, OK, je sors.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par falsam »

@Mesa: Ton code ne fonctionne pas. La police est énorme dans un context d'affichage standard.

Code : Tout sélectionner

;Plan de l'application
Declare Start()
Declare.f AjustFontSize(Size.l)
Declare Exit()

Start()

Procedure Start()
  Protected Font = LoadFont(#PB_Any, "Arial", AjustFontSize(8))
  
  SetGadgetFont(#PB_Default, FontID(Font))
  
  OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ButtonGadget(1, 700, 20, 80, 24, "Test")  
  
  ;Triggers
  BindEvent(#PB_Event_CloseWindow, @Exit())
  
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Procedure.f AjustFontSize(Size.l) 
  Protected fPpp.f, im 
  im = CreateImage(#PB_Any,1,1)
  StartVectorDrawing( ImageVectorOutput(im))
  fPpp = VectorResolutionY()
  StopVectorDrawing()
  FreeImage(im)
  ProcedureReturn fppp
EndProcedure

Procedure Exit()  
  End
EndProcedure
@Gally : Idem !! Ta procédure ne fonctionne pas. Les caractéres sont minuscules dans un context d'affichage standard.

Code : Tout sélectionner

EnableExplicit

;Plan de l'application
Declare Start()
Declare.f AjustFontSize(lSize.l)
Declare Exit()

Start()

Procedure Start()
  Protected Font = LoadFont(#PB_Any, "Arial", AjustFontSize(8))
  
  SetGadgetFont(#PB_Default, FontID(Font))
  
  OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ButtonGadget(1, 700, 20, 80, 24, "Test")  
  
  ;Triggers
  BindEvent(#PB_Event_CloseWindow, @Exit())
  
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Global.f fPpp = -1

Procedure.f AjustFontSize(lSize.l) 
;
;
;
  Define.i iwindow, iimage
  
  If fPpp < 0
    iwindow = OpenWindow(#PB_Any, 0, 0, 100, 100, "", #PB_Window_Invisible)
    If IsWindow(iwindow)
      iimage = CreateImage(#PB_Any,1,1)
      If IsImage(iimage)
        If StartVectorDrawing(ImageVectorOutput(iimage))
          fPpp = VectorResolutionX()
          StopVectorDrawing()
        EndIf
        FreeImage(iimage)
      EndIf
      CloseWindow(iwindow)
    EndIf
  EndIf
  ProcedureReturn (lSize * 96) / fPpp
  
EndProcedure

Procedure Exit()  
  End
EndProcedure
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par Micoute »

Je comprend mieux pourquoi dans mes tests, ça ne fonctionnait pas quand je modifiais le texte des applications, car quand je l'agrandissais, il était tronqué, ce qui me paraissait normal, mais je pensais bêtement qu'il s'adapterait à l'affichage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par falsam »

En prenant le code de Mesa et une correction de Gally j'ai une procédure qui a l'air de tenir la route. Est il possible que certains d'entres vous utilisant un contexte d'affichage non standard peuvent tester ce code ? Merci d'avance.

Code : Tout sélectionner

EnableExplicit

;Plan de l'application
Declare Start()
Declare.f AjustFontSize(Size.i)
Declare Exit()

Start()

Procedure Start()
  Protected Font = LoadFont(#PB_Any, "Arial", AjustFontSize(8))
  
  SetGadgetFont(#PB_Default, FontID(Font))
  
  OpenWindow(0, 0, 0, 800, 600, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ButtonGadget(1, 700, 20, 80, 24, "Test")  
  
  ;Triggers
  BindEvent(#PB_Event_CloseWindow, @Exit())
  
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Procedure.f AjustFontSize(Size.i) 
  Static fPpp.f
  Protected im 
  
  If fPpp = 0
    im = CreateImage(#PB_Any,1,1)
    StartVectorDrawing( ImageVectorOutput(im))
    fPpp = VectorResolutionX()
    StopVectorDrawing()
    FreeImage(im)
  EndIf
  
  ProcedureReturn (Size * 96) / fPpp
EndProcedure

Procedure Exit()  
  End
EndProcedure
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par GallyHC »

Bonjour,

J'ai voulu allez trop vite, c'est corriger. Merci falsam

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
Cordialement,
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
ChrisR
Messages : 221
Inscription : sam. 14/févr./2015 16:20

Re: [ok]Affichage des interfaces graphiques selon DPi window

Message par ChrisR »

Merci pour la procédure AjustFontSize :)

.
Répondre