Own Flat Gadgets as Object
Re: Own Flat Gadgets as Object
Module BaseClassSmall
Update v1.14.1
- Change name of Macro 'dq' to '_dq_'
- Update method QueryInterface with default result 'IUnknown'
This adjustment has no effect on the examples.
Update v1.14.1
- Change name of Macro 'dq' to '_dq_'
- Update method QueryInterface with default result 'IUnknown'
This adjustment has no effect on the examples.
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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
ClockGadget Update v1.04
- Optimize DoTimerEvent
NumberGadget Update v1.02
- Added DoTimerEvent for cursor
- New cursor and edit functions
- Optimize DoTimerEvent
NumberGadget Update v1.02
- Added DoTimerEvent for cursor
- New cursor and edit 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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
Nice
Add this to the textbox example: TextBox\SetFont(FontID(0))
Add this to the textbox example: TextBox\SetFont(FontID(0))
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Re: Own Flat Gadgets as Object
TextBoxGadget Update v1.05.1
- Added check TextBox\SetFont(0)
- Update example
Thanks Skywalk
- Added check TextBox\SetFont(0)
- Update example
Thanks Skywalk
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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
SwitchGadget Update v1.06.0
Code: Select all
;-TOP
; Comment : Object SwitchGadget Number 42 ;)
; Author : mk-soft
; Version : v1.06.0
; Create : 01.05.2019
; Update : 18.01.2020
; OS : All
; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305
IncludeFile "Modul_BaseClassSmall.pb"
EnableExplicit
; *****************************************************************************
;- Module Public
DeclareModule SwitchGadget
UseModule BaseClass
Interface iSwitchGadget Extends iBaseClass
Resize(x, y, Width, Height)
Redraw(State = #True)
GetID()
SetColor(ColorType, Color)
GetColor(ColorType)
SetState(State)
GetState()
SetUserData(UserData)
GetUserData()
EndInterface
UnuseModule BaseClass
Declare Create(Gadget, x, y, Width, Height, FrontColor = #PB_Default, LineColor = #PB_Default, Flags = 0)
EndDeclareModule
;- Module Private
Module SwitchGadget
EnableExplicit
UseModule BaseClass
NewClass(iSwitchGadget)
Structure sSwitchGadget Extends sBaseClass
Gadget.i
UserData.i
; Params
x.i
y.i
Width.i
Height.i
LineColor.i
FrontColor.i
BackColor.i
Flags.i
; Data
Redraw.i
Event.i
State.i
EndStructure
Declare DrawGadget(*this)
;-- Public Object Function
Procedure Resize(*this.sSwitchGadget, x, y, Width, Height)
With *this
If x <> #PB_Ignore
\x = x
EndIf
If y <> #PB_Ignore
\y = y
EndIf
If Width <> #PB_Ignore
\Width = Width
EndIf
If Height <> #PB_Ignore
\Height = Height
EndIf
ResizeGadget(\Gadget, \x, \y, \Width, \Height)
EndWith
EndProcedure : AsMethode(Resize)
; ----
Procedure Redraw(*this.sSwitchGadget, State)
With *this
\Redraw = State
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(Redraw)
; ----
Procedure GetID(*this.sSwitchGadget)
ProcedureReturn *this\Gadget
EndProcedure : AsMethode(GetID)
; ----
Procedure SetColor(*this.sSwitchGadget, ColorType, Color)
With *this
Select ColorType
Case #PB_Gadget_FrontColor
\FrontColor = Color
Case #PB_Gadget_BackColor
\BackColor = Color
Case #PB_Gadget_LineColor
\LineColor = Color
EndSelect
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetColor)
Procedure GetColor(*this.sSwitchGadget, ColorType)
Protected color
With *this
Select ColorType
Case #PB_Gadget_FrontColor
color = \FrontColor
Case #PB_Gadget_BackColor
color = \BackColor
Case #PB_Gadget_LineColor
color = \LineColor
EndSelect
ProcedureReturn color
EndWith
EndProcedure : AsMethode(GetColor)
; ----
Procedure SetState(*this.sSwitchGadget, State)
With *this
\State = State
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetState)
Procedure GetState(*this.sSwitchGadget)
With *this
ProcedureReturn \State
EndWith
EndProcedure : AsMethode(GetState)
; ----
Procedure SetUserData(*this.sSwitchGadget, UserData)
With *this
\UserData = UserData
EndWith
EndProcedure : AsMethode(SetUserData)
Procedure GetUserData(*this.sSwitchGadget)
With *this
ProcedureReturn \UserData
EndWith
EndProcedure : AsMethode(GetUserData)
;-- Drawing and Events Functions
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Procedure NSColorByNameToRGB(NSColorName.s)
Protected.cgfloat red, green, blue
Protected nscolorspace, rgb
nscolorspace = CocoaMessage(0, CocoaMessage(0, 0, "NSColor " + NSColorName), "colorUsingColorSpaceName:$", @"NSCalibratedRGBColorSpace")
If nscolorspace
CocoaMessage(@red, nscolorspace, "redComponent")
CocoaMessage(@green, nscolorspace, "greenComponent")
CocoaMessage(@blue, nscolorspace, "blueComponent")
rgb = RGB(red * 255.0, green * 255.0, blue * 255.0)
ProcedureReturn rgb
EndIf
EndProcedure
CompilerEndIf
Procedure.i BlendColor(Color1.i, Color2.i, Scale.i = 50) ; Thanks to Thorsten
Protected.f R1, G1, B1, R2, G2, B2
Protected.f Blend1 = Scale / 100
Protected.f Blend2 = 1.0 - Blend1
R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1)
R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2)
ProcedureReturn RGB(R1*Blend1 + R2 * Blend2, G1*Blend1 + G2 * Blend2, B1*Blend1 + B2 * Blend2)
EndProcedure
Procedure GetSystemColor(Type)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Select Type
Case #PB_Gadget_FrontColor
ProcedureReturn GetSysColor_(#COLOR_WINDOWTEXT)
Case #PB_Gadget_BackColor
ProcedureReturn GetSysColor_(#COLOR_3DFACE)
Case #PB_Gadget_LineColor
ProcedureReturn #Gray
EndSelect
CompilerCase #PB_OS_Linux
Select Type
Case #PB_Gadget_FrontColor
ProcedureReturn #Black
Case #PB_Gadget_BackColor
ProcedureReturn $F8F8F8
Case #PB_Gadget_LineColor
ProcedureReturn #Gray
EndSelect
CompilerCase #PB_OS_MacOS
Protected UserDefaults, NSString
Select Type
Case #PB_Gadget_FrontColor
ProcedureReturn NSColorByNameToRGB("controlTextColor")
Case #PB_Gadget_BackColor
UserDefaults = CocoaMessage(0, 0, "NSUserDefaults standardUserDefaults")
NSString = CocoaMessage(0, UserDefaults, "stringForKey:$", @"AppleInterfaceStyle")
If NSString And PeekS(CocoaMessage(0, NSString, "UTF8String"), -1, #PB_UTF8) = "Dark"
ProcedureReturn BlendColor(NSColorByNameToRGB("controlBackgroundColor"), #White, 85)
Else
ProcedureReturn BlendColor(NSColorByNameToRGB("windowBackgroundColor"), #White, 85)
EndIf
Case #PB_Gadget_LineColor
ProcedureReturn #Gray
EndSelect
CompilerEndSelect
EndProcedure
; ----
Procedure DrawGadget(*this.sSwitchGadget)
Protected x, y, dx, dy, radius
Protected LineColor, FrontColor, BackColor, BlendColor
With *this
Select \Event
Case #PB_EventType_LeftButtonUp
If \State
\State = #False
Else
\State = #True
EndIf
\Event = 0
PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_Change, \State)
EndSelect
If StartDrawing(CanvasOutput(\Gadget))
LineColor = \LineColor
FrontColor = \FrontColor
BackColor = \BackColor
If FrontColor = #PB_Default
FrontColor = $FF5050
EndIf
If LineColor = #PB_Default
LineColor = #Gray
EndIf
dx = DesktopScaledX(\Width)
dy = DesktopScaledY(\Height)
; Hintergrund
Box(0, 0, dx, dy, BackColor)
; Schalter
If dx > dy
If dy & 1 = 0
dy - 1
EndIf
; Draw Border
If \Flags = #PB_Canvas_Border
DrawingMode(#PB_2DDrawing_Outlined)
Box(0, 0, dx, dy, #Gray)
x = 2
y = 2
dx - 4
dy - 4
EndIf
radius = (dy - 2) / 2
If Not \State
DrawingMode(#PB_2DDrawing_Default)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, BlendColor(backColor, LineColor, 70))
DrawingMode(#PB_2DDrawing_Outlined)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, LineColor)
DrawingMode(#PB_2DDrawing_Default)
Circle(x + radius + 1, x + radius + 1, radius, LineColor)
Else
DrawingMode(#PB_2DDrawing_Default)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, BlendColor(backColor, FrontColor, 70))
DrawingMode(#PB_2DDrawing_Outlined)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, FrontColor)
DrawingMode(#PB_2DDrawing_Default)
Circle(x + dx - radius - 2, y + radius + 1, radius, FrontColor)
EndIf
Else
If dx & 1 = 0
dx - 1
EndIf
; Draw Border
If \Flags = #PB_Canvas_Border
DrawingMode(#PB_2DDrawing_Outlined)
Box(0, 0, dx, dy, #Gray)
x = 2
y = 2
dx - 4
dy - 4
EndIf
radius = (dx - 2) / 2
If Not \State
DrawingMode(#PB_2DDrawing_Default)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, BlendColor(BackColor, LineColor, 70))
DrawingMode(#PB_2DDrawing_Outlined)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, LineColor)
DrawingMode(#PB_2DDrawing_Default)
Circle(x + radius + 1, y + dy - radius - 2, radius, LineColor)
Else
DrawingMode(#PB_2DDrawing_Default)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, BlendColor(BackColor, FrontColor, 70))
DrawingMode(#PB_2DDrawing_Outlined)
RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, FrontColor)
DrawingMode(#PB_2DDrawing_Default)
Circle(x + radius + 1, y + radius + 1, radius, FrontColor)
EndIf
EndIf
StopDrawing()
EndIf
EndWith
EndProcedure
; ----
Procedure DoEvents()
Protected *this.sSwitchGadget = GetGadgetData(EventGadget())
Protected event, update
With *this
If *this
event = EventType()
Select event
Case #PB_EventType_MouseEnter
Case #PB_EventType_MouseLeave
Case #PB_EventType_MouseMove
Case #PB_EventType_MouseWheel
Case #PB_EventType_LeftButtonDown : update = #True
Case #PB_EventType_LeftButtonUp : update = #True
Case #PB_EventType_LeftClick
Case #PB_EventType_LeftDoubleClick
Case #PB_EventType_RightButtonDown
Case #PB_EventType_RightButtonUp
Case #PB_EventType_RightClick
Case #PB_EventType_RightDoubleClick
Case #PB_EventType_MiddleButtonDown
Case #PB_EventType_MiddleButtonUp
Case #PB_EventType_Focus
Case #PB_EventType_LostFocus
Case #PB_EventType_KeyDown
Case #PB_EventType_KeyUp
Case #PB_EventType_Input
Case #PB_EventType_Resize : update = #True
\x = GadgetX(\Gadget)
\y = GadgetY(\Gadget)
\Width = GadgetWidth(\Gadget)
\Height = GadgetHeight(\Gadget)
EndSelect
If update
\Event = event
DrawGadget(*this)
EndIf
EndIf
EndWith
EndProcedure
;-- Object Functions
Procedure Initialize(*this.sSwitchGadget)
Protected result
With *this
result = CanvasGadget(\Gadget, \x, \y, \Width, \Height)
If result
If \Gadget = #PB_Any
\Gadget = result
EndIf
\Redraw = #True
\Event = #Null
\BackColor = GetSystemColor(#PB_Gadget_BackColor)
DrawGadget(*this)
SetGadgetData(\Gadget, *this)
BindGadgetEvent(\Gadget, @DoEvents())
EndIf
EndWith
EndProcedure : AsInitializeObject(Initialize)
; ----
Procedure Dispose(*this.sSwitchGadget)
With *this
If IsGadget(\Gadget)
FreeGadget(\Gadget)
EndIf
EndWith
EndProcedure : AsDisposeObject(Dispose)
; ----
Procedure Create(Gadget, x, y, Width, Height, FrontColor = #PB_Default, LineColor = #PB_Default, Flags = 0)
Protected *object.sSwitchGadget
With *object
AllocateObject(*object, sSwitchGadget)
If *object
\Gadget = Gadget
\x = x
\y = y
\Width = Width
\Height = Height
\FrontColor = FrontColor
\LineColor = LineColor
\Flags = Flags
EndIf
InitializeObject(*object)
ProcedureReturn *object
EndWith
EndProcedure
; ----
CheckInterface()
EndModule
; *****************************************************************************
;- Example
CompilerIf #PB_Compiler_IsMainFile
Enumeration Windows
#Main
EndEnumeration
Enumeration Gadgets 10
#Button10
#Button11
#Button12
EndEnumeration
Enumeration Status
#MainStatusBar
EndEnumeration
Procedure Main()
Protected.SwitchGadget::iSwitchGadget btn10, btn11, btn12
Protected i, state, color
Dim btn.SwitchGadget::iSwitchGadget(9)
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object SwitchGadget Number 42 ;)", #PB_Window_SystemMenu)
FrameGadget(#PB_Any, 5, 5, 470, 75, "Switches")
TextGadget(#PB_Any, 15, 25, 35, 20, "On")
TextGadget(#PB_Any, 15, 50, 35, 20, "Off")
For i = 0 To 9
btn(i) = SwitchGadget::Create(i, i * 30 + 50, 25, 24, 40, #Blue, #Gray, #PB_Canvas_Border)
Next
TextGadget(#PB_Any, 10, 94, 120, 20, "FrontColor Green")
TextGadget(#PB_Any, 10, 129, 120, 20, "LineColor Red")
btn10 = SwitchGadget::Create(#Button10, 140, 95, 40, 20)
btn11 = SwitchGadget::Create(#Button11, 140, 125, 40, 20)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 0 To 9
Case #Button10
If EventType() = #PB_EventType_Change
If btn10\GetState()
color = $008D00 ; #Green
Else
color = #PB_Default
EndIf
For i = 0 To 9
btn(i)\SetColor(#PB_Gadget_FrontColor, color)
Next
EndIf
Case #Button11
If EventType() = #PB_EventType_Change
If EventData() ; State
color = #Red
Else
color = #Gray
EndIf
For i = 0 To 9
btn(i)\SetColor(#PB_Gadget_LineColor, Color)
Next
EndIf
EndSelect
EndSelect
ForEver
For i = 0 To 9
btn(i)\Release()
Next
EndIf
EndProcedure : Main()
CompilerEndIf
Last edited by mk-soft on Sat Feb 29, 2020 12:48 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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
SwitchGadget Update v1.05
- Border owner draw
- Border owner draw
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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
NumberGadget Update v1.03.1
- Bugfix
- Added event left double click
- Bugfix
- Added event left double click
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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
GaugeGadget Update v1.02.2
- Fix DesktopScaledXY with negative values
- Fix DesktopScaledXY with negative values
Code: Select all
;-TOP
; Comment : Object GaugeGadget No 42 ;)
; Author : mk-soft
; Version : v1.02.2
; Create : 23.02.2020
; Update : 26.02.2020
; OS : All
; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305
IncludeFile "Modul_BaseClassSmall.pb"
EnableExplicit
; *****************************************************************************
;- Global
Enumeration
#GaugeValue
#GaugeValue_Min
#GaugeValue_Max
#GaugeValue_Range_Min
#GaugeValue_Range_Max
#GaugeValue_Step
#GaugeValue_Decimals
EndEnumeration
Enumeration
#GaugeColor_Background
#GaugeColor_Border
#GaugeColor_Text
#GaugeColor_Center
#GaugeColor_Pointer
#GaugeColor_Scala
#GaugeColor_Range_Min
#GaugeColor_Range_Middle
#GaugeColor_Range_Max
EndEnumeration
;- Module Public
DeclareModule GaugeGadget
UseModule BaseClass
Enumeration
#GaugeValue
#GaugeValue_Min
#GaugeValue_Max
#GaugeValue_Range_Min
#GaugeValue_Range_Max
#GaugeValue_Step
#GaugeValue_Decimals
EndEnumeration
Enumeration
#GaugeColor_Background
#GaugeColor_Border
#GaugeColor_Text
#GaugeColor_Center
#GaugeColor_Pointer
#GaugeColor_Scala
#GaugeColor_Range_Min
#GaugeColor_Range_Middle
#GaugeColor_Range_Max
EndEnumeration
Interface iGaugeGadget Extends iBaseClass
Resize(x, y, Width, Height)
Redraw(State = #True)
GetID()
SetColor(ColorType, Color)
GetColor(ColorType)
SetValue(Type, Value.f)
GetValue.f(Type)
SetText(Text.s)
GetText.s()
SetFont(FontID)
GetFont()
SetUserData(UserData)
GetUserData()
EndInterface
UnuseModule BaseClass
Declare Create(Gadget, x, y, Width, Height, Text.s, Flags = 0)
EndDeclareModule
;- Module Private
Module GaugeGadget
EnableExplicit
UseModule BaseClass
NewClass(iGaugeGadget)
Structure sGaugeGadget Extends sBaseClass
Gadget.i
UserData.i
; Params
x.i
y.i
Width.i
Height.i
Text.s
Flags.i
; Data Color
Color_Background.i
Color_Border.i
Color_Text.i
Color_Center.i
Color_Pointer.i
Color_Scala.i
Color_Range_Min.i
Color_Range_Middle.i
Color_Range_Max.i
; Date Values
Value.f
Value_Min.f
Value_Max.f
Value_Range_Min.f
Value_Range_Max.f
Value_Step.f
Value_Decimals.f
; Data
BorderSize.i
FontID.i
Image.i
Renew.i
; System
Redraw.i
Event.i
EndStructure
Global DefaultFont = LoadFont(#PB_Any, "", 11)
Declare DrawGadget(*this)
;-- Public Object Function
Procedure Resize(*this.sGaugeGadget, x, y, Width, Height)
With *this
If x <> #PB_Ignore
\x = x
EndIf
If y <> #PB_Ignore
\y = y
EndIf
If Width <> #PB_Ignore
\Width = Width
EndIf
If Height <> #PB_Ignore
\Height = Height
EndIf
ResizeGadget(\Gadget, \x, \y, \Width, \Height)
EndWith
EndProcedure : AsMethode(Resize)
; ----
Procedure Redraw(*this.sGaugeGadget, State)
With *this
\Redraw = State
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(Redraw)
; ----
Procedure GetID(*this.sGaugeGadget)
ProcedureReturn *this\Gadget
EndProcedure : AsMethode(GetID)
; ----
Procedure SetColor(*this.sGaugeGadget, ColorType, Color)
With *this
\Renew = #True
Select ColorType
Case #GaugeColor_Background
\Color_Background = Color | $FF000000
\Renew = #True
Case #GaugeColor_Border
\Color_Border = Color | $FF000000
\Renew = #True
Case #GaugeColor_Text
\Color_Text = Color | $FF000000
\Renew = #True
Case #GaugeColor_Center
\Color_Center = Color | $FF000000
\Renew = #True
Case #GaugeColor_Pointer
\Color_Pointer = Color | $FF000000
\Renew = #True
Case #GaugeColor_Scala
\Color_Scala = Color | $FF000000
\Renew = #True
Case #GaugeColor_Range_Min
\Color_Range_Min = Color | $FF000000
\Renew = #True
Case #GaugeColor_Range_Middle
\Color_Range_Middle = Color | $FF000000
\Renew = #True
Case #GaugeColor_Range_Max
\Color_Range_Max = Color | $FF000000
\Renew = #True
EndSelect
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetColor)
Procedure GetColor(*this.sGaugeGadget, ColorType)
Protected color
With *this
Select ColorType
Case #GaugeColor_Background
ProcedureReturn \Color_Background
Case #GaugeColor_Border
ProcedureReturn \Color_Border
Case #GaugeColor_Text
ProcedureReturn \Color_Text
Case #GaugeColor_Center
ProcedureReturn \Color_Center
Case #GaugeColor_Pointer
ProcedureReturn \Color_Pointer
Case #GaugeColor_Scala
ProcedureReturn \Color_Scala
Case #GaugeColor_Range_Min
ProcedureReturn \Color_Range_Min
Case #GaugeColor_Range_Middle
ProcedureReturn \Color_Range_Middle
Case #GaugeColor_Range_Max
ProcedureReturn \Color_Range_Max
EndSelect
ProcedureReturn 0
EndWith
EndProcedure : AsMethode(GetColor)
; ----
Procedure SetValue(*this.sGaugeGadget, Type, Value.f)
With *this
Select Type
Case #GaugeValue
\Value = Value
Case #GaugeValue_Min
\Value_Min = Value
\Renew = #True
Case #GaugeValue_Max
\Value_Max = Value
\Renew = #True
Case #GaugeValue_Range_Min
\Value_Range_Min = Value
\Renew = #True
Case #GaugeValue_Range_Max
\Value_Range_Max = Value
\Renew = #True
Case #GaugeValue_Step
\Value_Step = Value
\Renew = #True
Case #GaugeValue_Decimals
\Value_Decimals = Value
\Renew = #True
EndSelect
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetValue)
Procedure.f GetValue(*this.sGaugeGadget, Type)
With *this
Select Type
Case #GaugeValue
ProcedureReturn \Value
Case #GaugeValue_Min
ProcedureReturn \Value_Min
Case #GaugeValue_Max
ProcedureReturn \Value_Max
Case #GaugeValue_Range_Min
ProcedureReturn \Value_Range_Min
Case #GaugeValue_Range_Max
ProcedureReturn \Value_Range_Max
Case #GaugeValue_Step
ProcedureReturn \Value_Step
Case #GaugeValue_Decimals
ProcedureReturn \Value_Decimals
EndSelect
EndWith
EndProcedure : AsMethode(GetValue)
; ----
Procedure SetText(*this.sGaugeGadget, Text.s)
With *this
\Text = Text
\Renew = #True
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetText)
Procedure.s GetText(*this.sGaugeGadget)
With *this
ProcedureReturn \Text
EndWith
EndProcedure : AsMethode(GetText)
; ----
Procedure SetFont(*this.sGaugeGadget, FontID)
With *this
If FontID
\FontID = FontID
Else
\FontID = #PB_Default
EndIf
\Renew = #True
If \Redraw
DrawGadget(*this)
EndIf
EndWith
EndProcedure : AsMethode(SetFont)
Procedure GetFont(*this.sGaugeGadget)
With *this
ProcedureReturn \FontID
EndWith
EndProcedure : AsMethode(GetFont)
; ----
Procedure SetUserData(*this.sGaugeGadget, UserData)
With *this
\UserData = UserData
EndWith
EndProcedure : AsMethode(SetUserData)
Procedure GetUserData(*this.sGaugeGadget)
With *this
ProcedureReturn \UserData
EndWith
EndProcedure : AsMethode(GetUserData)
;-- Drawing and Events Functions
Procedure DrawGadget(*this.sGaugeGadget)
Protected.d x, y, dx, dy, center_x, center_y, delta_xy, delta, x1, x2, strokewidth, fontsize
Protected.d range, angle0, angle1, angle2, steps
Protected text.s, FontID
With *this
; Grundwerte
If \Width > 0
dx = DesktopScaledX(\Width)
Else
dx = 1
EndIf
If \Height > 0
dy = DesktopScaledY(\Height)
Else
dy = 1
EndIf
center_x = dx * 0.5
center_y = dy * 0.5
If dy > dx
delta_xy = dx * 0.5
Else
delta_xy = dy * 0.5
EndIf
range = \Value_Max - \Value_Min
If \Renew
\Renew = #False
; Altes Image löschen
If \Image
FreeImage(\Image)
EndIf
; Neues Image anlegen
\Image = CreateImage(#PB_Any, dx, dy)
If Not \Image
ProcedureReturn 0
EndIf
; Image neu zeichnen
If StartVectorDrawing(ImageVectorOutput(\Image))
; Schrift auswählen
If \FontID = #PB_Default
FontID = FontID(DefaultFont)
Else
FontID = \FontID
EndIf
; Hintergrund
AddPathBox(0.0, 0.0, dx, dy)
VectorSourceColor(\Color_Background)
FillPath()
; Rahmen
AddPathBox(0.0, 0.0, dx, dy)
VectorSourceColor(\Color_Border)
StrokePath(\BorderSize)
; Text
fontsize = delta_xy * 0.15
VectorFont(FontID, fontsize)
VectorSourceColor(\Color_Text)
x = center_x - VectorTextWidth(\Text) / 2
y = center_y + delta_xy * 0.75 - VectorTextHeight(\Text) / 2
MovePathCursor(x, y)
DrawVectorText(\Text)
; Range Defaults
delta = delta_xy * 0.85
strokewidth = delta_xy * 0.15
RotateCoordinates(center_x, center_y, 120.0)
; Range Min
angle1 = 0.0
angle2 = (\Value_Range_Min - \Value_Min) / range * 300.0
AddPathCircle(center_x, center_y, delta, angle1, angle2)
VectorSourceColor(\Color_Range_Min)
StrokePath(strokewidth)
; Range Middle
angle1 = angle2
angle2 = (\Value_Range_Max - \Value_Min) / range * 300.0
AddPathCircle(center_x, center_y, delta, angle1, angle2)
VectorSourceColor(\Color_Range_Middle)
StrokePath(strokewidth)
; Range Max
angle1 = angle2
angle2 = 300.0
AddPathCircle(center_x, center_y, delta, angle1, angle2)
VectorSourceColor(\Color_Range_Max)
StrokePath(strokewidth)
; Teile 0.5
delta = delta_xy * 0.85
strokewidth = delta_xy * 0.15
ResetCoordinates()
RotateCoordinates(center_x, center_y, 120.0)
angle1 = 0.0
steps = \Value_Step / range * 150.0
While angle1 < 300.01
AddPathCircle(center_x, center_y, delta, angle1 - 0.2, angle1 + 0.2)
angle1 + steps
Wend
VectorSourceColor(\Color_Scala)
StrokePath(strokewidth)
; Teile 1.0
delta = delta_xy * 0.75
strokewidth = delta_xy * 0.05
ResetCoordinates()
RotateCoordinates(center_x, center_y, 120.0)
angle1 = 0.0
steps = \Value_Step / range * 300.0
While angle1 < 300.01
AddPathCircle(center_x, center_y, delta, angle1 - 0.2, angle1 + 0.2)
angle1 + steps
Wend
VectorSourceColor(\Color_Scala)
StrokePath(strokewidth)
; Zahlen
delta = delta_xy * 0.60
fontsize = delta_xy * 0.12
ResetCoordinates()
VectorFont(FontID, fontsize)
VectorSourceColor(\Color_Text)
angle1 = 0.0
steps = \Value_Step / range * 300.0
While angle1 < 300.01
text = StrF(range * angle1 / 300.0 + \Value_Min, \Value_Decimals)
angle0 = Radian(angle1 + 120.0)
x = Cos(angle0) * delta - VectorTextWidth(text) / 2.0
y = Sin(angle0) * delta - VectorTextHeight(text) / 2.0
MovePathCursor(center_x + x, center_y + y)
DrawVectorText(text)
angle1 + steps
Wend
StopVectorDrawing()
EndIf
EndIf
If StartVectorDrawing(CanvasVectorOutput(\Gadget))
; Hintergrund
DrawVectorImage(ImageID(\Image))
; Zeiger Aussen
angle1 = (\Value - \Value_Min) / range * 300 + 30.0
x = delta_xy * 0.04
y = delta_xy * 0.60
strokewidth = delta_xy * 0.01
ResetCoordinates()
RotateCoordinates(center_x, center_y, angle1)
MovePathCursor(center_x - x, center_y)
AddPathLine(center_x, center_y + y)
AddPathLine(center_x + x, center_y)
VectorSourceColor(\Color_Center)
StrokePath(strokewidth, #PB_Path_RoundEnd)
; Zeiger Innen
delta = delta_xy * 0.7
strokewidth = delta_xy * 0.015
MovePathCursor(center_x, center_y)
AddPathLine(center_x, center_y + delta)
VectorSourceColor(\Color_Pointer)
StrokePath(strokewidth, #PB_Path_RoundEnd)
; Zeiger Mitte
ResetCoordinates()
delta = delta_xy * 0.06
AddPathCircle(center_x, center_y, delta)
VectorSourceColor(\Color_Center)
FillPath()
delta = delta_xy * 0.03
AddPathCircle(center_x, center_y, delta)
VectorSourceColor(\Color_Background)
FillPath()
StopVectorDrawing()
EndIf
EndWith
EndProcedure
; ----
Procedure DoEvents()
Protected *this.sGaugeGadget = GetGadgetData(EventGadget())
Protected event, update
With *this
If *this
event = EventType()
Select event
Case #PB_EventType_Resize : update = #True
\x = GadgetX(\Gadget)
\y = GadgetY(\Gadget)
\Width = GadgetWidth(\Gadget)
\Height = GadgetHeight(\Gadget)
\Renew = #True
EndSelect
If update
\Event = event
DrawGadget(*this)
EndIf
EndIf
EndWith
EndProcedure
;-- Object Functions
Procedure Initialize(*this.sGaugeGadget)
Protected result
With *this
result = CanvasGadget(\Gadget, \x, \y, \Width, \Height, \Flags)
If result
If \Gadget = #PB_Any
\Gadget = result
EndIf
\Redraw = #True
\Event = #Null
; Default Colors
\Color_Background = $FFD3D3D3
\Color_Border = $FF000000
\Color_Text = $FF000000
\Color_Center = $FF000000
\Color_Pointer = $FF0000FF
\Color_Scala = $FF000000
\Color_Range_Min = $FF00C0F0
\Color_Range_Middle = $FFFF9020
\Color_Range_Max = $FF0040F0
; Default Values
\Value = 0.0
\Value_Min = 0.0
\Value_Max = 100.0
\Value_Range_Min = 0.0
\Value_Range_Max = 100.0
\Value_Step = 10.0
\Value_Decimals = 0.0
; Default Properties
\BorderSize = 1
\FontID = #PB_Default
\Image = 0
\Renew = #True
; Init
DrawGadget(*this)
SetGadgetData(\Gadget, *this)
BindGadgetEvent(\Gadget, @DoEvents())
EndIf
EndWith
EndProcedure : AsInitializeObject(Initialize)
; ----
Procedure Dispose(*this.sGaugeGadget)
With *this
If IsGadget(\Gadget)
FreeGadget(\Gadget)
EndIf
If IsImage(\Image)
FreeImage(\Image)
EndIf
EndWith
EndProcedure : AsDisposeObject(Dispose)
; ----
Procedure Create(Gadget, x, y, Width, Height, Text.s, Flags = 0)
Protected *object.sGaugeGadget
With *object
AllocateObject(*object, sGaugeGadget)
If *object
\Gadget = Gadget
\x = x
\y = y
\Width = Width
\Height = Height
\Text = Text
\Flags = Flags
EndIf
InitializeObject(*object)
ProcedureReturn *object
EndWith
EndProcedure
; ----
CheckInterface()
EndModule
; *****************************************************************************
;- Example
CompilerIf #PB_Compiler_IsMainFile
Enumeration Windows
#Main
EndEnumeration
Enumeration Gadgets
#Gauge1
EndEnumeration
Enumeration Status
#MainStatusBar
EndEnumeration
Procedure UpdateWindow()
ResizeGadget(#Gauge1, 10, 10, WindowWidth(#Main) - 20, WindowHeight(#Main) - 20)
EndProcedure
Procedure Main()
; Define button object
Protected.GaugeGadget::iGaugeGadget Gauge
Protected font
Protected Value.f, Value2.f = 2.0
;font = LoadFont(0, "Courier New", 11)
;font = LoadFont(0, "Tahoma", 11)
font = LoadFont(0, "Comic Sans MS", 11)
#MainStyle = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 400, 400, "Object GaugeGadget No 42 ;)", #MainStyle)
If Date() >> 2 & 1
Gauge = GaugeGadget::Create(#Gauge1, 10, 10, 380, 380, "POWER")
Gauge\Redraw(#False)
Gauge\SetValue(#GaugeValue_Min, -20.0)
Gauge\SetValue(#GaugeValue_Max, 120.0)
Gauge\SetValue(#GaugeValue_Step, 20.0)
Gauge\SetValue(#GaugeValue_Range_Min, 0.0)
Gauge\SetValue(#GaugeValue_Range_Max, 100.0)
Gauge\Redraw()
Else
Gauge = GaugeGadget::Create(#Gauge1, 10, 10, 380, 380, "POWER", #PB_Canvas_Border)
Gauge\Redraw(#False)
Gauge\SetValue(#GaugeValue_Min, -20.0)
Gauge\SetValue(#GaugeValue_Max, 120.0)
Gauge\SetValue(#GaugeValue_Step, 10.0)
Gauge\SetValue(#GaugeValue_Range_Min, 0.0)
Gauge\SetValue(#GaugeValue_Range_Max, 100.0)
Gauge\SetColor(#GaugeColor_Background, $1F1F1F)
Gauge\SetColor(#GaugeColor_Text, $0000EE)
Gauge\SetColor(#GaugeColor_Center, $FF0000)
Gauge\SetColor(#GaugeColor_Scala, $696969)
Gauge\SetColor(#GaugeColor_Range_Min, $00C9EE)
Gauge\SetColor(#GaugeColor_Range_Middle, $CD7418)
Gauge\SetColor(#GaugeColor_Range_Max, $2C2CEE)
Gauge\SetFont(FontID(0))
Gauge\Redraw()
EndIf
BindEvent(#PB_Event_SizeWindow, @UpdateWindow())
AddWindowTimer(#Main, 1, 100)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #Gauge1
If EventType() = #PB_EventType_LeftClick
EndIf
EndSelect
Case #PB_Event_Timer
If EventTimer() = 1
Value + Value2
If Value >= 110.0
Value2 = -2.0
ElseIf Value <= -10
Value2 = 2.0
EndIf
Gauge\SetValue(#GaugeValue, value)
EndIf
EndSelect
ForEver
Gauge\Release()
EndIf
EndProcedure : Main()
CompilerEndIf
Last edited by mk-soft on Sun Mar 29, 2020 11:31 am, edited 6 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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
New gadget added. A simple gauge control.
The background will only be redrawn when creating and resizing.
This saves about 20% cpu resources of the program.
The background will only be redrawn when creating and resizing.
This saves about 20% cpu resources of the program.
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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Re: Own Flat Gadgets as Object
GaugeGadget Update v1.02.0
- Optimize code
GaugeGadget Update v1.02.1
- Fix DesktopScaledXY with negative values
SwitchGadget Update v1.06.0
- Update Style
- Optimize code
GaugeGadget Update v1.02.1
- Fix DesktopScaledXY with negative values
SwitchGadget Update v1.06.0
- Update Style
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
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive