Module OwnGadgets Base

[mk-soft]

Have once optimized my module OwnGadgetBase so far that you can write different modules with your own gadgets.

In the base there are two modules.
1. OwnGadgetFunctions as a public module to read and write the properties of your own gadgets.
2. OwnGadgetCommon as private module as basic within the own gadgets.

The following procedures are assigned to the own gadget.
- ProgEventGadget for processing the events (BindGadgetEvent)
- ProgEventTimer for trigger processing (Add- and RemoveGadgetTimer if required)
- ProgReDraw to draw the gadget
- ProgProcess for reading or writing properties
- ProgRelease for processing before releasing the gadget (If required)

Each gadget consists of a basic structure GadgetObject. But you can extend it with your own data. See example TextBoxGadget.

You can certainly optimize it. Maybe write some suggestions

Update v1.09
- The type can be assigned in the property
- Add macros to the common
> _PropertyX : Sets the type of the property.
> PropertyX : For simplified reading

Update v1.11
- Added Set- GetAllProperty(...) as string

Update v1.12
- Rename NewProperty to AddProperty

Update v1.13
- Bugfix RemoveGadgetTimer

OwnGadgetBase.pb

Code: Select all

;-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]

Update v1.14
- Added flash to ButtonColorGadget
- Added ImageBoxGadget

Update v1.15
- Added Debugger warning for properties
- ImageBoxGadget better performance

OwnGadgets.pb

Code: Select all

;-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]

Example ButtonColorGadget and TextBoxGadget

Code: Select all

;-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]

[mk-soft]

Example ClockGadget

Code: Select all

;-TOP

; Comment: Example Modul OwnGadgets ClockGadget
;
; Author : mk-soft
; Version: v1.12
; Created: 02.09.2016
; Updated: 09.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 Main()
    Protected flags, event, gadget, color, file.s, properties.s
    
    ;file = GetUserDirectory(#PB_Directory_ProgramData)
    file = GetHomeDirectory()
    
    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)
      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]

[CELTIC88]

amazing, thank for sharing

[dcr3]

If you resize the window all the way to the top
both buttons disappear.

same for the clock example, you get an
error on line 1277 >Strokepath(strokewidth).


Nice code.
Thank You.

[mk-soft]

If you resize the window all the way to the top
both buttons disappear.

Its a SplitterGadget problem. You can move the splitter separator

same for the clock example, you get an
error on line 1277 >Strokepath(strokewidth).

Thanks, fixed ClockGadget

Update OwnGadgets.pb v1.12

[Kwai chang caine]

What a really big code
Works very well here W10 X64 / v5.62 X86
Thanks a lot for sharing this wonderfull code

[mk-soft]

OwnGadgetBase Update v1.13
- Bugfix RemoveGadgetTimer

OwnGadgets Update v1.14
- Added flash to ButtonColorGadget
- Added ImageBoxGadget

Example ImageBoxGadget

Code: Select all

;-TOP

; Comment: Example Modul OwnGadgets ImageBoxGadget
;
; Author : mk-soft
; Version: v1.02
; Created: 06.10.2018
; Updated: 
; 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
  
  ; -------------------------------------------------------------------------------------
  
  If CreateImage(0, 32, 32, 32, $F0F0F0)
    StartDrawing(ImageOutput(0))
    Box(4, 4, 24, 24, #Black)
    Box(5, 5, 22, 22, #Gray)
    StopDrawing()
  EndIf
  
  If CreateImage(1, 32, 32, 32, $F0F0F0)
    StartDrawing(ImageOutput(1))
    Circle(15, 15, 12, #Black)
    Circle(15, 15, 10, #Red)
    StopDrawing()
  EndIf
  
  If CreateImage(2, 32, 32, 32, $F0F0F0)
    StartDrawing(ImageOutput(2))
    Circle(15, 15, 12, #Black)
    Circle(15, 15, 10, #Yellow)
    StopDrawing()
  EndIf
  
  If CreateImage(3, 32, 32, 32, $F0F0F0)
    StartDrawing(ImageOutput(3))
    Circle(15, 15, 12, #Black)
    Circle(15, 15, 10, #Green)
    StopDrawing()
  EndIf
  
  If CreateImage(4, 32, 32, 32, $F0F0F0)
    StartDrawing(ImageOutput(4))
    Circle(15, 15, 12, #Black)
    Circle(15, 15, 10, #Blue)
    StopDrawing()
  EndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    LoadImage(5, #PB_Compiler_Home + "Examples\Sources\Data\PureBasic.bmp")
    LoadImage(6, #PB_Compiler_Home + "Examples\Sources\Data\Background.bmp")
  CompilerElse
    LoadImage(5, #PB_Compiler_Home + "examples/sources/Data/PureBasic.bmp")
    LoadImage(6, #PB_Compiler_Home + "examples/sources/Data/Background.bmp")
  CompilerEndIf  
  
  ; -------------------------------------------------------------------------------------
  
  Procedure SizeWindow()
    Protected dx = WindowWidth(0)
    Protected dy = WindowHeight(0)
    
    ResizeGadget(0, dx / 3 * 0 + 5, dy / 3 * 0 + 5, dx / 3 - 10, dy / 3 - 10)
    ResizeGadget(1, dx / 3 * 1 + 5, dy / 3 * 0 + 5, dx / 3 - 10, dy / 3 - 10)
    ResizeGadget(2, dx / 3 * 2 + 5, dy / 3 * 0 + 5, dx / 3 - 10, dy / 3 - 10)
    
    ResizeGadget(3, dx / 3 * 0 + 5, dy / 3 * 1 + 5, dx / 1 - 10, dy / 3 - 10)
    ResizeGadget(4, dx / 3 * 0 + 5, dy / 3 * 2 + 5, dx / 1 - 10, dy / 3 - 10)
      
  EndProcedure
  
  BindEvent(#PB_Event_SizeWindow, @SizeWindow())
  
  ; -------------------------------------------------------------------------------------
  
  Define dx, dy
  
  If OpenWindow(0, #PB_Ignore, #PB_Ignore, 400, 400, "OnwGadgets - ImageBoxGadget", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
    dx = WindowWidth(0)
    dy = WindowHeight(0)
    
    ImageBoxGadget(0, dx / 3 * 0 + 5, dy / 3 * 0 + 5, dx / 3 - 10, dy / 3 - 10, 0, 0)
    ImageBoxGadget(1, dx / 3 * 1 + 5, dy / 3 * 0 + 5, dx / 3 - 10, dy / 3 - 10, 0, 1)
    ImageBoxGadget(2, dx / 3 * 2 + 5, dy / 3 * 0 + 5, dx / 3 - 10, dy / 3 - 10, 0, 1)
    
    ImageBoxGadget(3, dx / 3 * 0 + 5, dy / 3 * 1 + 5, dx / 1 - 10, dy / 3 - 10, 5, 0)
    ImageBoxGadget(4, dx / 3 * 0 + 5, dy / 3 * 2 + 5, dx / 1 - 10, dy / 3 - 10, 5, 1)
    
    SetProperty(0, "ImageList", 4, 1)
    
    SetProperty(1, "ImageList", 1, 1)
    SetProperty(1, "BorderSize", 0)
    
    SetProperty(2, "Redraw", #False)
    SetProperty(2, "Count", 3)
    SetProperty(2, "ImageList", 2, 1)
    SetProperty(2, "ImageList", 1, 2)
    SetProperty(2, "FlashTime", 400)
    SetProperty(2, "FlashImage1", 1)
    SetProperty(2, "FlashImage2", 2)
    SetProperty(2, "Redraw", #True)
    
    SetProperty(4, "Redraw", #False)
    SetProperty(4, "ImageList", 6, 1)
    SetProperty(4, "BackColor", #Blue)
    SetProperty(4, "BorderColor", #Blue)
    SetProperty(4, "BorderSize", 4)
    SetProperty(4, "Alpha", 200)
    SetProperty(4, "Redraw", #True)
    
    BindEvent(#PB_Event_SizeWindow, @SizeWindow())
  
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 0
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(0, "Flash") = #False
                  SetProperty(0, "Flash", #True)
                Else
                  SetProperty(0, "Flash", #False)
                EndIf
              EndIf
              
            Case 1
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(1, "Flash") = #False
                  SetProperty(1, "Flash", #True)
                Else
                  SetProperty(1, "Flash", #False)
                EndIf
              EndIf
              
            Case 2
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(2, "Flash") = #False
                  SetProperty(2, "Flash", #True)
                Else
                  SetProperty(2, "Flash", #False)
                EndIf
              EndIf
              
            Case 3
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(3, "Flags") = 0
                  SetProperty(3, "Flags", 1)
                Else
                  SetProperty(3, "Flags", 0)
                EndIf
              EndIf
              
            Case 4
              If EventType() = #PB_EventType_LeftClick
                If GetProperty(4, "Index") = 0
                  SetProperty(4, "Index", 1)
                Else
                  SetProperty(4, "Index", 0)
                EndIf
              EndIf
            
          EndSelect
          
      EndSelect
      
    ForEver
    
    CloseWindow(0)
    
  EndIf
  
CompilerEndIf

[/size]

[mk-soft]

OwnGadgets Update v1.15
- Added Debugger warning for properties
- ImageBoxGadget better performance

Better performance with ImageBoxGadget.
The pictures are now only prepared when there is a change in value or size.

Maybe somebody will want to create more gadgets.