Module ScaleGadgets

Share your advanced PureBasic knowledge/code with the community.
Post Reply
mestnyi
Addict
Addict
Posts: 999
Joined: Mon Nov 25, 2013 6:41 am

Re: Module ScaleGadgets

Post by mestnyi »

Not bad thanks.
My two pennies :)

Code: Select all

;-TOP

; Comment: ScaleObject
; Author : mk-soft
; Version: v0.8
; Create : 27.11.2018
; Update : 02.12.2018
; OS     : All

; ***************************************************************************************

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  Import "-no-pie" : EndImport
CompilerEndIf

EnableExplicit

DeclareModule ScaleObjects
  
  Declare SetScaleObject(Type.i, x.f = 1.0, y.f = 1.0, dx.f = 1.0, dy.f = 1.0, Images = #True)
  Declare SetGadgetImage(Gadget, ImageID)
  Declare ScaleObject(Type, Obgect, x, y, dx, dy)
  Declare ScaleAllGadgets(Window, DeltaDY = 0, ScaleFont = #True, ScaleImage = #True)
  Declare Create(Type, Name.s, Obgect.i, x, y, dx, dy, Text.s, Param1, Param2, Param3, Flags)
  
  
  ; Macros
  Macro dq
    "
  EndMacro
  
  ; Window´s
  Macro OpenWindow(Window, x, y, InnerWidth, InnerHeight, Title, Flags = 0, ParentID = 0) 
    Create(- 1, dq#Window#dq, Window, x, y, InnerWidth, InnerHeight, Title, ParentID, 0,0, Flags) 
  EndMacro
  
  ; Gadget´s
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Macro MDIGadget(gadget, x, y, dx, dy, SubMenu, FirstMenuItem, Flags = 0)
      Create(#PB_GadgetType_MDI, dq#Gadget#dq, Gadget, x, y, dx, dy, "", SubMenu, FirstMenuItem, 0, Flags)
    EndMacro
  CompilerEndIf
  
  Macro WebGadget(gadget, x, y, dx, dy, url) : Create(#PB_GadgetType_Web, dq#Gadget#dq, Gadget, x, y, dx, dy, url, 0, 0, 0, 0) : EndMacro
  Macro PanelGadget(gadget, x, y, dx, dy) : Create(#PB_GadgetType_Panel, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro IPAddressGadget(gadget, x, y, dx, dy) : Create(#PB_GadgetType_IPAddress, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro TreeGadget(gadget, x, y, dx, dy, Flags = 0) : Create(#PB_GadgetType_Tree, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro OptionGadget(gadget, x, y, dx, dy, text) : Create(#PB_GadgetType_Option, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags) : EndMacro
  Macro EditorGadget(gadget, x, y, dx, dy, Flags = 0) : Create(#PB_GadgetType_Editor, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro CanvasGadget(gadget, x, y, dx, dy, Flags = 0) : Create(#PB_GadgetType_Canvas, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro ComboBoxGadget(gadget, x, y, dx, dy, Flags = 0) : Create(#PB_GadgetType_ComboBox, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro TextGadget(gadget, x, y, dx, dy, text, Flags = 0) : Create(#PB_GadgetType_Text, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags) : EndMacro
  Macro ListViewGadget(gadget, x, y, dx, dy, Flags = 0) : Create(#PB_GadgetType_ListView, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro FrameGadget(gadget, x, y, dx, dy, text, Flags = 0) : Create(#PB_GadgetType_Frame, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags) : EndMacro
  Macro ContainerGadget(gadget, x, y, dx, dy, Flags = 0) : Create(#PB_GadgetType_Container, dq#Gadget#dq, Gadget, x, y, dx, dy, "", 0, 0, 0, Flags) : EndMacro
  Macro ButtonGadget(Gadget, x, y, dx, dy, text, Flags = 0) : Create(#PB_GadgetType_Button, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags) : EndMacro
  Macro StringGadget(gadget, x, y, dx, dy, text, Flags = 0) : Create(#PB_GadgetType_String, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags) : EndMacro
  Macro ShortcutGadget(gadget, x, y, dx, dy, Shortcut) : Create(#PB_GadgetType_Shortcut, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Shortcut, 0, 0, Flags) : EndMacro
  Macro ScintillaGadget(gadget, x, y, dx, dy, Callback) : Create(#PB_GadgetType_Scintilla, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Callback, 0, 0, Flags) : EndMacro
  Macro CheckBoxGadget(gadget, x, y, dx, dy, text, Flags = 0) : Create(#PB_GadgetType_CheckBox, dq#Gadget#dq, Gadget, x, y, dx, dy, text, 0, 0, 0, Flags) : EndMacro
  Macro CalendarGadget(gadget, x, y, dx, dy, Date, Flags = 0) : Create(#PB_GadgetType_Calendar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Date, 0, 0, Flags) : EndMacro
  Macro DateGadget(gadget, x, y, dx, dy, Mask, Date, Flags = 0) : Create(#PB_GadgetType_Date, dq#Gadget#dq, Gadget, x, y, dx, dy, Mask, Date, 0, 0, Flags) : EndMacro
  Macro ImageGadget(gadget, x, y, dx, dy, ImageID, Flags = 0) : Create(#PB_GadgetType_Image, dq#Gadget#dq, Gadget, x, y, dx, dy, "", ImageID, 0, 0, Flags) : EndMacro
  Macro SpinGadget(gadget, x, y, dx, dy, param1, param2, Flags = 0) : Create(#PB_GadgetType_Spin, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, 0, Flags) : EndMacro
  Macro HyperLinkGadget(gadget, x, y, dx, dy, text, Color, Flags = 0) : Create(#PB_GadgetType_HyperLink, dq#Gadget#dq, Gadget, x, y, dx, dy, text, Color, 0, 0, Flags) : EndMacro
  Macro ButtonImageGadget(Gadget, x, y, dx, dy, ImageID, Flags = 0) : Create(#PB_GadgetType_ButtonImage, dq#Gadget#dq, Gadget, x, y, dx, dy, "", ImageID, 0, 0, Flags) : EndMacro
  Macro SplitterGadget(gadget, x, y, dx, dy, param1, param2, Flags = 0) : Create(#PB_GadgetType_Splitter, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, 0, Flags) : EndMacro
  Macro TrackBarGadget(gadget, x, y, dx, dy, param1, param2, Flags = 0) : Create(#PB_GadgetType_TrackBar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, 0, Flags) : EndMacro
  Macro ExplorerListGadget(gadget, x, y, dx, dy, Directory, Flags = 0) : Create(#PB_GadgetType_ExplorerList, dq#Gadget#dq, Gadget, x, y, dx, dy, Directory, 0, 0, 0, Flags) : EndMacro
  Macro ExplorerTreeGadget(gadget, x, y, dx, dy, Directory, Flags = 0) : Create(#PB_GadgetType_ExplorerTree, dq#Gadget#dq, Gadget, x, y, dx, dy, Directory, 0, 0, 0, Flags) : EndMacro
  Macro ExplorerComboGadget(gadget, x, y, dx, dy, Directory, Flags = 0) : Create(#PB_GadgetType_ExplorerCombo, dq#Gadget#dq, Gadget, x, y, dx, dy, Directory, 0, 0, 0, Flags) : EndMacro
  Macro ListIconGadget(gadget, x, y, dx, dy, Titel, TitelWidth, Flags = 0) : Create(#PB_GadgetType_ListIcon, dq#Gadget#dq, Gadget, x, y, dx, dy, Titel, TitelWidth, 0, 0, Flags) : EndMacro
  Macro ProgressBarGadget(gadget, x, y, dx, dy, Minimum, Maximum, Flags = 0) : Create(#PB_GadgetType_ProgressBar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", Minimum, Maximum, 0, Flags) : EndMacro
  Macro ScrollBarGadget(gadget, x, y, dx, dy, param1, param2, param3, Flags = 0) : Create(#PB_GadgetType_ScrollBar, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, param3, Flags) : EndMacro
  Macro ScrollAreaGadget(gadget, x, y, dx, dy, param1, param2, param3, Flags = 0) : Create(#PB_GadgetType_ScrollArea, dq#Gadget#dq, Gadget, x, y, dx, dy, "", param1, param2, param3, Flags) : EndMacro
  
  ; Resize
  Macro ResizeGadget(gadget, x, y, dx, dy) : ScaleObject(gadget, x, y, dx, dy) : EndMacro
  Macro ResizeWindow(window, x, y, dx, dy) : ScaleWindow(window, x, y, dx, dy) : EndMacro
  
  ; 
  Macro PB_Function5 (Function, _1_=, _2_=, _3_=, _4_=, _5_=) : Function (_1_, _2_, _3_, _4_, _5_) : EndMacro
  Macro PB_Function6 (Function, _1_=, _2_=, _3_=, _4_=, _5_=, _6_=) : Function (_1_, _2_, _3_, _4_, _5_, _6_) : EndMacro
  Macro PB_Function7 (Function, _1_=, _2_=, _3_=, _4_=, _5_=, _6_=, _7_=) : Function (_1_, _2_, _3_, _4_, _5_, _6_, _7_) : EndMacro
  Macro PB_Function8 (Function, _1_=, _2_=, _3_=, _4_=, _5_=, _6_=, _7_=, _8_=) : Function (_1_, _2_, _3_, _4_, _5_, _6_, _7_, _8_) : EndMacro
  Macro PB_Function9 (Function, _1_=, _2_=, _3_=, _4_=, _5_=, _6_=, _7_=, _8_=, _9_=) : Function (_1_, _2_, _3_, _4_, _5_, _6_, _7_, _8_, _9_) : EndMacro
EndDeclareModule

Module ScaleObjects
  
  EnableExplicit
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Import internal function
  
  ; Force Import Fonts
  Global __Dummy = LoadFont(#PB_Any, "", 11) : FreeFont(__Dummy)
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
      PB_Font_Objects.i
    EndImport
  CompilerElse
    ImportC ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
      PB_Font_Objects.i
    EndImport
  CompilerEndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    ; PB Interne Struktur Gadget MacOS
    Structure sdkGadget
      *gadget
      *container
      *vt
      UserData.i
      Window.i
      Type.i
      Flags.i
    EndStructure
  CompilerEndIf
  
  ; -----------------------------------------------------------------------------------
  
  Procedure WindowPB(WindowID) ; Find pb-id over handle
    Protected result, window
    result = -1
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @window)
      If WindowID = WindowID(window)
        result = window
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Window_Objects)
    ProcedureReturn result
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GadgetPB(GadgetID) ; Find pb-id over handle
    Protected result, gadget
    result = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      If GadgetID = GadgetID(gadget)
        result = gadget
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Gadget_Objects)
    ProcedureReturn result
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure ImagePB(ImageID) ; Find pb-id over handle
    Protected result, image
    result = -1
    PB_Object_EnumerateStart(PB_Image_Objects)
    While PB_Object_EnumerateNext(PB_Image_Objects, @image)
      If ImageID = ImageID(image)
        result = image
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Image_Objects)
    ProcedureReturn result
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  #ScaleFontMin = 7 
  #ScaleFontMax = 25
  
  Structure udtWindowList
    ; Header
    Name.s
    Window.i
    ; Data
    x.i
    y.i
    dx.i
    dy.i
  EndStructure
  
  Structure udtGadgetList
    ; Header
    Name.s
    Gadget.i
    Window.i
    ; Data
    x.i
    y.i
    dx.i
    dy.i
    image.i
    scaleimage.i
  EndStructure
  
  ; ---------------------------------------------------------------------------------------
  
  Global NewMap WindowList.udtWindowList()
  Global NewMap GadgetList.udtGadgetList()
  
  Global Dim ScaleFont(#ScaleFontMax)
  
  Global.f ScaleObjectX, ScaleObjectY, ScaleObjectDX, ScaleObjectDY
  Global.f ScaleFontFaktor
  Global.i ScaleImages
  
  ; -----------------------------------------------------------------------------------
  
  Procedure InitScale()
    ScaleObjectX = 1.0
    ScaleObjectY = 1.0
    ScaleObjectDX = 1.0
    ScaleObjectDY = 1.0
  EndProcedure : InitScale()
  
  ; -----------------------------------------------------------------------------------
  
  Procedure InitFont()
    Protected index, font
    For index = #ScaleFontMin To #ScaleFontMax
      ScaleFont(index) = LoadFont(#PB_Any, "", index)
    Next
    
    CompilerSelect #PB_Compiler_OS
      CompilerCase #PB_OS_Windows
        ScaleFontFaktor = 0.9
      CompilerCase #PB_OS_Linux
        ScaleFontFaktor = 1.1
      CompilerCase #PB_OS_MacOS
        ScaleFontFaktor = 1.2
    CompilerEndSelect
    font = ScaleFontFaktor * 10
    SetGadgetFont(#PB_Default, FontID(ScaleFont(font)))
  EndProcedure : InitFont()
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SetScaleObject(Type.i, x.f = 1.0, y.f = 1.0, dx.f = 1.0, dy.f = 1.0, Images = #True)
    Protected font
    ScaleObjectX = x
    ScaleObjectY = y
    ScaleObjectDX = dx
    ScaleObjectDY = dy
    
    ScaleImages = Images
    font = ScaleObjectDY * ScaleFontFaktor * 10.0
    If font < #ScaleFontMin
      font = #ScaleFontMin
    ElseIf font > #ScaleFontMax
      font = #ScaleFontMax
    EndIf
    SetGadgetFont(#PB_Default, FontID(ScaleFont(font)))
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SetGadgetImage(Gadget, Image)
    If FindMapElement(GadgetList(), Hex(Gadget))
      With GadgetList()
        If FindMapElement(WindowList(), Hex(\Window))
          \image = image
          If IsImage(\scaleimage)
            FreeImage(\scaleimage)
          EndIf  
          \scaleimage = CopyImage(\image, #PB_Any)
          ResizeImage(\scaleimage, ImageWidth(\image) * ScaleObjectDX, ImageHeight(\image) * ScaleObjectDY)
          Select GadgetType(Gadget)
            Case #PB_GadgetType_ButtonImage
              SetGadgetAttribute(Gadget, #PB_Button_Image, ImageID(\scaleimage))
            Case #PB_GadgetType_Image
              SetGadgetState(Gadget, ImageID(\scaleimage))
          EndSelect
        EndIf
      EndWith
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure ScaleObject(Type, Object, x, y, dx, dy)
    If x <> #PB_Ignore
      x = x * ScaleObjectX
    EndIf
    If x <> #PB_Ignore
      y = y * ScaleObjectY
    EndIf
    If x <> #PB_Ignore
      dx = dx * ScaleObjectDX
    EndIf
    If x <> #PB_Ignore
      dy = dy * ScaleObjectDY
    EndIf
    
    If Type =- 1
      PB_Function5(ResizeWindow,Object, x, y, dx, dy)
    Else
      PB_Function5(ResizeGadget,Object, x, y, dx, dy)
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure ScaleAllGadgets(Window, DeltaDY = 0, ScaleFont = #True, ScaleImage = #True)
    Protected WindowID, ScaleX.f, ScaleY.f, font
    
    ScaleX = 1.0 * (WindowWidth(Window)) / WindowList()\dx 
    ScaleY = 1.0 * (WindowHeight(Window) - DeltaDY) / (WindowList()\dy - DeltaDY)
    
    With GadgetList()
      ForEach GadgetList()
        If \Window = Window
          ; PB Linux Bug ? - No resize is gadget inside splitter gadget
          CompilerIf #PB_Compiler_OS = #PB_OS_Linux
            Protected parentid, parent, i
            parentid = GadgetID(\Gadget)
            parentid = gtk_widget_get_parent_(parentid)
            parent = GadgetPB(parentid)
            If parent < 0
              parentid = gtk_widget_get_parent_(parentid)
            EndIf
            parent = GadgetPB(parentid)
            If parent >= 0 And GadgetType(parent) = #PB_GadgetType_Splitter
              ; Do Nothing
            Else
              PB_Function5(ResizeGadget,\Gadget, \x * ScaleX, \y * ScaleY, \dx * ScaleX, \dy * ScaleY)
            EndIf
          CompilerElse
            PB_Function5(ResizeGadget,\Gadget, \x * ScaleX, \y * ScaleY, \dx * ScaleX, \dy * ScaleY)
          CompilerEndIf
          
          If ScaleFont
            font = ScaleObjectDY * ScaleFontFaktor * ScaleY * 10.0
            If font < #ScaleFontMin
              font = #ScaleFontMin
            ElseIf font > #ScaleFontMax
              font = #ScaleFontMax
            EndIf
            SetGadgetFont(\Gadget, FontID(ScaleFont(font)))
          EndIf
          
          If ScaleImage
            Select GadgetType(\Gadget)
              Case #PB_GadgetType_ButtonImage
                If \image >= 0
                  FreeImage(\scaleimage)
                  \scaleimage = CopyImage(\image, #PB_Any)
                  ResizeImage(\scaleimage, ImageWidth(\image) * ScaleObjectDX * ScaleX, ImageHeight(\image) * ScaleObjectDY * ScaleY)
                  SetGadgetAttribute(\Gadget, #PB_Button_Image, ImageID(\scaleimage))
                EndIf
              Case #PB_GadgetType_Image
                If \image >= 0
                  FreeImage(\scaleimage)
                  \scaleimage = CopyImage(\image, #PB_Any)
                  ResizeImage(\scaleimage, ImageWidth(\image) * ScaleObjectDX * ScaleX, ImageHeight(\image) * ScaleObjectDY * ScaleY)
                  SetGadgetState(\Gadget, ImageID(\scaleimage))
                EndIf
            EndSelect
          EndIf
        EndIf
      Next
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure Create(Type, Name.s, Object, x, y, dx, dy, Text.s, Param1, Param2, Param3, Flags)
    Protected result, const.s, rt.s
    
    x = x * ScaleObjectX
    y = y * ScaleObjectY
    dx = dx * ScaleObjectDX
    dy = dy * ScaleObjectDY
    
    Select Type
      Case - 1 
        result = PB_Function8(OpenWindow, Object, x, y, dx, dy, Text, Flags, Param1)
      Case #PB_GadgetType_Button : result = PB_Function7(ButtonGadget, Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_ButtonImage : result = PB_Function7(ButtonImageGadget,Object, x, y, dx, dy, Param1, Flags)
      Case #PB_GadgetType_Calendar : result = PB_Function7(CalendarGadget,Object, x, y, dx, dy, Param1, Flags)
      Case #PB_GadgetType_Canvas : result = PB_Function6(CanvasGadget,Object, x, y, dx, dy, Flags)
      Case #PB_GadgetType_CheckBox : result = PB_Function7(CheckBoxGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_ComboBox : result = PB_Function6(ComboBoxGadget,Object, x, y, dx, dy, Flags)
      Case #PB_GadgetType_Container : result = PB_Function6(ContainerGadget,Object, x, y, dx, dy, Flags)
      Case #PB_GadgetType_Date : result = PB_Function8(DateGadget,Object, x, y, dx, dy, Text, Param1, Flags)
      Case #PB_GadgetType_Editor : result = PB_Function6(EditorGadget,Object, x, y, dx, dy, Flags)
      Case #PB_GadgetType_ExplorerCombo : result = PB_Function7(ExplorerComboGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_ExplorerList : result = PB_Function7(ExplorerListGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_ExplorerTree : result = PB_Function7(ExplorerTreeGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_Frame : result = PB_Function7(FrameGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_HyperLink : result = PB_Function8(HyperLinkGadget,Object, x, y, dx, dy, Text, Param1, Flags)
      Case #PB_GadgetType_Image : result = PB_Function7(ImageGadget,Object, x, y, dx, dy, Param1, Flags)
      Case #PB_GadgetType_IPAddress : result = PB_Function5(IPAddressGadget,Object, x, y, dx, dy)
      Case #PB_GadgetType_ListIcon : result = PB_Function8(ListIconGadget,Object, x, y, dx, dy, Text, Param1, Flags)
      Case #PB_GadgetType_ListView : result = PB_Function6(ListViewGadget,Object, x, y, dx, dy, Flags)
        CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        Case #PB_GadgetType_MDI : result = PB_Function8(MDIGadget,Object, x, y, dx, dy, Param1, Param2, Flags)
        CompilerEndIf
      Case #PB_GadgetType_Option : result = PB_Function6(OptionGadget,Object, x, y, dx, dy, Text)
      Case #PB_GadgetType_Panel : result = PB_Function5(PanelGadget,Object, x, y, dx, dy)
      Case #PB_GadgetType_ProgressBar : result = PB_Function8(ProgressBarGadget,Object, x, y, dx, dy, Param1, Param2, Flags)
      Case #PB_GadgetType_Scintilla : result = PB_Function6(ScintillaGadget,Object, x, y, dx, dy, Param1)
      Case #PB_GadgetType_ScrollArea : result = PB_Function9(ScrollAreaGadget,Object, x, y, dx, dy, Param1, Param2, Param3, Flags)
      Case #PB_GadgetType_ScrollBar : result = PB_Function9(ScrollBarGadget,Object, x, y, dx, dy, Param1, Param2, Param3, Flags)
      Case #PB_GadgetType_Shortcut : result = PB_Function6(ShortcutGadget,Object, x, y, dx, dy, Param1)
      Case #PB_GadgetType_Spin : result = PB_Function8(SpinGadget,Object, x, y, dx, dy, Param1, Param2, Flags)
      Case #PB_GadgetType_Splitter : result = PB_Function8(SplitterGadget,Object, x, y, dx, dy, Param1, Param2, Flags)
      Case #PB_GadgetType_String : result = PB_Function7(StringGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_Text : result = PB_Function7(TextGadget,Object, x, y, dx, dy, Text, Flags)
      Case #PB_GadgetType_TrackBar : result = PB_Function8(TrackBarGadget,Object, x, y, dx, dy, Param1, Param2, Flags)
      Case #PB_GadgetType_Tree : result = PB_Function6(TreeGadget,Object, x, y, dx, dy, Flags)
      Case #PB_GadgetType_Web : result = PB_Function6(WebGadget,Object, x, y, dx, dy, Text)
    EndSelect
    
    If result = 0
      ProcedureReturn 0
    EndIf
    
    If Object = #PB_Any
      Object = result
    EndIf
    
    If Type =- 1
      AddMapElement(WindowList(), Hex(Object))
      
      With WindowList()
        \Name = Name
        \Window = Object
        \x = x
        \y = y
        \dx = dx
        \dy = dy
        
      EndWith
    Else
      AddMapElement(GadgetList(), Hex(Object))
      
      With GadgetList()
        \Name = Name
        \Gadget = Object
        \Window = WindowPB(UseGadgetList(0))
        \x = x
        \y = y
        \dx = dx
        \dy = dy
        
        Select GadgetType(Object)
          Case #PB_GadgetType_ButtonImage
            If Param1
              \image = ImagePB(Param1)
              \scaleimage = CopyImage(\image, #PB_Any)
              If ScaleImages
                ResizeImage(\scaleimage, ImageWidth(\image) * ScaleObjectDX, ImageHeight(\image) * ScaleObjectDY)
                SetGadgetAttribute(Object, #PB_Button_Image, ImageID(\scaleimage))
              EndIf
            EndIf
          Case #PB_GadgetType_Image
            If Param1
              \image = ImagePB(Param1)
              \scaleimage = CopyImage(\image, #PB_Any)
              If ScaleImages
                ResizeImage(\scaleimage, ImageWidth(\image) * ScaleObjectDX, ImageHeight(\image) * ScaleObjectDY)
                SetGadgetState(Object, ImageID(\scaleimage))
              EndIf
            EndIf
        EndSelect
      EndIf
      
    EndWith
    
    Debug result
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
EndModule

; ---------------------------------------------------------------------------------------

Macro UseScaleObjects()
  UseModule ScaleObjects
EndMacro

; ***************************************************************************************

;-Example

CompilerIf #PB_Compiler_IsMainFile
  
  UseModule ScaleObjects
  
  Enumeration Window 1
    #Main
  EndEnumeration
  
  Enumeration Gadget
    #Editor
    #Container
    #ButtonB0
    #ButtonB1
    #ButtonB2
  EndEnumeration
  
  Enumeration MenuItem
    #New
    #Load
    #Save
    #Exit
  EndEnumeration
  
  Enumeration StatusBar
    #StatusBar
  EndEnumeration
  
  ; -----------------------------------------------------------------
  
  Global ExitApplication
  Global window, button

    
  SetScaleObject(1,1.25, 1.25, 1.25, 1.25)
  SetScaleObject(-1,1.25, 1.25, 1.25, 1.25)
  
  ;   CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  ;     SetScaleObject(1, 1.0, 1.0, 1.0, 0.9)
  ;   CompilerEndIf
  
  ; -----------------------------------------------------------------
  
  Procedure DoSizeWindow()
    ScaleAllGadgets(window, MenuHeight() + StatusBarHeight(#StatusBar))
  EndProcedure
  
  ; -----------------------------------------------------------------
  
  Procedure OpenMain(x = 10, y = 10, width = 550, height = 415)
    window = OpenWindow(#PB_Any, x, y, width, height + MenuHeight(), "Module ScaleObjects", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
    
    If CreateMenu(0, WindowID(window))
      ; Mac Menu´s
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        MenuItem(#PB_Menu_About, "")
        MenuItem(#PB_Menu_Preferences, "")
        MenuItem(#PB_Menu_Quit, "")
      CompilerEndIf
      MenuTitle("&File")
      MenuItem(#New, "&New")
      MenuItem(#Load, "&Load")
      MenuItem(#Save, "&Save")
      MenuBar()
      MenuItem(#Exit, "&Exit")
    EndIf
    
    CreateStatusBar(#StatusBar, WindowID(window))
    AddStatusBarField(#PB_Ignore)
    StatusBarText(#StatusBar, 0, "ScaleObjects")
    EditorGadget(#Editor, 10, 10, 530, 310)
    SetGadgetText(#Editor, "I like Purebasic!")
    ContainerGadget(#Container, 10, 330, 530, 50, #PB_Container_Single)
    ButtonGadget(#ButtonB0, 10, 10, 160, 30, "Button 0")
    ButtonGadget(#ButtonB1, 180, 10, 170, 30, "Button 1")
    button = ButtonGadget(#PB_Any, 360, 10, 160, 30, "Button 2")
    CloseGadgetList()
  EndProcedure
  
  OpenMain()
  
  BindEvent(#PB_Event_SizeWindow, @DoSizeWindow())
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        ExitApplication = 1
        
    EndSelect
  Until ExitApplication
  
  End
  
CompilerEndIf
Last edited by mestnyi on Mon Dec 03, 2018 12:41 pm, edited 2 times in total.
Top
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 341
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: Module ScaleGadgets

Post by Mindphazer »

Hello mestnyi,
i have a "syntax error on line 53" :shock:
I don't understand why ?
MacBook Pro 14" M1 Pro - 16 Gb - MacOS 14 - Iphone 15 Pro Max - iPad at home
...and unfortunately... Windows at work...
Top
#NULL
Addict
Addict
Posts: 1440
Joined: Thu Aug 30, 2007 11:54 pm
Location: right here

Re: Module ScaleGadgets

Post by #NULL »

duplicate Macro definitions and undefined variables.
Top
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 341
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: Module ScaleGadgets

Post by Mindphazer »

True !!!
I need glasses 8)
MacBook Pro 14" M1 Pro - 16 Gb - MacOS 14 - Iphone 15 Pro Max - iPad at home
...and unfortunately... Windows at work...
Top
Martin Verlaan
Enthusiast
Enthusiast
Posts: 133
Joined: Sun Apr 01, 2018 11:26 am

Re: Module ScaleGadgets

Post by Martin Verlaan »

Hi mk-soft,

It doesn't work if I define gadgets like this:

Code: Select all

global window, button

window = OpenWindow(#PB_Any, x, y, width, height, "", #PB_Window_SystemMenu|#PB_Window_SizeGadget)
button = ButtonGadget(#PB_Any, 110, 170, 100, 25, "Close")
Maybe you have a solution?
Top
mestnyi
Addict
Addict
Posts: 999
Joined: Mon Nov 25, 2013 6:41 am

Re: Module ScaleGadgets

Post by mestnyi »

Martin Verlaan wrote:Hi mk-soft,

It doesn't work if I define gadgets like this:

Code: Select all

global window, button

window = OpenWindow(#PB_Any, x, y, width, height, "", #PB_Window_SystemMenu|#PB_Window_SizeGadget)
button = ButtonGadget(#PB_Any, 110, 170, 100, 25, "Close")
Maybe you have a solution?
Works I updated the example above.
Top
Martin Verlaan
Enthusiast
Enthusiast
Posts: 133
Joined: Sun Apr 01, 2018 11:26 am

Re: Module ScaleGadgets

Post by Martin Verlaan »

Thanks for the fast update!
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5389
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ScaleGadgets

Post by mk-soft »

@mestnyi

Nice idea with the macros.
But it is a bit easier to call the internal PB function without having to create all parameters.
I'll add that we don't need two modules anymore.

Code: Select all

Macro PB(Function)
  Function
EndMacro

Procedure MyMessage(Titel.s, Info.s, Flag)
  Debug Titel + " / " + Info
EndProcedure

Macro MessageRequester(Titel, Info, Flag = 0)
  MyMessage(Titel, Info, Flag)
EndMacro

Macro PB(Function)
  Function
EndMacro

MessageRequester("Info", "Hello") ; <- Macro replace this to MyMessage(...)

PB(MessageRequester)("Info", "Hello") ; <- Macro replace this to MessageRequester(...)
Last edited by mk-soft on Mon Dec 03, 2018 6:07 pm, edited 2 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5389
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ScaleGadgets

Post by mk-soft »

Update v0.9
- Remove extra module for macros

Because of the good idea of mestnyi, the extra module for the macros could be removed.
So we only need the module ScaleGadgets with the required macros and functions.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
blueb
Addict
Addict
Posts: 1044
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: Module ScaleGadgets

Post by blueb »

Thanks mk-soft.
Your ScaleGadgets module is quickly becoming a favorite. :mrgreen:

A few points that might be considered improvements...

#1 - Initial scale value - instead of:
SetScaleGadget(1.25, 1.25, 1.25, 1.25)
SetScaleWindow(1.25, 1.25, 1.25, 1.25)
perhaps: SetInitScale(1.25)

or perhaps even: SetAutoScale()
ScaleGadgets module determines users screen size
monitor is 1024 x 768... sets SetInitScale(1.00)
monitor is 1920 x 1080... sets SetInitScale(1.50), etc.

#2 - Most re-sizable Windows should have a minimum scale value.
e.g. Programmer sets the MinScaleValue(.75) so that buttons, etc are still properly displayed.


#3 - I use a free program called: Moffsoft FreeCalc (http://www.moffsoft.com/) It's a Windows calculator
replacement that allows resizing. When you resize the Window, it also resizes the Status bar.
Will this be possible in the future. It seems a little odd to see the Status bar remain small when the
Window size is enlarged.

Thanks for all your efforts.
- It was too lonely at the top.

System : PB 6.10 LTS (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
Top
mestnyi
Addict
Addict
Posts: 999
Joined: Mon Nov 25, 2013 6:41 am

Re: Module ScaleGadgets

Post by mestnyi »

mk-soft wrote:@mestnyi

Nice idea with the macros.
But it is a bit easier to call the internal PB function without having to create all parameters.
I'll add that we don't need two modules anymore.

Code: Select all

Macro PB(Function)
  Function
EndMacro

Procedure MyMessage(Titel.s, Info.s, Flag)
  Debug Titel + " / " + Info
EndProcedure

Macro MessageRequester(Titel, Info, Flag = 0)
  MyMessage(Titel, Info, Flag)
EndMacro

Macro PB(Function)
  Function
EndMacro

MessageRequester("Info", "Hello") ; <- Macro replace this to MyMessage(...)

PB(MessageRequester)("Info", "Hello") ; <- Macro replace this to MessageRequester(...)
And why is it two?

Code: Select all

Macro PB(Function)
  Function
EndMacro
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5389
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ScaleGadgets

Post by mk-soft »

mestnyi wrote: And why is it two?

Code: Select all

Macro PB(Function)
  Function
EndMacro
Copy / Paste Error :mrgreen:
Sorry :wink:
One of them will be able to remove.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5389
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ScaleGadgets

Post by mk-soft »

blueb wrote:Thanks mk-soft.
Your ScaleGadgets module is quickly becoming a favorite. :mrgreen:
Thanks 8)

Small macro for SetScale...

Code: Select all

Macro SetScale(Factor, Images = #True)
  SetScaleGadget(Factor, Factor, Factor, Factor, Images)
  SetScaleWindow(Factor, Factor, Factor, Factor)
EndMacro

SetScale(1.25)
If you still have the API for all OS for the status bar together or someone already has it, I could add it.
But I want it to always run on all OSes.

Still have a problem with gadgets on a PanelGadget. It's missing under mac os, from the second panel on, the gadget's superview entry.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: Module ScaleGadgets

Post by Mijikai »

Works really nice, thanks for sharing :)
(Only tested on Windows 7 / 10)
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5389
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module ScaleGadgets

Post by mk-soft »

Update v0.10
- Bugfix Macros
- Added Macro SetScale(Factor)

:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
Post Reply

Return to “Tricks 'n' Tips”