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