Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Doppelt verkettete Liste- Baum
| Uploader: |  Elektronix |
| Datum/Zeit: | 20.06.2008 09:37:04 |
/'***************************************************************************************************
*****************************************************************************************************
*********************** Programmiert von Elektronix **************************
*********************** **************************
*********************** mit FreeBasic 0.18.2 und FBEdit 1.0.5.8 **************************
*****************************************************************************************************
*****************************************************************************************************
'/
/'Dies ist eine Sammlung von Funktionen und Variablen zur Erstellung und Verwaltung
von doppelt verketteten Listen. Jedes Listenelement enthält einen Zeiger auf einen neuen
Listenkopf, so daß daraus auch jede Art von Bäumen erstellt werden kann. Durch die doppelte
Verkettung kann die Liste auch als FIFO oder als LAFO genutzt werden. Die Funk-
tionen dafür sind jedoch nicht implementiert. (Die vorhandenen Funktionen ermöglichen dieses
Verhalten auch, nur etwas umständlicher.) Andererseits enthält jeder Kopfknoten auch einen
Zeiger auf den übergeordneten Listenkopf.
Es können in einer Liste nicht 2 gleiche Werte existieren. Andererseits können in verschiedenen
Sublisten gleichlautende Werte stehen. Wenn auf einen davon zugegriffen werden soll, muß
zunächst die entsprechende Subliste bzw. das Element, an dem der Sublistenkopf angelegt ist,
gesucht werden.
Zu beachten ist, daß die Listenelemente im Speicher allociiert werden. Wenn die Liste/
der Baum nicht mehr benötigt wird, muß also HeadNode.DeleteSubList() vom Kopfknoten der
obersten Liste ausgeführt werden, damit der Baum vollständig deallociiert wird. Anderenfalls
hinterläßt er große Mengen Speicherleaks.
Die Funktionen für die verschiedenen Baum-Arten sind nicht implementiert, dies kann der
User bei Bedarf selbst übernehmen.
Die Ausgaben während des Programmablaufs dienen der besseren Nachvollziehbarkeit
der Funktionen bei der Demonstration. Sie können unterbunden werden, indem man die
Print-Anweisungen innerhalb der Funktionen auskommentiert.
Die Funktionen sind alle nach bestem Wissen und Gewissen auf Fehler geprüft. Garantie dafür
lehnt der Autor jedoch ab.
Viel Spaß.
############################################################################################'/
'Forward-Referenzierung
Type ListEnd As EndNode
Type ListHead As HeadNode
Type ListItem
Declare Function CompareValues (NewValue as String) As Integer
Value As String
ItemOrder As Integer
pPrevItem As ListItem Ptr
pNextItem As ListItem Ptr
pSubListHead As ListHead PTR
pHead As ListHead Ptr
pEnd As ListEnd Ptr
Declare Constructor(ByRef pListHead As ListHead Ptr, ByRef pListEnd As ListEnd Ptr, ByRef pListItem As ListItem Ptr, NewValue As String)
End Type
'*************************************************
Type EndNode
ItemNumbs As Integer
pHead As ListHead Ptr
pLastItem As ListItem Ptr
Style As String
Declare Constructor (ByRef pListHead As ListHead Ptr,ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr)
End Type
'*************************************************
Type HeadNode
pFirstItem As ListItem Ptr
pEnd As ListEnd Ptr
Style As String
Level As Integer
pParentHead As ListHead Ptr
Declare Sub DeleteSubList()
Declare Function SearchItemAdress(pListItem As ListItem Ptr, SearchValue As String, SearchDepth As Integer, ByRef Path As String) As ListItem PTR
Declare Constructor (ByRef pListHead As HeadNode Ptr, ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr, Style As String)
End Type
Dim shared PListHeadBackUp As ListHead Ptr = 0
'*************************************************
Declare Sub Tree_ResetListPointers(ByRef pListHead As HeadNode Ptr, pListEnd As EndNode Ptr, pListItem As ListItem PTR)
Declare Sub List_DeleteItem(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, deleteValue As String)
Declare Sub List_DisplayList(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
Declare Sub List_DisplayListReverse(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
Declare Function List_AddItem (pListHead As HeadNode Ptr, pListEnd As EndNode ptr, pListItem As Listitem Ptr, NewValue As String) As ListItem Ptr
Declare Function List_SearchElementPos(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, SearchValue As String) As Integer
Declare Function List_ReadListByPosSteps(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, StartPos As Integer, Steps As Integer) As String
Declare Function List_GetValueByPos(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Position As Integer) As String
Declare Function Tree_CreateSubList(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Value As String, Style As String) As HeadNode Ptr
Declare Function Tree_AppendSubList(pListHead As HeadNode Ptr, pListEnd As EndNode Ptr, ByRef pAppendItem As ListItem Ptr, AppendValue As String, Style As String) As HeadNode Ptr
Declare Function Tree_AppendSubListItem(pListHead As HeadNode Ptr, pListEnd As EndNode Ptr, pLisItem As ListItem Ptr, AppendItem As String, AppendValue As String) As ListItem Ptr
Constructor HeadNode (ByRef pListHead As HeadNode Ptr, ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr, Style As String)
/'Der Konsturktur des Listenkopfes erstellt einen Listenkopf und Allociiert Speicher,
dessen Adresse an den Zeiger pListHead zugewiesen wird. Gleichzeitig wird der Konstruktor
des Endknotens aufgerufen
Der Parameter "Style" gibt an, ob die Liste sortiert oder unsortiert sein soll.
Bei sortierten Listen werden die Elemente von der Funktion List_AddItem() nach alphabetischer
Reihenfolge sortiert. Bei unsortierten Listen werden neue Elemente nur hinten angefügt.
Die Default-Option ist die sortierte Liste: Style "sorted". Beim Zuweisen des Styles ist auf
die Kleinschreibung zu achten.'/
Dim ListEnd As EndNode = EndNode (@this, pListEnd, pListItem) 'Listenende einrichten
pListHead = Callocate (Len(HeadNode))
pListHead->Style = Style
pListHead->pEnd = pListEnd
pListEnd->pHead = pListHead
Print
Print "Begin Constructor HeadNode"
Print "pListHead = "; pListHead
Print "pListEnd = ";pListEnd
Print "End Constructor HeadNode"
Print
End Constructor
Constructor EndNode (ByRef pListHead As ListHead Ptr, ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr)
pListEnd = @this
pListEnd = Callocate(Len(EndNode)) 'Listenelement anlegen
Print
Print "Begin Constructor EndNode"
Print "pListEnd = "; pListEnd
Print "End Constructor EndNode"
Print
End Constructor
Constructor ListItem(ByRef pListHead As ListHead Ptr, ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr, NewValue As String)
/'Der ListItem-Konstruktor allociiert Speicher für ein neues Listenelement und weist sie den
Referenzen des Zeigers pListItem zu. Außerdem werden in dem Element die Adressen des Kopf- und Endknotens
vermerkt, sowie im endknoten die Anzahl der Elemente aktualisiert.'/
Print "Begin Constructor ListItem"
this.Value = NewValue
pListItem = Callocate(Len(ListItem))
pListItem->Value = this.Value
pListItem->pHead = pListHead
pListItem->pEnd = pListEnd
' Kopf und Ende setzen
If pListHead->pFirstItem = 0 Then
pListHead->pFirstItem = pListItem
EndIf
If pListEnd->pLastItem = 0 Then
pListEnd->pLastItem = pListItem
EndIf
pListItem->pPrevItem = 0
pListItem->pNextItem = 0
pListEnd->ItemNumbs = pListEnd->ItemNumbs + 1
Print "pListHead = "; pListHead
Print "pListEnd = "; pListEnd
Print "pListItem =";pListItem
Print "End Constructor ListItem"
Print '/
End Constructor
'********************************************************
/'Dim pListHead As HeadNode Ptr = 0 'Listenkopf einrichten
Dim pListEnd As EndNode Ptr = 0
Dim pListItem As ListItem Ptr = 0
'/
Function HeadNode.SearchItemAdress (pListItem As ListItem Ptr, SearchValue As String, SearchDepth As Integer, ByRef Path As String) As ListItem Ptr
/'Die Funktion sucht die Adresse eines Listenelements. Per Zeiger kann man dann darauf
bzw. auf die Records des Elementes zugreifen. Kein das gesuchte Element nicht gefunden,
gibt die Funktion einen 0-Zeiger zurück.
Mit dem Parameter "SearchDepht" kann in einem Baum
die Suchtiefe festgelegt werden. Bei -1 wird der komplette Baum durchsucht, bei 0 nur der
aktuelle Ast.
Path gibt den Pfad innerhalb des Baumes an.'/
If this.pFirstItem = 0 Then
pListItem = 0
Else
pListItem = this.pFirstItem
Dim pListItemBackUp As ListItem Ptr
Dim PathString As String
Do
If pListItem->Value <> "" Then PathString = "\"+pListItem->Value
pListItemBackUp = pListItem
Print "#### Schritt 1: Ueberpruefen des Wertes ####"
If pListItem->CompareValues(SearchValue) = 0 Then 'Wenn Wert gleich
Exit Do
Else
Print "#### Schritt 2: Suchen nach Subliste ####"
If pListItem->pSubListHead <> 0 Then
Print "Ueberpruefen der Subliste"
If (SearchDepth <0 Or pListItem->pSubListHead->Level <= SearchDepth) And pListItem->pSubListHead->pFirstItem <> 0 Then
pListitem = pListItem->pSubListHead->SearchItemAdress(pListItem->pSubListHead->pFirstItem, SearchValue, SearchDepth, Path)
If pListItem = 0 Then
pListItem = pListItemBackup
Else
Exit Do
EndIf
EndIf
EndIf
If pListItem->pNextItem <> 0 Then
Print "#### Schritt 3: Uebernehmen des nächsten Zeigers ####"
pListItem = pListItem->pNextItem
Print pListItem
Else
pListItem = 0
Exit Do
EndIf
EndIf
Loop
If pListItem->Value <> "" Then Path = PathString + Path
EndIf
Return pListItem
End Function
Function ListItem.CompareValues (NewValue As String) As Integer
/'Vergleicht den neuen Wert mit dem Wert des Listenelementes, aus dem die Funktion
aufgerufen wurde. Ist das Element größer, gibt sie 1 zurück, ist es gleich, gibt sie 0 zurück,
ist das neue Element kleiner, ergibt die Funktion -1.'/
Dim Response As Integer
If NewValue > this.Value Then
Response = 1
ElseIf NewValue = this.Value Then
Response = 0
ElseIf NewValue < this.Value Then
Response = -1
EndIf
Return Response
End Function
Sub HeadNode.DeleteSubList()
/'Die Funktion löscht einen Listenzweig und ruft, falls sie neue Sublisten findet,
die entspechende Funktion der Subliste auf. Auf diese Weise werden sämtliche Sublisten eines
Zweiges gelöscht. Wenn die Funktion aus dem Kopfknoten der Hauptliste aufgerufen wird, löscht dies
den gesamten Baum.'/
Dim pDeleteItem As ListItem Ptr'Für DeleteList
Dim pListItem As ListItem Ptr
If this.pFirstItem = 0 Then'Ab hier bei DeleteList auskommentieren.
Print "Keine Liste vorhanden
Else
pListItem = This.pFirstItem 'Zeiger Auf den Listenanfang setzen
Do
If pListItem->pSubListHead <> 0 Then
pListItem->pSubListHead->DeletesubList()
DeAllocate pListItem->pSubListHead->pEnd
DeAllocate pListItem->pSubListHead
pListItem->pSubListHead = 0
EndIf
pDeleteItem = pListItem
List_DeleteItem(@this, this.pEnd, pListItem, pDeleteItem->Value)
If pListItem->pNextItem <> 0 Then
pListItem = pListItem->pNextItem 'nächsten Zeiger übernehmen
EndIf
Loop while this.pEnd->ItemNumbs <> 0'Durchlauf, solange noch ein nächster Zeiger existiert
EndIf
DeAllocate pDeleteItem
pDeleteItem = 0
pListItem = 0
This.pEnd->pLastItem = 0
This.pFirstItem = 0'/
End Sub
Function List_AddItem (pListhead As HeadNode Ptr, pListEnd As EndNode ptr, pListItem As ListItem Ptr, NewValue as String)As ListItem Ptr
[komm]LydEaWUgRnVua3Rpb24gZvxndCBlaW4gbmV1ZXMgRWxlbWVudCBpbiBlaW5lIExpc3RlIG9kZXIgU3VibGlzdGUgZWluLiBSüGNrZ2FiZXdlcnQgaXN0IGRpZQogICAgQWRyZXNzZSBkZXMgbmV1ZW4gRWxlbWVudGVzLiBadXIg3GJlcnByüGZ1bmcsIG9iIGRlciBXZXJ0IGluIGRlciBMaXN0ZSBzY2hvbiBlbnRoYWx0ZW4gaXN0LAogICAgd2lyZCBTZWFyY2hJdGVtQWRkcmVzcyBkZXMgTGlzdGVua29wZmVzIGF1c2dlZvxocnQuIFdlbm4gZGVyIFdlcnQgYmVyZWl0cyB2b3JoYW5kZW4gaXN0LCB3aXJkIAogICAga2VpbiBuZXVlcyBFbGVtZW50IGVyc3RlbGx0LiBEYW5uIGdpYnQgZGllIEZ1bmt0aW9uIDAgenVyüGNrLiBXZW5uIG5vY2gga2VpbmUgTGlzdGUgZXJzdGVsbHQKICAgIHd1cmRlLCBlcmdpYnQgZGllIEZ1bmt0aW9uIC0xLicv[/komm]
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
pListItem = -1
Else
If pListHead->SearchItemAdress(pListItem, NewValue, 0, "") = 0 Then 'Ermitteln, ob Wert bereits vorhanden
Dim Item As ListItem = ListItem(pListHead, pListEnd, pListItem, NewValue)
'Setzen der Kopf- und End-Zeiger wird im Constructor vorgenommen
If pListEnd->ItemNumbs = 1 Then 'wenn dies der erste Eintrag ist
pListHead->pFirstItem = pListItem
pListEnd->pLastItem = pListItem
pListItem->pPrevItem = 0
pListItem->pNextItem = 0
Elseif pListHead->Style = "sorted" Then 'Wenn es schon einen Eintrag gibt
pListItem->pNextItem = pListHead->pFirstItem 'pNextItem auf das erste Listenelement gesetzt
Dim Response As Integer = 0
If pListItem->pNextItem->CompareValues(pListItem->Value) = -1 Then
'wenn der neue Wert kleiner als der erste ist
pListItem->pNextItem = pListHead->pFirstItem
pListItem->pNextItem->pPrevItem = pListItem
pListHead->pFirstItem = pListItem
Else 'Suchen, solange der neue Wert größer oder nicht am Ende ist
Do
If pListItem->pNextItem = 0 Then 'Wenn an der letzten Stelle der Liste
Response = 2
Else
If pListItem->pNextItem->CompareValues(pListItem->Value) > -1 Then
'Wenn in der Liste, nächster Wert größer als neuer Wert
pListItem->pNextItem = pListItem->pNextItem->pNextItem
Response = 0
Else
Response = 1
EndIf
EndIf
Loop while Response = 0
EndIf
If Response = 2 Then
pListItem->pPrevItem = pListEnd->pLastItem
pListItem->pNextItem = pListItem->pPrevItem->pNextItem
pListItem->pPrevItem->pNextItem = pListItem
pListEnd->pLastItem = pListItem
ElseIf Response = 1 Then
pListItem->pPrevItem = pListItem->pNextItem->pPrevItem
pListitem->pNextItem = pListItem->pPrevItem->pNextItem
pListItem->pNextItem->pPrevItem = pListItem
pListItem->pPrevItem->pNextItem = pListitem
EndIf
ElseIf pListHead->Style = "unsorted" Then
pListItem->pPrevItem = pListEnd->pLastItem
pListItem->pNextItem = pListItem->pPrevItem->pNextItem
pListItem->pPrevItem->pNextItem = pListItem
pListEnd->pLastItem = pListItem
EndIf
Else
pListitem = 0
EndIf
EndIf
Return pListItem
End Function
Function Tree_CreateSubList(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Value As String, Style As String) As HeadNode Ptr
[komm]LydEaWUgRnVua3Rpb24gZXJzdGVsbHQgZWluZSBuZXVlIFN1Ykxpc3QuIFNpZSB3aXJkIG51ciB2b24gCiAgICBkZXIgRnVua3Rpb24gVHJlZV9BcHBlbmRTdWJMaXN0IGF1ZmdlcnVmZW4uIERvcnQgZmluZGV0IGRpZSBGZWhsZXL8YmVycHL8ZnVuZyBzdGF0dC4gCiAgICBUcmVlX0NyZWF0ZVN1Ykxpc3Qgc29sbHRlIHZvbSBOdXR6ZXIgbmljaHQgc2VsYnN0IGF1ZmdlcnVmZW4gd2VyZGVuLiBSüGNrZ2FiZXdlcnQgaXN0IGRpZSAKICAgIEFkcmVzc2UgZGVzIG5ldWVuIExpc3RlbmtvcGZlcy4gU2llIHdpcmQgZGVtIFplaWdlciBMaXN0SXRlbS0mZ3Q7cFN1Ykxpc3RIZWFkIHp1Z2V3aWVzZW4uJy8ß[/komm]
Print "Neue Liste wird angehängt"
Dim SubListHead As HeadNode = HeadNode (pListHead, pListEnd, pListItem, Style)
pListHead->pParentHead = pListItem->pHead
Print "ParentHead = ";pListHead->pParentHead
pListHead->Level = pListHead->pParentHead->Level +1
Print "Neuer Level:"; pListhead->Level
pListItem->pSubListHead = pListHead
Print "pListItem->pSubListHead";pListItem->pSubListHead
Return pListHead
End Function
Function Tree_AppendSubList(pListHead As HeadNode Ptr, pListEnd As EndNode Ptr, ByRef pAppendItem As ListItem Ptr, AppendValue As String, Style As String) As HeadNode Ptr
/'Die Funktion fügt eine Subliste- einen Listenzweig- an ein bestehendes Listenelement an.
Zunächst wird die Adresse des Listenelementes, an dem der neue Zweig entstehen soll, ermittelt,
danach wird mit Tree_CreateSubList() die neue Liste erstellt. Rückgabewert ist die Adresse
des neuen Listenkopfes. Wenn bereits eine Liste an diesem Element existiert, wird deren
Kopfadresse zurückgegeben, wenn das Element nicht existiert, ergit die Funktion 0. '/
pAppendItem = pListHead->SearchItemAdress(pAppendItem, AppendValue, -1, "")
Dim NewSubListHead As HeadNode PTR
If pAppendItem <> 0 Then
Print "Neue Liste wird angehaengt"
Print pAppendItem->pSubListHead
If pAppendItem->pSubListHead = 0 Then
pAppendItem->pSubListHead = Tree_CreateSubList(pAppendItem->pSubListHead, pListEnd, pAppendItem, AppendValue, Style)
NewSubListHead = pAppendItem->pSubListHead
Else
Print "Liste existiert bereits"
NewSubListHead = pAppendItem->pSubListHead
EndIf
If pAppendItem->pSubListHead->Style <> "unsorted" And pAppendItem->pSubListHead->Style <> "sorted" then
pAppendItem->pSubListHead->Style = "sorted"
EndIf
Else
NewSubListHead = 0
EndIf
Print "Neue Sublist: ";NewSubListHead
Return NewSubListHead
End Function
Function Tree_AppendSubListItem(pListHead As HeadNode Ptr, pListEnd As EndNode Ptr, pListItem As ListItem Ptr, AppendItem As String, AppendValue As String) As ListItem Ptr
/'Die Funktion fügt in eine Zweigliste ein neues Element ein. Dazu wird zuerst die Adresse
des Elementes gesucht, an dem die Zweigliste angehängt ist. Diese Funktion kann auch vom Nutzer
umgangen werden, indem er pListHead->SearchItemAdress() aus dem Hauptprogramm ausführt und
die gefundene Adresse der Funktion List_AddItem() übergibt. Wenn die Zweigliste nicht gefunden wird,
ist wird kein neues Element erstellt und 0 zurückgegeben.'/
pListItem = pListHead->SearchItemAdress(pListItem, AppendItem, -1, "")
If pListItem<> 0 then
pListHead = pListItem->pSubListHead
pListEnd = pLisTItem->pSubListHead->pEnd
pListItem = List_AddItem (pListHead, pListEnd, pListItem, AppendValue)
EndIf
Return pListItem
End Function
Function List_GetValueByPos(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Position As Integer) As String
/'Die Funktion ermittelt dden Wert eines Elementes an einer vorgegebenen Position
in einer Liste oder einem Zweig. Wenn die Position nicht in der Liste enthalten ist,
ist der Rückgabewert "".'/
pListItem = 0
Dim Response As String = ""
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
Response = ""
Else
If pListHead->pFirstItem = 0 Then
'Print "Keine Liste vorhanden
Response = ""
Else
Dim Counter As Integer
If Position > pListEnd->ItemNumbs Or Position <=0 then
Position = 1
Response = ""
EndIf
If Position > 0 And Position <= pListEnd->ItemNumbs Then
pListItem = pListHead->pFirstItem
If Position > 1 Then
For Counter = 1 To Position -1
pListItem = pListItem->pNextItem
Next Counter
EndIf
EndIf
Response = pListItem->Value
EndIf
EndIf
Return Response
End Function
Function List_ReadListByPosSteps(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, StartPos As Integer, Steps As Integer) As String
/'Die Funktion ermöglicht das schrittweise oder Ausschnittweise
Auslesen einer Liste oder eines Zweiges. Zurückgegeben wird der Wert des letzten abge-
fragten Elementes. Wenn keine Liste vorhanden ist, wird nichts ("") zurückgegeben. Die
Adresse des Elementes wird per Referenz an pListItem zugewiesen.'/
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
Else
pListItem = 0
Dim Value As String
If pListHead->pFirstItem = 0 Then
Value = ""
Else
Dim Counter As Integer
If StartPos > pListEnd->ItemNumbs Or StartPos <=0 then
StartPos = 1
Value = ""
EndIf
If Steps > pListEnd->ItemNumbs Then
Steps = pListEnd->ItemNumbs
EndIf
If StartPos > 0 And StartPos <= pListEnd->ItemNumbs Then
pListItem = pListHead->pFirstItem
If StartPos > 1 Then
For Counter = 1 To StartPos-1
pListItem = pListItem->pNextItem
Next Counter
EndIf
EndIf
Value = pListItem->Value
For Counter = 1 To Steps
Print pListItem->Value
pListItem = pListItem->pNextItem
Next Counter
EndIf
EndIf
Return pListItem->Value
End Function
Function List_SearchElementPos(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, SearchValue As String) As Integer
/'Hier wird die Position eines Elementes innerhalb der Liste ermittelt. Wenn das Element
nicht gefunden wird, ist die Rückgabe 0, ansonsten ist es die Position innerhalb der Liste,
gezählt vom Kopfknoten her.'/
Dim Position As Integer = 0
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
'Position = -1
Else
If pListHead->pFirstItem = 0 Then
'Print "Keine Liste vorhanden
Position = 0
pListItem = 0
Else
pListItem = pListHead->pFirstItem 'Zeiger Auf den Listenanfang setzen
Do
Position = Position + 1
If pListItem->CompareValues(SearchValue) = 0 Then
'Print "Wert "; pListItem->Value; " gefunden."
'Print "Die Position ist: "
Exit Do
Else
If pListItem->pNextItem <> 0 Then
pListItem = pListItem->pNextItem 'nächsten Zeiger übernehmen
EndIf
If pListItem->pNextItem = 0 Then
If pListItem->CompareValues(SearchValue) = 0 Then
Position = Position + 1
Exit Do
Else
'Print "Wert nicht gefunden"
pListItem = 0
Exit Do
EndIf
EndIf
EndIf
Loop
EndIf
EndIf
Return Position
End Function
Sub Tree_ResetListPointers(ByRef pListHead As HeadNode Ptr, pListEnd As EndNode Ptr, pListItem As ListItem PTR)
/'Diese Funktion setzt alle Zeiger auf ihren Anfangswert zurück. Dies ist nötig, da einige
Funktionen die Zeiger per Referenz verändern. Wenn dann eine andere Funktion ausgeführt wird,
die sich an den Anfangswerten orientiert, kann dies zu Fehlern führen. Die Funktion sollte
vor jeder anderen Listenfunktion ausgeführt werden. Als Sicherungsort der Anfangswerte
sollte eine Backup-Kopie der Zeiger eingesetzt werden.'/
pListHead = pListHeadBackUp
If pListHead <> 0 then
pListEnd = pListHead->pEnd
pListItem = pListHead->pFirstItem
EndIf
End Sub
Sub List_DisplayList(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
/'Diese Sub stellt eine Liste oder einen Zweig der Reihenfolge nach dar.'/
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
Else
If pListHead->pFirstItem = 0 Then
Print "Keine Elemente vorhanden
Else
pListItem = pListHead->pFirstItem 'Zeiger Auf den Listenanfang setzen
Do
Print pListItem->Value
If pListItem->pNextItem <> 0 Then
pListItem = pListItem->pNextItem 'nächsten Zeiger übernehmen
EndIf
If pListItem->pNextItem = 0 Then
Print pListItem->Value
EndIf
Loop while pListItem->pNextItem <> 0'Durchlauf, solange noch ein nächster Zeiger existiert
EndIf
Print "Die Liste hat"; pListEnd->ItemNumbs; " Elemente."
EndIf
End Sub
Sub List_DisplayListReverse(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
/'Diese Funktion stellt eine Liste oder einen Zweig in umgekehrter Reihenfolge dar. Dient
vorläufig nur zur Demonstration der doppelten Verkettung.'/
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
Else
If pListEnd->pLastItem = 0 Then
Print "Keine Elemente vorhanden
Else
Print "Die Liste hat"; pListEnd->ItemNumbs; " Elemente."
pListItem = pListEnd->pLastItem 'Zeiger Auf den Listenanfang setzen
Do
Print pListItem->Value
If pListItem->pPrevItem <> 0 Then
pListItem = pListItem->pPrevItem 'nächsten Zeiger übernehmen
EndIf
If pListItem->pPrevItem = 0 Then
Print pListItem->Value
EndIf
Loop while pListItem->pPrevItem <> 0'Durchlauf, solange noch ein nächster Zeiger existiert
EndIf
EndIf
End Sub
Sub List_DeleteItem(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, deleteValue As String)
/'Diese Funktion löscht ein Element aus einer Liste oder einem Zweig.'/
If pListHead = 0 Then
Print "Liste noch nicht erstellt"
Else
Dim pDeleteItem As ListItem Ptr
pDeleteItem = pListHead->SearchItemAdress(pListItem,DeleteValue,-1, "")
If pDeleteItem->pSubListHead <> 0 Then
pDeleteItem->pSubListHead->DeleteSubList()
EndIf
If pDeleteItem = pListHead->pFirstItem And pDeleteItem = pListEnd->pLastItem Then
'Wenn erstes = letztes Element-> nur 1 Element vorhanden
pListEnd->pLastItem = 0
pListHead->pFirstItem = 0
Print "Einziges Element"
EndIf
If pDeleteItem <> 0 then
If pDeleteItem->pNextItem <> 0 Then 'wenn nicht letztes Element:
pDeleteItem->pNextItem->pPrevItem = pDeleteItem->pPrevItem
EndIf
If pDeleteItem->pPrevItem <> 0 Then 'wenn nicht erstes Element
pDeleteItem->pPrevItem->pNextItem = pDeleteItem->pNextItem
EndIf
If pDeleteItem = pListEnd->pLastItem Then 'Wenn letztes Element
If pDeleteItem->pPrevItem <> 0 then
pDeleteItem->pPrevItem->pNextItem = 0
EndIf
pListEnd->pLastItem = pDeleteItem->pPrevItem
EndIf
If pDeleteItem = pListHead->pFirstItem Then 'Wenn erstes Element
If pDeleteItem->pNextItem <> 0 Then
pDeleteItem->pNextItem->pPrevItem = 0
EndIf
pListHead->pFirstItem = pDeleteItem->pNextItem
EndIf
Print pDeleteItem->Value
Print "Element wird geloescht"
Deallocate pDeleteItem
pListEnd->ItemNumbs = pListEnd->ItemNumbs - 1
pDeleteItem = 0
'sleep
EndIf
EndIf
End Sub
'________________________________________________________________________________________________
[komm]LycqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKgoqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKgoqKioqKioqKioqKioqKioqKioqKioqKiAgICAgICAgICAgIFByb2dyYW1taWVydCB2b24gRWxla3Ryb25peCAgICAgICAgICAgICAqKioqKioqKioqKioqKioqKioqKioqKioqKgoqKioqKioqKioqKioqKioqKioqKioqKiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAqKioqKioqKioqKioqKioqKioqKioqKioqKgoqKioqKioqKioqKioqKioqKioqKioqKiAgICAgICBtaXQgRnJlZUJhc2ljIDAuMTguMiB1bmQgRkJFZGl0IDEuMC41LjggICAgICAqKioqKioqKioqKioqKioqKioqKioqKioqKgoqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKgoqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKioqKgonLwßß[/komm]
[komm]LydEaWVzIGlzdCBlaW4gRGVtby1Qcm9ncmFtbSB6dSBEZW1vbnN0cmF0aW9uIGRlciB2ZXJrZXR0ZXRlbiBMaXN0ZSBiencuIGVpbmVzIEJhdW1lcyBhdXMgCnZlcmtldHRldGVuIExpc3Rlbi4nLwßß[/komm]
#Include "StringTree_bk.bi"
Dim pListHead As HeadNode Ptr = 0 'Listenkopf einrichten
Dim pListEnd As EndNode Ptr = 0
Dim pListItem As ListItem Ptr = 0
Dim pNewSubList As HeadNode PTR
Dim NewValue As String
Dim GoOn As String = "w"
pListHeadBackUp = pListHead
'pListEnd = pListHead->pEnd
'pListItem = pListHead->pFirstItem
Do while GoOn <> "b"
Print "Was wollen Sie Tun?"
Print "sortierte Liste erstellen:...... e"
Print "unsortierte Liste erstellen:.... u"
Print "Neuen Wert eingeben:............ w"
Print "Liste ansehen:.................. a"
Print "Liste Rueckwärts ansehen:....... r"
Print "Adresse eines Elementes suchen:. s"
Print "Position eines Wertes suchen:... p"
Print "Wert an einer best. Position:... V"
Print "Listenausschnitt anzeigen:...... c"
Print "Listenelement loeschen:......... l"
Print "ganze Liste Loeschen:........... z"
Print "Neuen sortierten Zweig erstellen.ne"
Print "Wert in einer Sublist einfügen...nw"
Print "Subliste anzeigen................na"
Print "beenden:........................ b"
Input GoOn
Tree_ResetListPointers(pListHead, pListEnd, pListItem)
Select Case GoOn
Case "e"
Dim ListHead As HeadNode = HeadNode (pListHead, pListEnd, pListItem, "sorted")
pListHeadBackUp = pListHead
Case "u"
Dim ListHead As HeadNode = HeadNode (pListHead, pListEnd, pListItem, "unsorted")
pListHeadBackUp = pListHead
case "a"
List_DisplayList(pListHead, pListEnd, pListItem)
Case "r"
List_DisplayListReverse(pListHead, pListEnd, pListItem)
Case "w"
If pListHead <> 0 then
Do While GoOn = "j" Or GoOn = "w"
Input "Wort eingeben:";NewValue
Sleep 75
pListitem = List_AddItem(pListHead, pListEnd, pListItem, NewValue)
Input "Weiteren Wert eingeben(j/n)"; GoOn
Loop
Else
Print "noch keine Liste"
EndIf
Case "b"
pListHead->DeleteSubList()
DeAllocate pListEnd
DeAllocate pListHead
Exit Do
Case "s"
Dim SearchValue As String
Dim SearchDepth As Integer
Dim Path As String
Input "Von welchem Wert wollen Sie die Adresse suchen";SearchValue
Input "Suchtiefe"; SearchDepth
Print pListHead->SearchItemAdress(pListItem, SearchValue, SearchDepth, Path)
Print "Pfad = "; Path
Case "p"
Dim SearchValue As String
Input "Welchen Wert wollen sie suchen"; SearchValue
Print List_SearchElementPos(pListhead, pListEnd, pListItem, SearchValue)
Case "l"
Dim DeleteValue As String
Input "Welchen Wert wollen Sie loeschen"; DeleteValue
List_DeleteItem(pListhead, pListEnd, pListItem, DeleteValue)
Case "v"
Dim Position As Integer = 0
Input "Welche Position wollen Sie abfragen" ; Position
Print "Der Wert an Position "; Position; " ist "; List_GetValueByPos(pListHead, pListEnd, pListItem, Position)
Print "Der Zeiger ist:"; pListItem
Case "c"
Dim StartPos As Integer
Dim Steps As Integer
Dim NewValue As String
Input "Ab welcher Position soll angezeigt werden"; StartPos
Input "Wieviele Elemente sollen angezeigt werden"; Steps
NewValue = List_ReadListByPosSteps(pListHead, pListEnd, pListItem, StartPos, Steps)
Print NewValue
Case "ne"
Dim Value As String
Input "an welchem Element soll der neue Zweig wachsen?"; Value
pNewSubList = Tree_AppendSubList(pListHead, pListEnd, pListItem, Value, "Sorted")
If pListItem<>0 Then
Print "NewSubList = ";pNewSubList 'as HeadNode PTR
Print pListitem->pSubListHead
Print pListHead->Level
Print pNewSubList->Level
EndIf '/
Case "nw"
Dim NewValue As String
Dim Value As String
Input "In welcher Subliste soll der neue Wert stehen?"; Value
pListItem = pListHead->SearchItemAdress(pListItem, Value, -1, "")
If pListItem<> 0 then
Input "Welcher Wert soll eingefügt werden?"; NewValue
pListHead = pListItem->pSubListHead
pListEnd = pNewSubList->pEnd
List_AddItem (pListHead, pListEnd, pListItem, NewValue)
EndIf
Case "na"
Dim SubList As String
Input "Welche Subliste soll dargestellt werden"; SubList
pListitem = pListHead->SearchItemAdress(pListItem, SubList, -1, "")
If pListItem <> 0 Then
pListHead = pListItem->pSubListHead
pListEnd = pListItem->pSubListHead->pEnd
List_DisplayList(pListHead, pListEnd, pListItem)
EndIf
Case "z"
pListHead->DeleteSubList()
End Select
'Tree_ResetListPointers(pListHead, pListEnd, pListItem)
Loop