Named GadgetData

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 6242
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Named GadgetData

Post by mk-soft »

With GadgetData can unfortunately only assign a value to a gadget.
But sometimes you want to store multiple values (Properties). For this, the values are stored in a map.

Update v1.03

Update v1.04
- Added CloseWindowEx(...)

Update v1.05
- Added check for remove panel item
- Added InitGadgetData(event) for Mac OS. On Mac remove internal GadgetObject with next (Wait)/WindowEvent

Here's an example with a BindGadgetEvent for the Calendar gadget

Code: Select all

;-Begin

; Comment: Named GadgetData
; Author : mk-soft
; Version: v1.05
; Created: 08.11.2015
; Updated: 26.11.2015
; Link   : http://www.purebasic.fr/english/viewtopic.php?f=12&t=63937

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

DeclareModule MyGadgetData
  
  Declare   InitGadgetData(event = #PB_Event_FirstCustomValue)
  Declare   SetGadgetDataValue(gadget, *value, property.s = "Default")
  Declare   GetGadgetDataValue(gadget, property.s = "Default")
  Declare   SetGadgetDataString(gadget, text.s, property.s = "Default")
  Declare.s GetGadgetDataString(gadget, property.s = "Default")
  Declare   FreeGadgetData(gadget)
  Declare   DebugGadgetData(gadget)
  Declare   RemoveGadgetItemEx(gadget, position)
  Declare   FreeGadgetEx(gadget)
  Declare   CloseWindowEx(window)
  
EndDeclareModule

Module MyGadgetData
  
  EnableExplicit
  
  Structure udtMyGadgetData
    value.i
    text.s
  EndStructure
  
  Structure udtMyGadgetDataSet
    gadget.i
    Map ds.udtMyGadgetData()
  EndStructure
  
  Global NewList GadgetData.udtMyGadgetDataSet()
  Global event_update
  
  Declare UpdateGadgetData()
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure InitGadgetData(event = #PB_Event_FirstCustomValue)
    
    BindEvent(event, @UpdateGadgetData())
    event_update = event
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetDataValue(gadget, *value, property.s = "Default")
    
    Protected *map.udtMyGadgetDataSet
    
    *map = GetGadgetData(gadget)
    If *map = 0
      *map = AddElement(GadgetData())
      If *map
        *map\gadget = gadget
        *map\ds(property)\value = *value
        SetGadgetData(gadget, *map)
      EndIf
    Else
      *map\ds(property)\value = *value
    EndIf
      
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure GetGadgetDataValue(gadget, property.s = "Default")
    
    Protected *map.udtMyGadgetDataSet
    
    *map = GetGadgetData(gadget)
    If *map
      ProcedureReturn *map\ds(property)\value
    Else
      ProcedureReturn 0
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure SetGadgetDataString(gadget, text.s, property.s = "Default")
    
    Protected *map.udtMyGadgetDataSet
    
    *map = GetGadgetData(gadget)
    If *map = 0
      *map = AddElement(GadgetData())
      If *map
        *map\gadget = gadget
        *map\ds(property)\text = text
        SetGadgetData(gadget, *map)
      EndIf
    Else
      *map\ds(property)\text = text
    EndIf
      
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure.s GetGadgetDataString(gadget, property.s = "Default")
    
    Protected *map.udtMyGadgetDataSet
    
    *map = GetGadgetData(gadget)
    If *map
      ProcedureReturn *map\ds(property)\text
    Else
      ProcedureReturn ""
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure FreeGadgetData(gadget)
    
    Protected *map.udtMyGadgetDataSet
    
    ForEach GadgetData()
      If GadgetData()\gadget = gadget
        DeleteElement(GadgetData(), 1)
      EndIf
    Next
    SetGadgetData(gadget, 0)
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure DebugGadgetData(gadget)
    
    Protected *map.udtMyGadgetDataSet
    
    *map = GetGadgetData(gadget)
    If *map
      ForEach *map\ds()
        Debug "Property('" + MapKey(*map\ds()) + "') = " + *map\ds()\value + " : " + *map\ds()\text
      Next
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure UpdateGadgetData()
    
    ForEach GadgetData()
      If Not IsGadget(GadgetData()\gadget)
        DeleteElement(GadgetData(), 1)
      EndIf
    Next
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure RemoveGadgetItemEx(gadget, position)
    
    RemoveGadgetItem(gadget, position)
    If GadgetType(gadget) = #PB_GadgetType_Panel
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        PostEvent(event_update)
      CompilerElse
        UpdateGadgetData()
      CompilerEndIf
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure FreeGadgetEx(gadget)
    
    If gadget = #PB_All
      FreeGadget(#PB_All)
      ClearList(GadgetData())
    Else
      FreeGadget(gadget)
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        PostEvent(event_update)
      CompilerElse
        UpdateGadgetData()
      CompilerEndIf
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  Procedure CloseWindowEx(window)
    
    If window = #PB_All
      CloseWindow(#PB_All)
      ClearList(GadgetData())
    Else
      CloseWindow(window)
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        PostEvent(event_update)
      CompilerElse
        UpdateGadgetData()
      CompilerEndIf
    EndIf
    
  EndProcedure
  
  ; ---------------------------------------------------------------------------------------
  
  
EndModule

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

;-Init

UseModule MyGadgetData

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  InitGadgetData()
CompilerEndIf

Macro SetGadgetData(gadget, value, property = "Default")
  SetGadgetDataValue(gadget, value, property)
EndMacro

Macro GetGadgetData(gadget, property = "Default")
  GetGadgetDataValue(gadget, property)
EndMacro

Macro RemoveGadgetItem(gadget, position)
  RemoveGadgetItemEx(gadget, position)
EndMacro

Macro FreeGadget(gadget)
  FreeGadgetEx(gadget)
EndMacro

Macro CloseWindow(window)
  CloseWindowEx(window)
EndMacro

;-End Named GadgetData

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

CompilerIf #PB_Compiler_IsMainFile
  
  ; CalendarGadget Events
  
  Procedure EventHandler_Calendar()
    
    Protected gadget, datetime, date, lastdate
    
    gadget = EventGadget()
    
    If EventType() <> #PB_EventType_Change 
      datetime = GetGadgetState(gadget)
      date = datetime / 86400
      lastdate = GetGadgetData(gadget, "EventData")
      If date <> lastdate
        lastdate = date
        SetGadgetData(gadget, lastdate, "EventData")
        PostEvent(#PB_Event_Gadget, EventWindow(), gadget, #PB_EventType_Change, datetime)
      EndIf
      
    EndIf
    
  EndProcedure
  
  Procedure Init_Calendar(gadget, first = #False)
    
    SetGadgetData(Gadget, Date() / 86400, "EventData")
    If first
      PostEvent(#PB_Event_Gadget, EventWindow(), gadget, #PB_EventType_Change, Date())
    EndIf
    BindGadgetEvent(Gadget, @EventHandler_Calendar())
    
  EndProcedure
  
  Procedure Main()
    
    Protected event
    
    If OpenWindow(0, #PB_Ignore, #PB_Ignore, 600, 400, "Hello")
      CalendarGadget(0, 10, 10, 200, 200)  
      CalendarGadget(1, 220, 10, 200, 200)  
    EndIf
    Init_Calendar(0, #True)
    Init_Calendar(1, #True)
    
    Repeat
      event = WaitWindowEvent()
      Select event
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 0
              Select EventType()
                Case #PB_EventType_Change
                  Debug "New date 0: " + FormatDate("%dd.%mm.%yyyy", EventData())
                  cnt = GetGadgetData(0) + 1
                  SetGadgetData(0, cnt)
                  SetGadgetDataString(0, FormatDate("%dd.%mm.%yyyy", EventData()), "Date")
                  DebugGadgetData(0)
                  
              EndSelect
              
            Case 1
              Select EventType()
                Case #PB_EventType_Change
                  Debug "New date 1: " + FormatDate("%dd.%mm.%yyyy", EventData())
                  cnt = GetGadgetData(1) + 1
                  SetGadgetData(1, cnt)
                  SetGadgetDataString(1, FormatDate("%dd.%mm.%yyyy", EventData()), "Date")
                  DebugGadgetData(1)
                  
              EndSelect
            
          EndSelect
      EndSelect
      
    ForEver
    
  EndProcedure : Main()
  
CompilerEndIf
Last edited by mk-soft on Thu Nov 26, 2015 11:39 pm, edited 5 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Named GadgetData

Post by mestnyi »

+1
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Named GadgetData

Post by Kwai chang caine »

Works well
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
RSBasic
Moderator
Moderator
Posts: 1228
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Named GadgetData

Post by RSBasic »

Thank you for your code. Image
Image
Image
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Named GadgetData

Post by davido »

@mk-soft,
Very nice, thank you for sharing. 8)
DE AA EB
User avatar
mk-soft
Always Here
Always Here
Posts: 6242
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Named GadgetData

Post by mk-soft »

Thanks :wink:

I wanted to released all resources with "CloseWindow".
But do not go so easy because pb don´t released gadgets resources after "CloseWindow"
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Named GadgetData

Post by mestnyi »

But do not go so easy because pb don´t released gadgets resources after "CloseWindow"
precisely with the problem?
User avatar
mk-soft
Always Here
Always Here
Posts: 6242
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Named GadgetData

Post by mk-soft »

I checked "CloseWindow" under windows and linux
I think it´s a Bug under Mac

http://www.purebasic.fr/english/viewtop ... 24&t=63979
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
mestnyi
Addict
Addict
Posts: 1098
Joined: Mon Nov 25, 2013 6:41 am

Re: Named GadgetData

Post by mestnyi »

mac os but I realized I have no, I have not been able to establish on virtualbox. :cry:
User avatar
mk-soft
Always Here
Always Here
Posts: 6242
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Named GadgetData

Post by mk-soft »

Update v1.04
- Added CloseWindowEx(...)

Update GadgetData over CloseWindow or FreeGadget of ContainerGadget don´t work on Mac :(
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
mk-soft
Always Here
Always Here
Posts: 6242
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Named GadgetData

Post by mk-soft »

Update v1.05
- Added check for remove panel item
- Added InitGadgetData(event) for Mac OS. On Mac remove internal GadgetObject with next (Wait)/WindowEvent

:wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply