Bind of variables

Sujets variés concernant le développement en PureBasic
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Bind of variables

Message par microdevweb »

Bonjour,
Voici un petit test de Bing à la Java. Le principe est de binder des variables et de les mettre à jour automatiquement.

Remarque : utilise les thread avec le principe de producteur / consommateur et un buffer de type fifo

Bon actuellement le code n'est pas commenté et pas très propre (c'est juste un teste)

Le but serait de faire par après un module table avec un bind automatique, ainsi que pour d'autre gadget pourquoi pas

Code du main

Code : Tout sélectionner

XIncludeFile "bind.pbi"
Global myLst.BIND::listProperty = BIND::newListProperty()

Procedure callBack(item.BIND::stringProperty,line,column,action)
  Protected n
  Select action
    Case BIND::#ACTION_ADD
      AddGadgetItem(0,-1,item\getValue())
      SetGadgetItemData(0,CountGadgetItems(0)-1,item)
    Case BIND::#ACTION_SET
      For n = 0 To CountGadgetItems(0)-1
        If GetGadgetItemData(0,n) = item
          SetGadgetItemText(0,n,item\getValue())
        EndIf
      Next
  EndSelect
EndProcedure
myLst\link(@callBack())
Procedure exit()
  End
EndProcedure

Procedure add()
  Protected myItems.BIND::itemProperty
  myItems = myLst\addLine()
  myItems\addItem(BIND::newStringProperty(GetGadgetText(1)))
  SetGadgetText(1,"")
EndProcedure

Procedure edit()
  If GetGadgetState(0) > -1
    Protected item.BIND::stringProperty = GetGadgetItemData(0,GetGadgetState(0))
    item\setValue(GetGadgetText(1))
  EndIf
EndProcedure




OpenWindow(0,0,0,800,600,"Teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ListIconGadget(0,0,0,200,600,"Name",200,#PB_ListIcon_AlwaysShowSelection)
StringGadget(1,220,50,150,30,"")
ButtonGadget(2,220,80,100,30,"Add")
ButtonGadget(3,220,120,100,30,"Edit")
BindEvent(#PB_Event_CloseWindow,@exit(),0)
BindGadgetEvent(2,@add())
BindGadgetEvent(3,@edit())

Repeat 
  WaitWindowEvent()
ForEver

Code du module

Code : Tout sélectionner

DeclareModule BIND
  Enumeration 
    #ACTION_ADD
    #ACTION_SET
    #ACTION_DELETE
  EndEnumeration
  Interface stringProperty
    getValue.s()
    setValue(values.s)
  EndInterface
  Interface listProperty
    addLine()
    link(callback)
    getItem(line)
  EndInterface
  Interface itemProperty
    addItem(stringProperty)
    getStringProperty(column)
  EndInterface
  
  Declare newStringProperty(value.s = "")
  Declare newListProperty()
EndDeclareModule
Module BIND
  EnableExplicit
  #BUFFER_LEN = 50
  
  Prototype callback(*stringProperty,line,column,action)
  
  
  Structure _stringProperty
    *methods
    value.s
    action.i
    column.i
    line.i
    *parent
  EndStructure
  Structure _fifo
    mutex.i
    items.i
    spaces.i
    Array *buffer._stringProperty(#BUFFER_LEN)
    input.i
    output.i
    *callback.callback
  EndStructure
  Structure _listItems
    *methods
    List *myStringProperty._stringProperty()
    *parent
    line.i
  EndStructure
  Structure _listProperty
    *methods
    List *myList._listItems()
    *myFifo._fifo
    popThr.i
    *callback
  EndStructure
  
  Procedure push(*this._fifo,*item)
    With *this
      WaitSemaphore(\spaces)      ; wait for space into the buffer
      LockMutex(\mutex)           ; mutual exclusion
      \buffer(\input) = *item     ; push into the list
      \input +1                   ; next list position
      ; manage circular list
      If \input >= #BUFFER_LEN    ; uper to buffer length
        \input = 0
      EndIf
      UnlockMutex(\mutex)         ; end of mutual exclusion
      SignalSemaphore(\items)     ; tel data available
    EndWith
  EndProcedure
  
  Procedure pop(*this._fifo)
    With *this
      Protected *returned_value._stringProperty 
      Repeat
        WaitSemaphore(\items)               ; wait for data available
        LockMutex(\mutex)                   ; mutual exclusion
        *returned_value = \buffer(\output)  ; load from the List
        \output +1                          ; next list position
                                            ; manage circular list
        If \output >= #BUFFER_LEN           ; uper to bufer length
          \output = 0
        EndIf
        UnlockMutex(\mutex)                 ; End of mutual exclusion
        SignalSemaphore(\spaces)            ; tel space available
        \callback(*returned_value,*returned_value\line,*returned_value\column,*returned_value\action)
      ForEver
    EndWith
  EndProcedure
  
  
  Procedure newStringProperty(value.s = "")
    Protected *this._stringProperty = AllocateStructure(_stringProperty)
    With *this
      \methods = ?S_string_pro
      \value = value
      ProcedureReturn *this
    EndWith
  EndProcedure
  
  Procedure newListProperty()
    Protected *this._listProperty = AllocateStructure(_listProperty)
    With *this
      \methods = ?S_list_pro
      \myFifo = AllocateStructure(_fifo)
      ProcedureReturn *this
    EndWith
  EndProcedure
  
  Procedure newListItem()
    Protected *this._listItems = AllocateStructure(_listItems)
    With *this
      \methods = ?S_list_item
      ProcedureReturn *this
    EndWith
  EndProcedure
  
  Procedure list_addLine(*this._listProperty)
    With *this
      AddElement(\myList())
      \myList() = newListItem()
      \myList()\parent = *this
      \myList()\line = ListSize(\myList())
      ProcedureReturn \myList()
    EndWith
  EndProcedure
  
  Procedure addItem(*this._listItems,*stringProperty._stringProperty)
    With *this
      AddElement(\myStringProperty())
      \myStringProperty() = *stringProperty
      *stringProperty\column = ListSize(\myStringProperty())
      *stringProperty\parent = *this
      Define *p._listProperty = \parent
      *stringProperty\line = \line
      *stringProperty\action = #ACTION_ADD
      push(*p\myFifo,*stringProperty)
      ProcedureReturn \myStringProperty()
    EndWith
  EndProcedure
  
  Procedure list_link(*this._listProperty,*method)
    With *this
      If Not \popThr
        \myFifo\mutex = CreateMutex()
        \myFifo\items = CreateSemaphore(0)
        \myFifo\spaces = CreateSemaphore(#BUFFER_LEN)
        \myFifo\callback = *method
        \popThr = CreateThread(@pop(),\myFifo)
      EndIf
    EndWith
  EndProcedure
  
  Procedure.s str_getValue(*this._stringProperty)
    With *this
      ProcedureReturn \value
    EndWith
  EndProcedure
  
  Procedure list_get(*this._listProperty,line)
    With *this
      If SelectElement(\myList(),line - 1)
        ProcedureReturn  \myList()
      EndIf
      ProcedureReturn 0  
    EndWith
  EndProcedure
  
  Procedure item_get(*this._listItems,column)
    With *this
      If SelectElement(\myStringProperty(),column -1)
        ProcedureReturn \myStringProperty()
      EndIf
      ProcedureReturn 0
    EndWith
  EndProcedure
  
  Procedure str_setValue(*this._stringProperty,value.s)
    With *this
      \value = value.s
      Define  *p._listItems = \parent
      Define *pp._listProperty = *p\parent
      \action = #ACTION_SET
      push(*pp\myFifo,*this)
    EndWith
  EndProcedure
  
  DataSection
    S_string_pro:
    Data.i @str_getValue()
    Data.i @str_setValue()
    S_list_pro:
    Data.i @list_addLine()
    Data.i @list_link()
    Data.i @list_get()
    S_list_item:
    Data.i @addItem()
    Data.i @item_get()
  EndDataSection
EndModule
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Bind of variables

Message par Kwai chang caine »

Comme dab c'est joli 8)
Mais alors, faut se lever de bonne heure pour caser tout ça dans une conversation 8O :oops:
Je ne pense pas que ça me servira un jour, mais en tout cas merci du partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Répondre