Module OwnGadgetBase

[mk-soft]

Habe mal mein Modul OwnGadgetBase so weit optimiert das man verschiedene Module mit eigene Gadgets schreiben kann.

In der Basis gibt es zwei Module.
1. OwnGadgetFunctions als Public-Modul zum Lesen und schreiben der Properties von den eigenen Gadgets.
2. OwnGadgetCommon als Private-Modul als Basic innerhalb der eigenen Gadgets.

Folgende Prozeduren werden den eigenen Gadget zugewiesen.
- ProgEventGadget zur Verarbeitung der Events (BindGadgetEvent)
- ProgEventTimer zur Verarbeitung von Trigger (Bei bedarf. Add- and RemoveGadgetTimer)
- ProgReDraw zum zeichnen des Gadgets
- ProgProcess zum lesen oder schreiben von Properties
- ProgRelease zur Verarbeitung vor dem freigeben des Gadgets (Bei bedarf)

Jedes Gadget besteht aus einer Basis-Struktur GadgetObject. Diese kann man aber mit eignen Daten erweitern. Siehe Beispiel TextBoxGadget.

Kann man bestimmt noch optimieren. Vielleicht mal ein paar Anregungen schreiben

Update v1.09
- GadgetList auf Maps umgestellt
- Im Property kann der VarType zugewiesen werden
- Macros zum Common hinzufügt
. * _PropertyX : Legt den VarType vom Property fest
. * PropertyX : Zum vereinfachten lesen

Update v1.11
- Hinzugefügt: Set- GetAllProperty(...) als String

Update v1.12
- NewProperty zu AddProperty umbenannt

OwnGadgetBase.pb

Code: Alles auswählen

;-TOP

; Comment: Modul OwnGadgetBase
; Author : mk-soft
; Version: v1.13
; Created: 02.09.2016
; Updated: 06.10.2018
; Link   :

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

;- Declare Module Private Common

DeclareModule OwnGadgetsCommon
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Common Enumerations
  
  Enumeration ProcessState
    #Nothing
    #SetProperty
    #GetProperty
    #SetAllProperty
    #GetAllProperty
    #AddProperty
    #RemoveProperty
  EndEnumeration
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Common Prototypes
  
  Prototype ProtoEventGadget()
  Prototype ProtoEventTimer(*GadgetObject)
  Prototype ProtoReDraw(*GadgetObject, State)
  Prototype ProtoProcess(*GadgetObject, State, PropertyName.s, Type, *Value, Index)
  Prototype ProtoRelease(*GadgetObject)
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Common Structures
  
  Structure udtValue
    StructureUnion
      iVal.i
      fltVal.f
      dblVal.d
    EndStructureUnion
    sVal.s
  EndStructure
  
  Structure udtProperty
    Type.w
    Res.w
    StructureUnion
      iVal.i
      fltVal.f
      dblVal.d
    EndStructureUnion
    sVal.s
  EndStructure
  
  Structure udtGadgetObject
    *EventGadget.ProtoEventGadget
    *EventTimer.ProtoEventTimer
    *ReDraw.ProtoReDraw
    *Process.ProtoProcess
    *Release.ProtoRelease
    Window.i
    Gadget.i
    Type.i
    Time.i
    Map Property.udtProperty()
  EndStructure
  
  Global NewMap *GadgetList.udtGadgetObject()
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Common Object Functions
  Declare NewGadgetObject(Gadget, *GadgetObject)
  Declare GetGadgetObject(Gadget)
  
  ;-- Common Timer Functions
  Declare AddGadgetTimer(*GadgetObject, Timeout)
  Declare RemoveGadgetTimer(*GadgetObject)
  
  ;-- Common Help Macros / SetProperty with Type
  
  Macro _PropertyI(Name, Object=*GadgetObject)
    Object\Property(Name)\Type = #PB_Integer : Object\Property()\iVal
  EndMacro
  
  Macro _PropertyS(Name, Object=*GadgetObject)
    Object\Property(Name)\Type = #PB_String : Object\Property()\sVal
  EndMacro
  
  Macro _PropertyF(Name, Object=*GadgetObject)
    Object\Property(Name)\Type = #PB_Float : Object\Property()\fltVal
  EndMacro
  
  Macro _PropertyD(Name, Object=*GadgetObject)
    Object\Property(Name)\Type = #PB_Double : Object\Property()\dlbBal
  EndMacro
  
  ;-- Common Help Macros / GetProperty
  
  Macro PropertyI(Name, Object=*GadgetObject)
    Object\Property(Name)\iVal
  EndMacro
  
  Macro PropertyS(Name, Object=*GadgetObject)
    Object\Property(Name)\sVal
  EndMacro
  
  Macro PropertyF(Name, Object=*GadgetObject)
    Object\Property(Name)\fltVal
  EndMacro
  
  Macro PropertyD(Name, Object=*GadgetObject)
    Object\Property(Name)\dlbBal
  EndMacro
  
  ; -----------------------------------------------------------------------------------
  
EndDeclareModule

;- Module Private Common

Module OwnGadgetsCommon
  
  Global DoEventWindow = OpenWindow(#PB_Any, 0, 0, 0, 0, "DoGadgetEvents", #PB_Window_Invisible | #PB_Window_NoGadgets)
  
  ; -----------------------------------------------------------------------------------
  
  Procedure NewGadgetObject(Gadget, *GadgetObject)
    If FindMapElement(*GadgetList(), Hex(Gadget))
      If *GadgetList()\EventGadget
        UnbindGadgetEvent(*GadgetList()\Gadget, *GadgetList()\EventGadget)
      EndIf
      If *GadgetList()\Time
        RemoveGadgetTimer(*GadgetList())
      EndIf
      If *GadgetList()\Release
        *GadgetList()\Release(*GadgetList())
      EndIf
      If IsGadget(*GadgetList()\Gadget)
        FreeGadget(*GadgetList()\Gadget)
      EndIf
      FreeStructure(*GadgetList())
      DeleteMapElement(*GadgetList())
    EndIf
    AddMapElement(*GadgetList(), Hex(Gadget))
    *GadgetList() = *GadgetObject
    *GadgetList()\Window = UseGadgetList(0)
    *GadgetList()\Gadget = Gadget
    *GadgetList()\Type = GadgetType(Gadget)
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure GetGadgetObject(Gadget)
    If FindMapElement(*GadgetList(), Hex(Gadget))
      ProcedureReturn *GadgetList()
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure AddGadgetTimer(*GadgetObject.udtGadgetObject, Timeout)
    If Timeout
      AddWindowTimer(DoEventWindow, *GadgetObject, Timeout)
      *GadgetObject\Time = Timeout
    Else
      If *GadgetObject\Time
        RemoveWindowTimer(DoEventWindow, *GadgetObject)
        *GadgetObject\Time = 0
      EndIf
    EndIf
  EndProcedure
  
  ; ---
  
  Procedure RemoveGadgetTimer(*GadgetObject.udtGadgetObject)
    If *GadgetObject\Time
      RemoveWindowTimer(DoEventWindow, *GadgetObject)
      *GadgetObject\Time = 0
    EndIf
  EndProcedure
  
  ; ---
  
  Procedure EventGadgetTimerCB()
    Protected *GadgetObject.udtGadgetObject = EventTimer()
    If *GadgetObject\EventTimer
      *GadgetObject\EventTimer(*GadgetObject)
    EndIf
  EndProcedure
  
  BindEvent(#PB_Event_Timer, @EventGadgetTimerCB(), DoEventWindow)
  
  ; -------------------------------------------------------------------------------------
  
EndModule

;- End Module Private Common

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

;- Declare Module Public Functions

DeclareModule OwnGadgetFunctions
  
  ;-- Public Global Functions
  Declare DestroyWindow(Window)
  Declare DestroyGadget(Gadget, WindowID = 0)
  
  ;-- Public Property Functions
  Declare   SetProperty(Gadget, PropertyName.s, Value.i, Index.i = 0)
  Declare.i GetProperty(Gadget, PropertyName.s, Index.i = 0)
  Declare   SetPropertyString(Gadget, PropertyName.s, Text.s, Index.i = 0)
  Declare.s GetPropertyString(Gadget, PropertyName.s, Index.i = 0)
  Declare   SetPropertyFloat(Gadget, PropertyName.s, Value.f, Index.i = 0)
  Declare.f GetPropertyFloat(Gadget, PropertyName.s, Index.i = 0)
  Declare   SetPropertyDouble(Gadget, PropertyName.s, Value.d, Index.i = 0)
  Declare.d GetPropertyDouble(Gadget, PropertyName.s, Index.i = 0)
  
  Declare   SetAllProperty(Gadget, Text.s, Flags = 0)
  Declare.s GetAllProperty(Gadget, Flags = 0)
  
  Declare   AddProperty(Gadget, PropertyName.s, Value.i, Index.i = 0)
  Declare   AddPropertyString(Gadget, PropertyName.s, Text.s, Index.i = 0)
  Declare   AddPropertyFloat(Gadget, PropertyName.s, Value.f, Index.i = 0)
  Declare   AddPropertyDouble(Gadget, PropertyName.s, Value.d, Index.i = 0)
  
  Declare.i RemoveProperty(Gadget, PropertyName.s, Index.i = 0)
  
EndDeclareModule

;- Module Public Functions

Module OwnGadgetFunctions
  
  UseModule OwnGadgetsCommon
  
  EnableExplicit
  
  ; -----------------------------------------------------------------------------------
  
  ; Bugfix for PB-Version v5.42
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS And #PB_Compiler_Version <= 542
    Procedure MyUseGadgetList(ID)
      Protected WinID
      WinID = UseGadgetList(ID) : UseGadgetList(WinID)
      ProcedureReturn WinID
    EndProcedure
    
    Macro UseGadgetList(ID)
      MyUseGadgetList(ID)
    EndMacro
  CompilerEndIf
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Public Global Functions
  
  Procedure DestroyWindow(Window)
    Protected *GadgetObject.udtGadgetObject, WindowID
    
    If IsWindow(Window)
      WindowID = WindowID(Window)
      ForEach *GadgetList()
        If *GadgetList()\Window = WindowID
          If *GadgetList()\EventGadget
            UnbindGadgetEvent(*GadgetList()\Gadget, *GadgetList()\EventGadget)
          EndIf
          If *GadgetList()\Time
            RemoveGadgetTimer(*GadgetList())
          EndIf
          If *GadgetList()\Release
            *GadgetList()\Release(*GadgetList())
          EndIf
          If IsGadget(*GadgetList()\Gadget)
            FreeGadget(*GadgetList()\Gadget)
          EndIf
          FreeStructure(*GadgetList())
          DeleteMapElement(*GadgetList())
        EndIf
      Next
      CloseWindow(Window)
    EndIf
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure DestroyGadget(Gadget, WindowID = 0)
    Protected *GadgetObject.udtGadgetObject
    
    If Gadget = #PB_All
      ForEach *GadgetList()
        If WindowID = 0 Or *GadgetList()\Window = WindowID
          If *GadgetList()\EventGadget
            UnbindGadgetEvent(*GadgetList()\Gadget, *GadgetList()\EventGadget)
          EndIf
          If *GadgetList()\Time
            RemoveGadgetTimer(*GadgetList())
          EndIf
          If *GadgetList()\Release
            *GadgetList()\Release(*GadgetList())
          EndIf
          If IsGadget(*GadgetList()\Gadget)
            FreeGadget(*GadgetList()\Gadget)
          EndIf
          FreeStructure(*GadgetList())
          DeleteMapElement(*GadgetList())
        EndIf
      Next
      If WindowID = 0
        FreeGadget(#PB_All)
      EndIf
    Else
      If FindMapElement(*GadgetList(), Hex(Gadget))
        If *GadgetList()\EventGadget
          UnbindGadgetEvent(*GadgetList()\Gadget, *GadgetList()\EventGadget)
        EndIf
        If *GadgetList()\Time
          RemoveGadgetTimer(*GadgetList())
        EndIf
        If *GadgetList()\Release
          *GadgetList()\Release(*GadgetList())
        EndIf
        FreeStructure(*GadgetList())
        DeleteMapElement(*GadgetList())
      EndIf
      If IsGadget(Gadget)
        FreeGadget(Gadget)
      EndIf
    EndIf
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  ;-- Public Property Functions
  
  Procedure SetProperty(Gadget, PropertyName.s, Value.i, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #SetProperty, property, #PB_Integer, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.i GetProperty(Gadget, PropertyName.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, value.udtValue
    Protected result.i
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            \Process(*GadgetObject, #GetProperty, property, #PB_Integer, @Value, Index)
            result = value\iVal
          EndIf
        EndWith
      EndIf
    EndIf
    
    ProcedureReturn result
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SetPropertyString(Gadget, PropertyName.s, Text.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result, Value.udtValue
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            Value\sVal = Text
            result = \Process(*GadgetObject, #SetProperty, property, #PB_String, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s GetPropertyString(Gadget, PropertyName.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, value.udtValue
    Protected result.s
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            \Process(*GadgetObject, #GetProperty, property, #PB_String, @Value, Index)
            result = value\sVal
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SetPropertyFloat(Gadget, PropertyName.s, Value.f, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #SetProperty, property, #PB_Float, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.f GetPropertyFloat(Gadget, PropertyName.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, value.udtValue
    Protected result.f
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            \Process(*GadgetObject, #GetProperty, property, #PB_Float, @Value, Index)
            result = value\fltVal
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SetPropertyDouble(Gadget, PropertyName.s, Value.d, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #SetProperty, property, #PB_Double, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.d GetPropertyDouble(Gadget, PropertyName.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, value.udtValue
    Protected result.d
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            \Process(*GadgetObject, #GetProperty, property, #PB_Double, @Value, Index)
            result = value\dblVal
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure SetAllProperty(Gadget, Text.s, Flags = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result, Value.udtValue
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          If \Process
            Value\sVal = Text
            result = \Process(*GadgetObject, #SetAllProperty, property, Flags, @Value, 0)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s GetAllProperty(Gadget, Flags = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, value.udtValue
    Protected result.s
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          If \Process
            \Process(*GadgetObject, #GetAllProperty, property, Flags, @Value, 0)
            result = value\sVal
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure AddProperty(Gadget, PropertyName.s, Value.i, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #AddProperty, property, #PB_Integer, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure AddPropertyString(Gadget, PropertyName.s, Text.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #AddProperty, property, #PB_String, @Text, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure AddPropertyFloat(Gadget, PropertyName.s, Value.f, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #AddProperty, property, #PB_Float, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure AddPropertyDouble(Gadget, PropertyName.s, Value.d, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s, result
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #AddProperty, property, #PB_Double, @Value, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.i RemoveProperty(Gadget, PropertyName.s, Index.i = 0)
    Protected *GadgetObject.udtGadgetObject, property.s
    Protected result.i
    
    If IsGadget(Gadget)
      *GadgetObject = GetGadgetObject(Gadget)
      If *GadgetObject
        With *GadgetObject
          property = LCase(PropertyName)
          If \Process
            result = \Process(*GadgetObject, #RemoveProperty, property, #Null, #Null, Index)
          EndIf
        EndWith
      EndIf
    EndIf
    
    ProcedureReturn result
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
EndModule

;- End Module Public Funtions

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

[/size]

[mk-soft]

OwnGadgets.pb

Code: Alles auswählen

;-TOP

; Comment: Modul OwnGadgets
; - ButtonColorGadget, TextBoxGadget, ImageBoxGadget, ClockGadget
;
; Author : mk-soft
; Version: v1.15
; Created: 02.09.2016
; Updated: 07.10.2018
; Link   :
;

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

XIncludeFile "OwnGadgetBase.pb"

DeclareModule OwnGadgets
  
  EnumerationBinary TextBox
    #TEXT_Right
    #TEXT_HCenter
    #TEXT_VCenter
    #TEXT_Bottom
  EndEnumeration
  
  Declare ButtonColorGadget(Gadget, x, y, Width, Height, Text.s)
  Declare TextBoxGadget(Gadget, x, y, Width, Height, Text.s, Flags = 0)
  Declare ImageBoxGadget(Gadget, x, y, Width, Height, Image, Flags = 0)
  Declare ClockGadget(Gadget, x, y, Width, Height)
  
EndDeclareModule

;- Module Own Gadgets

Module OwnGadgets
  
  UseModule OwnGadgetsCommon
  
  EnableExplicit
  
  ; -------------------------------------------------------------------------------------
  
  ; Bugfix for PB-Version v5.42
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS And #PB_Compiler_Version <= 542
    Procedure MyUseGadgetList(ID)
      Protected WinID
      WinID = UseGadgetList(ID) : UseGadgetList(WinID)
      ProcedureReturn WinID
    EndProcedure
    
    Macro UseGadgetList(ID)
      MyUseGadgetList(ID)
    EndMacro
  CompilerEndIf
  
  ; -----------------------------------------------------------------------------------
  
  ; 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
  
  ; -------------------------------------------------------------------------------------
  
  ;--- ButtonColorGadget
  
  Structure udtColorButtonObject Extends udtGadgetObject
    flash.i
    hm_flash.i
  EndStructure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventHandlerColorButton()
    Protected state, redraw, *GadgetObject.udtColorButtonObject
    state = EventType()
    Select state
      Case #PB_EventType_LeftButtonDown
        redraw = #True
      Case #PB_EventType_LeftButtonUp
        redraw = #True
      Case #PB_EventType_MouseEnter
        redraw = #True
      Case #PB_EventType_MouseLeave
        redraw = #True
      Case #PB_EventType_Resize
        redraw = #True
    EndSelect
    If redraw
      *GadgetObject = GetGadgetObject(EventGadget())
      *GadgetObject\ReDraw(*GadgetObject, state)
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventTimerColorButton(*GadgetObject.udtColorButtonObject)
    *GadgetObject\hm_flash = ~*GadgetObject\hm_flash
    *GadgetObject\ReDraw(*GadgetObject, 0)
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReDrawColorButton(*GadgetObject.udtColorButtonObject, State)
    Protected dx, dy, text.s, flags, fontid, bordercolor, bordersize, textcolor, backcolor
    
    With *GadgetObject
      If StartDrawing(CanvasOutput(\Gadget))
        dx = GadgetWidth(\Gadget)
        dy = GadgetHeight(\Gadget)
        text = PropertyS("text")
        flags = PropertyI("flags")
        fontid = PropertyI("fontid")
        bordercolor = PropertyI("bordercolor")
        bordersize = PropertyI("bordersize")
        If \flash
          If \hm_flash
            textcolor = PropertyI("flashfrontcolor")
            backcolor = PropertyI("flashbackcolor")
          Else
            textcolor = PropertyI("flashbackcolor")
            backcolor = PropertyI("flashfrontcolor")
          EndIf
        Else
          textcolor = PropertyI("textcolor")
          If State = #PB_EventType_LeftButtonUp Or State = #PB_EventType_MouseEnter
            backcolor = PropertyI("backcolormouseover")
          Else
            backcolor = PropertyI("backcolor")
          EndIf
        EndIf
        If fontid
          DrawingFont(fontid)
        EndIf
        Box(0, 0, dx, dy, borderColor)
        Box(borderSize, borderSize, dx - borderSize * 2, dy - borderSize * 2, backColor)
        DrawingMode(#PB_2DDrawing_Transparent)
        FrontColor(textcolor)
        DrawTextBox(0, 0, dx, dy, text, flags)
        StopDrawing()
      EndIf
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ProcessColorButton(*GadgetObject.udtColorButtonObject, State, PropertyName.s, Type, *Value.udtValue, Index)
    
    With *GadgetObject
      Select state
        Case #SetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  \Property()\iVal = *Value\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  \Property()\sVal = *Value\sVal
                EndIf
            EndSelect
            Select PropertyName
              Case "flash"
                If *Value\iVal And Not \flash
                  \flash = #True
                  \hm_flash = #False
                  AddGadgetTimer(*GadgetObject, \Property("flashtime")\iVal)
                Else
                  \flash = #False
                  RemoveGadgetTimer(*GadgetObject)
                EndIf
              Case "flashtime"
                If \flash
                  AddGadgetTimer(*GadgetObject, \Property("flashtime")\iVal)
                EndIf
            EndSelect
            If \Property("redraw")\iVal
              \ReDraw(*GadgetObject, 0)
            EndIf
          Else
            DebuggerWarning("Warning: ButtonColorGadget property not exists: " + PropertyName)
          EndIf
          
        Case #GetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  *Value\iVal = \Property()\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  *Value\sVal = \Property()\sVal
                EndIf
            EndSelect
          Else
            DebuggerWarning("Warning: BottonColorGadget property not exists: " + PropertyName)
          EndIf
      EndSelect
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReleaseColorButton(*GadgetObject.udtColorButtonObject)
    ; Debug "Release ColorButtonGadget " + *GadgetObject\Gadget
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ButtonColorGadget(Gadget, x, y, Width, Height, Text.s)
    Protected result, id, *GadgetObject.udtColorButtonObject
    
    result = CanvasGadget(Gadget, x, y, Width, Height)
    If result
      If Gadget = #PB_Any
        id = result
      Else
        id = Gadget
      EndIf
      *GadgetObject = AllocateStructure(udtColorButtonObject)
      NewGadgetObject(id, *GadgetObject)
      With *GadgetObject
        \EventGadget = @EventHandlerColorButton()
        \EventTimer = @EventTimerColorButton()
        \ReDraw =@ReDrawColorButton()
        \Process = @ProcessColorButton()
        \Release = @ReleaseColorButton()
        _PropertyI("redraw") = #True
        _PropertyS("text") = Text
        _PropertyI("flags") = #TEXT_HCenter | #TEXT_VCenter
        _PropertyI("fontid") = 0
        _PropertyI("textcolor") = $000000
        _PropertyI("backcolor") = $F0F0F0
        _PropertyI("backcolormouseover") = $E0E0E0
        _PropertyI("bordercolor") = $A0A0A0
        _PropertyI("bordersize") = 1
        _PropertyI("flash") = #False
        _PropertyI("flashtime") = 800
        _PropertyI("flashfrontcolor") = $00FFFF
        _PropertyI("flashbackcolor") = $000000
        \ReDraw(*GadgetObject, #Null)
        BindGadgetEvent(\Gadget, \EventGadget)
      EndWith
      
    EndIf
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  ;--- TextBoxGadget
  
  Structure udtTextBoxObject Extends udtGadgetObject
    Array TextList.s(3)
    flash.i
    hm_flash.i
  EndStructure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventHandlerTextBox()
    Protected state, redraw, *GadgetObject.udtTextBoxObject
    state = EventType()
    Select state
      Case #PB_EventType_Resize
        redraw = #True
    EndSelect
    If redraw
      *GadgetObject = GetGadgetObject(EventGadget())
      *GadgetObject\ReDraw(*GadgetObject, state)
    EndIf
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventTimerTextBox(*GadgetObject.udtTextBoxObject)
    *GadgetObject\hm_flash = ~*GadgetObject\hm_flash
    *GadgetObject\ReDraw(*GadgetObject, 0)
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReDrawTextBox(*GadgetObject.udtTextBoxObject, State)
    
    Protected x, y, dx, dy, index, text.s, flags
    Protected fontid, bordercolor, textcolor, backcolor , flash
    
    
    With *GadgetObject
      If StartDrawing(CanvasOutput(\Gadget))
        x = 0
        y = 0
        dx = GadgetWidth(\Gadget)
        dy = GadgetHeight(\Gadget)
        index = PropertyI("index")
        If index >= 0 And index <= ArraySize(\TextList())
          text = \TextList(index)
        Else
          text = "***"
        EndIf
        flags = PropertyI("flags")
        fontid = PropertyI("fontid")
        bordercolor = PropertyI("bordercolor")
        If \flash
          If \hm_flash
            textcolor = PropertyI("flashfrontcolor")
            backcolor = PropertyI("flashbackcolor")
          Else
            textcolor = PropertyI("flashbackcolor")
            backcolor = PropertyI("flashfrontcolor")
          EndIf
        Else
          textcolor = PropertyI("textcolor")
          backcolor = PropertyI("backcolor")
        EndIf
        If fontid
          DrawingFont(fontid)
        EndIf
        Box(x, y, dx, dy, backcolor)
        DrawingMode(#PB_2DDrawing_Outlined)
        Box(x, y, dx, dy, bordercolor)
        DrawingMode(#PB_2DDrawing_Transparent)
        FrontColor(textcolor)
        DrawTextBox(x, y, dx, dy, text, flags)
        StopDrawing()
      EndIf
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ProcessTextBox(*GadgetObject.udtTextBoxObject, State, PropertyName.s, Type, *Value.udtValue, Index)
    Protected dx, dy, text.s, fontid, bordercolor, textcolor, backcolor
    
    With *GadgetObject
      Select state
        Case #SetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  \Property()\iVal = *Value\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  \Property()\sVal = *Value\sVal
                EndIf
            EndSelect
            Select PropertyName
              Case "count"
                ReDim \TextList(*Value\iVal)
              Case "flash"
                If *Value\iVal And Not \flash
                  \flash = #True
                  \hm_flash = #False
                  AddGadgetTimer(*GadgetObject, \Property("flashtime")\iVal)
                Else
                  \flash = #False
                  RemoveGadgetTimer(*GadgetObject)
                EndIf
              Case "flashtime"
                If \flash
                  AddGadgetTimer(*GadgetObject, \Property("flashtime")\iVal)
                EndIf
            EndSelect
            If \Property("redraw")\iVal
              \ReDraw(*GadgetObject, 0)
            EndIf
          ElseIf PropertyName = "textlist"
            If Index >= 0 And Index <= ArraySize(\TextList())
              \TextList(Index) = *Value\sVal
              If \Property("redraw")\iVal And \Property("index")\iVal = Index
                \ReDraw(*GadgetObject, 0)
              EndIf
            EndIf
          Else
            DebuggerWarning("Warning: TextBoxGadget property not exists: " + PropertyName)
          EndIf
          
        Case #GetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  *Value\iVal = \Property()\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  *Value\sVal = \Property()\sVal
                EndIf
            EndSelect
          ElseIf PropertyName = "textlist"
            If Type = #PB_String
              If Index >= 0 And Index <= ArraySize(\TextList())
                *Value\sVal = \TextList(Index)
              EndIf
            EndIf
          Else
            DebuggerWarning("Warning: TextBoxGadget property not exists: " + PropertyName)
          EndIf
          
      EndSelect
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReleaseTextBox(*GadgetObject.udtTextBoxObject)
    ; Debug "Release TextBoxGadget " + *GadgetObject\Gadget
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure TextBoxGadget(Gadget, x, y, Width, Height, Text.s, Flags = 0)
    Protected result, id, *GadgetObject.udtTextBoxObject
    
    result = CanvasGadget(Gadget, x, y, Width, Height)
    If result
      If Gadget = #PB_Any
        id = result
      Else
        id = Gadget
      EndIf
      *GadgetObject = AllocateStructure(udtTextBoxObject)
      NewGadgetObject(id, *GadgetObject)
      
      With *GadgetObject
        \EventGadget = @EventHandlerTextBox()
        \EventTimer = @EventTimerTextBox()
        \ReDraw = @ReDrawTextBox()
        \Process = @ProcessTextBox()
        \Release = @ReleaseTextBox()
        \TextList(0) = Text
        _PropertyI("redraw") = #True
        _PropertyI("index") = 0
        _PropertyI("count") = 3
        _PropertyI("flags") = Flags
        _PropertyI("fontid") = 0
        _PropertyI("bordercolor") = $808080
        _PropertyI("textcolor") = 0
        _PropertyI("backcolor") = $F0F0F0
        _PropertyI("flash") = #False
        _PropertyI("flashtime") = 800
        _PropertyI("flashfrontcolor") = $00FFFF
        _PropertyI("flashbackcolor") = $000000
        \ReDraw(*GadgetObject, #Null)
        BindGadgetEvent(\Gadget, \EventGadget)
      EndWith
      
    EndIf
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  ;--- ImageBoxGadget
  
  Structure udtImageBoxObject Extends udtGadgetObject
    Array ImageList.i(1)
    flash.i
    hm_flash.i
    ; Buffer
    width.i
    height.i
    flags.i
    alpha.i
    backcolor.i
    bordercolor.i
    bordersize.i
    image.i
    flashimage1.i
    flashimage2.i
  EndStructure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventHandlerImageBox()
    Protected *GadgetObject.udtImageBoxObject
    Select EventType()
      Case #PB_EventType_Resize
        *GadgetObject = GetGadgetObject(EventGadget())
        *GadgetObject\ReDraw(*GadgetObject, #True)
    EndSelect
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventTimerImageBox(*GadgetObject.udtImageBoxObject)
    *GadgetObject\hm_flash = ~*GadgetObject\hm_flash
    *GadgetObject\ReDraw(*GadgetObject, #False)
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReDrawImageBox(*GadgetObject.udtImageBoxObject, State)
    
    Protected dx, dy, index, flashindex1, flashindex2, image, image_dx, image_dy
    
    
    With *GadgetObject
      If state
        \width = GadgetWidth(\Gadget)
        \height = GadgetHeight(\Gadget)
        \flags = PropertyI("flags")
        \alpha = PropertyI("alpha")
        \backcolor = PropertyI("backcolor")
        \bordercolor = PropertyI("bordercolor")
        \bordersize = PropertyI("bordersize")
        index = PropertyI("index")
        flashindex1 = PropertyI("flashimage1")
        flashindex2 = PropertyI("flashimage2")
        If \image
          FreeImage(\image)
        EndIf
        If \flashimage1
          FreeImage(\flashimage1)
        EndIf
        If \flashimage2
          FreeImage(\flashimage2)
        EndIf
        If index >= 0 And index <= ArraySize(\ImageList())
          \image = CopyImage(\ImageList(index), #PB_Any)
        Else
          \image = 0
        EndIf
        If flashindex1 >= 0 And flashindex1 <= ArraySize(\ImageList())
          \flashimage1 = CopyImage(\ImageList(flashindex1), #PB_Any)
        Else
          \flashimage1 = 0
        EndIf
        If flashindex2 >= 0 And flashindex2 <= ArraySize(\ImageList())
          \flashimage2 = CopyImage(\ImageList(flashindex2), #PB_Any)
        Else
          \flashimage2 = 0
        EndIf
        If \flags
          ResizeImage(\image, \width - \bordersize * 2, \height - \bordersize * 2)
          ResizeImage(\flashimage1, \width - \bordersize * 2, \height - \bordersize * 2)
          ResizeImage(\flashimage2, \width - \bordersize * 2, \height - \bordersize * 2)
        EndIf
      EndIf
      
      If StartDrawing(CanvasOutput(\Gadget))
        dx = \width
        dy = \height
        If \flash
          If \hm_flash
            image = \flashimage1
          Else
            image = \flashimage2
          EndIf
        Else
          image = \image
        EndIf
        Box(0, 0, dx, dy, \borderColor)
        Box(\borderSize, \borderSize, dx - \borderSize * 2, dy - \borderSize * 2, \backColor)
        If IsImage(image)
          If \flags
            DrawAlphaImage(ImageID(image), \borderSize, \borderSize, \alpha)
          Else
            image_dx = ImageWidth(image)
            image_dy = ImageHeight(image)
            ClipOutput(\borderSize, \borderSize, dx - \borderSize * 2, dy - \borderSize * 2)
            DrawAlphaImage(ImageID(image), (dx - image_dx) / 2, (dy - image_dy) / 2, \alpha)
          EndIf
        EndIf
        StopDrawing()
      EndIf
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ProcessImageBox(*GadgetObject.udtImageBoxObject, State, PropertyName.s, Type, *Value.udtValue, Index)
    Protected dx, dy, text.s, fontid, bordercolor, textcolor, backcolor
    
    With *GadgetObject
      Select state
        Case #SetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  \Property()\iVal = *Value\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  \Property()\sVal = *Value\sVal
                EndIf
            EndSelect
            Select PropertyName
              Case "count"
                ReDim \ImageList(*Value\iVal)
              Case "flash"
                If *Value\iVal And Not \flash
                  \flash = #True
                  \hm_flash = #False
                  AddGadgetTimer(*GadgetObject, \Property("flashtime")\iVal)
                Else
                  \flash = #False
                  RemoveGadgetTimer(*GadgetObject)
                EndIf
              Case "flashtime"
                If \flash
                  AddGadgetTimer(*GadgetObject, \Property("flashtime")\iVal)
                EndIf
            EndSelect
            If \Property("redraw")\iVal
              \ReDraw(*GadgetObject, #True)
            EndIf
          ElseIf PropertyName = "imagelist"
            If Index >= 0 And Index <= ArraySize(\ImageList())
              \ImageList(Index) = *Value\iVal
              If \Property("redraw")\iVal And \Property("index")\iVal = Index
                \ReDraw(*GadgetObject, #True)
              EndIf
            EndIf
          Else
            DebuggerWarning("Warning: ImageBoxGadget property not exists: " + PropertyName)
          EndIf
          
        Case #GetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  *Value\iVal = \Property()\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  *Value\sVal = \Property()\sVal
                EndIf
            EndSelect
          ElseIf PropertyName = "imagelist"
            If Type = #PB_Integer
              If Index >= 0 And Index <= ArraySize(\ImageList())
                *Value\iVal = \ImageList(Index)
              EndIf
            EndIf
          Else
            DebuggerWarning("Warning: ImageBoxGadget property not exists: " + PropertyName)
          EndIf
          
      EndSelect
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReleaseImageBox(*GadgetObject.udtImageBoxObject)
    With *GadgetObject
      If \image : FreeImage(\image) : EndIf
      If \flashimage1 : FreeImage(\flashimage1) : EndIf
      If \flashimage2 : FreeImage(\flashimage2) : EndIf
    EndWith
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ImageBoxGadget(Gadget, x, y, Width, Height, Image, Flags = 0)
    Protected result, id, *GadgetObject.udtImageBoxObject
    
    result = CanvasGadget(Gadget, x, y, Width, Height)
    If result
      If Gadget = #PB_Any
        id = result
      Else
        id = Gadget
      EndIf
      *GadgetObject = AllocateStructure(udtImageBoxObject)
      NewGadgetObject(id, *GadgetObject)
      
      With *GadgetObject
        \EventGadget = @EventHandlerImageBox()
        \EventTimer = @EventTimerImageBox()
        \ReDraw = @ReDrawImageBox()
        \Process = @ProcessImageBox()
        \Release = @ReleaseImageBox()
        \ImageList(0) = Image
        _PropertyI("redraw") = #True
        _PropertyI("index") = 0
        _PropertyI("count") = 3
        _PropertyI("flags") = Flags
        _PropertyI("alpha") = 255
        _PropertyI("bordercolor") = $808080
        _PropertyI("bordersize") = 1
        _PropertyI("backcolor") = $F0F0F0
        _PropertyI("flash") = #False
        _PropertyI("flashtime") = 800
        _PropertyI("flashimage1") = 0
        _PropertyI("flashimage2") = 1
        \ReDraw(*GadgetObject, #True)
        BindGadgetEvent(\Gadget, \EventGadget)
      EndWith
      
    EndIf
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  ;--- ClockGadget
  
  Structure udtClockObject Extends udtGadgetObject
    width.i
    height.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
  EndStructure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventHandlerClock()
    Protected *GadgetObject.udtClockObject
    Select EventType()
      Case #PB_EventType_Resize
        *GadgetObject = GetGadgetObject(EventGadget())
        *GadgetObject\ReDraw(*GadgetObject, #True)
    EndSelect
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventTimerClock(*GadgetObject.udtClockObject)
    *GadgetObject\ReDraw(*GadgetObject, #False)
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure RedrawClock(*GadgetObject.udtClockObject, State)
    
    Protected.d dx, dy, center_x, center_y, delta_y, y1, y2, angle, strokewidth
    Protected date, hours, minutes, seconds
    Protected i
    
    With *GadgetObject
      
      If state
        \width = GadgetWidth(\Gadget)
        \height = GadgetHeight(\Gadget)
        \backcolor = PropertyI("backcolor") | $FF000000
        \bordercolor = PropertyI("bordercolor") | $FF000000
        \bordersize = PropertyI("bordersize")
        \color_circle_hour = PropertyI("color.circle.hour") | $FF000000
        \color_circle_minute = PropertyI("color.circle.minute") | $FF000000
        \color_circle_center = PropertyI("color.circle.center") | $FF000000
        \color_hour = PropertyI("color.hour") | $FF000000
        \color_minute = PropertyI("color.minute") | $FF000000
        \color_second = PropertyI("color.second") | $FF000000
      EndIf
      
      StartVectorDrawing(CanvasVectorOutput(\Gadget))
      
      dx = \width
      dy = \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()
      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 ProcessClock(*GadgetObject.udtClockObject, State, PropertyName.s, Type, *Value.udtValue, Index)
    Protected properties.s, key.s, cnt, i
    
    With *GadgetObject
      Select State
        Case #SetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  \Property()\iVal = *Value\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  \Property()\sVal = *Value\sVal
                EndIf
            EndSelect
            If \Property("redraw")\iVal
              If \ReDraw
                \ReDraw(*GadgetObject, #True)
              EndIf
            EndIf
          Else
            DebuggerWarning("Warning: ClockGadget property not exists: " + PropertyName)
          EndIf
          
        Case #GetProperty
          If FindMapElement(\Property(), PropertyName)
            Select Type
              Case #PB_Integer
                If \Property()\Type = #PB_Integer
                  *Value\iVal = \Property()\iVal
                EndIf
              Case #PB_String
                If \Property()\Type = #PB_String
                  *Value\sVal = \Property()\sVal
                EndIf
            EndSelect
          Else
            DebuggerWarning("Warning: ClockGadget property not exists: " + PropertyName)
          EndIf
          
        Case #SetAllProperty
          If StringField(*Value\sVal, 1, #LF$) = "[ClockGadget]"
            cnt = CountString(*Value\sVal, #LF$)
            For i = 2 To cnt
              properties = StringField(*Value\sVal, i, #LF$)
              key = StringField(properties, 1, "=")
              If FindMapElement(\Property(), key)
                \Property()\iVal = Val(StringField(properties, 2, "="))
              EndIf
              \ReDraw(*GadgetObject, #True)
            Next
          EndIf
          
        Case #GetAllProperty
          properties =  "[ClockGadget]" + #LF$
          ForEach \Property()
            properties + MapKey(\Property()) + "=" + Str(\Property()\iVal) + #LF$
          Next
          *Value\sVal = properties
      EndSelect
    EndWith
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ReleaseClock(*GadgetObject.udtClockObject)
    ; Debug "Release ClockGadget " + *GadgetObject\Gadget
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure ClockGadget(Gadget, x, y, Width, Height)
    Protected result, id, *GadgetObject.udtClockObject
    
    result = CanvasGadget(Gadget, x, y, Width, Height)
    If result
      If Gadget = #PB_Any
        id = result
      Else
        id = Gadget
      EndIf
      *GadgetObject = AllocateStructure(udtClockObject)
      NewGadgetObject(id, *GadgetObject)
      
      With *GadgetObject
        \EventGadget = @EventHandlerClock()
        \EventTimer = @EventTimerClock()
        \ReDraw = @RedrawClock()
        \Process = @ProcessClock()
        \Release = @ReleaseClock()
        _PropertyI("redraw") = #True
        _PropertyI("backcolor") = $E0E0E0
        _PropertyI("bordercolor") = $000000
        _PropertyI("bordersize") = 2
        _PropertyI("color.circle.hour") = $C00000
        _PropertyI("color.circle.minute") = $000000
        _PropertyI("color.circle.center") = $404040
        _PropertyI("color.hour") = $000000
        _PropertyI("color.minute") = $000000
        _PropertyI("color.second") = $0000E0
        \ReDraw(*GadgetObject, #True)
        BindGadgetEvent(\Gadget, \EventGadget)
        AddGadgetTimer(*GadgetObject, 1000)
      EndWith
    EndIf
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
EndModule

;- End Module

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

[/size]

[mk-soft]

OwnGadget Beispiel ButtonColorGadget

Code: Alles auswählen

;-TOP

; Comment: Example Modul OwnGadgets ButtonColorGadget, TextBoxGadget
;
; Author : mk-soft
; Version: v1.11
; Created: 02.09.2016
; Updated: 10.09.2018
; Link   : 
;

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

CompilerIf #PB_Compiler_IsMainFile
  
  XIncludeFile "OwnGadgetBase.pb"
  XIncludeFile "OwnGadgets.pb"
  
  UseModule OwnGadgetFunctions
  UseModule OwnGadgets
  
  Macro FreeGadget(Gadget, WindowID = 0)
    DestroyGadget(Gadget, WindowID)
  EndMacro
  
  Macro CloseWindow(Window)
    DestroyWindow(Window)
  EndMacro
  
  Procedure SizeWindow()
    ResizeGadget(4, #PB_Ignore, #PB_Ignore, WindowWidth(0) - 10, WindowHeight(0) - 10)
  EndProcedure
  
  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
  
  BindEvent(#PB_Event_SizeWindow, @SizeWindow())
  
  LoadFont(0, "Arial", 13, #PB_Font_Bold)
  LoadFont(1, "Courier new", 13, #PB_Font_Bold)
    
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 400, 120, "OnwGadgets", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
    
    ContainerGadget(3, 0, 0, WindowWidth(0), 60)
    
    ButtonColorGadget(0, 10, 10, 160, 30, "***")
    SetProperty(0, "TextColor", $00F0F0)
    SetProperty(0, "BackColor", $F00000)
    SetProperty(0, "BackColorMouseOver", $0000A0)
    SetProperty(0, "FontID", FontID(0))
    SetPropertyString(0, "Text", "Flash Textbox")
    
    ButtonColorGadget(1, 225, 10, 160, 30, "Next Text")
    SetProperty(1, "BorderColor", $000000)
    SetProperty(1, "TextColor", $00F0F0)
    SetProperty(1, "BackColor", $F00000)
    SetProperty(1, "BackColorMouseOver", $0000A0)
    SetProperty(1, "FontID", FontID(0))
    
    CloseGadgetList()
    
    TextBoxGadget(2, 10, 50, 380, 50, "Owner TextBoxGadget", #TEXT_HCenter | #TEXT_VCenter)
    SetProperty(2, "FontID", FontID(1))
    SetProperty(2, "BackColor", $C0C000)
    SetProperty(2, "Count", 2)
    SetPropertyString(2, "TextList", "Purbasic is wonderfull", 1)
    SetPropertyString(2, "TextList", GetDataSectionText(?Text2), 2)
    
    SplitterGadget(4, 5, 5, WindowWidth(0) - 10, WindowHeight(0) - 10, 2, 3, #PB_Splitter_SecondFixed)
    
    ;Debug GetPropertyString(2, "TextList", 1)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 0
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(2, "Flash") = #False
                  SetProperty(2, "Flash", #True)
                Else
                  SetProperty(2, "Flash", #False)
                EndIf
              EndIf
              
            Case 1
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(2,"Index") < GetProperty(2, "Count")
                  SetProperty(2, "Index", GetProperty(2,"Index") + 1)
                Else
                  SetProperty(2, "Index", 0)
                EndIf  
              EndIf
              
          EndSelect
          
      EndSelect
      
    ForEver
    
    CloseWindow(0)
    
    
  EndIf
  
  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

[/size]

[Bisonte]

Erstmal

Kann man bestimmt noch optimieren. Vielleicht mal ein paar Anregungen schreiben

In die Bresche springe ich mal

Du benutzt eine Liste, um die GadgetObjects zu verwalten. Will sagen, du musst immer, um das richtige
Object zu bekommen die komplette Liste bis zum Fund durchlaufen. Wäre eine Map bei einer grossen
Anzahl von Gadgets nicht schneller ?

[mk-soft]

Update v1.09

Du benutzt eine Liste, um die GadgetObjects zu verwalten. Will sagen, du musst immer, um das richtige
Object zu bekommen die komplette Liste bis zum Fund durchlaufen. Wäre eine Map bei einer grossen
Anzahl von Gadgets nicht schneller ?

Danke, das Stimmt.

Habe jetzt intern auf Maps umgestellt. Ausserdem kann man jetzt den Type vom Property mit eintragen (#PB_Integer, etc).
Dazu habe ich zur Vereinfachung noch ein paar Macros hinzugefügt. Siehe Beispiel ButtonColorGadget.

[mk-soft]

Update v1.11
- Hinzugefügt: Set- GetAllProperty(...) als String
- ClockGadget hinzufügt

Das erste mal mit VectorDrawing gearbeitet

Beispiel ClockGadget. Mit rechter Maus die Einstellungen öffnen!

Code: Alles auswählen

;-TOP

; Comment: Example Modul OwnGadgets ClockGadget
;
; Author : mk-soft
; Version: v1.13
; Created: 06.09.2018
; Updated: 13.09.2018
; Link   :
;

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

CompilerIf #PB_Compiler_IsMainFile
  
  XIncludeFile "OwnGadgetBase.pb"
  XIncludeFile "OwnGadgets.pb"
  
  UseModule OwnGadgetFunctions
  UseModule OwnGadgets
  
  Macro FreeGadget(Gadget, WindowID = 0)
    DestroyGadget(Gadget, WindowID)
  EndMacro
  
  Macro CloseWindow(Window)
    DestroyWindow(Window)
  EndMacro
  
  Global language.s = "DE" ; "EN" ; "DE"
  
  ;----------------------------------------------------------------------------
  
  Procedure RestoreClockProperty(Gadget)
    SetProperty(Gadget, "Redraw", #False)
    SetProperty(Gadget, "Backcolor", $E0E0E0)
    SetProperty(Gadget, "Bordercolor", $000000)
    SetProperty(Gadget, "Bordersize", 2)
    SetProperty(Gadget, "Color.Circle.Hour", $C00000)
    SetProperty(Gadget, "Color.Circle.Minute", $000000)
    SetProperty(Gadget, "Color.Circle.Center", $404040)
    SetProperty(Gadget, "Color.Hour", $000000)
    SetProperty(Gadget, "Color.Minute", $000000)
    SetProperty(Gadget, "Color.Second", $0000E0)
    SetProperty(Gadget, "Redraw", #True)
  EndProcedure
  
  ;----------------------------------------------------------------------------
  
  Procedure SetClockProperty(Gadget)
    Protected id = 11
    SetProperty(Gadget, "Redraw", #False)
    SetProperty(Gadget, "Backcolor", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Bordercolor", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Bordersize", 2)
    SetProperty(Gadget, "Color.Circle.Hour", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Color.Circle.Minute", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Color.Circle.Center", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Color.Hour", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Color.Minute", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Color.Second", GetProperty(id, "BackColor")) : id + 1
    SetProperty(Gadget, "Redraw", #True)
  EndProcedure
  
  ;----------------------------------------------------------------------------
  
  Procedure OpenDialogProperty(Gadget)
    Protected x, y, dx, dy, dy2, id
    
    x = WindowX(0, #PB_Window_InnerCoordinate) + 40
    y = WindowY(0, #PB_Window_InnerCoordinate) + 40
    
    If OpenWindow(1, x, y, 300, 300, "", #PB_Window_SystemMenu, WindowID(0))
      Select language
        Case "EN"
          SetWindowTitle(1, "Settings")
        Case "DE"
          SetWindowTitle(1, "Einstellungen")
      EndSelect
      
      x = 5
      y = 5
      dx = 140
      dy = 25
      dy2 = 30
      
      Select language
        Case "EN"
          TextGadget(#PB_Any , x, y , dx, dy , "Backcolor: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Bordercolor: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Circle Hour: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Circle Minute: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Circle Center: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Pointer Hour: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Pointer Minute: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "pointer Second: ") : y + dy2
        Case "DE"   
          TextGadget(#PB_Any , x, y , dx, dy , "Hintergrund: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Rahmenfarbe: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Kreis Stunden: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Kreis Minuten: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Kreis Mitte: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Zeiger Stunden: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Zeiger Minuten: ") : y + dy2
          TextGadget(#PB_Any , x, y , dx, dy , "Zeiger Sekunden: ") : y + dy2
      EndSelect
      
      x + dx + 5
      y = 5
      dx = 60
      dy = 22
      dy2 = 30
      id = 11
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      ButtonColorGadget(id , x, y , dx, dy , "") : y + dy2 : id + 1
      
      id = 11
      SetProperty(id, "BackColor", GetProperty(Gadget, "BackColor")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "BorderColor")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "color.circle.hour")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "color.circle.minute")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "color.circle.center")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "color.hour")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "color.minute")) : id + 1
      SetProperty(id, "BackColor", GetProperty(Gadget, "color.second")) : id + 1
      
      x = 5
      y = WindowHeight(1) - 30
      dx = 95
      dy = 25
      Select Language
        Case "EN"
          ButtonGadget(21, x, y, dx, dy, "Default") : x + dx + 5
          ButtonGadget(22, x, y, dx, dy, "Ok") : x + dx + 5
          ButtonGadget(23, x, y, dx, dy, "Cancel")
        Case "DE"
          ButtonGadget(21, x, y, dx, dy, "Standard") : x + dx + 5
          ButtonGadget(22, x, y, dx, dy, "Ok") : x + dx + 5
          ButtonGadget(23, x, y, dx, dy, "Abbrechen")
      EndSelect   
      
    EndIf
  EndProcedure
  
  ;----------------------------------------------------------------------------
  
  Procedure SizeCB()
    ResizeGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) -20)
  EndProcedure
  
  ;----------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    #PS$ = "\"
  CompilerElse
    #PS$ = "/"
  CompilerEndIf
  
  Procedure.s GetUserDirectoryEx(DirectoryType, Path.s = "")
    Protected result.s, dir.s, part.s, cnt
    dir = GetUserDirectory(DirectoryType)
    If Right(dir, 1) <> #PS$
      dir + #PS$
    EndIf
    result = dir + path
    If Not FileSize(result) = -2
      result = dir
      Repeat
        cnt + 1
        part = StringField(path, cnt, #PS$)
        If Not Bool(part)
          Break
        EndIf
        result + part + #PS$
        If Not FileSize(result) = -2
          If Not CreateDirectory(result)
            Debug "Error: GetUserDirectoryEx(" + result + ")"
            ProcedureReturn ""
          EndIf
        EndIf
      ForEver
    EndIf
    If Right(result, 1) <> #PS$
      result + #PS$
    EndIf
    ProcedureReturn result
  EndProcedure
  
  ;----------------------------------------------------------------------------
  
  Procedure Main()
    Protected flags, event, gadget, color, file.s, properties.s
    
    file = GetUserDirectoryEx(#PB_Directory_ProgramData, "MK-Tools" + #PS$ + "MyClock")
    
    If Right(file, 1) <> #PS$
      file + #PS$
    EndIf
    
    file + "MyClockGadgetProperty.cfg"
    
    flags = #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget
    
    If OpenWindow(0, #PB_Ignore, #PB_Ignore, 420, 420, "ClockGadget", flags)
      StickyWindow(0, 1)
      ClockGadget(0, 10, 10, 400, 400)
      
      If ReadFile(0, file)
        While Not Eof(0)
          properties + ReadString(0, #PB_UTF8) + #LF$
        Wend
        SetAllProperty(0, properties)
        CloseFile(0)
      EndIf
      
      BindEvent(#PB_Event_SizeWindow, @SizeCB())
      
      Repeat
        event = WaitWindowEvent()
        Select event
          Case #PB_Event_Gadget
            gadget = EventGadget()
            Select gadget
              Case 0
                If EventType() = #PB_EventType_RightClick
                  If Not IsWindow(1)
                    OpenDialogProperty(0)
                  EndIf
                EndIf
              Case 11 To 18
                If EventType() = #PB_EventType_LeftClick
                  color = ColorRequester(GetProperty(gadget, "BackColor"))
                  SetProperty(gadget, "BackColor", color)
                EndIf
              Case 21
                RestoreClockProperty(0)
                CloseWindow(1)
              Case 22
                SetClockProperty(0)
                CloseWindow(1)
              Case 23
                CloseWindow(1)
                
            EndSelect
            
          Case #PB_Event_CloseWindow
            Select EventWindow()
              Case 0
                Break
              Case 1
                CloseWindow(1)
            EndSelect
            
        EndSelect
        
      ForEver
    EndIf
    
    ; Save Clock
    If CreateFile(0, file)
      WriteStringN(0, GetAllProperty(0), #PB_UTF8)
      CloseFile(0)
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

[/size]

[Rings]

gibts da irgendwelche besonderheiten was die PB version betrifft ?

Ich bekomme einen SYNTAX Fehler im modul OwnGadgetBase.pb bei:

Code: Alles auswählen

Module OwnGadgetsCommon
 
  Global DoEventWindow = OpenWindow(#PB_Any, 0, 0, 0, 0, DoEvents, #PB_Window_Invisible  #PB_Window_NoGadgets)

Test mit PB 5.62 x64

[RSBasic]

Hast du falsch kopiert? In deinem Code fehlt ein Separatur zwischen den Konstanten. Und "DoEvents" scheint, falls es keine String-Variable ist, auch nicht korrekt zu sein.

[Rings]

Hast du falsch kopiert? In deinem Code fehlt ein Separatur zwischen den Konstanten. Und "DoEvents" scheint, falls es keine String-Variable ist, auch nicht korrekt zu sein.

komisch, war wirklich so das beim copy&paste irgendwas verloren gegangen ist.
Habs neu gemacht und geht nun. Danke euch beiden.

[mk-soft]

Update v1.12
- NewProperty zu AddProperty umbenannt (Module OwnGadgetFunctions)

Der Name passt irgend wie besser...