Own Flat Gadgets as Object

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

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.
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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

ClockGadget Update v1.04
- Optimize DoTimerEvent

NumberGadget Update v1.02
- Added DoTimerEvent for cursor
- New cursor and edit functions

: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
User avatar
skywalk
Addict
Addict
Posts: 3972
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Own Flat Gadgets as Object

Post by skywalk »

Nice 8)
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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

TextBoxGadget Update v1.05.1
- Added check TextBox\SetFont(0)
- Update example

Thanks Skywalk :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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

SwitchGadget Update v1.05
- 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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

NumberGadget Update v1.03.1
- Bugfix
- Added event left double click

: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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

GaugeGadget Update v1.02.2
- 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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

New gadget added. A simple gauge control. :wink:

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
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Own Flat Gadgets as Object

Post by mk-soft »

GaugeGadget Update v1.02.0
- Optimize code

GaugeGadget Update v1.02.1
- Fix DesktopScaledXY with negative values

SwitchGadget Update v1.06.0
- Update Style

: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
Post Reply