PureBasic Forums - English

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

Named Properties for Gadgets like SetProp/GetProp (All OS)

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

Page 1 of 1

Named Properties for Gadgets like SetProp/GetProp (All OS)

Posted: Sat Jul 04, 2020 4:58 pm
by mk-soft
Hello, had too much time.

With windows there is the API SetProg and GetProp.
But this works better for all OS also with maps very well and need only some macros.

Update v1.03
- Change FreeProperties(...) - #PB_All deleted all properties of not exists gadgets
- Added ClearProperties() - Clear all properties

Code: Select all

;-TOP

; Named Properties for Gadgets by mk-soft, v1.03, 04.07.2020

Structure udtPropertyValue
  VarType.i
  StructureUnion
    iVal.i
    fltVal.f
    dblVal.d
  EndStructureUnion
  sVal.s
EndStructure

Structure udtProperty
  Map Value.udtPropertyValue()
EndStructure

Global NewMap MapProperty.udtProperty()

Macro SetPropertyInteger(_Gadget_, _Name_, _Value_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\VarType = #PB_Integer
  MapProperty()\Value()\iVal = _Value_
EndMacro

Macro SetPropertyFloat(_Gadget_, _Name_, _Value_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\VarType = #PB_Float
  MapProperty()\Value()\fltVal = _Value_
EndMacro

Macro SetPropertyDouble(_Gadget_, _Name_, _Value_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\VarType = #PB_Double
  MapProperty()\Value()\dblVal = _Value_
EndMacro

Macro SetPropertyString(_Gadget_, _Name_, _Value_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\VarType = #PB_String
  MapProperty()\Value()\sVal = _Value_
EndMacro

; ----

Macro GetPropertyInteger(_Gadget_, _Name_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\iVal
EndMacro

Macro GetPropertyFloat(_Gadget_, _Name_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\fltVal
EndMacro

Macro GetPropertyDouble(_Gadget_, _Name_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\dblVal
EndMacro

Macro GetPropertyString(_Gadget_, _Name_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\sVal
EndMacro

; ----

Macro GetPropertyVarType(_Gadget_, _Name_)
  MapProperty(Str(_Gadget_))\Value(_Name_)\VarType
EndMacro

Macro Properties(_Gadget_)
  MapProperty(Str(_Gadget_))
EndMacro

Macro FreeProperties(_Gadget_) ; <- #PB_All deleted all properties of not exists gadgets
  If _Gadget_ = #PB_All
    ForEach MapProperty()
      If Not IsGadget(Val(MapKey(MapProperty())))
        DeleteMapElement(MapProperty())
      EndIf
    Next
  Else
    DeleteMapElement(MapProperty(), Str(_Gadget_))
  EndIf
EndMacro

Macro ClearProperties() ; Clear all properties
  ClearMap(MapProperty())
EndMacro

; ****

CompilerIf #PB_Compiler_IsMainFile
  Debug "Set Properties"
  SetPropertyString(1, "Text", "Hello World")  
  SetPropertyInteger(1, "Year", 2020)  
  Debug "----"
  
  Debug "Get Properties"
  Debug "Text = " + GetPropertyString(1, "Text")
  Debug "Year = " + GetPropertyInteger(1, "Year")
  Debug "----"
  
  Debug "VarType of Year"
  r1 = GetPropertyVarType(1, "Year")
  Select r1
    Case 0 : Debug "Property not exists"
    Case #PB_Integer : Debug "- Integer"
    Case #PB_Float   : Debug "- Float"
    Case #PB_Double  : Debug "- Double"
    Case #PB_String  : Debug "- String"
  EndSelect
  Debug "----"
  
  Debug "VarType of Text"
  r1 = GetPropertyVarType(1, "Text")
  Select r1
    Case 0 : Debug "Property not exists"
    Case #PB_Integer : Debug "- Integer"
    Case #PB_Float   : Debug "- Float"
    Case #PB_Double  : Debug "- Double"
    Case #PB_String  : Debug "- String"
  EndSelect
  Debug "----"
  
  Debug "VarType of XYZ"
  r1 = GetPropertyVarType(1, "XYZ")
  Select r1
    Case 0 : Debug "Property not exists"
    Case #PB_Integer : Debug "- Integer"
    Case #PB_Float   : Debug "- Float"
    Case #PB_Double  : Debug "- Double"
    Case #PB_String  : Debug "- String"
  EndSelect
  Debug "----"
  
  ; FreeProperties(1)
  
  Debug "List of Properties"
  ForEach Properties(1)\Value()
    Debug MapKey(Properties(1)\Value())
  Next
  Debug "---"
  
CompilerEndIf

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Sun Jul 05, 2020 9:50 am
by Denis
Hi mk-soft,

Very interesting and clean code.

I will use it ASAP.
Thanks

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Sun Jul 05, 2020 7:06 pm
by Kwai chang caine
Thanks for sharing 8)

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 2:57 pm
by ebs
Hi mk-soft,

That is really clever! (and useful)

Can I make one suggestion? Change the FreeProperties macro to this:

Code: Select all

#ALL = -1
Macro FreeProperties(_Gadget_)
  If _Gadget_ = #ALL
    ClearMap(MapProperty())
  Else
    DeleteMapElement(MapProperty(), Str(_Gadget_))
  EndIf
EndMacro
That way, if you want to clear all properties:

Code: Select all

FreeProperties(#ALL)
Regards,
Eric

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 3:48 pm
by Joris
I don't understand what this is ment for. Do you have a example that shows something more clear ?

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 4:59 pm
by mk-soft
Maybe delete only no exists gadgets

Code: Select all

Macro FreeProperties(_Gadget_) ; <- #PB_All deleted all not exists Gadgets
  If _Gadget_ = #PB_All
    ForEach MapProperty()
      If Not IsGadget(Val(MapKey(MapProperty())))
        DeleteMapElement(MapProperty())
      EndIf
    Next
  Else
    DeleteMapElement(MapProperty(), Str(_Gadget_))
  EndIf
EndMacro

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 5:07 pm
by Josh
mk-soft wrote:Maybe delete only no exists gadgets
Why don't store the data in a structure with Set-/GetWindowData, Set-/GetGadgetData?

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 5:10 pm
by mk-soft
Joris wrote:I don't understand what this is ment for. Do you have a example that shows something more clear ?
Stupid example ...

Code: Select all

;-TOP

IncludeFile "NamedProperties.pb"

Enumeration Gadgets
  #String
  #ButtonRestore
EndEnumeration

Procedure Main()
  If OpenWindow(0, 100, 100, 400, 300, "Window", #PB_Window_SystemMenu)
    StringGadget(#String, 10, 10, 380, 25, "First Text")
    ButtonGadget(#ButtonRestore, 10, 50, 120, 30, "Restore")
    
    SetActiveGadget(#String)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Menu
          Select EventMenu()
              CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
              Case #PB_Menu_Quit
                Break
              CompilerEndIf
          EndSelect
          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #String
              Select EventType()
                Case #PB_EventType_Focus
                  SetPropertyString(#String, "FocusText", GetGadgetText(#String))
                  SetPropertyInteger(#String, "FocusDate", Date())
                  
              EndSelect
              
            Case #ButtonRestore
              SetGadgetText(#String, GetPropertyString(#String, "FocusText"))
              Debug "Restore from Date " + FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", GetPropertyInteger(#String, "FocusDate"))
              
          EndSelect
          
        Case #PB_Event_CloseWindow
          Break
          
      EndSelect
    ForEver
    
  EndIf
  
EndProcedure : Main()

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 5:22 pm
by mk-soft
Josh wrote:
mk-soft wrote:Maybe delete only no exists gadgets
Why don't store the data in a structure with Set-/GetWindowData, Set-/GetGadgetData?
1.
First you must get the pointer to the structured memory and create the structured memory when you use it for the first time.
2.
When closing windows or removing gadgets, you must ensure that the memory on the structure is freed. Otherwise you will get a memory leak, because then you will not be able to access the old data.
3.
Not for PB_Any
The data for the gadget is still available after the rebuild, or you can assign the data before.

[Edit]

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 7:01 pm
by mk-soft
Update v1.03
- Change FreeProperties(...) - #PB_All deleted all properties of not exists gadgets
- Added ClearProperties() - Clear all properties

It would be great if Fred would allow us to use the internal NumericMap functions.
:wink:

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 8:27 pm
by Josh
mk-soft wrote: 1.
First you must get the pointer to the structured memory and create the structured memory when you use it for the first time.
2.
When closing windows or removing gadgets, you must ensure that the memory on the structure is freed. Otherwise you will get a memory leak, because then you will not be able to access the old data.
3.
Not for PB_Any
The data for the gadget is still available after the rebuild, or you can assign the data before.
  1. One line of code. In most cases where I have to give data to a gadget, I have already stored it in a structure anyway.
  2. Yes, I have to free the allocated memory, that's what a programmer does. But this is no different with your system, otherwise you will have a problem if you create a new gadget with the same gadget number.
  3. I don't see an advantage here, but there is a danger. See point 2.
It doesn't matter, anyone can do it however they want. But I prefer to use the things that are natively available for this.

Re: Named Properties for Gadgets like SetProp/GetProp (All O

Posted: Mon Jul 06, 2020 8:46 pm
by mk-soft
This is only about the alternative Windows API function SetProp and GetPro for all OS.

It should only show that it is very easy to solve with maps and few macros.

Everybody can do it the way he wants ...

Re: Named Properties for Gadgets like SetProp/GetProp (All OS)

Posted: Sat Oct 23, 2021 11:02 am
by Rinzwind
With windows there is the API SetProg and GetProp.
Mind you, that Windows API is questionably slow, way, way slower than using a PB map for similar functionality.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited