Module Advanced Gadget Functions (All OS)

mk-soft · Post by **mk-soft** » Mon Oct 31, 2016 8:12 pm

Module AGF is a short name for "Advanced Gadget Functions"

The module solves the problem with Tab and Shift+Tab in linux and mac.
- GetPreviousGadget and GetNextGadget

Further functionalities have been added.
- Functions for Window and Gadget IDs
- MouseOver Gadget
- BindGadgetEvent and BindWindowEvent with EventData
- Named GadgetData

Update v1.08
- Bugfix Window

Update v1.09
- Added: SetAllGadgetFont(...)

Update v1.10
- Added: GetWindowList(...), GetGadgetList(...), GetImageList(...), GetFontList(...)

Update v1.11
- Added: WindowPB(...) and GadgetPB(...). Get PB-ID over handle

Update v1.12
- Added: MouseOver()

Update v1.13
- Added: BindEvent with EventData
- Added: Named GadgetData

Update v1.14
- Bugfix MouseOver

Update v1.15
- Added InitMouseOver() for Events MouseEnter and MouseLeave
- Added CheckCanvasMouse() for Events MouseClicks and MouseWheel

Update v1.17
- Added EnableGadgetDataEvent(State)
- Added Event #My_EventType_NewGadgetData and #My_EventType_ChangeGadgetData

Update v1.19
- Bugfix DebugGadgetData

Update v1.20
- Bugfix Memoryleak EventFreeMemoryPool()

Code: Select all

;-TOP

; Comment: Module Advanced Gadget Functions (AGF)
; Author : mk-soft
; Version: v1.22
; Created: 30.10.2016
; Updated: 29.09.2018
; Link   : http://www.purebasic.fr/english/viewtopic.php?f=12&t=66856
;

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

DeclareModule AGF
  ;- Begin of Declare Module
  
  ;TODO Check Enumeration
  
  Enumeration $7FFFFFFF Step -1 ; #PB_Event_FirstCustomValue
    #My_Event_FreeMemoryPool    ; Free Memory Pool of EventData
  EndEnumeration
  
  Enumeration $7FFFFFFF Step -1 ; #PB_EventType_FirstCustomValue
                                ; GadgetData
    #My_EventType_NewGadgetData
    #My_EventType_ChangeGadgetData
    ; CanvasGadget
    #My_EventType_LeftButtonClick
    #My_EventType_LeftButtonDoubleClick
    #My_EventType_MiddleButtonClick
    #My_EventType_MiddleButtonDoubleClick
    #My_EventType_RightButtonClick
    #My_EventType_RightButtonDoubleClick
    #My_EventType_MouseWheelUp
    #My_EventType_MouseWheelDown
  EndEnumeration
  
  ; StringHelper
  Declare   AllocateString(String.s)
  Declare.s FreeString(*mem)
  
  ; Window and Gadget Ident Functions
  Declare GetParentWindowID(Gadget)
  Declare GetPreviousGadget(Gadget, WindowID)
  Declare GetNextGadget(Gadget, WindowID)
  
  Declare GetWindowList(List Windows())
  Declare GetGadgetList(List Gadgets(), WindowID=0)
  Declare GetImageList(List Images())
  Declare GetFontList(List Fonts())
  
  Declare SetAllGadgetFont(FontID, WindowID=0)
  Declare SetAllGadgetColor(ColorType, Color, WindowID=0)
  
  Declare WindowPB(WindowID)
  Declare GadgetPB(GadgetID)
  
  ; MouseOver and Event MouseEnter, MouseLeave
  Declare MouseOver()
  Declare InitMouseOver()
  
  ; BindEvent with EventData
  Declare BindGadgetEventEx(Gadget, *Callback, EventType = #PB_All, EventData = 0)
  Declare UnbindGadgetEventEx(Gadget, *Callback, EventType = #PB_All)
  Declare SetGadgetEventDataEx(Gadget, *Callback, EventType = #PB_All, EventData = 0)
  
  Declare BindWindowEventEx(Window, *Callback, Event = #PB_All, EventData = 0)
  Declare UnbindWindowEventEx(Window, *Callback, Event = #PB_All)
  Declare SetWindowEventDataEx(Window, *Callback, Event = #PB_All, EventData = 0)
  
  ; Named GadgetData
  Declare   EnableGadgetDataEvent(State)
  Declare   SetGadgetDataInteger(gadget, value, property.s = "Default")
  Declare   GetGadgetDataInteger(gadget, property.s = "Default")
  Declare   SetGadgetDataFloat(gadget, value.f, property.s = "Default")
  Declare.f GetGadgetDataFloat(gadget, property.s = "Default")
  Declare   SetGadgetDataDouble(gadget, value.d, property.s = "Default")
  Declare.d GetGadgetDataDouble(gadget, property.s = "Default")
  Declare   SetGadgetDataString(gadget, text.s, property.s = "Default")
  Declare.s GetGadgetDataString(gadget, property.s = "Default")
  Declare   GetGadgetDataType(gadget, property.s = "Default")
  Declare   GetGadgetDataList(gadget, List Properties.s())
  Declare   FreeGadgetData(gadget)
  Declare   ClearGadgetData()
  Declare.s DebugGadgetData(gadget, property.s = "")
  
  ; Canvas Mouse EventType
  
  Declare CheckCanvasMouse()
  
  ;- End of Declare Module
EndDeclareModule

; ---------------------------------------------------------------------------------------

Module AGF
  ;- Begin of Module
  
  EnableExplicit
  
  ;-- Import internal function
  
  ; Force Import Fonts
  Global __Dummy = LoadFont(#PB_Any, "", 9) : FreeFont(__Dummy)
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
      PB_Font_Objects.i
    EndImport
  CompilerElse
    ImportC ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
      PB_Font_Objects.i
    EndImport
  CompilerEndIf
  
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    ; PB Interne Struktur Gadget MacOS
    Structure sdkGadget
      *gadget
      *container
      *vt
      UserData.i
      Window.i
      Type.i
      Flags.i
    EndStructure
  CompilerEndIf
  
  ; ---------------------------------------------------------------------------------------
  
  ;-- Stringhelper (Threaded)
  Procedure AllocateString(String.s)
    Protected *mem
    *mem = AllocateMemory(StringByteLength(string) + SizeOf(character))
    PokeS(*mem, String)
  EndProcedure
  
  Procedure.s FreeString(*mem)
    Protected result.s
    result = PeekS(*mem)
    FreeMemory(*mem)
    ProcedureReturn result
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ;-- GadgetID and WindowID functions
  
  Procedure GetParentWindowID(Gadget)
    Protected GadgetID, GadgetWindowID
    
    If IsGadget(Gadget)
      CompilerSelect #PB_Compiler_OS
        CompilerCase #PB_OS_MacOS
          Protected *Gadget.sdkGadget = IsGadget(Gadget)
          GadgetWindowID = WindowID(*Gadget\Window)
        CompilerCase #PB_OS_Linux
          GadgetID = GadgetID(Gadget)
          GadgetWindowID = gtk_widget_get_toplevel_ (GadgetID)
        CompilerCase #PB_OS_Windows
          GadgetID = GadgetID(Gadget)
          GadgetWindowID = GetAncestor_(GadgetID, #GA_ROOT)
      CompilerEndSelect
    EndIf
    ProcedureReturn GadgetWindowID
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetPreviousGadget(Gadget, WindowID)
    Protected object, prev_id, type
    
    prev_id = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
      type = GadgetType(object)
      If type <> #PB_GadgetType_Text And type <> #PB_GadgetType_Frame
        If GetParentWindowID(object) = WindowID
          If gadget = object
            If prev_id >= 0
              PB_Object_EnumerateAbort(PB_Gadget_Objects)
              Break
            EndIf
          Else
            prev_id = object
          EndIf
        EndIf
      EndIf
    Wend
    ProcedureReturn prev_id
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetNextGadget(Gadget, WindowID)
    Protected object, next_id, type
    
    next_id = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
      type = GadgetType(object)
      If type <> #PB_GadgetType_Text And type <> #PB_GadgetType_Frame
        If GetParentWindowID(object) = WindowID
          If next_id < 0
            next_id = object
          EndIf
          If gadget = object
            If PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
              If GetParentWindowID(object) = WindowID
                next_id = object
                PB_Object_EnumerateAbort(PB_Gadget_Objects)
                Break
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
    Wend
    ProcedureReturn next_id
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetWindowList(List Windows())
    Protected object
    ClearList(Windows())
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @object)
      AddElement(Windows())
      Windows() = object
    Wend
    ProcedureReturn ListSize(Windows())
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetGadgetList(List Gadgets(), WindowID=0)
    Protected object
    ClearList(Gadgets())
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @object)
      If WindowID = 0 Or GetParentWindowID(object) = WindowID
        AddElement(Gadgets())
        Gadgets() = object
      EndIf
    Wend
    ProcedureReturn ListSize(Gadgets())
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetImageList(List Images())
    Protected object
    ClearList(Images())
    PB_Object_EnumerateStart(PB_Image_Objects)
    While PB_Object_EnumerateNext(PB_Image_Objects, @object)
      AddElement(Images())
      Images() = object
    Wend
    ProcedureReturn ListSize(Images())
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetFontList(List Fonts())
    Protected object
    ClearList(Fonts())
    PB_Object_EnumerateStart(PB_Font_Objects)
    While PB_Object_EnumerateNext(PB_Font_Objects, @object)
      AddElement(Fonts())
      Fonts() = object
    Wend
    ProcedureReturn ListSize(Fonts())
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetAllGadgetFont(FontID, WindowID=0)
    Protected gadget
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      If WindowID = 0 Or GetParentWindowID(gadget) = WindowID
        SetGadgetFont(gadget, FontID)
      EndIf
    Wend
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetAllGadgetColor(ColorType, Color, WindowID=0)
    Protected gadget
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      If WindowID = 0 Or GetParentWindowID(gadget) = WindowID
        SetGadgetColor(gadget, ColorType, Color)
      EndIf
    Wend
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure WindowPB(WindowID) ; Find pb-id over handle
    Protected result, window
    result = -1
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @window)
      If WindowID = WindowID(window)
        result = window
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Window_Objects)
    ProcedureReturn result
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GadgetPB(GadgetID) ; Find pb-id over handle
    Protected result, gadget
    result = -1
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      If GadgetID = GadgetID(gadget)
        result = gadget
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Gadget_Objects)
    ProcedureReturn result
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- MouseOver and Event MouseEnter, MouseLeave
  
  Procedure MouseOver()
    Protected handle, window
    window = GetActiveWindow()
    If window < 0
      ProcedureReturn
    EndIf
    ; Get handle under mouse
    CompilerSelect #PB_Compiler_OS
      CompilerCase #PB_OS_Windows
        handle = WindowFromPoint_(DesktopMouseY() << 32 | DesktopMouseX())
      CompilerCase #PB_OS_MacOS
        Protected win_id, win_cv, pt.NSPoint
        win_id = WindowID(window)
        win_cv = CocoaMessage(0, win_id, "contentView")
        CocoaMessage(@pt, win_id, "mouseLocationOutsideOfEventStream")
        handle = CocoaMessage(0, win_cv, "hitTest:@", @pt)
      CompilerCase #PB_OS_Linux
        Protected desktop_x, desktop_y, *GdkWindow.GdkWindowObject
        *GdkWindow.GdkWindowObject = gdk_window_at_pointer_(@desktop_x,@desktop_y)
        If *GdkWindow
          gdk_window_get_user_data_(*GdkWindow, @handle)
        Else
          handle = 0
        EndIf
    CompilerEndSelect
    ProcedureReturn handle
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure MouseOverTimerCB()
    Static handle, lasthandle, window, lastwindow, gadget, lastgadget = -1
    handle = MouseOver()
    If handle <> lasthandle
      ; Do only is handle change
      window = GetActiveWindow()
      ;--- PB-ID from handle
      gadget = GadgetPB(handle)
      If gadget <> lastgadget
        If lastgadget >= 0
          If GadgetType(lastgadget) <> #PB_GadgetType_Canvas
            PostEvent(#PB_Event_Gadget, lastwindow, lastgadget, #PB_EventType_MouseLeave)
          EndIf
        EndIf
        If gadget >= 0
          If GadgetType(gadget) <> #PB_GadgetType_Canvas
            PostEvent(#PB_Event_Gadget, window, gadget, #PB_EventType_MouseEnter)
          EndIf
        EndIf
        lastwindow = window
        lastgadget = gadget
      EndIf
      lasthandle = handle
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure InitMouseOver()
    Static MyEventWindow, IsInit
    
    If Not IsInit
      IsInit = #True
      MyEventWindow = OpenWindow(#PB_Any, 0, 0, 0, 0, "MyEvents", #PB_Window_NoActivate | #PB_Window_NoGadgets | #PB_Window_Invisible)
      BindEvent(#PB_Event_Timer, @MouseOverTimerCB(), MyEventWindow, $EEEE)
      AddWindowTimer(MyEventWindow, $EEEE, 100)
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- BindEvent with EventData
  
  Prototype protoBindGadgetCB(EventData)
  Prototype protoBindWindowCB(EventData)
  
  Structure udtGadgetEvent
    Gadget.i
    EventType.i
    EventData.i
    *Callback.protoBindGadgetCB
  EndStructure
  
  Structure udtWindowEvent
    Window.i
    Event.i
    EventData.i
    *Callback.protoBindWindowCB
  EndStructure
  
  Global NewList GadgetEventList.udtGadgetEvent()
  Global NewList WindowEventList.udtWindowEvent()
  
  Global ActiveGadgetEvent
  Global ActiveWindowEvent
  
  Declare BindAllWindowEvent(*Callback)
  Declare UnbindAllWindowEvent(*Callback)
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure EventHandlerGadgetCB()
    Protected Gadget = EventGadget()
    Protected EventType = EventType()
    ForEach GadgetEventList()
      With GadgetEventList()
        If \Gadget = Gadget
          If \EventType = EventType Or \EventType = #PB_All
            \Callback(\EventData)
          EndIf
        EndIf
      EndWith
    Next
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure BindGadgetEventEx(Gadget, *Callback, EventType = #PB_All, EventData = 0)
    LastElement(GadgetEventList())
    AddElement(GadgetEventList())
    With GadgetEventList()
      \Gadget = Gadget
      \EventType = EventType
      \EventData = EventData
      \Callback = *Callback
    EndWith
    If Not ActiveGadgetEvent
      ActiveGadgetEvent = #True
      BindEvent(#PB_Event_Gadget, @EventHandlerGadgetCB())
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure UnbindGadgetEventEx(Gadget, *Callback, EventType = #PB_All)
    ForEach GadgetEventList()
      With GadgetEventList()
        If \Gadget = Gadget
          If \Callback = *Callback
            If \EventType = EventType
              DeleteElement(GadgetEventList())
            EndIf
          EndIf
        EndIf
      EndWith
    Next
    If ListSize(GadgetEventList()) = 0
      ActiveGadgetEvent = #False
      UnbindEvent(#PB_Event_Gadget, @EventHandlerGadgetCB())
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetEventDataEx(Gadget, *Callback, EventType = #PB_All, EventData = 0)
    Protected old_eventdata
    ForEach GadgetEventList()
      With GadgetEventList()
        If \Gadget = Gadget
          If \Callback = *Callback
            If \EventType = EventType
              old_eventdata = \EventData
              \EventData = EventData
              Break
            EndIf
          EndIf
        EndIf
      EndWith
    Next
    ProcedureReturn old_eventdata
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure EventHandlerWindowCB()
    Protected Window = EventWindow()
    Protected Event = Event()
    ForEach WindowEventList()
      With WindowEventList()
        If \Window = Window
          If \Event = Event Or \Event = #PB_All
            \Callback(\EventData)
          EndIf
        EndIf
      EndWith
    Next
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure BindWindowEventEx(Window, *Callback, Event = #PB_All, EventData = 0)
    LastElement(WindowEventList())
    AddElement(WindowEventList())
    With WindowEventList()
      \Window = Window
      \Event = Event
      \EventData = EventData
      \Callback = *Callback
    EndWith
    If Not ActiveWindowEvent
      ActiveWindowEvent = #True
      BindAllWindowEvent(@EventHandlerWindowCB())
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure UnbindWindowEventEx(Window, *Callback, Event = #PB_All)
    ForEach WindowEventList()
      With WindowEventList()
        If \Window = Window
          If \Callback = *Callback
            If \Event = Event
              DeleteElement(WindowEventList())
            EndIf
          EndIf
        EndIf
      EndWith
    Next
    If ListSize(WindowEventList()) = 0
      ActiveWindowEvent = #False
      UnbindAllWindowEvent(@EventHandlerWindowCB())
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetWindowEventDataEx(Window, *Callback, Event = #PB_All, EventData = 0)
    Protected old_eventdata
    ForEach WindowEventList()
      With WindowEventList()
        If \Window = Window
          If \Callback = *Callback
            If \Event = Event
              old_eventdata = \EventData
              \EventData = EventData
              Break
            EndIf
          EndIf
        EndIf
      EndWith
    Next
    ProcedureReturn old_eventdata
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure BindAllWindowEvent(*Callback)
    BindEvent(#PB_Event_Menu, *Callback)
    BindEvent(#PB_Event_Gadget, *Callback)
    BindEvent(#PB_Event_SysTray, *Callback)
    BindEvent(#PB_Event_Timer, *Callback)
    BindEvent(#PB_Event_CloseWindow, *Callback)
    BindEvent(#PB_Event_Repaint, *Callback)
    BindEvent(#PB_Event_SizeWindow, *Callback)
    BindEvent(#PB_Event_MoveWindow, *Callback)
    BindEvent(#PB_Event_MinimizeWindow, *Callback)
    BindEvent(#PB_Event_MaximizeWindow, *Callback)
    BindEvent(#PB_Event_RestoreWindow, *Callback)
    BindEvent(#PB_Event_ActivateWindow, *Callback)
    BindEvent(#PB_Event_DeactivateWindow, *Callback)
    BindEvent(#PB_Event_GadgetDrop, *Callback)
    BindEvent(#PB_Event_WindowDrop, *Callback)
    BindEvent(#PB_Event_LeftClick, *Callback)
    BindEvent(#PB_Event_LeftDoubleClick, *Callback)
    BindEvent(#PB_Event_RightClick, *Callback)
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure UnbindAllWindowEvent(*Callback)
    UnbindEvent(#PB_Event_Menu, *Callback)
    UnbindEvent(#PB_Event_Gadget, *Callback)
    UnbindEvent(#PB_Event_SysTray, *Callback)
    UnbindEvent(#PB_Event_Timer, *Callback)
    UnbindEvent(#PB_Event_CloseWindow, *Callback)
    UnbindEvent(#PB_Event_Repaint, *Callback)
    UnbindEvent(#PB_Event_SizeWindow, *Callback)
    UnbindEvent(#PB_Event_MoveWindow, *Callback)
    UnbindEvent(#PB_Event_MinimizeWindow, *Callback)
    UnbindEvent(#PB_Event_MaximizeWindow, *Callback)
    UnbindEvent(#PB_Event_RestoreWindow, *Callback)
    UnbindEvent(#PB_Event_ActivateWindow, *Callback)
    UnbindEvent(#PB_Event_DeactivateWindow, *Callback)
    UnbindEvent(#PB_Event_GadgetDrop, *Callback)
    UnbindEvent(#PB_Event_WindowDrop, *Callback)
    UnbindEvent(#PB_Event_LeftClick, *Callback)
    UnbindEvent(#PB_Event_LeftDoubleClick, *Callback)
    UnbindEvent(#PB_Event_RightClick, *Callback)
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- Named gadget data
  
  Structure udtGadgetData
    type.i
    StructureUnion
      iVal.i
      fltVal.f
      dblVal.d
    EndStructureUnion
    text.s
  EndStructure
  
  Structure udtGadgetDataSet
    gadget.i
    Map ds.udtGadgetData()
  EndStructure
  
  Global NewMap GadgetData.udtGadgetDataSet()
  Global MutexGadgetData = CreateMutex()
  Global IsEventGadgetData
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure EventFreeMemoryPool()
    Protected *property.string = EventData()
    FreeStructure(*property)
  EndProcedure
  
  BindEvent(#My_Event_FreeMemoryPool, @EventFreeMemoryPool())
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure EnableGadgetDataEvent(State)
    If Bool(State)
      IsEventGadgetData = #True
    Else
      IsEventGadgetData = #False
    EndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetDataInteger(gadget, value.i, property.s = "Default")
    
    Protected key.s, IsProperty, *Map.udtGadgetDataSet, *property.String
    
    LockMutex(MutexGadgetData)
    key = Hex(gadget)
    *map = FindMapElement(GadgetData(), key)
    If *map = 0
      *map = AddMapElement(GadgetData(), key)
    EndIf
    If *map
      IsProperty = FindMapElement(*map\ds(), property)
      *map\gadget = gadget
      *map\ds(property)\type = #PB_Integer
      *map\ds(property)\iVal = value
      If IsEventGadgetData
        *property = AllocateStructure(String)
        *property\s = property
        If IsProperty
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_ChangeGadgetData, *property)
        Else
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_NewGadgetData, *property)
        EndIf
        PostEvent(#My_Event_FreeMemoryPool, 0, Gadget, 0, *property)
      EndIf
    EndIf
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetGadgetDataInteger(gadget, property.s = "Default")
    
    Protected r1.i, *Map.udtGadgetDataSet
    
    LockMutex(MutexGadgetData)
    *map = FindMapElement(GadgetData(), Hex(gadget))
    If *map
      r1 = *Map\ds(property)\iVal
    Else
      r1 = 0
    EndIf
    UnlockMutex(MutexGadgetData)
    ProcedureReturn r1
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetDataFloat(gadget, value.f, property.s = "Default")
    
    Protected key.s, IsProperty, *Map.udtGadgetDataSet, *property.string
    
    LockMutex(MutexGadgetData)
    key = Hex(gadget)
    *map = FindMapElement(GadgetData(), key)
    If *map = 0
      *map = AddMapElement(GadgetData(), key)
    EndIf
    If *map
      IsProperty = FindMapElement(*map\ds(), property)
      *map\gadget = gadget
      *map\ds(property)\type = #PB_Float
      *map\ds(property)\fltVal = value
      If IsEventGadgetData
        *property = AllocateStructure(String)
        *property\s = property
        If IsProperty
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_ChangeGadgetData, *property)
        Else
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_NewGadgetData, *property)
        EndIf
        PostEvent(#My_Event_FreeMemoryPool, 0, Gadget, 0, *property)
      EndIf
    EndIf
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure.f GetGadgetDataFloat(gadget, property.s = "Default")
    
    Protected r1.f, *Map.udtGadgetDataSet
    
    LockMutex(MutexGadgetData)
    *map = FindMapElement(GadgetData(), Hex(gadget))
    If *map
      r1 = *Map\ds(property)\fltVal
    Else
      r1 = 0.0
    EndIf
    UnlockMutex(MutexGadgetData)
    ProcedureReturn r1
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetDataDouble(gadget, value.d, property.s = "Default")
    
    Protected key.s, IsProperty, *Map.udtGadgetDataSet, *property.string
    
    LockMutex(MutexGadgetData)
    key = Hex(gadget)
    *map = FindMapElement(GadgetData(), key)
    If *map = 0
      *map = AddMapElement(GadgetData(), key)
    EndIf
    If *map
      IsProperty = FindMapElement(*map\ds(), property)
      *map\gadget = gadget
      *map\ds(property)\type = #PB_Double
      *map\ds(property)\dblVal = value
      If IsEventGadgetData
        *property = AllocateStructure(String)
        *property\s = property
        If IsProperty
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_ChangeGadgetData, *property)
        Else
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_NewGadgetData, *property)
        EndIf
        PostEvent(#My_Event_FreeMemoryPool, 0, Gadget, 0,*property)
      EndIf
    EndIf
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure.d GetGadgetDataDouble(gadget, property.s = "Default")
    
    Protected r1.d, *Map.udtGadgetDataSet
    
    LockMutex(MutexGadgetData)
    *map = FindMapElement(GadgetData(), Hex(gadget))
    If *map
      r1 = *Map\ds(property)\dblVal
    Else
      r1 = 0.0
    EndIf
    UnlockMutex(MutexGadgetData)
    ProcedureReturn r1
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetDataString(gadget, text.s, property.s = "Default")
    
    Protected key.s, IsProperty, *Map.udtGadgetDataSet, *property.String
    
    LockMutex(MutexGadgetData)
    key = Hex(gadget)
    *map = FindMapElement(GadgetData(), key)
    If *map = 0
      *map = AddMapElement(GadgetData(), key)
    EndIf
    If *map
      IsProperty = FindMapElement(*map\ds(), property)
      *map\gadget = gadget
      *map\ds(property)\type = #PB_String
      *map\ds(property)\text = text
      If IsEventGadgetData
        *property = AllocateStructure(String)
        *property\s = property
        If IsProperty
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_ChangeGadgetData, *property)
        Else
          PostEvent(#PB_Event_Gadget, 0, Gadget, #My_EventType_NewGadgetData, *property)
        EndIf
        PostEvent(#My_Event_FreeMemoryPool, 0, Gadget, 0, *property)
      EndIf
    EndIf
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure.s GetGadgetDataString(gadget, property.s = "Default")
    
    Protected r1.s, *Map.udtGadgetDataSet
    
    LockMutex(MutexGadgetData)
    *map = FindMapElement(GadgetData(), Hex(gadget))
    If *map
      r1 = *Map\ds(property)\text
    Else
      r1 = ""
    EndIf
    UnlockMutex(MutexGadgetData)
    ProcedureReturn r1
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetGadgetDataType(gadget, property.s = "Default")
    
    Protected r1, *Map.udtGadgetDataSet
    
    LockMutex(MutexGadgetData)
    *Map = FindMapElement(GadgetData(), Hex(gadget))
    If *map
      r1 = *Map\ds(property)\type
    Else
      r1 = 0
    EndIf
    UnlockMutex(MutexGadgetData)
    ProcedureReturn r1
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetGadgetDataList(gadget, List Properties.s())
    
    Protected r1, *Map.udtGadgetDataSet
    
    LockMutex(MutexGadgetData)
    *map = FindMapElement(GadgetData(), Hex(gadget))
    If *map
      ClearList(Properties())
      ForEach GadgetData()
        AddElement(Properties())
        Properties() = MapKey(GadgetData())
      Next
      r1 = ListSize(Properties())
    Else
      r1 = 0
    EndIf
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure FreeGadgetData(gadget)
    
    LockMutex(MutexGadgetData)
    If FindMapElement(GadgetData(), Hex(gadget))
      DeleteMapElement(GadgetData())
    EndIf
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure ClearGadgetData()
    
    LockMutex(MutexGadgetData)
    ForEach GadgetData()
      If Not IsGadget(GadgetData()\gadget)
        DeleteMapElement(GadgetData())
      EndIf
    Next
    UnlockMutex(MutexGadgetData)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure.s DebugGadgetData(gadget, property.s = "")
    CompilerIf #PB_Compiler_Debugger
      Protected r1.s, *Map.udtGadgetDataSet, lf
      LockMutex(MutexGadgetData)
      *map = FindMapElement(GadgetData(), Hex(gadget))
      If *map
        If property = ""
          r1 = ""
          ForEach *map\ds()
            If lf : r1 + #LF$ : EndIf
            r1 + "GadgetData(" + gadget + ").Property('" + MapKey(*map\ds()) + "')."
            Select *Map\ds()\type
              Case #PB_Integer
                r1 + "Integer = " + *map\ds()\iVal
              Case #PB_Float
                r1 + "Float = " + *map\ds()\fltVal
              Case #PB_Double
                r1 + "Double = " + *map\ds()\dblVal
              Case #PB_String
                r1 + "String = " + *map\ds()\text
            EndSelect
            lf = #True
          Next
        Else
          If FindMapElement(*map\ds(), property)
            r1 = "GadgetData(" + gadget + ").Property('" + property + "')."
            Select *Map\ds()\type
              Case #PB_Integer
                r1 + "Integer = " + *map\ds()\iVal
              Case #PB_Float
                r1 + "Float = " + *map\ds()\fltVal
              Case #PB_Double
                r1 + "Double = " + *map\ds()\dblVal
              Case #PB_String
                r1 + "String = " + *map\ds()\text
            EndSelect
          Else
            r1 = "GadgetData(" + gadget + ") Property('" + property + "') = Nothing"
          EndIf
        EndIf
      EndIf
      UnlockMutex(MutexGadgetData)
      ProcedureReturn r1
    CompilerEndIf
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- Canvas Mouse Events
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    
    Procedure WinCB(hWnd, uMsg, wParam, lParam)
      Protected r1 = #PB_ProcessPureBasicEvents
      Protected gadget, wheel
      If uMsg = #WM_MOUSEWHEEL
        gadget = GadgetPB(MouseOver())
        If gadget >= 0 And GadgetType(gadget) = #PB_GadgetType_Canvas
          wheel = wParam >> 16 / 120
          If wheel > 0
            PostEvent(#PB_Event_Gadget, 0, gadget, #My_EventType_MouseWheelUp, Wheel)
          Else
            PostEvent(#PB_Event_Gadget, 0, gadget, #My_EventType_MouseWheelDown, Wheel)
          EndIf
        EndIf
      EndIf
      ProcedureReturn r1
    EndProcedure
    
    SetWindowCallback(@WinCB())
    
  CompilerEndIf
  
  ; ---------------------------------------------------------------------------------------
  
  Global DoubleClickTime = DoubleClickTime() ; ms
  Global ClickTime = 200                     ; ms
  
  Procedure CheckCanvasMouse()
    Static left_time1, left_time2, left_diff, left_lock
    Static middle_time1, middle_time2, middle_diff, middle_lock
    Static right_time1, right_time2, right_diff, right_lock
    Static wheel
    Select EventType()
        ; Left Button
      Case #PB_EventType_LeftButtonDown
        left_time1 = ElapsedMilliseconds()
        left_diff = ElapsedMilliseconds() - left_time2
        If left_time2 And left_diff > 1 And left_diff < DoubleClickTime
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_leftButtonDoubleClick)
          left_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
          left_lock = 1
        Else
          left_time2 = ElapsedMilliseconds()
        EndIf
      Case #PB_EventType_LeftButtonUp
        If Not left_lock And (ElapsedMilliseconds() - left_time1) < ClickTime
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_leftButtonClick)
        EndIf
        left_lock = 0
        ; Middle Button
      Case #PB_EventType_MiddleButtonDown
        middle_time1 = ElapsedMilliseconds()
        middle_diff = ElapsedMilliseconds() - middle_time2
        If middle_time2 And middle_diff > 1 And middle_diff < DoubleClickTime
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MiddleButtonDoubleClick)
          middle_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
          middle_lock = 1
        Else
          middle_time2 = ElapsedMilliseconds()
        EndIf
      Case #PB_EventType_MiddleButtonUp
        If Not middle_lock And (ElapsedMilliseconds() - middle_time1) < ClickTime
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MiddleButtonClick)
        EndIf
        middle_lock = 0
        ; Right Button
      Case #PB_EventType_RightButtonDown
        right_time1 = ElapsedMilliseconds()
        right_diff = ElapsedMilliseconds() - right_time2
        If Right_time2 And right_diff > 1 And right_diff < DoubleClickTime
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_RightButtonDoubleClick)
          right_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
          right_lock = 1
        Else
          right_time2 = ElapsedMilliseconds()
        EndIf
      Case #PB_EventType_RightButtonUp
        If Not right_lock And (ElapsedMilliseconds() - right_time1) < ClickTime
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_RightButtonClick)
        EndIf
        right_lock = 0
      Case #PB_EventType_MouseWheel
        wheel = GetGadgetAttribute(EventGadget(), #PB_Canvas_WheelDelta)
        If wheel > 0
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MouseWheelUp, wheel)
        Else
          PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MouseWheelDown, wheel)
        EndIf
    EndSelect
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  ;- End of Module
EndModule

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

[/size]

blueb · Post by **blueb** » Tue Nov 01, 2016 12:45 pm

Works well.

Corrected a slight misspelling on three lines in your code...

Should be: Text$ = "I have Focus use TAB or SHIFT + TAB"

davido · Post by **davido** » Tue Nov 01, 2016 7:49 pm

@mk-soft,

Nice. Thank you for sharing.

mestnyi · Post by **mestnyi** » Tue Nov 01, 2016 8:27 pm

Code: Select all

CompilerCase #PB_OS_Windows
  GadgetID = GadgetID(Gadget)
    While GadgetID 
      GadgetWindowID = GadgetID : GadgetID = GetParent_( GadgetID )
    Wend

It can be replaced with the

Code: Select all

CompilerCase #PB_OS_Windows
  ProcedureReturn GetAncestor_( GadgetID(Gadget), #GA_ROOT )

mk-soft · Post by **mk-soft** » Thu Nov 03, 2016 10:19 pm

Thanks,

I had time to make the changes...

ChrisR · Post by **ChrisR** » Sun Mar 12, 2017 12:13 am

Thanks for the AGF module

Small fix for #PB_OS_Windows

Code: Select all

GetAncestor_(GadgetID, #GA_ROOT)
...
ProcedureReturn GadgetWindowID

Should be

Code: Select all

GadgetWindowID = GetAncestor_(GadgetID, #GA_ROOT)
...
ProcedureReturn GadgetWindowID

mk-soft · Post by **mk-soft** » Fri Mar 17, 2017 3:47 pm

Ups...

Update v1.08
-Bugfix window

mk-soft · Post by **mk-soft** » Sun May 21, 2017 10:14 am

Update v 1.09
- Added SetAllGadgetFont(...)

Example

Code: Select all

;- Example 2

IncludeFile "AdvancedGadgetFunctions.pb"

#WindowWidth  = 450
#WindowHeight = 305

; Load our images.. 
;
LoadImage(0, #PB_Compiler_Home + "examples/sources/Data/Drive.bmp")
LoadImage(1, #PB_Compiler_Home + "examples/sources/Data/File.bmp")
LoadImage(2, #PB_Compiler_Home + "examples/sources/Data/PureBasic.bmp")

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  ; Only Windows supports .ico file format
  LoadImage(3, #PB_Compiler_Home + "examples/sources/Data/CdPlayer.ico")
CompilerElse
  LoadImage(3, #PB_Compiler_Home + "examples/sources/Data/Drive.bmp")
CompilerEndIf

CreatePopupMenu(0)
MenuItem(0, "Popup !")

If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "PureBasic - Advanced Gadget Demonstration", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
  
  ListIconGadget(5, 170, 50, 265, 200, "Column 1", 131)
  AddGadgetColumn(5, 1, "Column 2", 300)
  AddGadgetColumn(5, 2, "Column 3", 80)
  
  TextGadget(4, 10, 16, 180, 24, "Please wait while initializing...")
  
  ProgressBarGadget(3, 10, 260, #WindowWidth-25, 20, 0, 100)
  
  ; Update the ProgressBar, just for fun !
  ;
  For k=0 To 100
    SetGadgetState(3, k)
    Delay(10)
  Next
  
  ImageGadget      (0, 200, 5, 0, 0, ImageID(2))
  ButtonImageGadget(1, 384, 5, 50, 36, ImageID(3))
  
  TreeGadget    (2,  10, 50, 150, 200)
  
  SetGadgetText(4, "Initialize Ok... Welcome !")
  
  ; Fill Up the Tree gadget with lot of entries (including the image)
  ;
  
  For k=0 To 10
    AddGadgetItem(2, -1, "General "+Str(k), ImageID(1))
    AddGadgetItem(2, -1, "ScreenMode", ImageID(1))
    AddGadgetItem(2, -1, "640*480", ImageID(1), 1)
    AddGadgetItem(2, -1, "800*600", ImageID(3), 1)
    AddGadgetItem(2, -1, "1024*768", ImageID(1), 1)
    AddGadgetItem(2, -1, "1600*1200", ImageID(1), 1)
    AddGadgetItem(2, -1, "Joystick", ImageID(1))
  Next
  
  ; Fill Up the ListIcon gadget. Notice than the column are separated by Chr(10) (NewLine) character
  ;
  For k=0 To 100
    AddGadgetItem(5, -1, "Element "+Str(k)+Chr(10)+"C 2"+Chr(10)+"Comment 3", ImageID(3))
  Next
  
  SetGadgetState(5, 8)
  
  UseModule AGF
  LoadFont(0, "Arial", 12, #PB_Font_Italic)
  ;LoadFont(0, "Bradley Hand", 16)
  SetAllGadgetFont(FontID(0), WindowID(0))
  ;SetAllGadgetFont(FontID(0))
  
  Repeat
    Event = WaitWindowEvent()
    
    If Event = #PB_Event_Gadget
      
      Select EventGadget()
        Case 1
          MessageRequester("Information", "You did it !", 0)
          
        Case 2
          SetGadgetText(4, "Tree Gadget. Item selected: "+Str(GetGadgetState(2)))
          
          If EventType() = 2
            MessageRequester("Information", "Doubleclick: item"+Str(GetGadgetState(2))+", Text: "+GetGadgetText(2), 0)
          ElseIf EventType() = 1
            DisplayPopupMenu(0, WindowID(0))
          EndIf
          
        Case 5
          SetGadgetText(4, "ListIcon Gadget. Item selected: "+Str(GetGadgetState(5)))
          
          If EventType() = 2
            MessageRequester("Information", "Doubleclick: item"+Str(GetGadgetState(5))+", Text: "+GetGadgetText(5), 0)
          ElseIf EventType() = 1
            DisplayPopupMenu(0, WindowID(0))
          EndIf
          
      EndSelect
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow
EndIf

mk-soft · Post by **mk-soft** » Sat May 27, 2017 4:45 pm

Update v1.10
- Added: GetWindowList(...), GetGadgetList(...), GetImageList(...), GetFontList(...)

Code: Select all

...
  UseModule AGF
  
  LoadFont(0, "Arial", 10, #PB_Font_Italic)
  
  ; Update Gadgets
  NewList Gadgets()
  GetGadgetList(Gadgets(), WindowID(0))
  ForEach Gadgets()
    SetGadgetFont(Gadgets(), FontID(0))
    SetGadgetColor(Gadgets(), #PB_Gadget_FrontColor, $FF0000)
  Next
...

mk-soft · Post by **mk-soft** » Sat Jul 28, 2018 10:28 am

Update v1.11
- Added: WindowPB(...) and GadgetPB(...). Get PB-ID over handle

mk-soft · Post by **mk-soft** » Sat Jul 28, 2018 10:55 am

Update v1.12
- Added: MouseOver()

Code: Select all

...
Procedure TimerCB()
  Static handle, lasthandle
  handle = MouseOver()
  If handle <> lasthandle
    Debug GadgetPB(handle)
    lasthandle = handle
  EndIf
EndProcedure

...
AddWindowTimer(0, 1, 100)
BindEvent(#PB_Event_Timer, @TimerCB())
...

mk-soft · Post by **mk-soft** » Sun Jul 29, 2018 2:52 pm

Update v1.13
- Added: BindEvent with EventData
- Added: Named GadgetData

New example with "How to create new event mouse enter and mouse leave for all gadgets"

Code: Select all

;- Example 3

IncludeFile "AdvancedGadgetFunctions.pb"

UseModule AGF
 
#WindowWidth  = 450
#WindowHeight = 325

; Load our images..
;
LoadImage(0, #PB_Compiler_Home + "examples/sources/Data/Drive.bmp")
LoadImage(1, #PB_Compiler_Home + "examples/sources/Data/File.bmp")
LoadImage(2, #PB_Compiler_Home + "examples/sources/Data/PureBasic.bmp")

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  ; Only Windows supports .ico file format
  LoadImage(3, #PB_Compiler_Home + "examples/sources/Data/CdPlayer.ico")
CompilerElse
  LoadImage(3, #PB_Compiler_Home + "examples/sources/Data/Drive.bmp")
CompilerEndIf

;-- Example MouseOver and add new events
Procedure TimerCB()
  Static handle, lasthandle, window, lastwindow, gadget, lastgadget = -1
  handle = MouseOver()
  If handle <> lasthandle
    ; Do only is handle change
    window = GetActiveWindow()
    ;--- PB-ID from handle
    gadget = GadgetPB(handle)
    If gadget <> lastgadget
      If lastgadget >= 0
        If GadgetType(lastgadget) <> #PB_GadgetType_Canvas
          PostEvent(#PB_Event_Gadget, lastwindow, lastgadget, #PB_EventType_MouseLeave)
        EndIf
      EndIf
      If gadget >= 0
        If GadgetType(gadget) <> #PB_GadgetType_Canvas
          PostEvent(#PB_Event_Gadget, window, gadget, #PB_EventType_MouseEnter)
        EndIf
      EndIf
      StatusBarText(0, 0, " Mouse over Gadget " + Str(gadget))
      lastwindow = window
      lastgadget = gadget
    EndIf
    lasthandle = handle
  EndIf
EndProcedure

;-- Example get named gadget data
Procedure TextCB()
  Protected gadget = EventGadget()
  Select EventType()
    Case #PB_EventType_MouseEnter
      SetGadgetColor(gadget, #PB_Gadget_FrontColor, GetGadgetDataInteger(gadget, "ColorMouseEnter"))
    Case #PB_EventType_MouseLeave
      SetGadgetColor(gadget, #PB_Gadget_FrontColor, GetGadgetDataInteger(gadget, "ColorMouseLeave"))
  EndSelect
EndProcedure
     
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "PureBasic - Advanced Gadget Functions Demonstration", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
 
  CreateStatusBar(0, WindowID(0))
  AddStatusBarField(#WindowWidth)
  StatusBarText(0, 0, " Mouse")
 
  ListIconGadget(5, 170, 50, 265, 200, "Column 1", 131)
  AddGadgetColumn(5, 1, "Column 2", 300)
  AddGadgetColumn(5, 2, "Column 3", 80)
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    TextGadget(4, 10, 16, 200, 24, "Please wait while initializing...", #SS_NOTIFY)
  CompilerElse
    TextGadget(4, 10, 16, 200, 24, "Please wait while initializing...")
  CompilerEndIf
  
  ProgressBarGadget(3, 10, 260, #WindowWidth-25, 20, 0, 100)
 
  ImageGadget      (0, 200, 5, 0, 0, ImageID(2))
  ButtonImageGadget(1, 384, 5, 50, 36, ImageID(3))
 
  TreeGadget    (2,  10, 50, 150, 200)
 
  SetGadgetText(4, "Initialize Ok... Welcome !")
 
  ;-- Example set named gadget data
  SetGadgetDataInteger(4, $0000FF, "ColorMouseEnter")
  SetGadgetDataInteger(4, $FF0000, "ColorMouseLeave")
 
 
  For k=0 To 10
    AddGadgetItem(2, -1, "General "+Str(k), ImageID(1))
    AddGadgetItem(2, -1, "ScreenMode", ImageID(1))
    AddGadgetItem(2, -1, "640*480", ImageID(1), 1)
    AddGadgetItem(2, -1, "800*600", ImageID(3), 1)
    AddGadgetItem(2, -1, "1024*768", ImageID(1), 1)
    AddGadgetItem(2, -1, "1600*1200", ImageID(1), 1)
    AddGadgetItem(2, -1, "Joystick", ImageID(1))
  Next
 
  For k=0 To 100
    AddGadgetItem(5, -1, "Element "+Str(k)+Chr(10)+"C 2"+Chr(10)+"Comment 3", ImageID(3))
  Next
 
  SetGadgetState(5, 8)
 
  LoadFont(0, "Arial", 11, #PB_Font_Italic)
 
  ;-- Example get gadget list
  NewList Gadgets()
  GetGadgetList(Gadgets(), WindowID(0))
  ForEach Gadgets()
    SetGadgetFont(Gadgets(), FontID(0))
  Next
 
  ;-- Example set all gadgetcolor
  SetAllGadgetColor(#PB_Gadget_FrontColor, $FF0000)
 
  AddWindowTimer(0, 1, 100)
  BindEvent(#PB_Event_Timer, @TimerCB())
 
  BindGadgetEvent(4, @TextCB())
 
  Repeat
    Event = WaitWindowEvent()
   
    If Event = #PB_Event_Gadget
     
      ;--- Now check leftclick because new events mouse enter and leave
       
      Select EventGadget()
        Case 1
          If EventType() = #PB_EventType_LeftClick
            MessageRequester("Information", "You did it !", 0)
          EndIf
        Case 2
          If EventType() = #PB_EventType_LeftClick
            SetGadgetText(4, "Tree Gadget. Item selected: "+Str(GetGadgetState(2)))
          EndIf
        Case 5
          If EventType() = #PB_EventType_LeftClick
            SetGadgetText(4, "ListIcon Gadget. Item selected: "+Str(GetGadgetState(5)))
          EndIf
      EndSelect
     
    EndIf
   
  Until Event = #PB_Event_CloseWindow
EndIf

Kwai chang caine · Post by **Kwai chang caine** » Mon Jul 30, 2018 8:27 pm

Thanks for sharing

infratec · Post by **infratec** » Tue Jul 31, 2018 10:29 am

Hm...

just tried you AGF Module:
y and x not defined

Code: Select all

handle = WindowFromPoint_(y << 32 | x)

I replaced it with:

Code: Select all

handle = WindowFromPoint_(DesktopMouseY() << 32 | DesktopMouseX())

Bernd

mk-soft · Post by **mk-soft** » Tue Jul 31, 2018 10:39 am

Oh, Copy/Paste fault. Thanks

Update v1.14
- Bugfix MouseOver

P.S. Update Example because TextGadget need Flag "#SS_NOTIFY" under window and optimize code TimerCB()

PureBasic Forums - English

Module Advanced Gadget Functions (All OS)

Module Advanced Gadget Functions (All OS)

Re: Module AFG with usage "Tab and Shift+Tab in linux and ma

Re: Module AFG with usage "Tab and Shift+Tab in linux and ma

Re: Module AFG with usage "Tab and Shift+Tab in linux and ma

Re: Module AFG with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module AGF with usage "Tab and Shift+Tab in linux and ma

Re: Module Advanced Gadget Functions (All OS)

Re: Module Advanced Gadget Functions (All OS)

Re: Module Advanced Gadget Functions (All OS)