PureBasic Forums - English

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

Named GadgetData

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

Page 1 of 1

Named GadgetData

Posted: Sun Nov 08, 2015 2:34 pm
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

Re: Named GadgetData

Posted: Sun Nov 08, 2015 7:59 pm
by mestnyi
+1

Re: Named GadgetData

Posted: Mon Nov 09, 2015 10:16 am
by Kwai chang caine
Works well
Thanks for sharing 8)

Re: Named GadgetData

Posted: Mon Nov 09, 2015 10:24 am
by RSBasic
Thank you for your code. Image

Re: Named GadgetData

Posted: Mon Nov 09, 2015 4:52 pm
by davido
@mk-soft,
Very nice, thank you for sharing. 8)

Re: Named GadgetData

Posted: Tue Nov 10, 2015 10:28 pm
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"

Re: Named GadgetData

Posted: Fri Nov 13, 2015 2:03 pm
by mestnyi
But do not go so easy because pb don´t released gadgets resources after "CloseWindow"
precisely with the problem?

Re: Named GadgetData

Posted: Fri Nov 13, 2015 7:43 pm
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

Re: Named GadgetData

Posted: Fri Nov 13, 2015 8:21 pm
by mestnyi
mac os but I realized I have no, I have not been able to establish on virtualbox. :cry:

Re: Named GadgetData

Posted: Sat Nov 14, 2015 11:30 am
by mk-soft
Update v1.04
- Added CloseWindowEx(...)

Update GadgetData over CloseWindow or FreeGadget of ContainerGadget don´t work on Mac :(

Re: Named GadgetData

Posted: Thu Nov 26, 2015 11:37 pm
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:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited