Own Flat Gadgets as Object

mk-soft · **Posted:** Thu Dec 26, 2019 5:27 pm

Own flat gadget programmed as object.
The module BaseClassSmall is needed to create the objects in a simplified way. Show Link OOP-BaseClass

Do not use the PB function SetGadgetData. This is needed for fast access to the object for event processing.
Use the methods of object SetUserData and GetUserData for own data

- ButtonColorGadget
- TextBoxGadget
- ClockGadget
- NumberGadget
- SwitchGadget
- GaugeGadget

Modul_BaseClassSmall.pb

Code:

;-Begin Module BaseClass Small Version

; Comment : Module as Object
; Author  : mk-soft
; Version : v1.16
; Created : 16.08.2017
; Updated : 08.02.2020
; Link DE : http://www.purebasic.fr/german/viewtopic.php?f=8&t=29343
; Link EN : http://www.purebasic.fr/english/viewtopic.php?f=12&t=64305

; OS      : All

; ***************************************************************************************

DeclareModule BaseClass
  
  ; ---------------------------------------------------------------------------
  
  ; Internal class declaration
  
  Prototype ProtoInvoke(*This)
  
  Structure udtInvoke
    *Invoke.ProtoInvoke
  EndStructure
  
  Structure udtClass
    Array *vTable(3)
    Array Initialize.udtInvoke(0)
    Array Dispose.udtInvoke(0)
  EndStructure
  
  ; ---------------------------------------------------------------------------
  
  ; BaseClass declaration
  
  Structure sBaseSystem
    *vTable
    *Self.udtClass
    RefCount.i
    Mutex.i
  EndStructure
  
  ; Public Structure
  Structure sBaseClass
    System.sBaseSystem
  EndStructure
  
  ; Public Interface 
  Interface iBaseClass
    QueryInterface(*riid, *ppvObject)
    AddRef()
    Release()
  EndInterface
  
  ; ---------------------------------------------------------------------------
  
  Macro _dq_
    "
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
  ; Added New Class
  Declare AddClass(ClassName.s, ClassExtends.s, Size) ; Internal
  
  Macro NewClass(ClassInterface, ClassExtends=)
    ; Interface helper
    Interface __Interface Extends ClassInterface 
    EndInterface
    ; Internal class pointer
    Global *__Class.udtClass
    ; Add new class
    Procedure __NewClass()
      *__Class = AddClass(_dq_#ClassInterface#_dq_, _dq_#ClassExtends#_dq_, SizeOf(ClassInterface) / SizeOf(integer))
    EndProcedure : __NewClass()
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
  ; Macro for init object (short)
  Macro InitObject(sProperty)
    Protected *Object.sProperty, __cnt, __index
    *Object = AllocateStructure(sProperty)
    If *Object
      *Object\System\vTable = *__Class\vTable()
      *Object\System\Self = *__Class
      *Object\System\RefCount = 0
      *Object\System\Mutex = CreateMutex()
      __cnt = ArraySize(*Object\System\Self\Initialize())
      For __index = 1 To __cnt
        *Object\System\Self\Initialize(__index)\Invoke(*Object)
      Next
    EndIf
    ProcedureReturn *Object
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
  ; Macros for init object (advanced)
  Macro AllocateObject(Object, sProperty)
    Object = AllocateStructure(sProperty)
    If Object
      Object\System\vTable = *__Class\vTable()
      Object\System\Self = *__Class
      Object\System\RefCount = 0
      Object\System\Mutex = CreateMutex()
    EndIf
  EndMacro
  
  Macro InitializeObject(Object)
    If Object
      Protected __cnt, __index
      __cnt = ArraySize(Object\System\Self\Initialize())
      For __index = 1 To __cnt
        Object\System\Self\Initialize(__index)\Invoke(Object)
      Next
    EndIf
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
  ; Macros for clone object
  Macro CloneObject(This, Clone, sProperty)
    Clone = AllocateStructure(sProperty)
    If Clone
      CopyStructure(This, Clone, sProperty)
      Clone\System\RefCount = 0
      Clone\System\Mutex = CreateMutex()
    EndIf
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
  Macro LockObject(This)
    LockMutex(This\System\Mutex)
  EndMacro 
  
  Macro UnlockObject(This)
    UnlockMutex(This\System\Mutex)
  EndMacro 
  
  ; ---------------------------------------------------------------------------
  
  ; Macros to defined Initialize, Dispose, Methods
  
  ; Add Procedure as Initialize Object
  Macro AsInitializeObject(Name)
    Procedure __AddInitializeObject#Name()
      Protected index
      index = ArraySize(*__Class\Initialize()) + 1
      ReDim *__Class\Initialize(index)
      *__Class\Initialize(index)\Invoke = @Name()
    EndProcedure : __AddInitializeObject#Name()
  EndMacro
  
  ; Add Procedure as Dispose Object
  Macro AsDisposeObject(Name)
    Procedure __AddDisposeObject#Name()
      Protected index
      index = ArraySize(*__Class\Dispose()) + 1
      ReDim *__Class\Dispose(index)
      *__Class\Dispose(index)\Invoke = @Name()
    EndProcedure : __AddDisposeObject#Name()
  EndMacro
  
  ; Add Procedure as Methode or Overwrite inheritance methode
  Macro AsMethode(Name)
    Procedure __AddMethode#Name()
      *__Class\vTable(OffsetOf(__Interface\Name()) / SizeOf(integer)) = @Name()
    EndProcedure : __AddMethode#Name()
  EndMacro
  
  Macro AsNewMethode(Name)
    AsMethode(Name)
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
  ; Debugger functions
  
  Macro CheckInterface()
    CompilerIf #PB_Compiler_Debugger
      Procedure __CheckInterface()
        Protected *xml, *node, ErrorCount
        *xml = CreateXML(#PB_Any)
        If *xml
          *node = InsertXMLStructure(RootXMLNode(*xml), *__Class\vTable(), __Interface)
          *node = ChildXMLNode(*node)
          Repeat
            If Not *node
              Break
            EndIf
            If GetXMLNodeText(*node) = "0"
              ErrorCount + 1
              Debug "Module " + #PB_Compiler_Module + ": Error Interface - Missing Methode '" + GetXMLNodeName(*node) + "()'"
            EndIf
            *node = NextXMLNode(*node)
          ForEver
          FreeXML(*xml)
          If ErrorCount
            Debug "Module " + #PB_Compiler_Module + ": Error Count " + ErrorCount
            CallDebugger
          EndIf
        EndIf
      EndProcedure : __CheckInterFace()
    CompilerEndIf
  EndMacro
  
  ; ---------------------------------------------------------------------------
  
EndDeclareModule

Module BaseClass
  
  EnableExplicit
  
  ; ---------------------------------------------------------------------------
  
  Procedure QueryInterface(*This.sBaseClass, *riid, *ppvObject.integer)
    If *ppvObject = 0 Or *riid = 0
      ProcedureReturn $80070057 ; #E_INVALIDARG
    EndIf
    If CompareMemory(*riid, ?IID_IUnknown, 16)
      LockMutex(*This\System\Mutex)
      *ppvObject\i = *This
      *This\System\RefCount + 1
      UnlockMutex(*This\System\Mutex)
      ProcedureReturn 0 ; #S_OK
    Else
      *ppvObject\i = 0
      ProcedureReturn $80004002 ; (#E_NOINTERFACE)
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  Procedure AddRef(*This.sBaseClass)
    LockMutex(*This\System\Mutex)
    *This\System\RefCount + 1
    UnlockMutex(*This\System\Mutex)
    ProcedureReturn *This\System\RefCount
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  Procedure Release(*This.sBaseClass)
    Protected index, cnt
    With *This\System
      LockMutex(*This\System\Mutex)
      If \RefCount = 0
        cnt = ArraySize(\Self\Dispose())
        For index = cnt To 1 Step -1
          \Self\Dispose(index)\Invoke(*This)
        Next
        FreeMutex(*This\System\Mutex)
        FreeStructure(*This)
        ProcedureReturn 0
      Else
        \RefCount - 1
      EndIf
      UnlockMutex(*This\System\Mutex)
      ProcedureReturn \RefCount
    EndWith
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  Procedure AddClass(ClassName.s, ClassExtends.s, Size)
    Static NewMap Classes.udtClass()
    Protected *class.udtClass, *extends.udtClass, sClassName.s, sClassExtends.s
    sClassName = LCase(ClassName)
    sClassExtends = LCase(ClassExtends)
    CompilerIf #PB_Compiler_Debugger
      If FindMapElement(Classes(), sClassName)
        Debug "Error: Class '" + ClassName + "' already exists!"
        CallDebugger
        End -1
      EndIf
      If Bool(sClassExtends)
        *extends = FindMapElement(Classes(), sClassExtends)
        If Not *extends
          Debug "Error: Extends Class '" + ClassExtends + "' not exists!"
          CallDebugger
          End -1
        EndIf
      EndIf
    CompilerEndIf
    *class = AddMapElement(Classes(), sClassName)
    If *class
      If Bool(sClassExtends)
        *extends = FindMapElement(Classes(), sClassExtends)
        CopyStructure(*extends, *class, udtClass)
        ReDim *class\vTable(Size)
        ProcedureReturn *class
      Else
        ReDim *class\vTable(Size)
        *class\vTable(0) = @QueryInterface()
        *class\vTable(1) = @AddRef()
        *class\vTable(2) = @Release()
        ProcedureReturn *class
      EndIf
    Else
      Debug "Error: Class '" + ClassName + "' Out Of Memory!"
      CallDebugger
      End -1
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  DataSection
    IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
    Data.l $00000000
    Data.w $0000, $0000
    Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  EndDataSection
  
EndModule

;- End Module BaseClass

; ***************************************************************************************

mk-soft · **Posted:** Thu Dec 26, 2019 5:28 pm

ButtonColorGadget Update v1.03.1

Code:

;-TOP
; Comment : Object ButtonColorGadget No 42 ;)
; Author  : mk-soft
; Version : v1.03.1
; Create  : 01.05.2019
; Update  : 26.12.2019 (DPI)
; OS      : All

; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

; *****************************************************************************

;- Module Public

DeclareModule ButtonColorGadget
  
  UseModule BaseClass
  
  Interface iButtonColorGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    Redraw(State = #True)
    GetID()
    SetText(Text.s)
    GetText.s()
    SetColor(ColorType, Color)
    GetColor(ColorType)
    SetFont(FontID)
    GetFont()
    SetUserData(UserData)
    GetUserData()
  EndInterface
  
  UnuseModule BaseClass
  
  Declare Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $DCDCDC, Flags = 0)
  
EndDeclareModule

;- Module Private

Module ButtonColorGadget
  
  EnableExplicit
  
  UseModule BaseClass
  
  NewClass(iButtonColorGadget)
  
  Structure sButtonColorGadget Extends sBaseClass
    Gadget.i
    UserData.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Text.s
    FontID.i
    LineColor.i
    FrontColor.i
    BackColor.i
    Flags.i
    ; Data
    Redraw.i
    Event.i
  EndStructure
  
  Declare DrawGadget(*this)
  
  ;-- Public Object Function
  
  Procedure Resize(*this.sButtonColorGadget, 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.sButtonColorGadget, State)
    With *this
      \Redraw = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(Redraw)
  
  ; ----
  
  Procedure GetID(*this.sButtonColorGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
  
  ; ----
  
  Procedure SetText(*this.sButtonColorGadget, Text.s)
    With *this
      \Text = Text
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetText)
  
  Procedure.s GetText(*this.sButtonColorGadget)
    ProcedureReturn *this\Text
  EndProcedure : AsMethode(GetText)
  
  ; ----
  
  Procedure SetColor(*this.sButtonColorGadget, 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.sButtonColorGadget, 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 SetFont(*this.sButtonColorGadget, FontID)
    With *this
      If FontID
        \FontID = FontID
      Else
        \FontID = #PB_Default
      EndIf
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetFont)
  
  Procedure GetFont(*this.sButtonColorGadget)
    With *this
      ProcedureReturn \FontID
    EndWith
  EndProcedure : AsMethode(GetFont)
  
  ; ----
  
  Procedure SetUserData(*this.sButtonColorGadget, UserData)
    With *this
      \UserData = UserData
    EndWith
  EndProcedure : AsMethode(SetUserData)
  
  Procedure GetUserData(*this.sButtonColorGadget)
    With *this
      ProcedureReturn \UserData
    EndWith
  EndProcedure : AsMethode(GetUserData)
  
  ;-- Drawing and Events Functions
  
  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 DrawGadget(*this.sButtonColorGadget)
    Protected LineColor, FrontColor, BackColor
    Protected Width, Height
    With *this
      Select \Event
        Case #Null
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        Case #PB_EventType_MouseEnter
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $FFFFFF, 80)
          BackColor  = BlendColor(\BackColor, $FFFFFF, 80)
        Case #PB_EventType_MouseLeave
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        Case #PB_EventType_LeftButtonDown
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $000000, 80)
          BackColor  = BlendColor(\BackColor, $000000, 80)
        Case #PB_EventType_LeftButtonUp
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $FFFFFF, 80)
          BackColor  = BlendColor(\BackColor, $FFFFFF, 80)
        Case #PB_EventType_Resize
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        EndSelect
      
      Width = DesktopScaledX(\Width)
      Height = DesktopScaledY(\Height)
      If StartDrawing(CanvasOutput(\Gadget))
        Box(0, 0, Width, Height, LineColor)
        Box(1, 1, Width - 2, Height - 2, BackColor)
        DrawingFont(\FontID)
        DrawText(Width / 2 - TextWidth(\Text) / 2, Height / 2 - TextHeight(\Text) / 2, \Text, FrontColor, BackColor)
        StopDrawing()
      EndIf
    EndWith
    
  EndProcedure
  
  ; ----
  
  Procedure DoEvents()
    Protected *this.sButtonColorGadget = GetGadgetData(EventGadget())
    Protected event, update
    
    With *this
      If *this
        event = EventType()
        Select event
          Case #PB_EventType_MouseEnter : update = #True
          Case #PB_EventType_MouseLeave : update = #True
          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.sButtonColorGadget)
    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
        \FontID = #PB_Default
        \LineColor = #Gray
        DrawGadget(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
  
  ; ----
  
  Procedure Dispose(*this.sButtonColorGadget)
    With *this
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ----
  
  Procedure Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $DCDCDC, Flags = 0)
    Protected *object.sButtonColorGadget
    
    With *object
      AllocateObject(*object, sButtonColorGadget)
      If *object
        \Gadget     = Gadget
        \x          = x
        \y          = y
        \Width      = Width
        \Height     = Height
        \Text       = Text
        \FrontColor = FrontColor
        \BackColor  = BackColor
        \Flags      = Flags
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
  
  ; ----
  
  CheckInterface()
  
EndModule

; *****************************************************************************

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration Gadgets
    #Button1
    #Button2
    #Button3
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration
  
  LoadFont(0, "Courier New", 20, #PB_Font_Bold)
  
  Procedure Main()
    ; Define button object
    Protected.ButtonColorGadget::iButtonColorGadget btn, btn2, btn3
    
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object ButtonColorGadget No 42 ;)", #PB_Window_SystemMenu)
      btn  = ButtonColorGadget::Create(#Button1, 10, 10, 120, 30, "My Button", #Yellow, #Red)
      btn2 = ButtonColorGadget::Create(#Button2, 10, 80, 120, 30, "My Button 2")
      btn3 = ButtonColorGadget::Create(#Button3, 10, 120, 120, 30, "My Button 3")
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Button1
                If EventType() = #PB_EventType_LeftClick
                  If GadgetWidth(#Button1) <= 120
                    btn\Redraw(#False)
                    btn\Resize(#PB_Ignore, #PB_Ignore, 240, 60)
                    btn\SetText("My Big Button")
                    btn\SetFont(FontID(0))
                    btn\SetColor(#PB_Gadget_BackColor, #Green)
                    btn\SetColor(#PB_Gadget_FrontColor, #Black)
                    btn\SetColor(#PB_Gadget_LineColor, #Red)
                    btn\Redraw()
                  Else
                    btn\Redraw(#False)
                    btn\Resize(#PB_Ignore, #PB_Ignore, 120, 30)
                    btn\SetText("My Button")
                    btn\SetFont(#PB_Default)
                    btn\SetColor(#PB_Gadget_BackColor, #Red)
                    btn\SetColor(#PB_Gadget_FrontColor, #Yellow)
                    btn\SetColor(#PB_Gadget_LineColor, #Gray)
                    btn\Redraw()
                  EndIf
                EndIf
            EndSelect
            
        EndSelect
      ForEver
      
      btn\Release()
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

mk-soft · **Posted:** Thu Dec 26, 2019 5:29 pm

TextBoxGadget Update v1.05.1

Code:

;-TOP
; Comment : Object TextBoxGadget No 42 ;)
; Author  : mk-soft
; Version : v1.05.1
; Create  : 26.12.2019
; Update  : 12.01.2020 (DPI)
; OS      : All

; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

; *****************************************************************************

;- Global

EnumerationBinary TextBox
  #TEXT_Right
  #TEXT_HCenter
  #TEXT_VCenter
  #TEXT_Bottom
EndEnumeration

;- Module Public

DeclareModule TextBoxGadget
  
  UseModule BaseClass
  
  EnumerationBinary TextBox
    #TEXT_Right
    #TEXT_HCenter
    #TEXT_VCenter
    #TEXT_Bottom
  EndEnumeration
  
  Interface iTextBoxGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    Redraw(State = #True)
    GetID()
    AddText(Index, Text.s)
    RemoveText(Index)
    ClearText()
    SetIndex(Index)
    GetIndex()
    SetText(Text.s)
    GetText.s()
    SetColor(ColorType, Color)
    GetColor(ColorType)
    SetFont(FontID)
    GetFont()
    SetFlags(Flags)
    GetFlags()
    SetUserData(UserData)
    GetUserData()
  EndInterface
  
  UnuseModule BaseClass
  
  Declare Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $DCDCDC, Flags = 0)
  
EndDeclareModule

;- Module Private

Module TextBoxGadget
  
  EnableExplicit
  
  UseModule BaseClass
  
  NewClass(iTextBoxGadget)
  
  Structure sTextBoxGadget Extends sBaseClass
    Gadget.i
    UserData.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Text.s
    FontID.i
    LineColor.i
    FrontColor.i
    BackColor.i
    Flags.i
    ; Data
    Redraw.i
    Event.i
    Index.i
    Map TextList.s()
  EndStructure
  
  ; ********************************
  
  ; Kommentar     : DrawTextBox
  ; Author        : mk-soft
  ; Second Author :
  ; Orginal       : DrawTextBox.pbi
  ; Version       : 1.05
  ; Erstellt      : 20.04.2014
  ; Geändert      : 29.09.2018
  
  Procedure DrawTextBox(x, y, dx, dy, text.s, flags = 0)
    
    Protected is_right, is_hcenter, is_vcenter, is_bottom
    Protected text_width, text_height, rows_height
    Protected text_x, text_y, break_y
    Protected text2.s, rows, row, row_text.s, row_text1.s, out_text.s, start, count
    
    ; Flags
    is_right = flags & #TEXT_Right
    is_hcenter = flags & #TEXT_HCenter
    is_vcenter = flags & #TEXT_VCenter
    is_bottom = flags & #TEXT_Bottom
    
    ; Übersetze Zeilenumbrüche
    text = ReplaceString(text, #LFCR$, #LF$)
    text = ReplaceString(text, #CRLF$, #LF$)
    text = ReplaceString(text, #CR$, #LF$)
    
    ; Erforderliche Zeilenumbrüche setzen
    rows = CountString(text, #LF$)
    For row = 1 To rows + 1
      text2 = StringField(text, row, #LF$)
      If text2 = ""
        out_text + #LF$
        Continue
      EndIf
      start = 1
      count = CountString(text2, " ") + 1
      Repeat
        row_text = StringField(text2, start, " ") + " "
        Repeat
          start + 1
          row_text1 = StringField(text2, start, " ")
          If TextWidth(row_text + row_text1) < dx - 12
            row_text + row_text1 + " "
          Else
            Break
          EndIf
        Until start > count
        out_text + RTrim(row_text) + #LF$
      Until start > count
    Next
    
    ; Berechne Y-Position
    text_height = TextHeight("X")
    rows = CountString(out_text, #LF$)
    If is_vcenter
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1)) - 2
      CompilerElse
        text_y = (dy / 2 - text_height / 2) - (text_height / 2 * (rows-1))
      CompilerEndIf
    ElseIf is_bottom
      text_y = dy - (text_height * rows) - 2
    Else
      text_y = 2
    EndIf
    
    ; Korrigiere Y-Position
    While text_y < 2
      text_y = 2;+ text_height
    Wend
    
    break_y = dy - text_height / 2
    
    ; Text ausgeben
    For row = 1 To rows
      row_text = StringField(out_text, row, #LF$)
      If is_hcenter
        text_x = dx / 2 - TextWidth(row_text) / 2
      ElseIf is_right
        text_x = dx - TextWidth(row_text) - 4
      Else
        text_x = 4
      EndIf
      DrawText(x + text_x, y + text_y, row_text)
      text_y + text_height
      If text_y > break_y
        Break
      EndIf
    Next
    
    ProcedureReturn rows
    
  EndProcedure
  
  ; ********
  
  Declare DrawGadget(*this)
  
  ;-- Public Object Function
  
  Procedure Resize(*this.sTextBoxGadget, 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.sTextBoxGadget, State)
    With *this
      \Redraw = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(Redraw)
  
  ; ----
  
  Procedure GetID(*this.sTextBoxGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
  
  ; ----
  
  Procedure SetText(*this.sTextBoxGadget, Text.s)
    With *this
      \Text = Text
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetText)
  
  Procedure.s GetText(*this.sTextBoxGadget)
    ProcedureReturn *this\Text
  EndProcedure : AsMethode(GetText)
  
  ; ----
  
  Procedure AddText(*this.sTextBoxGadget, Index, Text.s)
    With *this
      \TextList(Str(Index)) = Text
    EndWith
  EndProcedure : AsMethode(AddText)
  
  Procedure RemoveText(*this.sTextBoxGadget, Index)
    With *this
      DeleteMapElement(\TextList(), Str(Index))
    EndWith
  EndProcedure : AsMethode(RemoveText)
  
  Procedure ClearText(*this.sTextBoxGadget)
    With *this
      ClearMap(\TextList())
    EndWith
  EndProcedure : AsMethode(ClearText)
  
  ; ----
  
  Procedure SetIndex(*this.sTextBoxGadget, Index)
    With *this
      \Index = Index
      If FindMapElement(\TextList(), Str(index))
        \Text = \TextList()
      Else
        \Text = ""
      EndIf
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetIndex)
  
  Procedure GetIndex(*this.sTextBoxGadget)
    ProcedureReturn *this\Index
  EndProcedure : AsMethode(GetIndex)
  
  ; ----
  
  Procedure SetColor(*this.sTextBoxGadget, 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.sTextBoxGadget, 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 SetFont(*this.sTextBoxGadget, FontID)
    With *this
      If FontID
        \FontID = FontID
      Else
        \FontID = #PB_Default
      EndIf
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetFont)
  
  Procedure GetFont(*this.sTextBoxGadget)
    With *this
      ProcedureReturn \FontID
    EndWith
  EndProcedure : AsMethode(GetFont)
  
  ; ----
  
  Procedure SetFlags(*this.sTextBoxGadget, Flags)
    With *this
      \Flags = Flags
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetFlags)
  
  Procedure GetFlags(*this.sTextBoxGadget)
    With *this
      ProcedureReturn \Flags
    EndWith
  EndProcedure : AsMethode(GetFlags)
  
  ; ----
  
  Procedure SetUserData(*this.sTextBoxGadget, UserData)
    With *this
      \UserData = UserData
    EndWith
  EndProcedure : AsMethode(SetUserData)
  
  Procedure GetUserData(*this.sTextBoxGadget)
    With *this
      ProcedureReturn \UserData
    EndWith
  EndProcedure : AsMethode(GetUserData)
  
  ;-- Drawing and Events Functions
  
  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 DrawGadget(*this.sTextBoxGadget)
    Protected LineColor, FrontColor, BackColor
    Protected Width, Height
    With *this
      Select \Event
        Case #Null
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        Case #PB_EventType_LeftButtonDown
          LineColor  = \LineColor
          FrontColor = BlendColor(\FrontColor, $000000, 95)
          BackColor  = BlendColor(\BackColor, $000000, 95)
        Case #PB_EventType_LeftButtonUp
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
        Case #PB_EventType_Resize
          LineColor  = \LineColor
          FrontColor = \FrontColor
          BackColor  = \BackColor
      EndSelect
      
      Width = DesktopScaledX(\Width)
      Height = DesktopScaledY(\Height)
      If StartDrawing(CanvasOutput(\Gadget))
        Box(0, 0, Width, Height, LineColor)
        Box(1, 1, Width - 2, Height - 2, BackColor)
        DrawingFont(\FontID)
        FrontColor(FrontColor)
        BackColor(BackColor)
        DrawTextBox(1, 1, Width - 2, Height - 2, \Text, \Flags)
        StopDrawing()
      EndIf
    EndWith
    
  EndProcedure
  
  ; ----
  
  Procedure DoEvents()
    Protected *this.sTextBoxGadget = 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.sTextBoxGadget)
    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
        \FontID = #PB_Default
        \LineColor = #Gray
        DrawGadget(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
  
  ; ----
  
  Procedure Dispose(*this.sTextBoxGadget)
    With *this
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ----
  
  Procedure Create(Gadget, x, y, Width, Height, Text.s, FrontColor = $000000, BackColor = $DCDCDC, Flags = 0)
    Protected *object.sTextBoxGadget
    
    With *object
      AllocateObject(*object, sTextBoxGadget)
      If *object
        \Gadget     = Gadget
        \x          = x
        \y          = y
        \Width      = Width
        \Height     = Height
        \Text       = Text
        \FrontColor = FrontColor
        \BackColor  = BackColor
        \Flags      = Flags
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
  
  ; ----
  
  CheckInterface()
  
EndModule

; *****************************************************************************

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration Gadgets
    #Text1
    #Button1
    #Button2
    #Button3
    #Button4
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration
  
  LoadFont(0, "Courier New", 16, #PB_Font_Bold)
  LoadFont(1, "Courier New", 20, #PB_Font_Bold | #PB_Font_Italic)
  
  Procedure.s GetDataSectionText(Addr)
    Protected result.s, temp.s
    While PeekC(Addr)
      temp = PeekS(Addr)
      Addr + StringByteLength(temp)  + SizeOf(Character)
      result + temp
    Wend
    ProcedureReturn result
  EndProcedure
  
  Procedure Main()
    
    ; Define Object
    Protected.TextBoxGadget::iTextBoxGadget TextBox
    
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Object TextBoxGadget No 42 ;)", #PB_Window_SystemMenu)
      TextBox = TextBoxGadget::Create(#Text1, 10, 10, 460, 240, "My TextBoxGadget", #Black, #White, #TEXT_VCenter | #TEXT_HCenter)
      TextBox\AddText(10, "Index 10: " + #LF$ + "Flags Left/Top - Background Red")
      TextBox\AddText(20, "Index 20: " + #LF$ + "Flags Right - Background Yellow")
      TextBox\AddText(9990, "Index 9990: " + #LF$ + "Flags Right/Bottom - Background Green")
      ButtonGadget(#Button1, 10, 260, 100, 25, "Button 1")
      ButtonGadget(#Button2, 120, 260, 100, 25, "Button 2")
      ButtonGadget(#Button3, 230, 260, 100, 25, "Button 3")
      ButtonGadget(#Button4, 340, 260, 100, 25, "Button 4")
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Text1
                If EventType() = #PB_EventType_LeftClick
                EndIf
              Case #Button1
                TextBox\Redraw(#False)
                TextBox\SetIndex(10)
                TextBox\SetFlags(0)
                TextBox\SetColor(#PB_Gadget_BackColor, #Red)
                TextBox\SetFont(FontID(0))
                TextBox\Redraw()
              Case #Button2
                TextBox\Redraw(#False)
                TextBox\SetIndex(20)
                TextBox\SetFlags(#TEXT_Right)
                TextBox\SetColor(#PB_Gadget_BackColor, #Yellow)
                TextBox\SetFont(FontID(1))
                TextBox\Redraw()
              Case #Button3
                TextBox\Redraw(#False)
                TextBox\SetIndex(9990)
                TextBox\SetFlags(#TEXT_Right | #TEXT_Bottom)
                TextBox\SetColor(#PB_Gadget_BackColor, #Green)
                TextBox\SetFont(#PB_Default)
                TextBox\Redraw()
              Case #Button4
                TextBox\Redraw(#False)
                TextBox\SetText(GetDataSectionText(?Text2))
                TextBox\SetFlags(#TEXT_HCenter | #TEXT_VCenter)
                TextBox\SetColor(#PB_Gadget_BackColor, #White)
                TextBox\SetFont(#PB_Default)
                TextBox\Redraw()
              
            EndSelect
            
        EndSelect
      ForEver
      
      TextBox\Release()
      
    EndIf
    
  EndProcedure : Main()
  
  DataSection
    Text2:
    Data.s "PureBasic is a native 32-bit and 64-bit programming language based on established BASIC rules." 
    Data.s "The key features of PureBasic are portability (Windows, Linux And MacOS X are currently supported)," 
    Data.s "the production of very fast And highly optimized executables And, of course, the very simple BASIC syntax."
    Data.s "PureBasic has been created For the beginner And expert alike."
    Data.s "We have put a lot of effort into its realization To produce a fast, reliable system friendly language."
    Data.s "In spite of its beginner-friendly syntax, the possibilities are endless With PureBasic's advanced "
    Data.s "features such As pointers, structures, procedures, dynamically linked lists And much more."
    Data.s "Experienced coders will have no problem gaining access To any of the legal OS structures"
    Data.s "Or API objects And PureBasic even allows inline ASM."
    Data.i 0
  EndDataSection
  
CompilerEndIf

mk-soft · **Posted:** Thu Dec 26, 2019 5:29 pm

ClockGadget Update v1.04 (DPI)

Code:

;-TOP
; Comment : Object ClockGadget No 42 ;)
; Author  : mk-soft
; Version : v1.04
; Create  : 01.05.2019
; Update  : 12.01.2020 (DPI)
; OS      : All

; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

; *****************************************************************************

;- Global

Enumeration
  #ClockColor_Background
  #ClockColor_Border
  #ClockColor_Circle_Hour
  #ClockColor_Circle_Minute
  #ClockColor_Circle_Center
  #ClockColor_Hour
  #ClockColor_Minute
  #ClockColor_Second
EndEnumeration

;- Module Public

DeclareModule ClockGadget
  
  UseModule BaseClass
  
  Enumeration
    #ClockColor_Background
    #ClockColor_Border
    #ClockColor_Circle_Hour
    #ClockColor_Circle_Minute
    #ClockColor_Circle_Center
    #ClockColor_Hour
    #ClockColor_Minute
    #ClockColor_Second
  EndEnumeration
  
  Interface iClockGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    Redraw(State = #True)
    GetID()
    SetColor(ColorType, Color)
    GetColor(ColorType)
    SetOffset(Seconds)
    GetOffset()
    SetUserData(UserData)
    GetUserData()
  EndInterface
  
  UnuseModule BaseClass
  
  Declare Create(Gadget, x, y, Width, Height, Flags = 0)
  
EndDeclareModule

;- Module Private

Module ClockGadget
  
  EnableExplicit
  
  UseModule BaseClass
  
  NewClass(iClockGadget)
  
  Structure sClockGadget Extends sBaseClass
    Gadget.i
    UserData.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Flags.i
    ; Data
    TimeOffset.i
    BackColor.i
    BorderColor.i
    BorderSize.i
    Color_Circle_Hour.i
    Color_Circle_Minute.i
    Color_Circle_Center.i
    Color_Hour.i
    Color_Minute.i
    Color_Second.i
    ;
    Redraw.i
    Event.i
  EndStructure
  
  Global DoTimerWindow
  
  Declare DrawGadget(*this)
  
  ;-- Public Object Function
  
  Procedure Resize(*this.sClockGadget, 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.sClockGadget, State)
    With *this
      \Redraw = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(Redraw)
  
  ; ----
  
  Procedure GetID(*this.sClockGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
  
  ; ----
  
  Procedure SetColor(*this.sClockGadget, ColorType, Color)
    With *this
      Select ColorType
        Case #ClockColor_Background
          \BackColor = Color | $FF000000
        Case #ClockColor_Border
          \BorderColor = Color | $FF000000
        Case #ClockColor_Circle_Hour
          \Color_Circle_Hour = Color | $FF000000
        Case #ClockColor_Circle_Minute
          \Color_Circle_Minute = Color | $FF000000
        Case #ClockColor_Circle_Center
          \Color_Circle_Center = Color | $FF000000
        Case #ClockColor_Hour
          \Color_Hour = Color | $FF000000
        Case #ClockColor_Minute
          \Color_Minute = Color | $FF000000
        Case #ClockColor_Second
          \Color_Second = Color | $FF000000
      EndSelect
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetColor)
  
  Procedure GetColor(*this.sClockGadget, ColorType)
    Protected color
    With *this
      Select ColorType
        Case #ClockColor_Background
          ProcedureReturn \BackColor
        Case #ClockColor_Border
          ProcedureReturn \BorderColor
        Case #ClockColor_Circle_Hour
          ProcedureReturn \Color_Circle_Hour
        Case #ClockColor_Circle_Minute
          ProcedureReturn \Color_Circle_Minute
        Case #ClockColor_Circle_Center
          ProcedureReturn \Color_Circle_Center
        Case #ClockColor_Hour
          ProcedureReturn \Color_Hour
        Case #ClockColor_Minute
          ProcedureReturn \Color_Minute
        Case #ClockColor_Second
          ProcedureReturn \Color_Second
      EndSelect
      ProcedureReturn 0
    EndWith
  EndProcedure : AsMethode(GetColor)
  
  ; ----
  
  Procedure SetOffset(*this.sClockGadget, Seconds)
    With *this
      \TimeOffset = Seconds
    EndWith
  EndProcedure : AsMethode(SetOffset)
  
  Procedure GetOffset(*this.sClockGadget)
    With *this
      ProcedureReturn \TimeOffset
    EndWith
  EndProcedure : AsMethode(GetOffset)
  
  ; ----
  
  Procedure SetUserData(*this.sClockGadget, UserData)
    With *this
      \UserData = UserData
    EndWith
  EndProcedure : AsMethode(SetUserData)
  
  Procedure GetUserData(*this.sClockGadget)
    With *this
      ProcedureReturn \UserData
    EndWith
  EndProcedure : AsMethode(GetUserData)
  
  ;-- Drawing and Events Functions
  
  Procedure DrawGadget(*this.sClockGadget)
    Protected.d dx, dy, center_x, center_y, delta_y, y1, y2, angle, strokewidth
    Protected date, hours, minutes, seconds
    Protected i
    
    With *this
      
      StartVectorDrawing(CanvasVectorOutput(\Gadget))
      
      dx = DesktopScaledX(\Width)
      dy = DesktopScaledY(\Height)
      
      ; Hintergrund
      AddPathBox(0.0, 0.0, dx, dy)
      VectorSourceColor(\BackColor)
      FillPath()
      
      ; Rahmen
      AddPathBox(0.0, 0.0, dx, dy)
      VectorSourceColor(\BorderColor)
      StrokePath(\BorderSize)
      
      center_x = dx * 0.5
      center_y = dy * 0.5
      
      If dy > dx
        delta_y = dx * 0.5
      Else
        delta_y = dy * 0.5
      EndIf
      
      ; Teil 60
      angle = 6.0
      y1 = delta_y * 0.85 + center_y
      y2 = delta_y * 0.9 + center_y
      strokewidth = delta_y * 0.01 + 0.5
      ResetCoordinates()
      RotateCoordinates(center_x, center_y, 180.0)
      For i = 1 To 60
        MovePathCursor(center_x, y1)
        AddPathLine(center_x, y2)
        RotateCoordinates(center_x, center_y, angle)
      Next
      VectorSourceColor(\Color_Circle_Minute)
      StrokePath(strokewidth)
      
      ; Teil 12
      angle = 30.0
      y1 = delta_y * 0.82 + center_y
      y2 = delta_y * 0.9 + center_y
      strokewidth = delta_y * 0.025 + 0.5
      ResetCoordinates()
      RotateCoordinates(center_x, center_y, 180.0)
      For i = 1 To 12
        MovePathCursor(center_x, y1)
        AddPathLine(center_x, y2)
        RotateCoordinates(center_x, center_y, angle)
      Next
      VectorSourceColor(\Color_Circle_Hour)
      StrokePath(strokewidth)
      
      ; Zeit
      date = Date() + \TimeOffset
      hours = Hour(date)
      minutes = Minute(date)
      seconds = Second(date)
      
      If hours >= 12
        hours - 12
      EndIf
      
      ; Teil Stunde
      angle = 180.0 + hours * 30.0 + minutes * 6.0 / 12.0
      y1 = center_y - delta_y * 0.1
      y2 = center_y + delta_y * 0.6
      strokewidth = delta_y * 0.04 + 0.5
      ResetCoordinates()
      RotateCoordinates(center_x, center_y, angle)
      MovePathCursor(center_x, y1)
      AddPathLine(center_x, y2)
      VectorSourceColor(\Color_Hour)
      StrokePath(strokewidth)
      
      ; Teil Minute
      angle = 180.0 + minutes * 6.0 + seconds * 6.0 / 60.0
      y1 = center_y - delta_y * 0.15
      y2 = center_y + delta_y * 0.75
      strokewidth = delta_y * 0.025 + 0.5
      ResetCoordinates()
      RotateCoordinates(center_x, center_y, angle)
      MovePathCursor(center_x, y1)
      AddPathLine(center_x, y2)
      VectorSourceColor(\Color_Minute)
      StrokePath(strokewidth)
      
      ; Teil Sekunden
      angle = 180.0 + seconds * 6.0
      y1 = center_y - delta_y * 0.2
      y2 = center_y + delta_y * 0.80
      strokewidth = delta_y * 0.015 + 0.5
      ResetCoordinates()
      RotateCoordinates(center_x, center_y, angle)
      MovePathCursor(center_x, y1)
      AddPathLine(center_x, y2)
      VectorSourceColor(\Color_Second)
      StrokePath(strokewidth)
      
      ; Mitte
      ResetCoordinates()
      AddPathCircle(center_x, center_y, delta_y * 0.05 + 0.5)
      VectorSourceColor(\Color_Circle_Center)
      FillPath()
      
      StopVectorDrawing()
      
    EndWith
      
  EndProcedure
  
  ; ----
  
  Procedure DoEvents()
    Protected *this.sClockGadget = 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
          Case #PB_EventType_LeftButtonUp
          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
  
  Procedure DoTimerEvent()
    Protected *this.sClockGadget = EventTimer()
    
    With *this
      If *this
        If \Redraw
          DrawGadget(*this)
        EndIf
      EndIf
    EndWith
  EndProcedure
  
  ;-- Object Functions
  
  Procedure Initialize(*this.sClockGadget)
    Protected result
    
    If Not DoTimerWindow
      DoTimerWindow = OpenWindow(#PB_Any, 0, 0, 0, 0, "DoTimerEvents", #PB_Window_Invisible | #PB_Window_NoGadgets)
      BindEvent(#PB_Event_Timer, @DoTimerEvent(), DoTimerWindow)
    EndIf
    
    With *this
      result = CanvasGadget(\Gadget, \x, \y, \Width, \Height, \Flags)
      If result
        If \Gadget = #PB_Any
          \Gadget = result
        EndIf
        \Redraw = #True
        \Event = #Null
        \BackColor = $FFE0E0E0
        \BorderColor = $FF000000
        \BorderSize = 2
        \Color_Circle_Hour = $FFC00000
        \Color_Circle_Minute = $FF000000
        \Color_Circle_Center = $FF404040
        \Color_Hour = $FF000000
        \Color_Minute = $FF000000
        \Color_Second = $FF0000E0
        DrawGadget(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
        AddWindowTimer(DoTimerWindow, *this, 1000)
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
  
  ; ----
  
  Procedure Dispose(*this.sClockGadget)
    With *this
      RemoveWindowTimer(DoTimerWindow, *this)
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ----
  
  Procedure Create(Gadget, x, y, Width, Height, Flags = 0)
    Protected *object.sClockGadget
    
    With *object
      AllocateObject(*object, sClockGadget)
      If *object
        \Gadget     = Gadget
        \x          = x
        \y          = y
        \Width      = Width
        \Height     = Height
        \Flags      = Flags
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
  
  ; ----
  
  CheckInterface()
  
EndModule

; *****************************************************************************

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration Gadgets
    #Clock1
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration
  
  Procedure UpdateWindow()
    ResizeGadget(#Clock1, 10, 10, WindowWidth(#Main) - 20, WindowHeight(#Main) - 20)
  EndProcedure
  
  Procedure Main()
    ; Define button object
    Protected.ClockGadget::iClockGadget Clock
    Protected flags = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
      
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 400, 400, "Object ClockGadget No 42 ;)", flags)
      Clock = ClockGadget::Create(#Clock1, 10, 10, 380, 380)
      
      Clock\SetColor(#ClockColor_Background, $8B6800)
      Clock\SetColor(#ClockColor_Circle_Minute, $60A4F4)
      Clock\SetColor(#ClockColor_Minute, $2F3E8B)
      ;Clock\SetOffset(-3600)
      
      BindEvent(#PB_Event_SizeWindow, @UpdateWindow())
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Clock1
                If EventType() = #PB_EventType_LeftClick
                EndIf
            EndSelect
            
        EndSelect
      ForEver
      
      Clock\Release()
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

Kwai chang caine · **Posted:** Thu Dec 26, 2019 6:47 pm

Thanks for sharing like usually all your great work

The buttom code works perfectly

, but the TextGadget have a problem with the constant several time declared

mk-soft · **Posted:** Thu Dec 26, 2019 6:58 pm

Bugfix TextBoxGadget

Was conflict with window os constants

mk-soft · **Posted:** Thu Dec 26, 2019 8:45 pm

ClockGadget now ready :wink:

Update v1.03
- all gadgets

Mesa · **Joined:** Fri Feb 24, 2012 10:19 am **Posts:** 147

I've got this message "Error: Extends Class ' ' not exists!" for all the gadgets with windows XP32b and PB5.71 LTS x86.

M.

mk-soft · **Posted:** Fri Dec 27, 2019 12:50 pm

@Mesa,

Tested it under XP and it works for me.
Can it be that a PB-Tool runs with you?

Kwai chang caine · **Posted:** Fri Dec 27, 2019 12:54 pm

mk-soft wrote:

Bugfix TextBoxGadget
Was conflict with window os constants

Works perfectly now !!!
Thanks for fix the bug

Quote:

ClockGadget now ready

Waooouuuhhh !!!
Splendid clock !!! :shock:

Works merveillously here with W10 X64 / v5.70 x86
Furthermore.... without any flickering at the resize :shock:

I'm not enough intelligent for understand all your works and codes :oops:

But thanks a lot for this great sharing

mk-soft · **Posted:** Wed Jan 08, 2020 12:46 pm

NumberGadget Update v1.03.2
- Fix EventType ReturnKey

Code:

;-TOP
; Comment : Object NumberGadget No 42 ;)
; Author  : mk-soft
; Version : v1.03.2
; Create  : 08.01.2020 (DPI)
; Update  : 22.02.2020
; OS      : All

; Link BaseClass : https://www.purebasic.fr/english/viewtopic.php?f=12&t=64305

IncludeFile "Modul_BaseClassSmall.pb"

EnableExplicit

; *****************************************************************************

;- Global

CompilerIf #PB_Compiler_Version >= 572
  #PB_EventType_ReturnKey = $501 ; SDK Event.h
CompilerEndIf

Enumeration
EndEnumeration

;- Module Public

DeclareModule NumberGadget
  
  UseModule BaseClass
  
  Interface iNumberGadget Extends iBaseClass
    Resize(x, y, Width, Height)
    Redraw(State = #True)
    GetID()
    SetNumber(Number.s)
    GetNumber.s()
    SetFont(FontID)
    GetFont()
    SetColor(ColorType, Color)
    GetColor(ColorType)
    SetUserData(UserData)
    GetUserData()
  EndInterface
  
  UnuseModule BaseClass
  
  Declare Create(Gadget, x, y, Width, Height, Number.s, Point.s = ".", Sufix.s = "")
  
EndDeclareModule

;- Module Private

Module NumberGadget
  
  EnableExplicit
  
  UseModule BaseClass
  
  NewClass(iNumberGadget)
  
  CompilerIf #PB_Compiler_Version >= 572
    #PB_EventType_ReturnKey = $501 ; SDK Event.h
  CompilerEndIf

  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      #PB_Shortcut_Enter = 13
    CompilerCase #PB_OS_Linux
      #PB_Shortcut_Enter = 65421
    CompilerCase #PB_OS_MacOS
      #PB_Shortcut_Enter = 3
  CompilerEndSelect
  
  #CursorTimer = 500
  
  Structure sNumberGadget Extends sBaseClass
    Gadget.i
    UserData.i
    ; Params
    x.i
    y.i
    Width.i
    Height.i
    Number.s
    Point.s
    Sufix.s
    ; Data
    FrontColor.i
    BackColor.i
    LineColor.i
    FontID.i
    IsFocus.i
    IsEdit.i
    Edit.s
    CursorPos.i
    CursorHide.i
    ;
    Redraw.i
    Event.i
  EndStructure
  
  Global DoTimerWindow
  
  Declare DrawGadget(*this)
  
  ;-- Public Object Function
  
  Procedure Resize(*this.sNumberGadget, 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.sNumberGadget, State)
    With *this
      \Redraw = State
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(Redraw)
  
  ; ----
  
  Procedure GetID(*this.sNumberGadget)
    ProcedureReturn *this\Gadget
  EndProcedure : AsMethode(GetID)
  
  ; ----
  
  Procedure SetNumber(*this.sNumberGadget, Number.s)
    With *this
      \Number = Number
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetNumber)
  
  Procedure.s GetNumber(*this.sNumberGadget)
    With *this
      ProcedureReturn \Number
    EndWith
  EndProcedure : AsMethode(GetNumber)
  
  ; ----
  
  Procedure SetFont(*this.sNumberGadget, FontID)
    With *this
      If FontID
        \FontID = FontID
      Else
        \FontID = #PB_Default
      EndIf
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure : AsMethode(SetFont)
  
  Procedure GetFont(*this.sNumberGadget)
    With *this
      ProcedureReturn \FontID
    EndWith
  EndProcedure : AsMethode(GetFont)
  
  ; ----
  
  Procedure SetColor(*this.sNumberGadget, 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.sNumberGadget, ColorType)
    With *this
      Select ColorType
        Case #PB_Gadget_FrontColor
          ProcedureReturn \FrontColor
        Case #PB_Gadget_BackColor
          ProcedureReturn \BackColor
        Case #PB_Gadget_LineColor
          ProcedureReturn \LineColor
      EndSelect    
    EndWith
  EndProcedure : AsMethode(GetColor)
  
  ; ----
  
  Procedure SetUserData(*this.sNumberGadget, UserData)
    With *this
      \UserData = UserData
    EndWith
  EndProcedure : AsMethode(SetUserData)
  
  Procedure GetUserData(*this.sNumberGadget)
    With *this
      ProcedureReturn \UserData
    EndWith
  EndProcedure : AsMethode(GetUserData)
  
  ;-- Drawing and Events Functions
  
  Procedure DrawGadget(*this.sNumberGadget)
    Protected text.s, text_width.i, text_height, cursor_dx
    Protected Width, Height
    With *this
      If StartDrawing(CanvasOutput(\Gadget))
        
        Width = DesktopScaledX(\Width)
        Height = DesktopScaledY(\Height)
      
        If \FontID
          DrawingFont(\FontID)
        EndIf
        Box(0, 0, Width, Height, \BackColor)
        If \IsFocus
          Box(0, 0, Width, Height, \LineColor)
          Box(2, 2, Width - 4, Height- 4, \BackColor)
        Else
          Box(0, 0, Width, Height, #Gray)
          Box(1, 1, Width - 2, Height- 2, \BackColor)
        EndIf
        If \IsEdit
          text = \Edit
        Else
          text = \Number
        EndIf
        text + \Sufix
        DrawingMode(#PB_2DDrawing_Default)
        text_width = TextWidth(text)
        text_height = TextHeight("X")
        DrawText(Width - text_width - 4, Height / 2 - text_height / 2, text, \FrontColor, \BackColor)
        If \IsEdit And Not \CursorHide
          cursor_dx = Width - text_width + TextWidth(Left(text, \CursorPos))
          Line(cursor_dx - 4, Height / 2 - text_height / 2, 1, text_height, \FrontColor)
        EndIf
        StopDrawing()
      EndIf
    EndWith
  EndProcedure
  
  Procedure DoEvents()
    Protected *this.sNumberGadget = GetGadgetData(EventGadget())
    Protected key.i
    
    With *this
      If *this
        \Event = EventType()
        Select \Event
          Case #PB_EventType_Focus
            \IsFocus = #True
            DrawGadget(*this)
            
          Case #PB_EventType_LostFocus
            \IsFocus = #False
            If \IsEdit
              \IsEdit = #False
              \Number = \Edit
              RemoveWindowTimer(DoTimerWindow, *this)
              PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_Change)
            EndIf
            DrawGadget(*this)
            
          Case #PB_EventType_LeftDoubleClick
            If Not \IsEdit
              \IsEdit = #True
              \Edit = \Number
              \CursorPos = Len(\Edit)
              DrawGadget(*this)
              AddWindowTimer(DoTimerWindow, *this, #CursorTimer)
            EndIf
            
          Case #PB_EventType_Input
            key = GetGadgetAttribute(\Gadget, #PB_Canvas_Input)
            Select key
              Case '-' , '+'
                If Not \IsEdit
                  \IsEdit = #True
                  \Edit = Chr(key)
                  \CursorPos = Len(\Edit)
                  DrawGadget(*this)
                  AddWindowTimer(DoTimerWindow, *this, #CursorTimer)
                ElseIf \IsEdit And \CursorPos = 0
                  \Edit = Left(\Edit, \CursorPos) + Chr(key) + Mid(\Edit, \CursorPos + 1)
                  \CursorPos + 1
                  DrawGadget(*this)
                EndIf
                
              Case '0' To '9'
                If Not \IsEdit
                  \IsEdit = #True
                  \Edit = Chr(key)
                  \CursorPos = Len(\Edit)
                  DrawGadget(*this)
                  AddWindowTimer(DoTimerWindow, *this, #CursorTimer)
                Else
                  \Edit = Left(\Edit, \CursorPos) + Chr(key) + Mid(\Edit, \CursorPos + 1)
                  \CursorPos + 1
                  DrawGadget(*this)
                EndIf
                
              Case '.', ','
                If \IsEdit And Not FindString(\Edit, \Point)
                  \Edit = Left(\Edit, \CursorPos) + \Point + Mid(\Edit, \CursorPos + 1)
                  \CursorPos + 1
                  DrawGadget(*this)
                EndIf
                
            EndSelect
            
          Case #PB_EventType_KeyDown
            key = GetGadgetAttribute(\Gadget, #PB_Canvas_Key)
            Select key
              Case #PB_Shortcut_Left
                If Not \IsEdit
                  \IsEdit = #True
                  \Edit = \Number
                  \CursorPos = 0
                  DrawGadget(*this)
                  AddWindowTimer(DoTimerWindow, *this, #CursorTimer)
                ElseIf \IsEdit And \CursorPos > 0
                  \CursorPos - 1
                  DrawGadget(*this)
                EndIf
                
              Case #PB_Shortcut_Right
                If Not \IsEdit
                  \IsEdit = #True
                  \Edit = \Number
                  \CursorPos = Len(\Edit)
                  DrawGadget(*this)
                  AddWindowTimer(DoTimerWindow, *this, #CursorTimer)
                ElseIf \IsEdit And \CursorPos < Len(\Edit)
                  \CursorPos + 1
                  DrawGadget(*this)
                EndIf
                
              Case #PB_Shortcut_Back
                If Not \IsEdit
                  \IsEdit = #True
                  \Edit = \Number
                  \CursorPos = Len(\Edit)
                  DrawGadget(*this)
                  AddWindowTimer(DoTimerWindow, *this, #CursorTimer)
                EndIf
                If \IsEdit And \CursorPos > 0
                  \Edit = Left(\Edit, \CursorPos - 1) + Mid(\Edit, \CursorPos + 1)
                  \CursorPos - 1
                  DrawGadget(*this)
                EndIf
                
              Case #PB_Shortcut_Delete
                If \IsEdit And Len(\Edit) > 0
                  \Edit = Left(\Edit, \CursorPos) + Mid(\Edit, \CursorPos + 2)
                  DrawGadget(*this)
                EndIf
                
              Case #PB_Shortcut_Tab, #PB_Shortcut_Return, #PB_Shortcut_Enter
                If \IsEdit
                  \IsEdit = #False
                  \Number = \Edit
                  DrawGadget(*this)
                  RemoveWindowTimer(DoTimerWindow, *this)
                  PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_Change)
                EndIf
                PostEvent(#PB_Event_Gadget, GetActiveWindow(), \Gadget, #PB_EventType_ReturnKey)
                
                
              Case #PB_Shortcut_Escape
                If \IsEdit
                  \IsEdit = #False
                  DrawGadget(*this)
                  RemoveWindowTimer(DoTimerWindow, *this)
                EndIf
                
            EndSelect
            
          Case #PB_EventType_Resize
            \x = GadgetX(\Gadget)
            \y = GadgetY(\Gadget)
            \Width = GadgetWidth(\Gadget)
            \Height = GadgetHeight(\Gadget)
            DrawGadget(*this)
          
        EndSelect
        
      EndIf
    EndWith
  EndProcedure
  
  Procedure DoTimerEvent()
    Protected *this.sNumberGadget = EventTimer()
    With *this
      \CursorHide = ~\CursorHide
      If \Redraw
        DrawGadget(*this)
      EndIf
    EndWith
  EndProcedure
  
  ;-- Object Functions
  
  Procedure Initialize(*this.sNumberGadget)
    Protected result
    
    If Not DoTimerWindow
      DoTimerWindow = OpenWindow(#PB_Any, 0, 0, 0, 0, "DoTimerEvents", #PB_Window_Invisible | #PB_Window_NoGadgets)
      BindEvent(#PB_Event_Timer, @DoTimerEvent(), DoTimerWindow)
    EndIf
    
    With *this
      result = CanvasGadget(\Gadget, \x, \y, \Width, \Height, #PB_Canvas_Keyboard)
      If result
        If \Gadget = #PB_Any
          \Gadget = result
        EndIf
        \Redraw = #True
        \Event = #Null
        \FrontColor = #Blue
        \BackColor = #White
        \LineColor = #Blue
        \FontID = 0
        \IsFocus = #False
        \IsEdit = #False
        DrawGadget(*this)
        SetGadgetData(\Gadget, *this)
        BindGadgetEvent(\Gadget, @DoEvents())
      EndIf
    EndWith
  EndProcedure : AsInitializeObject(Initialize)
  
  ; ----
  
  Procedure Dispose(*this.sNumberGadget)
    With *this
      If IsGadget(\Gadget)
        FreeGadget(\Gadget)
      EndIf
    EndWith
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ----
  
  Procedure Create(Gadget, x, y, Width, Height, Number.s, Point.s = ".", Sufix.s = "")
    Protected *object.sNumberGadget
    
    With *object
      AllocateObject(*object, sNumberGadget)
      If *object
        \Gadget     = Gadget
        \x          = x
        \y          = y
        \Width      = Width
        \Height     = Height
        \Number     = Number
        \Point      = Point
        \Sufix      = Sufix
      EndIf
      InitializeObject(*object)
      ProcedureReturn *object
    EndWith
  EndProcedure
  
  ; ----
  
  CheckInterface()
  
EndModule

; ****

CompilerIf #PB_Compiler_IsMainFile
  
  LoadFont(0, "Courier New", 14, #PB_Font_Italic)
  
  Procedure Main()
    
    Protected.NumberGadget::iNumberGadget *NumGadget0, *NumGadget1, *NumGadget2
    
    If OpenWindow(0, 100, 100, 300, 200, "Object NumberGadget No 42 ;)", #PB_Window_SystemMenu)
      *NumGadget0 = NumberGadget::Create(0, 10, 10, 280, 30, "", ",", " €")
      *NumGadget0\SetNumber("10,5")
      *NumGadget0\SetColor(#PB_Gadget_LineColor, #Red)
      *NumGadget0\SetFont(FontID(0))
      
      
      *NumGadget1 = NumberGadget::Create(1, 10, 50, 280, 30, "", ".", " kg")
      *NumGadget1\SetNumber("0.3")
      *NumGadget1\SetColor(#PB_Gadget_BackColor, #Green)
      
      *NumGadget2 = NumberGadget::Create(2, 10, 90, 280, 30, "", "", " km/h")
      *NumGadget2\SetNumber("120")
      *NumGadget2\SetColor(#PB_Gadget_FrontColor, #Red)
      *NumGadget2\SetColor(#PB_Gadget_BackColor, #Yellow)
      
      StringGadget(3, 10, 130, 280, 30, "Hello")
      
      SetActiveGadget(0)
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case 0
                If EventType() = #PB_EventType_Change
                  Debug "NumGadget 0 = " + *NumGadget0\GetNumber()
                EndIf
                If EventType() = #PB_EventType_ReturnKey
                  SetActiveGadget(1)
                EndIf
              Case 1
                If EventType() = #PB_EventType_Change
                  Debug "NumGadget 1 = " + *NumGadget1\GetNumber()
                EndIf
                If EventType() = #PB_EventType_ReturnKey
                  SetActiveGadget(2)
                EndIf
                
              Case 2
                If EventType() = #PB_EventType_Change
                  Debug "NumGadget 2 = " + *NumGadget2\GetNumber()
                EndIf
                If EventType() = #PB_EventType_ReturnKey
                  SetActiveGadget(0)
                EndIf
              
            EndSelect
            
        EndSelect
      ForEver
      
      *NumGadget0\Release()
      *NumGadget1\Release()
      *NumGadget2\Release()
      
    EndIf
    
    
  EndProcedure : Main()
  
CompilerEndIf

mk-soft · **Posted:** Wed Jan 08, 2020 12:47 pm

Update TextBoxGadget v1.04
- Fix Color

and new NumberGadget No 42

Mesa · **Joined:** Fri Feb 24, 2012 10:19 am **Posts:** 147

Quote:

@Mesa,

Tested it under XP and it works for me.
Can it be that a PB-Tool runs with you?

No, no pb tool runs and a did a new install of pb so with no user things like user librairies, etc.

And i've got the same error message "Error: Extends Class ' ' not exists!" for all the gadgets with windows XP32b and PB5.71 LTS x86.

An idea ?

M.

Mesa · **Joined:** Fri Feb 24, 2012 10:19 am **Posts:** 147

I found the problem, it was a problem with the macro dq.

M.

mk-soft · **Posted:** Thu Jan 09, 2020 5:17 pm

Mesa wrote:

I found the problem, it was a problem with the macro dq.

M.

What was the problem ?

PureBasic Forum

Own Flat Gadgets as Object

Who is online