Fragen zu DPI handling in PB

[Kukulkan]

Hallo,

ich hab mal mein Windows 7 auf Textgrösse 125% gestellt.

Das Ergebnis ist schon schön für die Augen, aber sehr unschön für alle meine PB Programme:

- Buttons sind zu klein um den Text zu fassen
- Sogar DrawText mit geladenem Font malt grösser und damit über die Ränder hinaus
- Vom Layout mal ganz abgesehen...

Selbst wenn ich mit LoadFont() und SetGadgetFont() der Sache entgegen wirken möchte, scheint sich Windows oder PureBasic darüber hinwegzusetzen. Aber nur bzgl. der Fontgrössen. Die Fenster und Gadgets bleiben wie angegeben (Angaben sind ja alle in Pixel).

Frage: Wie kann man mit PB Bordmitteln diesem Wahnsinn Herr werden?

Grüße,

Kukulkan

[ts-soft]

Ich finde gerade den Link nicht, aber der Code ist von freak und wurde im engl. Forum gepostet!

Code: Alles auswählen

 ;
;  Calculates the size required to display a Gadget properly.
;
;  Supported Gadgets:
;    Button, Checkbox, Option, Text, String, ComboBox, Image
;
;  Note:
;    For Gadgets with variable content (String, ComboBox), only the returned height
;    is useful, as the width will only be an absolute minimum value.
;
;  The 'Flags' parameter gives gadget flags to include in the calculation.
;  Currently only #PB_Text_Border makes a difference there.   
;

EnableExplicit
Macro Max(a, b)
 ((Not a > b) * b) | ((Not b > a) * a)
EndMacro

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  Structure PB_Gadget
    *Gadget.GtkWidget
    *Container.GtkWidget
    *VT
    UserData.i
    GadgetData.i[4]
  EndStructure
CompilerEndIf

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  Structure OSX_Rect
    top.w
    left.w
    bottom.w
    right.w
  EndStructure
 
  #noErr = 0
CompilerEndIf


; Stores the result in *Width\l and *Height\l
;
Procedure GetRequiredSize(Gadget, *Width.LONG, *Height.LONG, Flags = 0)

  CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    Protected DC, oldFont, Size.SIZE, LineSize.SIZE
    Protected Text$, count, empty, maxheight, index, Line$
    
    DC = GetDC_(GadgetID(Gadget))
    oldFont = SelectObject_(DC, GetGadgetFont(Gadget))

    Select GadgetType(Gadget)
   
      Case #PB_GadgetType_Text
        Text$ = RemoveString(GetGadgetText(Gadget), Chr(10))
        count = CountString(Text$, Chr(13)) + 1
        empty = 0
        maxheight = 0
        For index = 1 To count
          Line$ = StringField(Text$, index, Chr(13))
          If Line$ = ""
            empty + 1
          Else
            GetTextExtentPoint32_(DC, @Line$, Len(Line$), @LineSize)
            Size\cx = Max(Size\cx, LineSize\cx)
            Size\cy + LineSize\cy
            maxheight = Max(maxheight, LineSize\cy)
          EndIf
        Next index           
        Size\cy + empty * maxheight 
       
        If Flags & #PB_Text_Border
          Size\cx + GetSystemMetrics_(#SM_CXEDGE) * 2
          Size\cy + GetSystemMetrics_(#SM_CYEDGE) * 2
        Else           
          Size\cx + 2
          Size\cy + 2
        EndIf

      Case #PB_GadgetType_CheckBox, #PB_GadgetType_Option
        Text$ = GetGadgetText(Gadget)
        GetTextExtentPoint32_(DC, @Text$, Len(Text$), @Size)
        Size\cx + 20
        Size\cy = Max(Size\cy + 2, 20)
       
      Case #PB_GadgetType_Button
        Text$ = GetGadgetText(Gadget)
        GetTextExtentPoint32_(DC, @Text$, Len(Text$), @Size)
        Size\cx + GetSystemMetrics_(#SM_CXEDGE) * 2
        Size\cy = Max(Size\cy + GetSystemMetrics_(#SM_CYEDGE) * 2, 24)
        Size\cx + 10
       
      Case #PB_GadgetType_String
        Text$ = GetGadgetText(Gadget) + "Hg"
        GetTextExtentPoint32_(DC, @Text$, Len(Text$), @Size)
        Size\cx = GetSystemMetrics_(#SM_CXEDGE) * 2
        Size\cy = Max(Size\cy + GetSystemMetrics_(#SM_CXEDGE) * 2, 20)
       
      Case #PB_GadgetType_ComboBox
        GetTextExtentPoint32_(DC, @"Hg", 2, @Size)
        Size\cy = Max(Size\cy + 8, 21)
        Size\cx = Size\cy 
       
      Case #PB_GadgetType_Image
        Size\cx = GadgetWidth(Gadget)
        Size\cy = GadgetHeight(Gadget)
       
    EndSelect
   
    SelectObject_(DC, oldFont)
    ReleaseDC_(GadgetID(Gadget), DC)
    *Width\l  = Size\cx
    *Height\l = Size\cy
 
  CompilerCase #PB_OS_Linux
    Protected *Gadget.PB_Gadget, RealSize.GtkRequisition, Size.GtkRequisition
    
    *Gadget = IsGadget(Gadget)
   
    If *Gadget And *Gadget\Container And GadgetType(Gadget) <> #PB_GadgetType_ComboBox
      gtk_widget_size_request_(*Gadget\Container, @RealSize)
      gtk_widget_set_size_request_(*Gadget\Container, -1, -1)
      gtk_widget_size_request_(*Gadget\Container, @Size)     
      gtk_widget_set_size_request_(*Gadget\Container, RealSize\Width, RealSize\Height)
    Else
      gtk_widget_size_request_(GadgetID(Gadget), @RealSize)
      gtk_widget_set_size_request_(GadgetID(Gadget), -1, -1)             
      gtk_widget_size_request_(GadgetID(Gadget), @Size)   
      gtk_widget_set_size_request_(GadgetID(Gadget), RealSize\Width, RealSize\Height)
    EndIf
   
    If GadgetType(Gadget) = #PB_GadgetType_ComboBox Or GadgetType(Gadget) = #PB_GadgetType_String
      *Width\l  = 20
    Else
      *Width\l  = Size\Width
    EndIf
       
    *Height\l = Size\Height   

  CompilerCase #PB_OS_MacOS
    Protected Type, Rect.OSX_Rect, BaseLine.w
    Protected Height, Min, Max, Mid
    
    Type = GadgetType(Gadget)
   
    If Type = #PB_GadgetType_Image   
      *Width\l = GadgetWidth(Gadget)
      *Height\l = GadgetHeight(Gadget)
     
    ElseIf Type = #PB_GadgetType_Text
      realwidth   = GadgetWidth(Gadget)
     
      *Width\l = 40
      *Height\l = 20     
     
      ResizeGadget(Gadget, #PB_Ignore, #PB_Ignore, 1000, #PB_Ignore)
     
      If GetBestControlRect_(GadgetID(Gadget), @Rect, @BaseLine) = #noErr
        Height = Rect\bottom - Rect\top
        If Height > 0
       
          Min = 0
          Max = 1000
         
          While Max > Min + 2
            Mid = (Min + Max) / 2
           
            ResizeGadget(Gadget, #PB_Ignore, #PB_Ignore, Mid, #PB_Ignore)
           
            If GetBestControlRect_(GadgetID(Gadget), @Rect, @BaseLine) <> #noErr
              ProcedureReturn
            EndIf
           
            If Rect\bottom - Rect\top > Height
              Min = Mid
            Else
              Max = Mid
            EndIf
          Wend
         
          *Width\l = Rect\right - Rect\left + 2
          *Height\l = Max(Height, 20)
        EndIf
         
      EndIf
     
      ResizeGadget(Gadget, #PB_Ignore, #PB_Ignore, realwidth, #PB_Ignore)

    Else
      If GetBestControlRect_(GadgetID(Gadget), @Rect, @BaseLine) = #noErr
        *Width\l = Rect\right - Rect\left
        *Height\l = Max(Rect\bottom - Rect\top, 20)
       
        If Type = #PB_GadgetType_Button Or Type = #PB_GadgetType_String
          *Height\l = Max(*Height\l, 24)       
        EndIf       
      Else
        *Width\l = 40
        *Height\l = 20
      EndIf
     
      If Type = #PB_GadgetType_String Or Type  = #PB_GadgetType_ComboBox       
        *Width\l = 30
      EndIf
   
    EndIf
 
  CompilerEndSelect
 
EndProcedure

; convinience wrappers if only one size is needed
;
Procedure GetRequiredWidth(Gadget, Flags = 0)
  Protected Width.l, Height.l
  GetRequiredSize(Gadget, @Width, @Height, Flags)
  ProcedureReturn Width
EndProcedure

Procedure GetRequiredHeight(Gadget, Flags = 0)
  Protected Width.l, Height.l
  GetRequiredSize(Gadget, @Width, @Height, Flags)
  ProcedureReturn Height
EndProcedure

[Kukulkan]

Danke,

Ich hab das auch gefunden aber irgendwie fehlt PB wirklich eine ordentliche Layout Engine. Ich werd wohl so ein Include basteln was das für mich übernimmt.

Danke für den Tip. Den werd ich mir dann genauer ansehen.

PS. So als schneller Fix kann man nicht Windows sagen die angegebene Font Grösse zu nutzen statt diese zu skalieren?

Grüße,

Volker

[ts-soft]

Mir ist jedenfalls kein schneller Fix bekannt, aber eine Layout-Engine steht auf der ToDo Liste des
PB_TEAMS, ist nur wie immer die Frage, wann kommt sie

[Lambda]

Meinerseits gegen Ende dieser Woche. Workspace Control.

Natürlich Cross-platform, mit Theme-Unterstützung, benutzerdefinierten Layouts, Seiten, Pinnbar etc.

[ts-soft]

Unterstützt das auch das native look & feel, des Betriebssystems?

[Lambda]

Ja, habe verschiedene Varianten genauer unter die Lupe genommen. (.NET, Adobe etc) Was das extravagante angeht kann es auch diesen soweit das Wasser reichen. Bei Drag&Drop eine Platzierungs-Vorschau, Absetz-Vorschläge, weiche Blend-Effekte, aber gerade die Visual-Effects sind jeweils optional und beeinflussen die Performance nicht.

Edit: Wobei "Look" - mit Theme-Unterstützung an sich so oder so gedeckt wäre. Mit Alpha-Masken können auch Themen genutzt werden die sich den System-Farben anpassen.

[ts-soft]

Will kein Adobe und kein .NET, meine so wie PB die Gadgets darstellt, also nur mit XP-Style unterstützung, bzw.
im Classic-Style, wenn die aus ist.

Das geskinnte Zeuchxs, was Du meinst, will ich möglichst gar nicht sehen

[Lambda]

Das waren nur Beispiele (wie auch C4D) die gesamt verglichen wurden. Aber es würde an jedem selbst liegen welches Theme man nutzt. Wie gesagt, so ein "Multi-Color" Theme stellt praktisch den nativen System Stil dar.

[matbal]

@Kukulkan

Ich kenne das Problem auch, weil ich auf mein Notebook die DPI hochstellen muß, um etwas zu erkennen. Mir ging es aber nur um das proportionale Vergrößern entsprechend der eingestellten DPI. Mittlerweile habe ich eine Lösung gefunden, bei der man relativ wenig am Code ändern muß.

Der ursprüngliche Code stammt aus dem englischen Forum. DPI Aware Application
Ich habe noch zwei Funktionen hinzugefügt, die das eigentliche Resizen übernehmen. Die machen beide im Prinzip das selbe, nur mit unterschiedlicher Methode.

Die modifizierte ScaleDPI.pbi

Code: Alles auswählen

#PB_Compiler_Exe = #True ;This does not exist (yet?)

Global _ScaleDPI_X_.f = 1.0
Global _ScaleDPI_Y_.f = 1.0

#DefaultDPIX = 96.0 ;Different platforms might have different default DPI, Windows is 96 DPI.
#DefaultDPIY = 96.0

Macro ScaleDPIx(x)
   (x)*_ScaleDPI_X_
EndMacro
Macro ScaleDPIy(y)
   (y)*_ScaleDPI_Y_  
EndMacro

Procedure InitScaleDPI() ;Windows 5.0 or higher needed for minimum functionality of this procedure.
   Protected dpiaware.l = #False
   Protected hDC.i
   Protected lpx.i 
   Protected lpy.i
   Protected dll.i
   Protected *SetProcessDPIAware
   Protected *IsProcessDPIAware
   Protected ncm.NONCLIENTMETRICS
   Protected font.i
   Protected name$, points.i, styles.i, charset.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
   hDC = GetDC_(#Null)
   If hDC
      lpx = GetDeviceCaps_(hDC,#LOGPIXELSX)
      lpy = GetDeviceCaps_(hDC,#LOGPIXELSY)
      If lpx>0
         _ScaleDPI_X_ = lpx / #DefaultDPIX
      EndIf
      If lpy>0
         _ScaleDPI_Y_ = lpy / #DefaultDPIY
      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)
         name$ = PeekS(@ncm\lfMessageFont\lfFaceName)
         
         charset = ncm\lfMessageFont\lfCharSet
         
         points = -MulDiv_(ncm\lfMessageFont\lfHeight, 72, GetDeviceCaps_(hDC, #LOGPIXELSY))
         
         If ncm\lfMessageFont\lfWeight = 700 : styles = #PB_Font_Bold : EndIf
         If ncm\lfMessageFont\lfItalic > 0 : styles = styles + #PB_Font_Italic : EndIf
         
         
         font = LoadFont(#PB_Any,name$,points,#PB_Font_HighQuality|styles)
         If font
            SetGadgetFont(#PB_Default,FontID(font))
         EndIf
      EndIf
      
      ReleaseDC_(#Null,hDC)
   EndIf
   
EndProcedure


Procedure __EnumChild__(hwnd, Parent)
   Protected Buffer.s = Space(256)
   Protected RC.RECT
   Protected p1.POINT
   Protected p2.POINT
   
   GetClassName_(hwnd, @Buffer,256)  
   Debug Buffer
   If Buffer 
      ; Screen-Koordinaten des Gadgets  
      GetWindowRect_(hWnd, RC)      
      
      ; In Client-Koordinaten umwandeln
      p1\x = rc\left
      p1\y = rc\top
      ScreenToClient_(GetParent_(hwnd), p1)   
      p2\x = rc\right
      p2\y = rc\bottom
      ScreenToClient_(GetParent_(hwnd), p2)   
      
      ;Debug Str(p1\x) + " , " + Str(p1\y) + " - " + Str(p2\x - p1\x) + " , " + Str(p2\y - p1\y)
      
      ; Skalieren
      SetWindowPos_(hwnd, 0, ScaleDPIx(p1\x), ScaleDPIy(p1\y), ScaleDPIx(p2\x - p1\x), ScaleDPIy(p2\y - p1\y), #SWP_NOZORDER)
      
      ProcedureReturn 1
   EndIf
EndProcedure
Procedure WindowScaleDpi(Window)
   ; Skaliert alle Gadgets eines Windows
   
   EnumChildWindows_(WindowID(window), @__EnumChild__(), WindowID(window))
   
EndProcedure

Procedure GadgetScaleDpi(Gadget, LastGadget = 0)
   ; Skaliert ein oder mehrere Gadgets
   Protected.i i, x, y, w, h
   If LastGadget = 0
      LastGadget = Gadget
   EndIf
   
   For i = Gadget To LastGadget
      If IsGadget(i)
         x = GadgetX(i) * _ScaleDPI_X_
         y = GadgetY(i) * _ScaleDPI_Y_
         w = GadgetWidth(i) * _ScaleDPI_X_
         h = GadgetHeight(i) * _ScaleDPI_Y_
         ResizeGadget(i, x, y, w, h)
      EndIf
   Next i
   
EndProcedure

Man muß nur an sehr wenigen Stellen im eigenen Code Änderungen vornehmen. Ich habe hier das gleiche PureBasic-Gadget-Demo modifiziert, wie der ursprüngliche Autor. Ich habe nur wesentlich weniger schreiben müssen. Die Stellen, wo ich etwas einfügen mußte, habe ich mit ####### markiert.

* Am Anfang muß die Include eingebunden werden und die InitScaleDPI() aufgerufen werden.
* Die Fenstergröße muß manuell angepaßt werden mit ScaleDPIx() und ScaleDPIy(), und das Fenster sollte unsichtbar erstellt werden, damit man das rumrutschen der Gadgets nicht sieht.
* Nachdem das Fenster erstellt wurde, muß eine der beiden Resize-Funktionen aufgerufen werden und das Fenster wieder sichtbar gemacht werden.

WindowsScaleDPI() und GadgetScaleDPI() machen im Prinzip das selbe. Der Unterschied ist: Bei GadgetScaleDPI() müssen die Gadgets angegeben werden. Bei WindowsScaleDPI muß das Fenster angegeben werden.

Wenn Fenster noch in der Größe änderbar sein sollen, kann man awgdgres aus dem Packet verwenden: AWPB-Tools Includes
Das funktioniert nach dem Skalieren immer noch richtig.

Das Purebasic Gadget-Demo:

Code: Alles auswählen

;
; ------------------------------------------------------------
;
;   PureBasic - Gadget example file
;
;    (c) 2002 - Fantaisie Software
;
; ------------------------------------------------------------
;

IncludeFile "ScaleDPI.pbi" ; ################### 
InitScaleDPI()             ; ################### 

#WindowWidth  = 390
#WindowHeight = 350

; ########## Das Window muß manuell skaliert werden
; ########## Fenster sollte versteckt werden, damit man das Resizen nicht sieht
If OpenWindow(0, 100, 200, ScaleDPIx(#WindowWidth), ScaleDPIy(#WindowHeight), "PureBasic - Gadget Demonstration", #PB_Window_MinimizeGadget|#PB_Window_Invisible)
    
  Top = 10
  GadgetHeight = 24

  Frame3DGadget(#PB_Any, 10, Top, 370, 290, "Player...") : Top+20

  StringGadget(0,  20, Top, 200, GadgetHeight, "")
  ButtonGadget(1, 223, Top,  72, GadgetHeight, "Play")
  ButtonGadget(2, 295, Top,  72, GadgetHeight, "Stop")  : Top+35
  DisableGadget(2,1)
  
  GadgetToolTip(1,"Play the current song")
  
  PanelGadget(3, 20, Top, #WindowWidth-50, #WindowHeight-Top-60)
    AddGadgetItem(3, 0, "MP3 PlayList")
      ListViewGadget(4, 6, 10, 230, 148)

      For k=0 To 30
        AddGadgetItem(4, -1, "Music Song n° "+Str(k))
      Next

      ButtonGadget(5,  250, 10, 80, GadgetHeight, "Add")
      ButtonGadget(6,  250, 38, 80, GadgetHeight, "Remove")
      ButtonGadget(7,  250, 66, 80, GadgetHeight, "Select")
      GadgetToolTip(7, "Select the current song")
      
      TrackBarGadget(17, 10, 168, 310, 25, 0, 100)

    AddGadgetItem(3, 1, "Options")
      Top = 10
      CheckBoxGadget(10, 10, Top, 250, GadgetHeight, "Enable low-pass filter") : Top+30
      CheckBoxGadget(11, 10, Top, 250, GadgetHeight, "Enable visual plug-in")  : Top+30
      ComboBoxGadget(12, 10, Top, 250, 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, 10, Top, 80, GadgetHeight, "640*480") : Top+20
      OptionGadget(14, 10, Top, 80, GadgetHeight, "800*600") : Top+20
      OptionGadget(15, 10, Top, 80, GadgetHeight, "1024*768")
      SetGadgetState(13, 1)
      
      ButtonGadget(16, 150, Top, 80, GadgetHeight, "Info")
  CloseGadgetList()

  TextGadget  (9, 10, #WindowHeight-30, 250, 24, "PureBasic - Gadget demonstration")
  ButtonGadget(8, #WindowWidth-100, #WindowHeight-36, 80, 24, "Quit")

  SetGadgetState(3, 0)
  
  WindowScaleDpi(0)  ; ################   Gadgets neu positionieren
  HideWindow(0, 1)   ; ################   Fenster zeigen
  
  Repeat
    Event = WaitWindowEvent()
    
    If Event = #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...
          Event = #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 Event = #PB_Event_CloseWindow

EndIf

End