En m'aidant du debugger j'ai pu voir que la variable 'Item' est remise à zéro et donc on a une boucle infinie qui augmente la taille de la chaîne 'String' jusqu'à pu possible.
Code : Tout sélectionner
EnableExplicit
Structure Node
Element.s
nNodes.l
*Superior.Node
*Siblings.Node
*Children.Node
EndStructure
Structure Tree
*Current.Node
EndStructure
Procedure.l NewTree()
ProcedureReturn AllocateMemory( SizeOf(Tree) )
EndProcedure
Procedure.l IsEmpty(*Tree.Tree)
ProcedureReturn (Not *Tree\Current)
EndProcedure
Procedure.l IsRoot(*Tree.Tree)
Protected *Root.Node
*Root = *Tree\Current
If *Root And *Root\Superior
*Root = #Null
EndIf
ProcedureReturn *Root
EndProcedure
Procedure.l GetRoot(*Tree.Tree)
Protected *Root.Node
*Root = *Tree\Current
If *Root
While *Root\Superior
*Root = *Root\Superior
Wend
EndIf
ProcedureReturn *Root
EndProcedure
Procedure.l AddNode(*Tree.Tree)
Protected *Node.Node
*Node = AllocateMemory( SizeOf(Node) )
If *Tree\Current
*Tree\Current\nNodes + 1
If *Tree\Current\Children
*Tree\Current = *Tree\Current\Children
While *Tree\Current\Siblings
*Tree\Current = *Tree\Current\Siblings
Wend
*Tree\Current\Siblings = *Node
*Tree\Current = *Tree\Current\Superior
Else
*Tree\Current\Children = *Node
EndIf
EndIf
If *Node
*Node\Superior = *Tree\Current
*Tree\Current = *Node
EndIf
ProcedureReturn *Node
EndProcedure
Procedure.l InsertNode(*Tree.Tree)
Protected *Node.Node
*Node = AllocateMemory( SizeOf(Node) )
If *Tree\Current
*Tree\Current\nNodes + 1
If *Tree\Current\Children
*Tree = *Tree\Current\Children
*Node\Siblings = *Tree\Current
*Tree\Current = *Tree\Current\Superior
*Tree\Current\Children = *Node
Else
*Tree\Current\Children = *Node
EndIf
EndIf
If *Node
*Node\Superior = *Tree\Current
*Tree\Current = *Node
EndIf
ProcedureReturn *Node
EndProcedure
Procedure.l FreeNode(*Node.Node)
Protected Free.l = #True, *Temp.Node
If *Node
Free & FreeNode(*Node\Children)
*Temp = *Node
*Node = *Node\Siblings
Free & FreeMemory(*Temp)
While *Node
Free & FreeNode(*Node\Children)
*Temp = *Node
*Node = *Node\Siblings
Free & FreeMemory(*Temp)
Wend
EndIf
ProcedureReturn Free
EndProcedure
Procedure.l ClearTree(*Tree.Tree)
ProcedureReturn FreeNode( GetRoot(*Tree) )
EndProcedure
Procedure.l FreeTree(*Tree.Tree)
ProcedureReturn FreeNode( GetRoot(*Tree) ) & FreeMemory(*Tree)
EndProcedure
;-------------------------------------------------------------------------------
Procedure.l IsTreeString(String.s)
Protected Valid.l
If Left(String, 1) = "{" And Right(String, 1) = "}"
If CountString(String, "{") = CountString(String, "}")
If Not FindString(String, "{}", 1) ;pas d'élément vide
Valid = #True
EndIf
EndIf
EndIf
ProcedureReturn Valid
EndProcedure
Procedure.l ParseTreeString(*Tree.Tree, String.s)
Protected c.s, i.l = 1
If IsTreeString(String)
While i < Len(String)
c = Mid(String, i, 1)
Select c
Case "{"
AddNode(*Tree)
Case "}"
*Tree\Current = *Tree\Current\Superior
Default
*Tree\Current\Element + c
EndSelect
i + 1
Wend
EndIf
ProcedureReturn *Tree
EndProcedure
Procedure.l GetNodeValue(*Node.Node)
Protected Value.l
If *Node
Select Asc(*Node\Element)
Case '('
Value = GetNodeValue(*Node\Children)
Case '+'
If *Node\Children\Siblings
Value = GetNodeValue(*Node\Children\Siblings) + GetNodeValue(*Node\Children)
Else
Value = GetNodeValue(*Node\Children)
EndIf
Case '-'
If *Node\Children\Siblings
Value = GetNodeValue(*Node\Children) - GetNodeValue(*Node\Children\Siblings)
Else
Value = - GetNodeValue(*Node\Children)
EndIf
Case '*'
Value = GetNodeValue(*Node\Children) * GetNodeValue(*Node\Children\Siblings)
Case '/'
Value = GetNodeValue(*Node\Children) / GetNodeValue(*Node\Children\Siblings)
Default
Value = Val(*Node\Element)
EndSelect
EndIf
ProcedureReturn Value
EndProcedure
Procedure.l GetTreeValue(*Tree.Tree)
ProcedureReturn GetNodeValue( GetRoot(*Tree) )
EndProcedure
Procedure.s GetNodeString(*Node.Node)
Protected String.s
If *Node
If *Node\Element = "("
String = "(" + GetNodeString(*Node\Children) + ")"
Else
If *Node\Children And *Node\Children\Siblings
String = GetNodeString(*Node\Children)
String + *Node\Element
String + GetNodeString(*Node\Children\Siblings)
Else
String + *Node\Element
String + GetNodeString(*Node\Children)
EndIf
EndIf
EndIf
ProcedureReturn String
EndProcedure
Procedure.s GetTreeString(*Tree.Tree)
ProcedureReturn GetNodeString( GetRoot(*Tree) )
EndProcedure
Define Expression.l, TreeString.s
TreeString = "{+{3}{({*{5}{*{({-{/{*{*{({-{12}}}{6}}{8}}{4}}{/{/{*{/{4}{2}}{6}}{3}}{2}}}}{7}}}}}"
Expression = NewTree()
ParseTreeString(Expression, TreeString)
;-------------------------------------------------------------------------------
Procedure.l AddTreeGadgetNode(Gadget.l, *Node.Node, Depth.l)
If *Node
AddGadgetItem(Gadget, #PB_Default, *Node\Element, #Null, Depth)
AddTreeGadgetNode(Gadget, *Node\Children, Depth + 1)
*Node = *Node\Siblings
While *Node
AddGadgetItem(Gadget, #PB_Default, *Node\Element, #Null, Depth)
AddTreeGadgetNode(Gadget, *Node\Children, Depth + 1)
*Node = *Node\Siblings
Wend
EndIf
EndProcedure
Procedure.l SetTreeGadgetTree(Gadget.l, *Tree.Tree)
ClearGadgetItemList(Gadget)
AddTreeGadgetNode(Gadget, GetRoot(*Tree), 0)
EndProcedure
Procedure.s GetTreeGadgetString(Gadget.l)
Protected String.s, Count.l
Protected Item.l, Level.l, NextLevel.l
Count = CountGadgetItems(Gadget)
If Count
String = ""
While Item < Count
NextLevel = GetGadgetItemAttribute(Gadget, Item+1, #PB_Tree_SubLevel)
; If Level = 0 XOr Item = 0
; ;L'arbre a plusieurs racines !
; String = ""
; Break
; EndIf
String + "{" + GetGadgetItemText(Gadget, Item, #PB_Default)
While Level >= NextLevel
String + "}"
Level - 1
Wend
Level = NextLevel
Item + 1
Wend
EndIf
ProcedureReturn String
EndProcedure
;-------------------------------------------------------------------------------
DisableExplicit
If OpenWindow(0, 0, 0, 350, 180, "TreeGadget")
CreateGadgetList(WindowID(0))
TreeGadget(0, 10, 10, 330, 160)
SetTreeGadgetTree(0, Expression)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
Debug GetTreeGadgetString(0)
Debug TreeString
EndIf
