PureBasic Forum
https://www.purebasic.fr/english/

Own Flat Gadgets as Object
https://www.purebasic.fr/english/viewtopic.php?f=12&t=74267
Page 2 of 2

Author:  mk-soft [ Thu Jan 09, 2020 6:02 pm ]
Post subject:  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.

Author:  mk-soft [ Sun Jan 12, 2020 4:04 pm ]
Post subject:  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

:wink:

Author:  skywalk [ Sun Jan 12, 2020 5:09 pm ]
Post subject:  Re: Own Flat Gadgets as Object

Nice 8)
Add this to the textbox example: TextBox\SetFont(FontID(0))

Author:  mk-soft [ Sun Jan 12, 2020 5:43 pm ]
Post subject:  Re: Own Flat Gadgets as Object

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

Thanks Skywalk :wink:

Author:  mk-soft [ Sat Jan 18, 2020 3:31 pm ]
Post subject:  Re: Own Flat Gadgets as Object

SwitchGadget Update v1.05.1
Code:
;-TOP
; Comment : Object SwitchGadget Number 42 ;)
; Author  : mk-soft
; Version : v1.05.1
; 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.i R1, G1, B1, R2, G2, B2
    Protected.f Blend = Scale / 100
    R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1)
    R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2)
    ProcedureReturn RGB((R1*Blend) + (R2 * (1 - Blend)), (G1*Blend) + (G2 * (1 - Blend)), (B1*Blend) + (B2 * (1 - Blend)))
  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
        Select Type
          Case #PB_Gadget_FrontColor
            ProcedureReturn NSColorByNameToRGB("controlTextColor")
          Case #PB_Gadget_BackColor
            ProcedureReturn BlendColor(NSColorByNameToRGB("controlBackgroundColor"), #White, 85)
          Case #PB_Gadget_LineColor
            ProcedureReturn #Gray
        EndSelect
    CompilerEndSelect
  EndProcedure
 
  ; ----
 
  Procedure DrawGadget(*this.sSwitchGadget)
    Protected x, y, dx, dy, radius
    Protected LineColor, FrontColor, BackColor
   
    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 = $FF4040
        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_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, LineColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(LineColor)
            BackColor(BlendColor(LineColor, #White, 35))
            CircularGradient(x + radius + 1 + 1, y + radius + 1, radius)
            Circle(x + radius + 1, x + radius + 1, radius)
          Else
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dy - 4) / 2, (dy - 4) / 2, FrontColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(FrontColor)
            BackColor(BlendColor(FrontColor, #White, 35))
            CircularGradient(x + dx - radius - 2 + 1, y + radius + 1, radius)
            Circle(x + dx - radius - 2, y + radius + 1, radius)
          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_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, LineColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(LineColor)
            BackColor(BlendColor(LineColor, #White, 35))
            CircularGradient(x + radius + 1, y + dy - radius - 2 - 1, radius)
            Circle(x + radius + 1, y + dy - radius - 2, radius)
          Else
            DrawingMode(#PB_2DDrawing_Outlined)
            RoundBox(x + 2, y + 2, dx - 4, dy - 4, (dx - 4) / 2, (dx - 4) / 2, FrontColor)
            DrawingMode(#PB_2DDrawing_Gradient)
            FrontColor(FrontColor)
            BackColor(BlendColor(FrontColor, #White, 35))
            CircularGradient(x + radius + 1, y + radius + 1 - 1, radius)
            Circle(x + radius + 1, y + radius + 1, radius)
          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

Author:  mk-soft [ Sat Jan 18, 2020 8:24 pm ]
Post subject:  Re: Own Flat Gadgets as Object

SwitchGadget Update v1.05
- Border owner draw

Author:  mk-soft [ Sat Feb 22, 2020 3:16 pm ]
Post subject:  Re: Own Flat Gadgets as Object

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

:wink:

Author:  mk-soft [ Tue Feb 25, 2020 8:35 pm ]
Post subject:  Re: Own Flat Gadgets as Object

GaugeGadget Update v1.01.3
- Bugfix free image
- Bugfix text position
Code:
;-TOP
; Comment : Object GaugeGadget No 42 ;)
; Author  : mk-soft
; Version : v1.01.3
; Create  : 23.02.2020
; Update  : 25.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
    BackColor.i
    BorderColor.i
    BorderSize.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
    ;
    Value.f
    Value_Min.f
    Value_Max.f
    Value_Range_Min.f
    Value_Range_Max.f
    Value_Step.f
    Value_Decimals.f
    ;
    FontID.i
    Image.i
    Renew.i
    ;
    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
          \BackColor = Color | $FF000000
        Case #GaugeColor_Border
          \BorderColor = Color | $FF000000
        Case #GaugeColor_Text
          \Color_Text = Color | $FF000000
        Case #GaugeColor_Center
          \Color_Center = Color | $FF000000
        Case #GaugeColor_Pointer
          \Color_Pointer = Color | $FF000000
        Case #GaugeColor_Scala
          \Color_Scala = Color | $FF000000
        Case #GaugeColor_Range_Min
          \Color_Range_Min = Color | $FF000000
        Case #GaugeColor_Range_Middle
          \Color_Range_Middle = Color | $FF000000
        Case #GaugeColor_Range_Max
          \Color_Range_Max = Color | $FF000000
      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 \BackColor
        Case #GaugeColor_Border
          ProcedureReturn \BorderColor
        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
      \Renew = #True
      Select Type
        Case #GaugeValue
          \Value = Value
          \Renew = #False
        Case #GaugeValue_Min
          \Value_Min = Value
        Case #GaugeValue_Max
          \Value_Max  = Value
        Case #GaugeValue_Range_Min
          \Value_Range_Min = Value
        Case #GaugeValue_Range_Max
          \Value_Range_Max = Value
        Case #GaugeValue_Step
          \Value_Step = Value
        Case #GaugeValue_Decimals
          \Value_Decimals = Value
      EndSelect
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetValue)
 
  Procedure.f GetValue(*this.sGaugeGadget, Type)
    Protected r1.f
    With *this
      Select Type
        Case #GaugeValue
          r1 = \Value
        Case #GaugeValue_Min
          r1 = \Value_Min
        Case #GaugeValue_Max
          r1 = \Value_Max
        Case #GaugeValue_Range_Min
          r1 = \Value_Range_Min
        Case #GaugeValue_Range_Max
          r1 = \Value_Range_Max
        Case #GaugeValue_Step
          r1 = \Value_Step
        Case #GaugeValue_Decimals
          r1 = \Value_Decimals
      EndSelect
    EndWith
    ProcedureReturn r1
  EndProcedure : AsMethode(GetValue)
 
  ; ----
 
  Procedure SetText(*this.sGaugeGadget, Text.s)
    With *this
      \Text = Text
      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
      \Renew = #True
      If FontID
        \FontID = FontID
      Else
        \FontID = #PB_Default
      EndIf
      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
      dx = DesktopScaledX(\Width)
      dy = DesktopScaledY(\Height)
     
      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(\BackColor)
          FillPath()
          ; Rahmen
          AddPathBox(0.0, 0.0, dx, dy)
          VectorSourceColor(\BorderColor)
          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)
         
          delta = delta_xy * 0.85
          strokewidth = delta_xy * 0.15 + 0.5
          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 + 0.5
         
          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.80
          strokewidth = delta_xy * 0.15 + 0.5
         
          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.20)
            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 + 0.5
        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 + 0.5
        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(\BackColor)
        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
       
        \BackColor = $FFD3D3D3
        \BorderColor = $FF000000
        \BorderSize = 2
        \Color_Text = $FF000000
        \Color_Center = $FF000000
        \Color_Pointer = $FF0000FF
        \Color_Scala = $FF000000
        \Color_Range_Min = $FF00D7FF
        \Color_Range_Middle = $FFFF901E
        \Color_Range_Max = $FF0045FF
       
        \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
       
        \FontID = #PB_Default
        \Image = 0
        \Renew = #True
       
        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)
      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_Range_Min, 0.0)
      Gauge\SetValue(#GaugeValue_Range_Max, 100.0)
     
      If Date() >> 2 & 1
        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))
      EndIf
     
      Gauge\Redraw()
     
      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

Author:  mk-soft [ Tue Feb 25, 2020 8:41 pm ]
Post subject:  Re: Own Flat Gadgets as Object

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.

Page 2 of 2 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/