PureBasic

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

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.

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))

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 ?

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.

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.

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

Faut réinventer MUI pour Windows. Ou faire une interface graphique basée sur du Postscript comme sur NeXT... Euh... Bon, OK, je sors.

@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

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.

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

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

Merci pour la procédure AjustFontSize

.

PureBasic

[ok]Affichage des interfaces graphiques selon DPi windows

[ok]Affichage des interfaces graphiques selon DPi windows

Re: Affichage des interfaces graphiques selon DPi windows

Re: Affichage des interfaces graphiques selon DPi windows

Re: Affichage des interfaces graphiques selon DPi windows

Re: Affichage des interfaces graphiques selon DPi windows

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

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

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

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

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

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

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

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