PureBoard

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

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

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