Seite 1 von 1

Module: ScaleDPI (DPI aware) [WIN]

Verfasst: 04.03.2015 18:25
von Thorsten1867
Eine kleine Notlösung für die Vergrößerung der Schrift unter Windows (100% / 125% / 150%).
Das Fenster und die Gadgets werden entsprechend vergrößert.

Code: Alles auswählen

;/ === ScaleDPIModule.pbi ===  [ ab PureBasic V5.2x ]
;/ ( Windows only) 
;/ March 2015 by Thorsten1867
;/
;/ based on ScaleDPI of Roger Hågensen and matbal
;/

DeclareModule ScaleDPI
  Declare Window(Window.i, minW.i=#PB_Ignore, minH.i=#PB_Ignore, maxW.i=#PB_Ignore, maxH.i=#PB_Ignore)
  Declare Gadget(Gadget.i, LastGadget.i=#False)
EndDeclareModule


Module ScaleDPI

  EnableExplicit
  
  CompilerIf #PB_Compiler_Executable
    Prototype proto_SetProcessDPIAware()
    If OpenLibrary(0, "user32.dll")
      SetProcessDPIAware.proto_SetProcessDPIAware = GetFunction(0, "SetProcessDPIAware")
      If SetProcessDPIAware
        SetProcessDPIAware() ; Windows Vista+ / Windows Server 2008+
      EndIf
    EndIf
  CompilerEndIf

  Global ScaleDPI_X.f = GetDeviceCaps_(GetDC_(0),#LOGPIXELSX) / 96
  Global ScaleDPI_Y.f = GetDeviceCaps_(GetDC_(0),#LOGPIXELSY) / 96

  Macro dpiX(x)
    (x * ScaleDPI_X)
  EndMacro
  Macro dpiY(y)
    (y * ScaleDPI_Y)
  EndMacro

  Procedure Window(Window.i, minW.i=#PB_Ignore, minH.i=#PB_Ignore, maxW.i=#PB_Ignore, maxH.i=#PB_Ignore)
    Define.i x, y, w, h
    
    If IsWindow(Window)
      x = WindowX(Window) * ScaleDPI_X
      y = WindowY(Window) * ScaleDPI_Y
      w = WindowWidth(Window) * ScaleDPI_X
      h = WindowHeight(Window) * ScaleDPI_Y
      ResizeWindow(Window, x, y, w, h)
      
      If minW <> #PB_Ignore : minW * ScaleDPI_X : EndIf
      If minH <> #PB_Ignore : minH * ScaleDPI_Y : EndIf
      If maxW <> #PB_Ignore : maxW * ScaleDPI_X : EndIf
      If maxH <> #PB_Ignore : maxH * ScaleDPI_Y : EndIf
      WindowBounds(Window, minW, minH, maxW, maxH)
    EndIf
    
  EndProcedure  
  
  Procedure Gadget(Gadget.i, LastGadget.i=#False) ; Scale one or more gadgets
    Define.i i, x, y, w, h
    
    If LastGadget = #False : 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
  
EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  #Window_thUpdater = 1

  Enumeration 1
    ; Fonts
    #Arial9B
    ; Window_Update
    #Gadget_thUpdater_T_Anzahl
    #Gadget_thUpdater_T_UpdFiles
    #Gadget_thUpdater_F_Files
    #Gadget_thUpdater_T_Msg
    #Gadget_thUpdater_Progress
    #Gadget_thUpdater_F_Progress
    #Gadget_thUpdater_OK
  EndEnumeration
  
  LoadFont(#Arial9B, "Arial", 9, 256|#PB_Font_HighQuality)
  
  Procedure.i Window_thUpdater()
    If OpenWindow(#Window_thUpdater,451,213,330,153,"thIUpdater",#PB_Window_SystemMenu|#PB_Window_Tool|#PB_Window_ScreenCentered|#PB_Window_Invisible)
      TextGadget(#Gadget_thUpdater_T_Anzahl,15,15,40,20,"12",#PB_Text_Center|#PB_Text_Border)
        SetGadgetColor(#Gadget_thUpdater_T_Anzahl,#PB_Gadget_FrontColor,8388608)
        SetGadgetFont(#Gadget_thUpdater_T_Anzahl,FontID(#Arial9B))
      TextGadget(#Gadget_thUpdater_T_UpdFiles,60,16,255,18,"Dateien zur Aktualisierung")
        SetGadgetFont(#Gadget_thUpdater_T_UpdFiles,FontID(#Arial9B))
      FrameGadget(#Gadget_thUpdater_F_Files,5,0,320,45,"")
      TextGadget(#Gadget_thUpdater_T_Msg,15,70,300,16,"Starte .....",#PB_Text_Center)
        SetGadgetFont(#Gadget_thUpdater_T_Msg,FontID(#Arial9B))
      ProgressBarGadget(#Gadget_thUpdater_Progress,15,88,300,20,0,100)
      FrameGadget(#Gadget_thUpdater_F_Progress,5,50,320,68,"Download")
      ButtonGadget(#Gadget_thUpdater_OK,115,124,100,22,"Aktualisieren")
        SetGadgetFont(#Gadget_thUpdater_OK,FontID(#Arial9B)) 
      ScaleDPI::Gadget(#Gadget_thUpdater_T_Anzahl, #Gadget_thUpdater_OK)
      ScaleDPI::Window(#Window_thUpdater)
      HideWindow(#Window_thUpdater, #False)
      ProcedureReturn WindowID(#Window_thUpdater)
    EndIf
  EndProcedure
  
  If Window_thUpdater()
    Define.l quitWindow = #False
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow      ;{ Abbrechen
          If EventWindow() = #Window_thUpdater
            quitWindow = #True
          EndIf ;}
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Gadget_thUpdater_OK   ;{ Aktualisieren
              quitWindow = #True
              ;}
          EndSelect
      EndSelect
    Until quitWindow
    CloseWindow(#Window_thUpdater)
  EndIf
  
CompilerEndIf

Re: Module: ScaleDPI (DPI aware) [WIN]

Verfasst: 04.03.2015 18:37
von ts-soft
:allright: Schönes Modul!

Wollte noch erwähnen, das #PB_Any nicht unterstützt wird (oder ich hab was übersehen?).

Gruß
Thomas

Re: Module: ScaleDPI (DPI aware) [WIN]

Verfasst: 04.03.2015 19:06
von Thorsten1867
ts-soft hat geschrieben:Wollte noch erwähnen, das #PB_Any nicht unterstützt wird (oder ich hab was übersehen?).
Wie gesagt eine Notlösung. Ist noch weit entfernt von perfekt.