PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

ButtonColorGadget with standard purebasic function

https://www.purebasic.fr/english/viewtopic.php?t=59057

Page 1 of 1

ButtonColorGadget with standard purebasic function

Posted: Fri Apr 18, 2014 6:37 pm
by mk-soft
ButtonColorGagdet with the same features included as ButtonGadget, but with additional color function.
The gadget can, however, using the standard functions such as SetGadgetText (...), GetGadgetText (...), etc are changed.

The gadget can also be adapted as a basis for your own development. The Proc_FreeGadget (...) is always needed, since there the data and the gadget are released.

Support flags
- PB_Button_Default, #PB_Button_Left, #PB_Button_Right, #PB_Button_Multiline, #PB_Button_Toggle
Support colors
- #PB_Gadget_FrontColor, #PB_Gadget_BackColor, #PB_Gadget_LineColor
Support styles
- Windows 7, Windows 8,
Support OS
- Windows, Linux

Code: Select all

;-TOP
; Kommentar     : Modul ButtonColorGadget (development version)
; Author        : mk-soft
; Second Author : 
; Datei         : *.pb
; Version       : 1.19
; Erstellt      : 21.03.2014
; Geändert      : 19.04.2014
; 
; Compilermode  : ASCII, Unicode
; OS            : Windows, Linux
;
; ***************************************************************************************

;- Modul Public
DeclareModule ButtonColorGadget
  
  Declare Create(id, x, y, dx, dy, text.s, flags = #PB_Button_Default)
  
EndDeclareModule

;- Modul Private
Module ButtonColorGadget
  EnableExplicit
  
  ;- PB Interne System Funktionen
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
  CompilerElse
    ImportC ""
  CompilerEndIf
    PB_Object_GetObject(Objects.i, ID.i)
    PB_Gadget_Objects.i
  EndImport
  
  Import ""
    SYS_GetParameterIndex(String)
    SYS_GetOutputBuffer(StringLength, PreviousPosition)
    SYS_ResolveParameter(ParameterIndex)
  EndImport
  
  ;- Konstanten
  #ButtonColorStateDefault = 0
  #ButtonColorStateOver = 1
  #ButtonColorStateDown = 2
  
  ;- Declare Basisfunktionen
  Declare NewData(*this)
  Declare FreeData(*this)
  
  ;- Declare Eigene Funktionen
  Declare Draw(*MyGadgetVT)
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    ;- PB Interne Struktur Gadget Windows
    Structure Gadget
      Gadget.i
      *vt.GadgetVT
      UserData.i
      OldCallback.i
      Daten.i[4]
    EndStructure
  CompilerElse
    ;- PB Interne Struktur Gadget Linux
    Structure Gadget
      Gadget.i
      GadgetContainer.i
      *vt.GadgetVT
      UserData.i
      Daten.i[4]
    EndStructure
  CompilerEndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  ;- PB Interne Prototypen Windows
    Prototype Proc_Callback(*this.Gadget, Window, Message, wParam, lParam)
    Prototype Proc_FreeGadget(*this.Gadget)
    Prototype Proc_GetGadgetState(*this.Gadget)
    Prototype Proc_SetGadgetState(*this.Gadget, State)
    Prototype Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
    Prototype Proc_SetGadgetText(*this.Gadget, *Text)
    Prototype Proc_AddGadgetItem2(*this.Gadget, Position, *Text, *Image)
    Prototype Proc_AddGadgetItem3(*this.Gadget, Position, *Text, *Image, Flags)
    Prototype Proc_RemoveGadgetItem(*this.Gadget, Item)
    Prototype Proc_ClearGadgetItemList(*this.Gadget)
    Prototype Proc_ResizeGadget(*this.Gadget, x, y, width, height)
    Prototype Proc_CountGadgetItems(*this.Gadget)
    Prototype Proc_GetGadgetItemState(*this.Gadget, Item)
    Prototype Proc_SetGadgetItemState(*this.Gadget, Item, State)
    Prototype Proc_GetGadgetItemText(*this.Gadget, Item, Column, PreviousStringPosition)
    Prototype Proc_SetGadgetItemText(*this.Gadget, Item, *Text, Column)
    Prototype Proc_OpenGadgetList2(*this.Gadget, Item)
    Prototype Proc_GadgetX(*this.Gadget)
    Prototype Proc_GadgetY(*this.Gadget)
    Prototype Proc_GadgetWidth(*this.Gadget)
    Prototype Proc_GadgetHeight(*this.Gadget)
    Prototype Proc_HideGadget(*this.Gadget, State)
    Prototype Proc_AddGadgetColumn(*this.Gadget, Item, *Text, Column)
    Prototype Proc_RemoveGadgetColumn(*this.Gadget, Position)
    Prototype Proc_GetGadgetAttribute(*this.Gadget, Attribute)
    Prototype Proc_SetGadgetAttribute(*this.Gadget, Attribute, Value)
    Prototype Proc_GetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Column)
    Prototype Proc_SetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Value, Column)
    Prototype Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
    Prototype Proc_GetGadgetColor(*this.Gadget, ColorType)
    Prototype Proc_SetGadgetItemColor2(*this.Gadget, Item, ColorType, Color, Column)
    Prototype Proc_GetGadgetItemColor2(*this.Gadget, Item, ColorType, Column)
    Prototype Proc_SetGadgetItemData(*this.Gadget, Item, Value)
    Prototype Proc_GetGadgetItemData(*this.Gadget, Item)
    Prototype Proc_GetRequiredSize(*this.Gadget, *Width.integer, *Height.integer)
    Prototype Proc_SetActiveGadget(*this.Gadget)
    Prototype Proc_GetGadgetFont(*this.Gadget)
    Prototype Proc_SetGadgetFont(*this.Gadget, hFont)
    Prototype Proc_SetGadgetItemImage(*this.Gadget, hImage)
  CompilerElse
    ;- PB Interne Prototypen Linux
    PrototypeC Proc_ActivateGadget(*this.Gadget)
    PrototypeC Proc_FreeGadget(*this.Gadget)
    PrototypeC Proc_GetGadgetState(*this.Gadget)
    PrototypeC Proc_SetGadgetState(*this.Gadget, State)
    PrototypeC Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
    PrototypeC Proc_SetGadgetText(*this.Gadget, Text)
    PrototypeC Proc_AddGadgetItem2(*this.Gadget, Position, *Text, *Image)
    PrototypeC Proc_AddGadgetItem3(*this.Gadget, Position, *Text, *Image, Flags)
    PrototypeC Proc_RemoveGadgetItem(*this.Gadget, Item)
    PrototypeC Proc_ClearGadgetItemList(*this.Gadget)
    PrototypeC Proc_ResizeGadget(*this.Gadget, x, y, width, height)
    PrototypeC Proc_CountGadgetItems(*this.Gadget)
    PrototypeC Proc_GetGadgetItemState(*this.Gadget, Item)
    PrototypeC Proc_SetGadgetItemState(*this.Gadget, Item, State)
    PrototypeC Proc_GetGadgetItemText(*this.Gadget, Item, Column, PreviousStringPosition)
    PrototypeC Proc_SetGadgetItemText(*this.Gadget, Item, *Text, Column)
    PrototypeC Proc_OpenGadgetList2(*this.Gadget, Item)
    PrototypeC Proc_GadgetX(*this.Gadget)
    PrototypeC Proc_GadgetY(*this.Gadget)
    PrototypeC Proc_GadgetWidth(*this.Gadget)
    PrototypeC Proc_GadgetHeight(*this.Gadget)
    PrototypeC Proc_HideGadget(*this.Gadget, State)
    PrototypeC Proc_AddGadgetColumn(*this.Gadget, Item, *Text, Column)
    PrototypeC Proc_RemoveGadgetColumn(*this.Gadget, Position)
    PrototypeC Proc_GetGadgetAttribute(*this.Gadget, Attribute)
    PrototypeC Proc_SetGadgetAttribute(*this.Gadget, Attribute, Value)
    PrototypeC Proc_GetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Column)
    PrototypeC Proc_SetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Value, Column)
    PrototypeC Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
    PrototypeC Proc_GetGadgetColor(*this.Gadget, ColorType)
    PrototypeC Proc_SetGadgetItemColor2(*this.Gadget, Item, ColorType, Color, Column)
    PrototypeC Proc_GetGadgetItemColor2(*this.Gadget, Item, ColorType, Column)
    PrototypeC Proc_SetGadgetItemData(*this.Gadget, Item, Value)
    PrototypeC Proc_GetGadgetItemData(*this.Gadget, Item)
    PrototypeC Proc_GetRequiredSize(*this.Gadget, *Width.integer, *Height.integer)
    PrototypeC Proc_SetActiveGadget(*this.Gadget)
    PrototypeC Proc_GetGadgetFont(*this.Gadget)
    PrototypeC Proc_SetGadgetFont(*this.Gadget, hFont)
    PrototypeC Proc_SetGadgetItemImage(*this.Gadget, hImage)
  CompilerEndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    ;- PB Interne Struktur GadgetVT Windows
    Structure GadgetVT
      GadgetType.l   
      SizeOf.l       
      GadgetCallback.Proc_Callback
      FreeGadget.Proc_FreeGadget
      GetGadgetState.Proc_GetGadgetState
      SetGadgetState.Proc_SetGadgetState
      GetGadgetText.Proc_GetGadgetText
      SetGadgetText.Proc_SetGadgetText
      AddGadgetItem2.Proc_AddGadgetItem2
      AddGadgetItem3.Proc_AddGadgetItem3
      RemoveGadgetItem.Proc_RemoveGadgetItem
      ClearGadgetItemList.Proc_ClearGadgetItemList
      ResizeGadget.Proc_ResizeGadget
      CountGadgetItems.Proc_CountGadgetItems
      GetGadgetItemState.Proc_GetGadgetItemState
      SetGadgetItemState.Proc_SetGadgetItemState
      GetGadgetItemText.Proc_GetGadgetItemText
      SetGadgetItemText.Proc_SetGadgetItemText
      OpenGadgetList2.Proc_OpenGadgetList2
      GadgetX.Proc_GadgetX
      GadgetY.Proc_GadgetY
      GadgetWidth.Proc_GadgetWidth
      GadgetHeight.Proc_GadgetHeight
      HideGadget.Proc_HideGadget
      AddGadgetColumn.Proc_AddGadgetColumn
      RemoveGadgetColumn.Proc_RemoveGadgetColumn
      GetGadgetAttribute.Proc_GetGadgetAttribute
      SetGadgetAttribute.Proc_SetGadgetAttribute
      GetGadgetItemAttribute2.Proc_GetGadgetItemAttribute2
      SetGadgetItemAttribute2.Proc_SetGadgetItemAttribute2
      SetGadgetColor.Proc_SetGadgetColor
      GetGadgetColor.Proc_GetGadgetColor
      SetGadgetItemColor2.Proc_SetGadgetItemColor2
      GetGadgetItemColor2.Proc_GetGadgetItemColor2
      SetGadgetItemData.Proc_SetGadgetItemData
      GetGadgetItemData.Proc_GetGadgetItemData
      GetRequiredSize.Proc_GetRequiredSize
      SetActiveGadget.Proc_SetActiveGadget
      GetGadgetFont.Proc_GetGadgetFont
      SetGadgetFont.Proc_SetGadgetFont
      SetGadgetItemImage.Proc_SetGadgetItemImage
    EndStructure
  CompilerElse
    ;- PB Interne Struktur GadgetVT Linux
    Structure GadgetVT
      SizeOf.l
      GadgetType.l
      ActivateGadget.Proc_ActivateGadget;
      FreeGadget.Proc_FreeGadget;
      GetGadgetState.Proc_GetGadgetState;
      SetGadgetState.Proc_SetGadgetState;
      GetGadgetText.Proc_GetGadgetText;
      SetGadgetText.Proc_SetGadgetText;
      AddGadgetItem2.Proc_AddGadgetItem2;
      AddGadgetItem3.Proc_AddGadgetItem3;
      RemoveGadgetItem.Proc_RemoveGadgetItem;
      ClearGadgetItemList.Proc_ClearGadgetItemList;
      ResizeGadget.Proc_ResizeGadget;
      CountGadgetItems.Proc_CountGadgetItems;
      GetGadgetItemState.Proc_GetGadgetItemState;
      SetGadgetItemState.Proc_SetGadgetItemState;
      GetGadgetItemText.Proc_GetGadgetItemText;
      SetGadgetItemText.Proc_SetGadgetItemText;
      SetGadgetFont.Proc_SetGadgetFont;
      OpenGadgetList2.Proc_OpenGadgetList2;
      AddGadgetColumn.Proc_AddGadgetColumn;
      GetGadgetAttribute.Proc_GetGadgetAttribute;
      SetGadgetAttribute.Proc_SetGadgetAttribute;
      GetGadgetItemAttribute2.Proc_GetGadgetItemAttribute2;
      SetGadgetItemAttribute2.Proc_SetGadgetItemAttribute2;
      RemoveGadgetColumn.Proc_RemoveGadgetColumn;
      SetGadgetColor.Proc_SetGadgetColor;
      GetGadgetColor.Proc_GetGadgetColor;
      SetGadgetItemColor2.Proc_SetGadgetItemColor2;
      GetGadgetItemColor2.Proc_GetGadgetItemColor2;
      SetGadgetItemData.Proc_SetGadgetItemData;
      GetGadgetItemData.Proc_GetGadgetItemData;
      GetGadgetFont.Proc_GetGadgetFont;
      HideGadget.Proc_HideGadget; Nicht bei Linux vorhanden, sondern bei MacOS
    EndStructure
  CompilerEndIf
  
  ;- Eigene interne Struktur MyGadgetVT
  Structure udtMyGadgetVT
    ; Basis
    vt.GadgetVT ; Virtuelle Funktionstabelle. Nicht Verschieben!
    *vt_org.GadgetVT  ; Orginal virtuelle Funktionstabelle
    id.i        ; Gadget PB_ID
    ; Eigene Daten
    dx.i
    dy.i
    text.s
    flags.i
    state.i
    cstate.i
    style.i
    hFont.i
    frontcolor.i
    backcolor.i
    bordercolor.i
  EndStructure
  
  ;- Eigene interne Daten (Speicher)
  Global NewMap MyGadgetData.udtMyGadgetVT() 
  
  ; -------------------------------------------------------------------------------------
  
  ;- PB Interne Funktionen (Proceduren)
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    
    Procedure Proc_GadgetCallback(*this.Gadget, Window, Message, wParam, lParam)
      
      Protected *MyGadgetVT.udtMyGadgetVT
      Protected result
      
      *MyGadgetVT = *this\vt
      
      ; Nicht geklärt!
        result = #PB_ProcessPureBasicEvents
      
      ; SKD: Result to 0, if you don't want the event to be populated to next handlers
      
      If *MyGadgetVT\vt_org\GadgetCallback
        result = *MyGadgetVT\vt_org\GadgetCallback(*this.Gadget, Window, Message, wParam, lParam)
      EndIf
      ProcedureReturn result;
      
    EndProcedure

  ; -------------------------------------------------------------------------------------
  
  CompilerElse
  
    ProcedureC Proc_ActivateGadget(*this.Gadget)
      
      Protected *MyGadgetVT.udtMyGadgetVT
      Protected result
      
      *MyGadgetVT = *this\vt
      
      If *MyGadgetVT\vt_org\ActivateGadget
        result = *MyGadgetVT\vt_org\ActivateGadget(*this.Gadget)
      EndIf
      ProcedureReturn result;
      
    EndProcedure
    
    ; -------------------------------------------------------------------------------------
  
  CompilerEndIf
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_FreeGadget(*this.Gadget)
  CompilerElse
    ProcedureC Proc_FreeGadget(*this.Gadget)
  CompilerEndIf  
  
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    ; Eigene Daten freigeben  
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Debug "FreeGadget"
      
      ; Daten und Gadget freigeben
      result = FreeData(*this)
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetState(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GetGadgetState(*this.Gadget)
  CompilerEndIf  
  
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      result = *MyGadgetVT\state
    EndIf
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetState(*this.Gadget, State)
  CompilerElse
    ProcedureC Proc_SetGadgetState(*this.Gadget, State)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      With *MyGadgetVT
        \state = State
      EndWith
      Draw(*MyGadgetVT)
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
  CompilerElse
    ProcedureC Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    Protected String.s
    Protected StringLength
    Protected *output.Character
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      String = *MyGadgetVT\text
      StringLength = Len(string)
      
      ; String zurückgeben
      *Output = SYS_GetOutputBuffer(StringLength, PreviousStringPosition)
      CopyMemory(@String, *output, StringLength * SizeOf(character))
      *output + StringLength * SizeOf(character)
      *output\c = 0
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetText(*this.Gadget, *Text)
  CompilerElse
    ProcedureC Proc_SetGadgetText(*this.Gadget, *Text)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    Protected ParameterIndex, String.s
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Get the index of the parameter in the internal buffer (will Return 0 If it's not in the internal buffer)
      ParameterIndex = SYS_GetParameterIndex(*Text)
      If ParameterIndex
        ; Get back the string pointer only if it was on the internal buffer
        *Text = SYS_ResolveParameter(ParameterIndex)
      EndIf
      ; Anpassung Linux
      CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        String = PeekS(*Text)
      CompilerElse
        String = PeekS(*Text,-1, #PB_UTF8)
      CompilerEndIf
      
      *MyGadgetVT\text = String
      Draw(*MyGadgetVT)
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_AddGadgetItem2(*this.Gadget, Position, *Text, *Image)
  CompilerElse
    ProcedureC Proc_AddGadgetItem2(*this.Gadget, Position, *Text, *Image)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_AddGadgetItem3(*this.Gadget, Position, *Text, *Image, Flags)
  CompilerElse
    ProcedureC Proc_AddGadgetItem3(*this.Gadget, Position, *Text, *Image, Flags)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_RemoveGadgetItem(*this.Gadget, Item)
  CompilerElse
    ProcedureC Proc_RemoveGadgetItem(*this.Gadget, Item)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_ClearGadgetItemList(*this.Gadget)
  CompilerElse
    ProcedureC Proc_ClearGadgetItemList(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_ResizeGadget(*this.Gadget, x.l, y.l, width.l, height.l)
  CompilerElse
    ProcedureC Proc_ResizeGadget(*this.Gadget, x.l, y.l, width.l, height.l)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
      ; Orginale Funktion aufrufen
      If *MyGadgetVT\vt_org\ResizeGadget
        result =*MyGadgetVT\vt_org\ResizeGadget(*this.Gadget, x, y, width, height)
      EndIf
      
      ; Neu zeichnen
      If width <> #PB_Ignore
        *MyGadgetVT\dx = width
      EndIf
      If height <> #PB_Ignore
        *MyGadgetVT\dy = height
      EndIf
      Draw(*MyGadgetVT)
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_CountGadgetItems(*this.Gadget)
  CompilerElse
    ProcedureC Proc_CountGadgetItems(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetItemState(*this.Gadget, Item)
  CompilerElse
    ProcedureC Proc_GetGadgetItemState(*this.Gadget, Item)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetItemState(*this.Gadget, Item, State)
  CompilerElse
    ProcedureC Proc_SetGadgetItemState(*this.Gadget, Item, State)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetItemText(*this.Gadget, Item, Column, PreviousStringPosition)
  CompilerElse
    ProcedureC Proc_GetGadgetItemText(*this.Gadget, Item, Column, PreviousStringPosition)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    Protected String.s
    Protected StringLength
    Protected *output.Character
    
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      String = "Colum " + Str(Column)
      StringLength = Len(string)
      
      ; String zurückgeben
      *Output = SYS_GetOutputBuffer(StringLength, PreviousStringPosition)
      CopyMemory(@String, *output, StringLength)
      *output + StringLength * SizeOf(character)
      *output\c = 0
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetItemText(*this.Gadget, Item, *Text, Column)
  CompilerElse
    ProcedureC Proc_SetGadgetItemText(*this.Gadget, Item, *Text, Column)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    Protected ParameterIndex, String.s
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Get the index of the parameter in the internal buffer (will Return 0 If it's not in the internal buffer)
      ParameterIndex = SYS_GetParameterIndex(*Text)
      If ParameterIndex
        ; Get back the string pointer only if it was on the internal buffer
        *Text = SYS_ResolveParameter(ParameterIndex)
      EndIf
      ; Anpassung Linux
      CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        String = PeekS(*Text)
      CompilerElse
        String = PeekS(*Text,-1, #PB_UTF8)
      CompilerEndIf
      
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_OpenGadgetList2(*this.Gadget, Item)
  CompilerElse
    ProcedureC Proc_OpenGadgetList2(*this.Gadget, Item)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GadgetX(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GadgetX(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GadgetY(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GadgetY(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GadgetWidth(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GadgetWidth(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GadgetHeight(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GadgetHeight(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_HideGadget(*this.Gadget, State)
  CompilerElse
    ProcedureC Proc_HideGadget(*this.Gadget, State)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Debug "HideGadget " + Str(State)
      
      ; Orginal HideGadget aufrufen
      CompilerIf #PB_Compiler_OS <> #PB_OS_Linux
        If *MyGadgetVT\vt_org\HideGadget
          result = *MyGadgetVT\vt_org\HideGadget(*this, State)
        EndIf
      CompilerEndIf
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_AddGadgetColumn(*this.Gadget, Item, *Text, Column)
  CompilerElse
    ProcedureC Proc_AddGadgetColumn(*this.Gadget, Item, *Text, Column)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_RemoveGadgetColumn(*this.Gadget, Position)
  CompilerElse
    ProcedureC Proc_RemoveGadgetColumn(*this.Gadget, Position)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetAttribute(*this.Gadget, Attribute)
  CompilerElse
    ProcedureC Proc_GetGadgetAttribute(*this.Gadget, Attribute)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      If Attribute < 1024 ; CanvasGadget Attribute
        If *MyGadgetVT\vt_org\GetGadgetAttribute
          result = *MyGadgetVT\vt_org\GetGadgetAttribute(*this, Attribute)
        EndIf
      Else ; User Attribute ab 1024
        
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetAttribute(*this.Gadget, Attribute, Value)
  CompilerElse
    ProcedureC Proc_SetGadgetAttribute(*this.Gadget, Attribute, Value)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      If Attribute < 1024 ; CanvasGadget Attribute
        If *MyGadgetVT\vt_org\GetGadgetAttribute
          result = *MyGadgetVT\vt_org\SetGadgetAttribute(*this, Attribute, Value)
        EndIf
      Else ; User Attribute ab 1024
        
      EndIf
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Column)
  CompilerElse
    ProcedureC Proc_GetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Column)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Value, Column)
  CompilerElse
    ProcedureC Proc_SetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Value, Column)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
  CompilerElse
    ProcedureC Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Select ColorType
        Case #PB_Gadget_BackColor
          *MyGadgetVT\backcolor = Color
          Draw(*MyGadgetVT)
        Case #PB_Gadget_FrontColor
          *MyGadgetVT\frontcolor = Color
          Draw(*MyGadgetVT)
        Case #PB_Gadget_LineColor
          *MyGadgetVT\bordercolor = Color
          Draw(*MyGadgetVT)
      EndSelect
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetColor(*this.Gadget, ColorType)
  CompilerElse
    ProcedureC Proc_GetGadgetColor(*this.Gadget, ColorType)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Select ColorType
        Case #PB_Gadget_BackColor
          result = *MyGadgetVT\backcolor
        Case #PB_Gadget_FrontColor
          result = *MyGadgetVT\frontcolor
        Case #PB_Gadget_LineColor
          result = *MyGadgetVT\bordercolor
        
      EndSelect
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetItemColor2(*this.Gadget, Item, ColorType, Color, Column)
  CompilerElse
    ProcedureC Proc_SetGadgetItemColor2(*this.Gadget, Item, ColorType, Color, Column)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetItemColor2(*this.Gadget, Item, ColorType, Column)
  CompilerElse
    ProcedureC Proc_GetGadgetItemColor2(*this.Gadget, Item, ColorType, Column)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetItemData(*this.Gadget, Item, Value)
  CompilerElse
    ProcedureC Proc_SetGadgetItemData(*this.Gadget, Item, Value)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetItemData(*this.Gadget, Item)
  CompilerElse
    ProcedureC Proc_GetGadgetItemData(*this.Gadget, Item)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetRequiredSize(*this.Gadget, *Width.integer, *Height.integer)
  CompilerElse
    ProcedureC Proc_GetRequiredSize(*this.Gadget, *Width.integer, *Height.integer)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetActiveGadget(*this.Gadget)
  CompilerElse
    ProcedureC Proc_SetActiveGadget(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetFont(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GetGadgetFont(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      result = *MyGadgetVT\hFont
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetFont(*this.Gadget, hFont)
  CompilerElse
    ProcedureC Proc_SetGadgetFont(*this.Gadget, hFont)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      If hFont
        *MyGadgetVT\hFont = hFont
      Else
        *MyGadgetVT\hFont = #PB_Default
      EndIf
      Draw(*MyGadgetVT)
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetItemImage(*this.Gadget, hImage)
  CompilerElse
    ProcedureC Proc_SetGadgetItemImage(*this.Gadget, hImage)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; *************************************************************************************
  
  ;- Datenverwaltung
  
  Procedure NewData(*this.gadget)
    
    Protected *MyGadgetVT.udtMyGadgetVT, key.s
    
    key = "ID-" + Str(*this\Gadget)
    *MyGadgetVT = AddMapElement(MyGadgetData(), key)
    If *MyGadgetVT
      ; ----------------------------------------------------------
      ; Orginale Funktionstabelle kopieren
      CopyMemory(*this\vt, *MyGadgetVT\vt, SizeOf(GadgetVT))
      With *MyGadgetVT\vt
        ; Eigene Funktion FreeGadget eintragen, WIRD IMMER GEBRAUCHT
        \FreeGadget = @Proc_FreeGadget()
      
        ; Eigene Funktionen hinzufügen/umleiten
        \GetGadgetState = @Proc_GetGadgetState()
        \SetGadgetState = @Proc_SetGadgetState()
        \GetGadgetText = @Proc_GetGadgetText()
        \SetGadgetText = @Proc_SetGadgetText()
        \ResizeGadget = @Proc_ResizeGadget()
        \GetGadgetColor = @Proc_GetGadgetColor()
        \SetGadgetColor = @Proc_SetGadgetColor()
        \GetGadgetFont = @Proc_GetGadgetFont()
        \SetGadgetFont = @Proc_SetGadgetFont()
        ; ...
      EndWith
      ; ----------------------------------------------------------
      
      ; Orginale Funktionentabelle sichern
      *MyGadgetVT\vt_org = *this\vt
      ; Orginale Funktionentabelle ersetzen
      *this\vt = *MyGadgetVT
      
    EndIf
    
    ProcedureReturn *MyGadgetVT
    
  EndProcedure
    
  ; -------------------------------------------------------------------------------------
  
  Procedure FreeData(*this.gadget)
    
    Protected result, *MyGadgetVT.udtMyGadgetVT, key.s
    
    key = "ID-" + Str(*this\Gadget)
    *MyGadgetVT = FindMapElement(MyGadgetData(), key)
    If *MyGadgetVT
      ; Orginal FreeGadget aufrufen
      If *MyGadgetVT\vt_org\FreeGadget
        *MyGadgetVT\vt_org\FreeGadget(*this)
      EndIf
      ; Orginale Funktionstabelle wiederherstellen
      *this\vt = *MyGadgetVT\vt_org
      ; Eigene Daten löschen
      DeleteMapElement(MyGadgetData())
    EndIf
    ProcedureReturn result
    
  EndProcedure
    
  ; *************************************************************************************
  
  ;- Interne Funktionen
  
  Procedure DrawTextBox(x, y, dx, dy, text.s, flags)
    
    Protected is_multiline, is_left, is_right
    Protected text_width, text_height 
    Protected text_x, text_y
    Protected rows , row_text.s, row_text1.s, start, count
    
    is_multiline = flags & #PB_Button_MultiLine
    is_left = flags & #PB_Button_Left
    is_right = flags & #PB_Button_Right
    
    text_width = TextWidth(text)
    text_height = TextHeight(text)
    
    If Not is_multiline
      If is_left
        text_x = 6
        text_y = dy / 2 - text_height / 2
      ElseIf is_right
        text_x = dx - text_width - 6
        text_y = dy / 2 - text_height / 2
      Else
        text_x = dx / 2 - text_width / 2
        text_y = dy / 2 - text_height / 2
      EndIf
      DrawText(x + text_x, y + text_y, text)
      ProcedureReturn 1
    EndIf
    
    rows = text_width / dx
    start = 1
    text_y = (dy / 2 - text_height / 2) - (text_height / 2 * rows)
    count = CountString(text, " ") + 1
    Repeat
      row_text = StringField(text, start, " ") + " "
      Repeat
        start + 1
        row_text1 = StringField(text, start, " ")
        If TextWidth(row_text + row_text1) < dx - 12
          row_text + row_text1 + " "
        Else
          Break
        EndIf
      Until start > count
      row_text = Trim(row_text)
      If is_left
        text_x = 6
      ElseIf is_right
        text_x = dx - TextWidth(row_text) - 6
      Else
        text_x = dx / 2 - TextWidth(row_text) / 2
      EndIf
      DrawText(x + text_x, y + text_y, row_text)
      text_y + text_height
    Until start > count
      
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure Draw(*MyGadgetVT.udtMyGadgetVT)
    
    Protected backcolor, backcolor2, bordercolor2
    Protected dx, dy
    Protected text_width, text_height
    Protected text_x, text_y
    
    With *MyGadgetVT
      
      If \cstate = #ButtonColorStateDown Or \state = 1
        backcolor = RGB(Red(\backcolor) * 85 / 100, Green(\backcolor) * 85 / 100, Blue(\backcolor) * 85 / 100)
        bordercolor2 = $00C0C0C0
      ElseIf \cstate = #ButtonColorStateOver
        backcolor = RGB(Red(\backcolor) * 95 / 100, Green(\backcolor) * 95 / 100, Blue(\backcolor) * 95 / 100)
        bordercolor2 = $00FFFFFF
      Else
        backcolor = \backcolor
        bordercolor2 = $00FFFFFF
      EndIf
      StartDrawing(CanvasOutput(\id))
      If \dx > 2 And \dy > 2
        If \style
          ; Style Windows 8
          Box(0, 0, \dx, \dy, \bordercolor)
          Box(1, 1, \dx - 2, \dy - 2, backColor)
        Else
          ; Style Windows 7
          backcolor2 = RGB(Red(backcolor) * 95 / 100, Green(backcolor) * 95 / 100, Blue(backcolor) * 95 / 100)
          Box(0, 0, \dx, \dy, \bordercolor)
          Box(1, 1, \dx - 2, \dy - 2, bordercolor2)
          dx = \dx - 4
          dy = (\dy - 4) / 2
          Box(2, 2, dx, dy, backColor)
          Box(2, 2 + dy, dx, dy, backcolor2)
          Plot(0, 0, $00FFFFFF) : Plot(\dx - 1, 0, $00FFFFFF) : Plot(0 ,\dy - 1, $00FFFFFF) : Plot(\dx - 1,\dy - 1, $00FFFFFF)
          Plot(1, 1, \bordercolor) : Plot(\dx - 2, 1, \bordercolor) : Plot(1 ,\dy - 2, \bordercolor) : Plot(\dx - 2,\dy - 2, \bordercolor)
          Plot(2, 2, bordercolor2) : Plot(\dx - 3, 2, bordercolor2) : Plot(2 ,\dy - 3, bordercolor2) : Plot(\dx - 3,\dy - 3, bordercolor2)
        EndIf
        DrawingFont(\hFont)
        DrawingMode(#PB_2DDrawing_Transparent)
        FrontColor(\frontcolor)
        DrawTextBox(0, 0, \dx, \dy, \text, \flags)
      Else
        Box(0, 0, \dx, \dy, $00808080)
      EndIf
      StopDrawing()  
        
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure EventHandler()
    
    Protected *Gadget.Gadget, *MyGagetVT.udtMyGadgetVT
    
    *Gadget = IsGadget(EventGadget())
    If *Gadget
      *MyGagetVT = *Gadget\vt
      With *MyGagetVT
        Select EventType()
          Case #PB_EventType_MouseMove
            If \cstate = #ButtonColorStateDefault
              \cstate = #ButtonColorStateOver
              Draw(*MyGagetVT)
            EndIf
          Case #PB_EventType_MouseLeave
            \cstate = #ButtonColorStateDefault
            Draw(*MyGagetVT)
          Case #PB_EventType_LeftButtonDown
            \cstate = #ButtonColorStateDown
            Draw(*MyGagetVT)
          Case #PB_EventType_LeftButtonUp
            \cstate = #ButtonColorStateOver
            Draw(*MyGagetVT)
          Case #PB_EventType_LeftClick
            If \flags & #PB_Button_Toggle = #PB_Button_Toggle
              If \state
                \state = 0
              Else
                \state = 1
              EndIf
              Draw(*MyGagetVT)
            EndIf
        EndSelect
        
      EndWith
    EndIf
    
  EndProcedure
  
  ; *************************************************************************************
  
  ;- Public Funktionen
  
  Procedure Create(id, x, y, dx, dy, text.s, flags = #PB_Button_Default)
    
    Protected result, nr, *Gadget.Gadget, *MyGadgetVT.udtMyGadgetVT
    
    Repeat
      ; Gadget anlegen
      result = CanvasGadget(id, x, y , dx, dy)
      If result = 0
        Break
      EndIf
      If id = #PB_Any
        nr = result
      Else 
        nr = id
      EndIf
      *Gadget = IsGadget(nr)
      ;*Gadget = PB_Object_GetObject(PB_Gadget_Objects, nr)
      If *Gadget
        ; Eigene Daten anlegen
        *MyGadgetVT = NewData(*Gadget)
        If *MyGadgetVT = 0
          FreeGadget(nr)
          Break
        EndIf
        *MyGadgetVT\id = nr
        With *MyGadgetVT
          ; Eigene Daten zuweisen
          \dx = dx
          \dy = dy
          \text = text
          \flags = flags
          \state = 0
          \cstate = #ButtonColorStateDefault
          \hFont = GetGadgetFont(#PB_Default)
          \frontcolor = $00000000
          \backcolor = $00F0F0F0
          \bordercolor = $00808080
          If OSVersion() >= #PB_OS_Windows_8 And OSVersion() <= #PB_OS_Windows_Future
            \style = 1
          Else
            \style = 0
          EndIf
        EndWith
        ; Zeichnen
        Draw(*MyGadgetVT)
        
        ; Eventhandler setzen
        BindGadgetEvent(nr, @EventHandler(), #PB_All)
          
      Else
        result = 0
        Break
      EndIf
    Until #True
    
    ProcedureReturn result
    
  EndProcedure
  
  
EndModule

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

;- Test

CompilerIf #PB_Compiler_IsMainFile
  
  ;- Konstanten
  Enumeration ; Window ID
    #Window
  EndEnumeration
  
  Enumeration ; Menu ID
    #Menu
  EndEnumeration
  
  Enumeration ; MenuItem ID
    #Menu_Exit
  EndEnumeration
  
  Enumeration ; Statusbar ID
    #Statusbar
  EndEnumeration
  
  Enumeration ; Gadget ID
    
  EndEnumeration
  
  ; ***************************************************************************************
  
  ;- Globale Variablen
  Global exit = 0
  
  Macro ButtonGadget(Gadget, x, y, Width, Height, Text, Flags = #PB_Button_Default)
    ButtonColorGadget::Create(Gadget, x, y, Width, Height, Text, Flags)
  EndMacro
  
  ;- Fenster
  style = #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 500, 400, "Fenster", style)
    ; Menu
    If CreateMenu(#Menu, WindowID(#Window))
      MenuTitle("&Datei")
        MenuItem(#Menu_Exit, "Be&enden")
    EndIf
    ; Statusbar
    CreateStatusBar(#Statusbar, WindowID(#Window))
    ; Gadgets
    
    LoadFont(0, "Arial", 16)
    
    ButtonColorGadget::Create(0, 10 ,10, 200, 40, "Button 1", #PB_Button_Left)
    
    ButtonColorGadget::Create(1, 10 ,60, 200, 40, "Button 2", #PB_Button_MultiLine)
    SetGadgetColor(1, #PB_Gadget_BackColor, $00FF4040)
    SetGadgetColor(1, #PB_Gadget_FrontColor, $00FFFFFF)
    
    SetGadgetFont(1, FontID(0))
    
    ; Durch macro ersetzt
    ButtonGadget(2, 10, 180, 200, 40, "Button 3", #PB_Button_Toggle | #PB_Button_Right)
    SetGadgetColor(2, #PB_Gadget_BackColor, $000000FF)
    
    ResizeGadget(1, 10, 80, 200, 80)
    SetGadgetText(1, "Hello World! Button multiline")
    Debug "Button (" + GetGadgetText(1) + ")"
    
    ;-- Hauptschleife
    Repeat
      event   = WaitWindowEvent()
      Select event
        Case #PB_Event_Menu
          Select menu
            Case #Menu_Exit
              Exit = 1
          EndSelect
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 0
              If EventType() = #PB_EventType_LeftClick
                Debug "Button 1"
              EndIf
            Case 1
              If EventType() = #PB_EventType_LeftClick
                Debug "Button 2"
              EndIf
            Case 2
              If EventType() = #PB_EventType_LeftClick
                Debug "Button 3 State " + Str(GetGadgetState(2))
              EndIf
              
          EndSelect
          
              
        Case #PB_Event_CloseWindow
          Exit = 1
        
      EndSelect
      
    Until Exit
  EndIf
  
  CloseWindow(#Window)
  
CompilerEndIf
One can replace the function "ButtonGadget" with the following macro.
Helps in use of Form Designer

Code: Select all

Macro ButtonGadget(Gadget, x, y, Width, Height, Text, Flags = #PB_Button_Default)
  ButtonColorGadget::Create(Gadget, x, y, Width, Height, Text, Flags)
EndMacro
When a new version of PureBasic internal Structuren "Gadget" and "GadgetVT" must be checked.

Can someone test the gadget on a MacOS?

GT :wink:

Re: ButtonColorGadget with standard purebasic function

Posted: Fri Apr 18, 2014 7:27 pm
by said
Thanks for sharing mk-soft, that's very tricky and very educative ...
The outcome is very nice. Without being negative, does overriding PB native functions justify this complexity? Or you have other reasons for ...

Re: ButtonColorGadget with standard purebasic function

Posted: Fri Apr 18, 2014 7:46 pm
by mk-soft
It is a way own gadgets with the help of the "CanvasGadget" to develop without the helper functions for observed extra-ready. It can then use the standard functions of purebasic be used with the standard constants.

In the example all functions of purebasic are provided. However, not all connected to time with the virtual table. Show into NewData().

P.S.
Small Update v1.15 by EventHandling and SetGadgetState

Re: ButtonColorGadget with standard purebasic function

Posted: Fri Apr 18, 2014 8:29 pm
by mk-soft
Here now is the short version with only the necessary functions

ButtonColorGadget.pbi

Code: Select all

;-TOP
; Kommentar     : Modul ButtonColorGadget (short version)
; Author        : mk-soft
; Second Author : 
; Datei         : *.pb
; Version       : 1.19
; Erstellt      : 21.03.2014
; Geändert      : 19.04.2014
; 
; Compilermode  : ASCII, Unicode
; OS            : Windows, Linux
;
; ***************************************************************************************

;- Modul Public
DeclareModule ButtonColorGadget
  
  Declare Create(id, x, y, dx, dy, text.s, flags = #PB_Button_Default)
  
EndDeclareModule

;- Modul Private
Module ButtonColorGadget
  EnableExplicit
  
  ;- PB Interne System Funktionen
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
  CompilerElse
    ImportC ""
  CompilerEndIf
    PB_Object_GetObject(Objects.i, ID.i)
    PB_Gadget_Objects.i
  EndImport
  
  Import ""
    SYS_GetParameterIndex(String)
    SYS_GetOutputBuffer(StringLength, PreviousPosition)
    SYS_ResolveParameter(ParameterIndex)
  EndImport
  
  ;- Konstanten
  #ButtonColorStateDefault = 0
  #ButtonColorStateOver = 1
  #ButtonColorStateDown = 2
  
  ;- Declare Basisfunktionen
  Declare NewData(*this)
  Declare FreeData(*this)
  
  ;- Declare Eigene Funktionen
  Declare Draw(*MyGadgetVT)
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    ;- PB Interne Struktur Gadget Windows
    Structure Gadget
      Gadget.i
      *vt.GadgetVT
      UserData.i
      OldCallback.i
      Daten.i[4]
    EndStructure
  CompilerElse
    ;- PB Interne Struktur Gadget Linux
    Structure Gadget
      Gadget.i
      GadgetContainer.i
      *vt.GadgetVT
      UserData.i
      Daten.i[4]
    EndStructure
  CompilerEndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  ;- PB Interne Prototypen Windows
    Prototype Proc_Callback(*this.Gadget, Window, Message, wParam, lParam)
    Prototype Proc_FreeGadget(*this.Gadget)
    Prototype Proc_GetGadgetState(*this.Gadget)
    Prototype Proc_SetGadgetState(*this.Gadget, State)
    Prototype Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
    Prototype Proc_SetGadgetText(*this.Gadget, *Text)
    Prototype Proc_AddGadgetItem2(*this.Gadget, Position, *Text, *Image)
    Prototype Proc_AddGadgetItem3(*this.Gadget, Position, *Text, *Image, Flags)
    Prototype Proc_RemoveGadgetItem(*this.Gadget, Item)
    Prototype Proc_ClearGadgetItemList(*this.Gadget)
    Prototype Proc_ResizeGadget(*this.Gadget, x, y, width, height)
    Prototype Proc_CountGadgetItems(*this.Gadget)
    Prototype Proc_GetGadgetItemState(*this.Gadget, Item)
    Prototype Proc_SetGadgetItemState(*this.Gadget, Item, State)
    Prototype Proc_GetGadgetItemText(*this.Gadget, Item, Column, PreviousStringPosition)
    Prototype Proc_SetGadgetItemText(*this.Gadget, Item, *Text, Column)
    Prototype Proc_OpenGadgetList2(*this.Gadget, Item)
    Prototype Proc_GadgetX(*this.Gadget)
    Prototype Proc_GadgetY(*this.Gadget)
    Prototype Proc_GadgetWidth(*this.Gadget)
    Prototype Proc_GadgetHeight(*this.Gadget)
    Prototype Proc_HideGadget(*this.Gadget, State)
    Prototype Proc_AddGadgetColumn(*this.Gadget, Item, *Text, Column)
    Prototype Proc_RemoveGadgetColumn(*this.Gadget, Position)
    Prototype Proc_GetGadgetAttribute(*this.Gadget, Attribute)
    Prototype Proc_SetGadgetAttribute(*this.Gadget, Attribute, Value)
    Prototype Proc_GetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Column)
    Prototype Proc_SetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Value, Column)
    Prototype Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
    Prototype Proc_GetGadgetColor(*this.Gadget, ColorType)
    Prototype Proc_SetGadgetItemColor2(*this.Gadget, Item, ColorType, Color, Column)
    Prototype Proc_GetGadgetItemColor2(*this.Gadget, Item, ColorType, Column)
    Prototype Proc_SetGadgetItemData(*this.Gadget, Item, Value)
    Prototype Proc_GetGadgetItemData(*this.Gadget, Item)
    Prototype Proc_GetRequiredSize(*this.Gadget, *Width.integer, *Height.integer)
    Prototype Proc_SetActiveGadget(*this.Gadget)
    Prototype Proc_GetGadgetFont(*this.Gadget)
    Prototype Proc_SetGadgetFont(*this.Gadget, hFont)
    Prototype Proc_SetGadgetItemImage(*this.Gadget, hImage)
  CompilerElse
    ;- PB Interne Prototypen Linux
    PrototypeC Proc_ActivateGadget(*this.Gadget)
    PrototypeC Proc_FreeGadget(*this.Gadget)
    PrototypeC Proc_GetGadgetState(*this.Gadget)
    PrototypeC Proc_SetGadgetState(*this.Gadget, State)
    PrototypeC Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
    PrototypeC Proc_SetGadgetText(*this.Gadget, Text)
    PrototypeC Proc_AddGadgetItem2(*this.Gadget, Position, *Text, *Image)
    PrototypeC Proc_AddGadgetItem3(*this.Gadget, Position, *Text, *Image, Flags)
    PrototypeC Proc_RemoveGadgetItem(*this.Gadget, Item)
    PrototypeC Proc_ClearGadgetItemList(*this.Gadget)
    PrototypeC Proc_ResizeGadget(*this.Gadget, x, y, width, height)
    PrototypeC Proc_CountGadgetItems(*this.Gadget)
    PrototypeC Proc_GetGadgetItemState(*this.Gadget, Item)
    PrototypeC Proc_SetGadgetItemState(*this.Gadget, Item, State)
    PrototypeC Proc_GetGadgetItemText(*this.Gadget, Item, Column, PreviousStringPosition)
    PrototypeC Proc_SetGadgetItemText(*this.Gadget, Item, *Text, Column)
    PrototypeC Proc_OpenGadgetList2(*this.Gadget, Item)
    PrototypeC Proc_GadgetX(*this.Gadget)
    PrototypeC Proc_GadgetY(*this.Gadget)
    PrototypeC Proc_GadgetWidth(*this.Gadget)
    PrototypeC Proc_GadgetHeight(*this.Gadget)
    PrototypeC Proc_HideGadget(*this.Gadget, State)
    PrototypeC Proc_AddGadgetColumn(*this.Gadget, Item, *Text, Column)
    PrototypeC Proc_RemoveGadgetColumn(*this.Gadget, Position)
    PrototypeC Proc_GetGadgetAttribute(*this.Gadget, Attribute)
    PrototypeC Proc_SetGadgetAttribute(*this.Gadget, Attribute, Value)
    PrototypeC Proc_GetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Column)
    PrototypeC Proc_SetGadgetItemAttribute2(*this.Gadget, Item, Attribute, Value, Column)
    PrototypeC Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
    PrototypeC Proc_GetGadgetColor(*this.Gadget, ColorType)
    PrototypeC Proc_SetGadgetItemColor2(*this.Gadget, Item, ColorType, Color, Column)
    PrototypeC Proc_GetGadgetItemColor2(*this.Gadget, Item, ColorType, Column)
    PrototypeC Proc_SetGadgetItemData(*this.Gadget, Item, Value)
    PrototypeC Proc_GetGadgetItemData(*this.Gadget, Item)
    PrototypeC Proc_GetRequiredSize(*this.Gadget, *Width.integer, *Height.integer)
    PrototypeC Proc_SetActiveGadget(*this.Gadget)
    PrototypeC Proc_GetGadgetFont(*this.Gadget)
    PrototypeC Proc_SetGadgetFont(*this.Gadget, hFont)
    PrototypeC Proc_SetGadgetItemImage(*this.Gadget, hImage)
  CompilerEndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    ;- PB Interne Struktur GadgetVT Windows
    Structure GadgetVT
      GadgetType.l   
      SizeOf.l       
      GadgetCallback.Proc_Callback
      FreeGadget.Proc_FreeGadget
      GetGadgetState.Proc_GetGadgetState
      SetGadgetState.Proc_SetGadgetState
      GetGadgetText.Proc_GetGadgetText
      SetGadgetText.Proc_SetGadgetText
      AddGadgetItem2.Proc_AddGadgetItem2
      AddGadgetItem3.Proc_AddGadgetItem3
      RemoveGadgetItem.Proc_RemoveGadgetItem
      ClearGadgetItemList.Proc_ClearGadgetItemList
      ResizeGadget.Proc_ResizeGadget
      CountGadgetItems.Proc_CountGadgetItems
      GetGadgetItemState.Proc_GetGadgetItemState
      SetGadgetItemState.Proc_SetGadgetItemState
      GetGadgetItemText.Proc_GetGadgetItemText
      SetGadgetItemText.Proc_SetGadgetItemText
      OpenGadgetList2.Proc_OpenGadgetList2
      GadgetX.Proc_GadgetX
      GadgetY.Proc_GadgetY
      GadgetWidth.Proc_GadgetWidth
      GadgetHeight.Proc_GadgetHeight
      HideGadget.Proc_HideGadget
      AddGadgetColumn.Proc_AddGadgetColumn
      RemoveGadgetColumn.Proc_RemoveGadgetColumn
      GetGadgetAttribute.Proc_GetGadgetAttribute
      SetGadgetAttribute.Proc_SetGadgetAttribute
      GetGadgetItemAttribute2.Proc_GetGadgetItemAttribute2
      SetGadgetItemAttribute2.Proc_SetGadgetItemAttribute2
      SetGadgetColor.Proc_SetGadgetColor
      GetGadgetColor.Proc_GetGadgetColor
      SetGadgetItemColor2.Proc_SetGadgetItemColor2
      GetGadgetItemColor2.Proc_GetGadgetItemColor2
      SetGadgetItemData.Proc_SetGadgetItemData
      GetGadgetItemData.Proc_GetGadgetItemData
      GetRequiredSize.Proc_GetRequiredSize
      SetActiveGadget.Proc_SetActiveGadget
      GetGadgetFont.Proc_GetGadgetFont
      SetGadgetFont.Proc_SetGadgetFont
      SetGadgetItemImage.Proc_SetGadgetItemImage
    EndStructure
  CompilerElse
    ;- PB Interne Struktur GadgetVT Linux
    Structure GadgetVT
      SizeOf.l
      GadgetType.l
      ActivateGadget.Proc_ActivateGadget;
      FreeGadget.Proc_FreeGadget;
      GetGadgetState.Proc_GetGadgetState;
      SetGadgetState.Proc_SetGadgetState;
      GetGadgetText.Proc_GetGadgetText;
      SetGadgetText.Proc_SetGadgetText;
      AddGadgetItem2.Proc_AddGadgetItem2;
      AddGadgetItem3.Proc_AddGadgetItem3;
      RemoveGadgetItem.Proc_RemoveGadgetItem;
      ClearGadgetItemList.Proc_ClearGadgetItemList;
      ResizeGadget.Proc_ResizeGadget;
      CountGadgetItems.Proc_CountGadgetItems;
      GetGadgetItemState.Proc_GetGadgetItemState;
      SetGadgetItemState.Proc_SetGadgetItemState;
      GetGadgetItemText.Proc_GetGadgetItemText;
      SetGadgetItemText.Proc_SetGadgetItemText;
      SetGadgetFont.Proc_SetGadgetFont;
      OpenGadgetList2.Proc_OpenGadgetList2;
      AddGadgetColumn.Proc_AddGadgetColumn;
      GetGadgetAttribute.Proc_GetGadgetAttribute;
      SetGadgetAttribute.Proc_SetGadgetAttribute;
      GetGadgetItemAttribute2.Proc_GetGadgetItemAttribute2;
      SetGadgetItemAttribute2.Proc_SetGadgetItemAttribute2;
      RemoveGadgetColumn.Proc_RemoveGadgetColumn;
      SetGadgetColor.Proc_SetGadgetColor;
      GetGadgetColor.Proc_GetGadgetColor;
      SetGadgetItemColor2.Proc_SetGadgetItemColor2;
      GetGadgetItemColor2.Proc_GetGadgetItemColor2;
      SetGadgetItemData.Proc_SetGadgetItemData;
      GetGadgetItemData.Proc_GetGadgetItemData;
      GetGadgetFont.Proc_GetGadgetFont;
      HideGadget.Proc_HideGadget; Nicht bei Linux vorhanden, sondern bei MacOS
    EndStructure
  CompilerEndIf
  
  ;- Eigene interne Struktur MyGadgetVT
  Structure udtMyGadgetVT
    ; Basis
    vt.GadgetVT ; Virtuelle Funktionstabelle. Nicht Verschieben!
    *vt_org.GadgetVT  ; Orginal virtuelle Funktionstabelle
    id.i        ; Gadget PB_ID
    ; Eigene Daten
    dx.i
    dy.i
    text.s
    flags.i
    state.i
    cstate.i
    style.i
    hFont.i
    frontcolor.i
    backcolor.i
    bordercolor.i
  EndStructure
  
  ;- Eigene interne Daten (Speicher)
  Global NewMap MyGadgetData.udtMyGadgetVT() 
  
  ; -------------------------------------------------------------------------------------
  
  ;- PB Interne Funktionen (Proceduren)
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_FreeGadget(*this.Gadget)
  CompilerElse
    ProcedureC Proc_FreeGadget(*this.Gadget)
  CompilerEndIf  
  
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    ; Eigene Daten freigeben  
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Debug "FreeGadget"
      
      ; Daten und Gadget freigeben
      result = FreeData(*this)
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetState(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GetGadgetState(*this.Gadget)
  CompilerEndIf  
  
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      result = *MyGadgetVT\state
    EndIf
    
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetState(*this.Gadget, State)
  CompilerElse
    ProcedureC Proc_SetGadgetState(*this.Gadget, State)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      With *MyGadgetVT
        \state = State
      EndWith
      Draw(*MyGadgetVT)
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
  CompilerElse
    ProcedureC Proc_GetGadgetText(*this.Gadget, PreviousStringPosition)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    Protected String.s
    Protected StringLength
    Protected *output.Character
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      String = *MyGadgetVT\text
      StringLength = Len(string)
      
      ; String zurückgeben
      *Output = SYS_GetOutputBuffer(StringLength, PreviousStringPosition)
      CopyMemory(@String, *output, StringLength * SizeOf(character))
      *output + StringLength * SizeOf(character)
      *output\c = 0
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetText(*this.Gadget, *Text)
  CompilerElse
    ProcedureC Proc_SetGadgetText(*this.Gadget, *Text)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    Protected ParameterIndex, String.s
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Get the index of the parameter in the internal buffer (will Return 0 If it's not in the internal buffer)
      ParameterIndex = SYS_GetParameterIndex(*Text)
      If ParameterIndex
        ; Get back the string pointer only if it was on the internal buffer
        *Text = SYS_ResolveParameter(ParameterIndex)
      EndIf
      ; Anpassung Linux
      CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        String = PeekS(*Text)
      CompilerElse
        String = PeekS(*Text,-1, #PB_UTF8)
      CompilerEndIf
      
      *MyGadgetVT\text = String
      Draw(*MyGadgetVT)
    EndIf
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_ResizeGadget(*this.Gadget, x.l, y.l, width.l, height.l)
  CompilerElse
    ProcedureC Proc_ResizeGadget(*this.Gadget, x.l, y.l, width.l, height.l)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      
      ; Orginale Funktion aufrufen
      If *MyGadgetVT\vt_org\ResizeGadget
        result =*MyGadgetVT\vt_org\ResizeGadget(*this.Gadget, x, y, width, height)
      EndIf
      
      ; Neu zeichnen
      If width <> #PB_Ignore
        *MyGadgetVT\dx = width
      EndIf
      If height <> #PB_Ignore
        *MyGadgetVT\dy = height
      EndIf
      Draw(*MyGadgetVT)
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
  CompilerElse
    ProcedureC Proc_SetGadgetColor(*this.Gadget, ColorType, Color)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Select ColorType
        Case #PB_Gadget_BackColor
          *MyGadgetVT\backcolor = Color
          Draw(*MyGadgetVT)
        Case #PB_Gadget_FrontColor
          *MyGadgetVT\frontcolor = Color
          Draw(*MyGadgetVT)
        Case #PB_Gadget_LineColor
          *MyGadgetVT\bordercolor = Color
          Draw(*MyGadgetVT)
      EndSelect
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetColor(*this.Gadget, ColorType)
  CompilerElse
    ProcedureC Proc_GetGadgetColor(*this.Gadget, ColorType)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      Select ColorType
        Case #PB_Gadget_BackColor
          result = *MyGadgetVT\backcolor
        Case #PB_Gadget_FrontColor
          result = *MyGadgetVT\frontcolor
        Case #PB_Gadget_LineColor
          result = *MyGadgetVT\bordercolor
        
      EndSelect
      
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_GetGadgetFont(*this.Gadget)
  CompilerElse
    ProcedureC Proc_GetGadgetFont(*this.Gadget)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      result = *MyGadgetVT\hFont
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Procedure Proc_SetGadgetFont(*this.Gadget, hFont)
  CompilerElse
    ProcedureC Proc_SetGadgetFont(*this.Gadget, hFont)
  CompilerEndIf  
    
    Protected *MyGadgetVT.udtMyGadgetVT, result
    
    *MyGadgetVT = *this\vt
    If *MyGadgetVT
      ; Code
      If hFont
        *MyGadgetVT\hFont = hFont
      Else
        *MyGadgetVT\hFont = #PB_Default
      EndIf
      Draw(*MyGadgetVT)
    EndIf
    ProcedureReturn result
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  ; *************************************************************************************
  
  ;- Datenverwaltung
  
  Procedure NewData(*this.gadget)
    
    Protected *MyGadgetVT.udtMyGadgetVT, key.s
    
    key = "ID-" + Str(*this\Gadget)
    *MyGadgetVT = AddMapElement(MyGadgetData(), key)
    If *MyGadgetVT
      ; ----------------------------------------------------------
      ; Orginale Funktionstabelle kopieren
      CopyMemory(*this\vt, *MyGadgetVT\vt, SizeOf(GadgetVT))
      With *MyGadgetVT\vt
        ; Eigene Funktion FreeGadget eintragen, WIRD IMMER GEBRAUCHT
        \FreeGadget = @Proc_FreeGadget()
      
        ; Eigene Funktionen hinzufügen/umleiten
        \GetGadgetState = @Proc_GetGadgetState()
        \SetGadgetState = @Proc_SetGadgetState()
        \GetGadgetText = @Proc_GetGadgetText()
        \SetGadgetText = @Proc_SetGadgetText()
        \ResizeGadget = @Proc_ResizeGadget()
        \GetGadgetColor = @Proc_GetGadgetColor()
        \SetGadgetColor = @Proc_SetGadgetColor()
        \GetGadgetFont = @Proc_GetGadgetFont()
        \SetGadgetFont = @Proc_SetGadgetFont()
        ; ...
      EndWith
      ; ----------------------------------------------------------
      
      ; Orginale Funktionentabelle sichern
      *MyGadgetVT\vt_org = *this\vt
      ; Orginale Funktionentabelle ersetzen
      *this\vt = *MyGadgetVT
      
    EndIf
    
    ProcedureReturn *MyGadgetVT
    
  EndProcedure
    
  ; -------------------------------------------------------------------------------------
  
  Procedure FreeData(*this.gadget)
    
    Protected result, *MyGadgetVT.udtMyGadgetVT, key.s
    
    key = "ID-" + Str(*this\Gadget)
    *MyGadgetVT = FindMapElement(MyGadgetData(), key)
    If *MyGadgetVT
      ; Orginal FreeGadget aufrufen
      If *MyGadgetVT\vt_org\FreeGadget
        *MyGadgetVT\vt_org\FreeGadget(*this)
      EndIf
      ; Orginale Funktionstabelle wiederherstellen
      *this\vt = *MyGadgetVT\vt_org
      ; Eigene Daten löschen
      DeleteMapElement(MyGadgetData())
    EndIf
    ProcedureReturn result
    
  EndProcedure
    
  ; *************************************************************************************
  
  ;- Interne Funktionen
  
  Procedure DrawTextBox(x, y, dx, dy, text.s, flags)
    
    Protected is_multiline, is_left, is_right
    Protected text_width, text_height 
    Protected text_x, text_y
    Protected rows , row_text.s, row_text1.s, start, count
    
    is_multiline = flags & #PB_Button_MultiLine
    is_left = flags & #PB_Button_Left
    is_right = flags & #PB_Button_Right
    
    text_width = TextWidth(text)
    text_height = TextHeight(text)
    
    If Not is_multiline
      If is_left
        text_x = 6
        text_y = dy / 2 - text_height / 2
      ElseIf is_right
        text_x = dx - text_width - 6
        text_y = dy / 2 - text_height / 2
      Else
        text_x = dx / 2 - text_width / 2
        text_y = dy / 2 - text_height / 2
      EndIf
      DrawText(x + text_x, y + text_y, text)
      ProcedureReturn 1
    EndIf
    
    rows = text_width / dx
    start = 1
    text_y = (dy / 2 - text_height / 2) - (text_height / 2 * rows)
    count = CountString(text, " ") + 1
    Repeat
      row_text = StringField(text, start, " ") + " "
      Repeat
        start + 1
        row_text1 = StringField(text, start, " ")
        If TextWidth(row_text + row_text1) < dx - 12
          row_text + row_text1 + " "
        Else
          Break
        EndIf
      Until start > count
      row_text = Trim(row_text)
      If is_left
        text_x = 6
      ElseIf is_right
        text_x = dx - TextWidth(row_text) - 6
      Else
        text_x = dx / 2 - TextWidth(row_text) / 2
      EndIf
      DrawText(x + text_x, y + text_y, row_text)
      text_y + text_height
    Until start > count
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure Draw(*MyGadgetVT.udtMyGadgetVT)
    
    Protected backcolor, backcolor2, bordercolor2
    Protected dx, dy
    Protected text_width, text_height
    Protected text_x, text_y
    
    With *MyGadgetVT
      
      If \cstate = #ButtonColorStateDown Or \state = 1
        backcolor = RGB(Red(\backcolor) * 85 / 100, Green(\backcolor) * 85 / 100, Blue(\backcolor) * 85 / 100)
        bordercolor2 = $00C0C0C0
      ElseIf \cstate = #ButtonColorStateOver
        backcolor = RGB(Red(\backcolor) * 95 / 100, Green(\backcolor) * 95 / 100, Blue(\backcolor) * 95 / 100)
        bordercolor2 = $00FFFFFF
      Else
        backcolor = \backcolor
        bordercolor2 = $00FFFFFF
      EndIf
      StartDrawing(CanvasOutput(\id))
      If \dx > 2 And \dy > 2
        If \style
          ; Style Windows 8
          Box(0, 0, \dx, \dy, \bordercolor)
          Box(1, 1, \dx - 2, \dy - 2, backColor)
        Else
          ; Style Windows 7
          backcolor2 = RGB(Red(backcolor) * 95 / 100, Green(backcolor) * 95 / 100, Blue(backcolor) * 95 / 100)
          Box(0, 0, \dx, \dy, \bordercolor)
          Box(1, 1, \dx - 2, \dy - 2, bordercolor2)
          dx = \dx - 4
          dy = (\dy - 4) / 2
          Box(2, 2, dx, dy, backColor)
          Box(2, 2 + dy, dx, dy, backcolor2)
          Plot(0, 0, $00FFFFFF) : Plot(\dx - 1, 0, $00FFFFFF) : Plot(0 ,\dy - 1, $00FFFFFF) : Plot(\dx - 1,\dy - 1, $00FFFFFF)
          Plot(1, 1, \bordercolor) : Plot(\dx - 2, 1, \bordercolor) : Plot(1 ,\dy - 2, \bordercolor) : Plot(\dx - 2,\dy - 2, \bordercolor)
          Plot(2, 2, bordercolor2) : Plot(\dx - 3, 2, bordercolor2) : Plot(2 ,\dy - 3, bordercolor2) : Plot(\dx - 3,\dy - 3, bordercolor2)
        EndIf
        DrawingFont(\hFont)
        DrawingMode(#PB_2DDrawing_Transparent)
        FrontColor(\frontcolor)
        DrawTextBox(0, 0, \dx, \dy, \text, \flags)
      Else
        Box(0, 0, \dx, \dy, $00808080)
      EndIf
      StopDrawing()  
        
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
Procedure EventHandler()
    
    Protected *Gadget.Gadget, *MyGagetVT.udtMyGadgetVT
    
    *Gadget = IsGadget(EventGadget())
    If *Gadget
      *MyGagetVT = *Gadget\vt
      With *MyGagetVT
        Select EventType()
          Case #PB_EventType_MouseMove
            If \cstate = #ButtonColorStateDefault
              \cstate = #ButtonColorStateOver
              Draw(*MyGagetVT)
            EndIf
          Case #PB_EventType_MouseLeave
            \cstate = #ButtonColorStateDefault
            Draw(*MyGagetVT)
          Case #PB_EventType_LeftButtonDown
            \cstate = #ButtonColorStateDown
            Draw(*MyGagetVT)
          Case #PB_EventType_LeftButtonUp
            \cstate = #ButtonColorStateOver
            Draw(*MyGagetVT)
          Case #PB_EventType_LeftClick
            If \flags & #PB_Button_Toggle = #PB_Button_Toggle
              If \state
                \state = 0
              Else
                \state = 1
              EndIf
              Draw(*MyGagetVT)
            EndIf
        EndSelect
        
      EndWith
    EndIf
    
  EndProcedure
  
  ; *************************************************************************************
  
  ;- Public Funktionen
  
  Procedure Create(id, x, y, dx, dy, text.s, flags = #PB_Button_Default)
    
    Protected result, nr, *Gadget.Gadget, *MyGadgetVT.udtMyGadgetVT
    
    Repeat
      ; Gadget anlegen
      result = CanvasGadget(id, x, y , dx, dy)
      If result = 0
        Break
      EndIf
      If id = #PB_Any
        nr = result
      Else 
        nr = id
      EndIf
      *Gadget = IsGadget(nr)
      ;*Gadget = PB_Object_GetObject(PB_Gadget_Objects, nr)
      If *Gadget
        ; Eigene Daten anlegen
        *MyGadgetVT = NewData(*Gadget)
        If *MyGadgetVT = 0
          FreeGadget(nr)
          Break
        EndIf
        *MyGadgetVT\id = nr
        With *MyGadgetVT
          ; Eigene Daten zuweisen
          \dx = dx
          \dy = dy
          \text = text
          \flags = flags
          \state = 0
          \cstate = #ButtonColorStateDefault
          \hFont = GetGadgetFont(#PB_Default)
          \frontcolor = $00000000
          \backcolor = $00F0F0F0
          \bordercolor = $00808080
          If OSVersion() >= #PB_OS_Windows_8 And OSVersion() <= #PB_OS_Windows_Future
            \style = 1
          Else
            \style = 0
          EndIf
        EndWith
        ; Zeichnen
        Draw(*MyGadgetVT)
        
        ; Eventhandler setzen
        BindGadgetEvent(nr, @EventHandler(), #PB_All)
          
      Else
        result = 0
        Break
      EndIf
    Until #True
    
    ProcedureReturn result
    
  EndProcedure
  
  
EndModule

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

Re: ButtonColorGadget with standard purebasic function

Posted: Fri Apr 18, 2014 8:51 pm
by mk-soft
Update v1.16
- Check OSVersion on runtime

Re: ButtonColorGadget with standard purebasic function

Posted: Fri Apr 18, 2014 9:34 pm
by rsts
canvasGadget's rock.

Very nice.

Thanks for sharing.

Re: ButtonColorGadget with standard purebasic function

Posted: Sat Apr 19, 2014 12:42 pm
by mk-soft
Thx :wink:

Update v1.18
Flag #PB_Button_Multiline now work

Update v1.19
- Bugfix Multilinebutton
- Bugfix Togglebutton

Re: ButtonColorGadget with standard purebasic function

Posted: Tue Apr 29, 2014 2:51 pm
by Kwai chang caine
Splendid your buttons :shock:
Thanks for sharing 8)

Re: ButtonColorGadget with standard purebasic function

Posted: Mon May 19, 2014 5:00 pm
by uwekel
Thanks for sharing! I could take some parts of this code for my CustomGadget template. In this context I have some questions:
  • Where does the information of the PB internal Gadget structure comes from or where can we get a most recent valid one?
  • Why do the structures differ between the OS?
  • Why there is no HideGadget function for Linux, althought the command exists?
  • Same with GadgetX/Y/Width/Height and GetRequiredSize!
Best regards
Uwe

Re: ButtonColorGadget with standard purebasic function

Posted: Tue May 20, 2014 6:28 pm
by mk-soft
For Windows, the information coming from the current version of purebasic from the folder SDK.
For linux the information coming from the version v4.1. Newer are not for disposal.
Unfortunately, no information is available for Mac OS.

Had already asked in the forum after the current SDK for linux and Mac. The code thus not future-proof. I hope fred the sdk for linux and mac updated.

GT :|

Re: ButtonColorGadget with standard purebasic function

Posted: Tue May 20, 2014 7:17 pm
by uwekel
What i found out so far is that Linux has now also a SetGadgetItemImage pointer.

Code: Select all

  Structure _GadgetVT
    SizeOf.l
    GadgetType.l
    *ActivateGadget
    *FreeGadget
    *GetGadgetState
    *SetGadgetState
    *GetGadgetText
    *SetGadgetText
    *AddGadgetItem2
    *AddGadgetItem3
    *RemoveGadgetItem
    *ClearGadgetItemList
    *ResizeGadget
    *CountGadgetItems
    *GetGadgetItemState
    *SetGadgetItemState
    *GetGadgetItemText
    *SetGadgetItemText
    *SetGadgetFont
    *OpenGadgetList2
    *AddGadgetColumn
    *GetGadgetAttribute
    *SetGadgetAttribute
    *GetGadgetItemAttribute2
    *SetGadgetItemAttribute2
    *RemoveGadgetColumn
    *SetGadgetColor
    *GetGadgetColor
    *SetGadgetItemColor2
    *GetGadgetItemColor2
    *SetGadgetItemData
    *GetGadgetItemData
    *GetGadgetFont
    *SetGadgetItemImage
    *HideGadget ;Mac & Windows only
  EndStructure
But maybe there is more and we dont know. It is not very clever to build software on undocumented features, but it is also very helpful :oops: Maybe PB-Team can supply some official details :-)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited