It is currently Sun Dec 16, 2018 5:03 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 31 posts ]  Go to page Previous  1, 2, 3  Next
Author Message
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 12:13 am 
Offline
Addict
Addict
User avatar

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3346
Location: New Zealand
That's awesome mk-soft, no mucking around with xml dialogs, thanks for sharing.

_________________
Got winter blues?
Enjoy a Caravan Trip into, "The Land of Grey and Pink", wine and punk weed optional!
https://www.youtube.com/watch?v=9hmFzGTxod4


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 7:05 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Nov 25, 2013 6:41 am
Posts: 708
Not bad thanks.
My two pennies :)

Code:
;-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
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 9:19 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Sep 10, 2012 10:41 am
Posts: 107
Location: Savoie
Hello mestnyi,
i have a "syntax error on line 53" :shock:
I don't understand why ?

_________________
MacBook Pro 13" Retina - 16 Gb - OSX 10.12 - Iphone 7 - iPad at home
...and unfortunately... Windows at work...


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 9:35 am 
Offline
Addict
Addict

Joined: Thu Aug 30, 2007 11:54 pm
Posts: 870
Location: right here
duplicate Macro definitions and undefined variables.


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 9:55 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Sep 10, 2012 10:41 am
Posts: 107
Location: Savoie
True !!!
I need glasses 8)

_________________
MacBook Pro 13" Retina - 16 Gb - OSX 10.12 - Iphone 7 - iPad at home
...and unfortunately... Windows at work...


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 12:05 pm 
Offline
User
User

Joined: Sun Apr 01, 2018 11:26 am
Posts: 94
Hi mk-soft,

It doesn't work if I define gadgets like this:
Code:
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
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 12:42 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Nov 25, 2013 6:41 am
Posts: 708
Martin Verlaan wrote:
Hi mk-soft,

It doesn't work if I define gadgets like this:
Code:
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
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 1:57 pm 
Offline
User
User

Joined: Sun Apr 01, 2018 11:26 am
Posts: 94
Thanks for the fast update!


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 5:23 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1478
Location: Germany
@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:
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(...)

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Mon Dec 03, 2018 6:07 pm, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Mon Dec 03, 2018 5:49 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1478
Location: Germany
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 OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Tue Dec 04, 2018 1:08 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Apr 26, 2003 2:15 pm
Posts: 746
Location: Cuernavaca, Mexico
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Tue Dec 04, 2018 5:12 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Nov 25, 2013 6:41 am
Posts: 708
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:
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:
Macro PB(Function)
  Function
EndMacro


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Tue Dec 04, 2018 7:16 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1478
Location: Germany
mestnyi wrote:
And why is it two?
Code:
Macro PB(Function)
  Function
EndMacro

Copy / Paste Error :mrgreen:
Sorry :wink:
One of them will be able to remove.

_________________
My Projects OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Thu Dec 06, 2018 10:46 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 1478
Location: Germany
blueb wrote:
Thanks mk-soft.
Your ScaleGadgets module is quickly becoming a favorite. :mrgreen:

Thanks 8)

Small macro for SetScale...
Code:
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 OOP-BaseClass / OOP-BaseClassDispatch / Event-Designer /
PB v3.30 / v5.60 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module ScaleGadgets
PostPosted: Thu Dec 06, 2018 11:38 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Sep 11, 2016 2:17 pm
Posts: 275
Works really nice, thanks for sharing :)
(Only tested on Windows 7 / 10)


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 31 posts ]  Go to page Previous  1, 2, 3  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 10 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye