Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Doppelt verkettete Liste für Strings
| Uploader: |  Elektronix |
| Datum/Zeit: | 22.02.2008 13:26:50 |
/'*****************************************************************************************************
*****************************************************************************************************
*********************** Programmiert von Elektronix **************************
*********************** **************************
*********************** mit FreeBasic 0.82.1 und FBEdit 1.0.5.8 **************************
*****************************************************************************************************
*****************************************************************************************************
'/
'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
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
Dim pListItem As ListItem Ptr = 0
Function ListItem.CompareValues (NewValue As String) As Integer
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
'*************************************************
Type EndNode
ItemNumbs As Integer
pHead As ListHead Ptr
pLastItem As ListItem Ptr
Declare Constructor (ByRef pListHead As ListHead Ptr,ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr)
End Type
Dim pListEnd As EndNode Ptr = 0
'*************************************************
Type HeadNode
pFirstItem As ListItem Ptr
pEnd As ListEnd Ptr
Declare Constructor (ByRef pListHead As HeadNode Ptr, ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr)
End Type
Dim pListHead As HeadNode Ptr = 0 'Listenkopf einrichten
'*************************************************
Constructor HeadNode (ByRef pListHead As HeadNode Ptr, ByRef pListEnd As EndNode Ptr, ByRef pListItem As ListItem Ptr)
Dim ListEnd As EndNode = EndNode (@this, pListEnd, pListItem) 'Listenende einrichten
pListHead = Callocate (Len(HeadNode))
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)
Print
Print "Begin Constructor ListItem"
this.Value = NewValue
pListItem = Callocate(Len(ListItem))
pListItem->Value = this.Value
pListItem->pHead = pListHead
pListItem->pEnd = pListEnd
'pListItem->Value = NewValue
' 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
'********************************************************
Declare Function AddItem (pListhead As HeadNode Ptr, pListEnd As EndNode ptr, pListItem As Listitem Ptr, NewValue As String) As ListItem Ptr
Declare Sub DisplayList(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
Declare Sub DisplayListReverse(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
Declare Sub DeleteItem(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, deleteValue As String)
Declare Sub DeleteList(ByRef pListhead As HeadNode Ptr, ByRef pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
Declare Function SearchItemAdress(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, deleteValue As String) As ListItem Ptr
Declare Function SearchElementPos(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, SearchValue As String) As Integer
Declare Function ReadListBySteps(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Steps As Integer) As Integer
Declare Function GetValueByPos(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Position As Integer) As String
Function GetValueByPos(pListHead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Position As Integer) As String
pListItem = 0
Dim Response As String = ""
If pListHead->pFirstItem = 0 Then
Print "Keine Liste vorhanden
Response = ""
Else
Dim Counter As Integer
Do while Position > pListEnd->ItemNumbs Or Position <=0
Print "Die Liste hat "; pListEnd->ItemNumbs; " Elemente."
Input "Geben Sie eine Position innerhalb der Liste ein"; Position
Response = ""
Loop
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
Return Response
End Function
Function ReadListBySteps(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, Steps As Integer) As Integer
End Function
Function SearchElementPos(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, SearchValue As String) As Integer
Dim Position As Integer = 0
If pListHead->pFirstItem = 0 Then
Print "Keine Liste vorhanden
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
Return Position
End Function
Sub DeleteList(ByRef pListhead As HeadNode Ptr, ByRef pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
Dim pDeleteItem As ListItem Ptr
If pListHead->pFirstItem = 0 Then
Print "Keine Liste vorhanden
Else
pListItem = pListHead->pFirstItem 'Zeiger Auf den Listenanfang setzen
Do
pDeleteItem = pListItem
DeleteItem(pListHead, pListEnd, pListItem, pDeleteItem->Value)
If pListItem->pNextItem <> 0 Then
pListItem = pListItem->pNextItem 'nächsten Zeiger übernehmen
EndIf
Loop while pListItem->pNextItem <> 0'Durchlauf, solange noch ein nächster Zeiger existiert
EndIf
DeAllocate pDeleteItem
pDeleteItem = 0
pListItem = 0
pListEnd->pLastItem = 0
pListHead->pFirstItem = 0
pListEnd->ItemNumbs = 0
End Sub
Sub DeleteItem(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, deleteValue As String)
Dim pDeleteItem As ListItem Ptr
pDeleteItem = SearchItemAdress(pListhead, pListEnd, pListItem, DeleteValue)
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
pListEnd->pLastItem = pDeleteItem->pPrevItem
EndIf
If pDeleteItem = pListHead->pFirstItem Then 'Wenn erstes Element
pListHead->pFirstItem = pDeleteItem->pNextItem
EndIf
If pDeleteItem = pListHead->pFirstItem And pDeleteItem = pListEnd->pLastItem Then
'Wenn erstes = letztes Element-> nur 1 Element vorhanden
pListEnd->pLastItem = 0
pListHead->pFirstItem = 0
EndIf
Print "Element wird geloescht"
Deallocate pDeleteItem
pListEnd->ItemNumbs = pListEnd->ItemNumbs - 1
pDeleteItem = 0
EndIf
End Sub
Function SearchItemAdress(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr, SearchValue As String) As ListItem Ptr
If pListHead->pFirstItem = 0 Then
Print "Keine Liste vorhanden
Else
pListItem = pListHead->pFirstItem 'Zeiger Auf den Listenanfang setzen
Do
If pListItem->CompareValues(SearchValue) = 0 Then
'Print "Wert "; pListItem->Value; " gefunden."
Print "Die Adresse 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
Exit Do
Else
Print "Wert nicht gefunden"
pListItem = 0
Exit Do
EndIf
EndIf
EndIf
Loop
EndIf
Return pListItem
End Function
Function AddItem (pListhead As HeadNode Ptr, pListEnd As EndNode ptr, pListItem As ListItem Ptr, NewValue as String)As ListItem PTR
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
Else '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
'Print "neues Element VOR dem bestehenden einfügen"
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
'Print "Einfügen des letzten Elementes am Ende"
pListItem->pPrevItem = pListEnd->pLastItem
pListItem->pNextItem = pListItem->pPrevItem->pNextItem
pListItem->pPrevItem->pNextItem = pListItem
pListEnd->pLastItem = pListItem
ElseIf Response = 1 Then
'Print "Einfügen des neuen Elementes zwischen zwei ältere"
pListItem->pPrevItem = pListItem->pNextItem->pPrevItem
pListitem->pNextItem = pListItem->pPrevItem->pNextItem
pListItem->pNextItem->pPrevItem = pListItem
pListItem->pPrevItem->pNextItem = pListitem
EndIf
EndIf
Return pListItem
End Function
Sub DisplayList(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
If pListHead->pFirstItem = 0 Then
Print "Keine Liste 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."
End Sub
Sub DisplayListReverse(pListhead As HeadNode Ptr, pListEnd As EndNode ptr, ByRef pListItem As ListItem Ptr)
If pListEnd->pLastItem = 0 Then
Print "Keine Liste 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
End Sub
'________________________________________________________________________________________________
Dim ListHead As HeadNode = HeadNode (pListHead, pListEnd, pListItem)
Dim NewValue As String
Dim GoOn As String = "w"
Do while GoOn <> "b"
Print "Was wollen Sie Tun?"
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 "Listenelement loeschen:......... l"
Print "ganze Liste Loeschen:........... z"
Print "beenden:........................ b"
Input GoOn
Do While GoOn = "j" Or GoOn = "w"
Input "Wort eingeben:";NewValue
Sleep 75
pListitem = AddItem(pListHead, pListEnd, pListItem, NewValue)
Print "pListitem->Value:";pListitem->Value
Print "pListHead->pEnd:";pListHead->pEnd '= pListEnd
Print "pListEnd->pHead:";pListEnd->pHead' = pListHead
Print "pListHead->pFirstItem:";pListHead->pFirstItem' = pListItem
Print "pListEnd->pLastItem:";pListEnd->pLastItem '= pListItem
Print "pListitem->pHead:";pListitem->pHead' = pListHead
Print "pListItem->pEnd:";pListItem->pEnd' = pListEnd
Print "pListItem->pPrevItem:";pListItem->pPrevItem '= 0
Print "pListItem->pNextItem:";pListItem->pNextItem '= 0
Print "pListEnd->ItemNumbs:";pListEnd->ItemNumbs
Input "Weiteren Wert eingeben(j/n)"; GoOn
Loop
Select Case GoOn
case "a"
DisplayList(pListHead, pListEnd, pListItem)
Case "r"
DisplayListReverse(pListHead, pListEnd, pListItem)
Case "b"
DeleteList(pListhead, pListEnd, pListItem)
DeAllocate pListEnd
DeAllocate pListHead
Exit Do
Case "s"
Dim SearchValue As String
Input "Von welchem Wert wollen Sie die Adresse suchen";SearchValue
Print SearchItemAdress(pListhead, pListEnd, pListItem, SearchValue)
Case "p"
Dim SearchValue As String
Input "Welchen Wert wollen sie suchen"; SearchValue
Print SearchElementPos(pListhead, pListEnd, pListItem, SearchValue)
Case "l"
Dim DeleteValue As String
Input "Welchen Wert wollen Sie loeschen"; DeleteValue
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 "; GetValueByPos(pListhead, pListEnd, pListItem, Position)
Print "Der Zeiger ist:"; pListItem
Case "z"
DeleteList(pListhead, pListEnd, pListItem)
End select
Loop