Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

linkedlist.bi

Uploader:MitgliedThePuppetMaster
Datum/Zeit:13.04.2008 19:14:22

'##############################################################################################################
'   LinkedList
' By.: Martin Wiemann
' Date: 23.03.2008 - 14:23
'##############################################################################################################
#include once "crt/string.bi"



'##############################################################################################################
Function ColCreate(ByRef B_Collection as Integer PTR) as UByte
Dim CID as Integer PTR = ALLOCATE(SizeOf(Integer) * 3)
If CID = 0 Then Return 1
CID[0] = 0: CID[1] = 0: CID[2] = 0
B_Collection = CID
Return 0
End Function



'##############################################################################################################
Function ColDestroy(ByRef V_Collection as Integer PTR) as UByte
If V_Collection = 0 Then Return 2
Dim NID as Integer PTR = V_Collection
Dim AID as Integer PTR
Do
    If NID = 0 Then Exit Do
    AID = Cast(Integer PTR, NID[2]): NID[2] = 0
    If NID[1] <> 0 Then DEALLOCATE(Cast(Integer PTR, NID[1])): NID[1] = 0
    DEALLOCATE(NID)
    NID = AID
Loop
DEALLOCATE(V_Collection)
V_Collection = 0
Return 0
End Function



'##############################################################################################################
Function ColGetItemX(ByRef V_Collection as Integer PTR, V_Item as UInteger) as Integer PTR
If V_Collection = 0 Then Return 0
If V_Item < 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim X as UInteger
Do
    If NID = 0 Then Exit Do
    X += 1
    If X = V_Item Then Return NID
    NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function



'##############################################################################################################
Declare Function ColSet Overload (ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as Integer) as UByte
Declare Function ColSet (ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as UInteger) as UByte

'##############################################################################################################
Function ColSet(ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as Integer) as UByte
If V_Collection = 0 Then Return 2
If V_Item < 0 Then Return 3
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
Dim AID as Integer PTR = Cast(Integer PTR, NID[1])
If AID = 0 Then
    AID = Allocate(SizeOf(V_Value))
Else: AID = REALLOCATE(AID, SizeOf(V_Value))
End If
NID[1] = Cast(Integer, AID)
*AID = V_Value
Return 0
End Function



'--------------------------------------------------------------------------------------------------------------
Function ColSet(ByRef V_Collection as Integer PTR, V_Item as UInteger, V_Value as String) as UByte
If V_Collection = 0 Then Return 2
If V_Item < 0 Then Return 3
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
Dim AID as String PTR = Cast(String PTR, NID[1])
If AID = 0 Then
    AID = Allocate(Len(V_Value))
Else: AID = REALLOCATE(AID, Len(V_Value))
End If
NID[1] = Cast(Integer, AID)
*AID = V_Value
Return 0
End Function



'##############################################################################################################
Function ColGetInt(ByRef V_Collection as Integer PTR, V_Item as UInteger) as Integer
If V_Collection = 0 Then Return 0
If V_Item < 0 Then Return 0
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
If NID <> 0 Then
    Return *Cast(Integer PTR, NID[1])
Else: Return 0
End If
End Function



'--------------------------------------------------------------------------------------------------------------
Function ColGetIntPTR(ByRef V_Collection as Integer PTR, V_Item as UInteger) as Integer PTR
If V_Collection = 0 Then Return 0
If V_Item < 0 Then Return 0
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
If NID <> 0 Then
    Return Cast(Integer PTR, NID[1])
Else: Return 0
End If
End Function



'--------------------------------------------------------------------------------------------------------------
Function ColGetStr(ByRef V_Collection as Integer PTR, V_Item as Integer) as String
If V_Collection = 0 Then Return ""
If V_Item < 0 Then Return ""
Dim NID as Integer PTR = ColGetItemX(V_Collection, V_Item)
If NID <> 0 Then
    Dim XLen as Integer ptr = Cast(Integer ptr, NID[1])
    Dim T as String = Space(*XLen)
    memcpy(strptr(T), Cast(integer ptr, NID[1]) + 1 , *XLen)
    Return T
Else: Return ""
End If
End Function



'##############################################################################################################
Declare Function ColAdd Overload    (ByRef V_Collection as Integer PTR, V_Value as Integer, V_ToItem as UInteger = -1) as UByte
Declare Function ColAdd Overload    (ByRef V_Collection as Integer PTR, V_Value as Integer PTR, V_ToItem as UInteger = -1) as UByte
Declare Function ColAdd             (ByRef V_Collection as Integer PTR, V_Value as String, V_ToItem as UInteger = -1) as UByte


'##############################################################################################################
Function ColAddX(ByRef V_Collection as Integer PTR, V_ToItem as UInteger = -1) as Integer PTR
If V_Collection = 0 Then
    If ColCreate(V_Collection) <> 0 Then Return 0
    Return V_Collection
End if
Dim NID as Integer PTR = V_Collection
Dim AID as Integer PTR
Dim LID as Integer PTR
Dim X as UInteger
If V_ToItem = cast(integer, -1) Then LID = NID: NID = 0
Do
    If NID = 0 Then
        AID = ALLOCATE(SizeOf(Integer) * 3)
        If AID = 0 Then Return 0
        AID[0] = Cast(Integer, LID)
        AID[2] = 0
        If LID <> 0 Then LID[2] = Cast(Integer, AID)
        V_Collection[0] = Cast(Integer, AID)
        Return AID
    End If
    X += 1
    If X >= V_ToItem Then
        AID = ALLOCATE(SizeOf(Integer) * 3)
        If AID = 0 Then Return 0
        AID[0] = Cast(Integer, LID)
        AID[2] = Cast(Integer, NID)
        If NID <> 0 Then NID[0] = Cast(Integer, AID)
        If LID <> 0 Then LID[2] = Cast(Integer, AID)
        If X = 1 Then V_Collection = AID
        Return AID
    End If
    LID = NID
    NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function



'##############################################################################################################
Function ColAdd(ByRef V_Collection as Integer PTR, V_Value as Integer, V_ToItem as UInteger = -1) as UByte
Dim NID as Integer PTR = ColAddX(V_Collection, V_ToItem)
If NID = 0 Then Return 1
Dim TID as Integer PTR
TID = Allocate(sizeof(integer))
*TID = V_Value
NID[1] = Cast(Integer, TID)
Return 0
End Function



'--------------------------------------------------------------------------------------------------------------
Function ColAdd(ByRef V_Collection as Integer PTR, V_Value as Integer PTR, V_ToItem as UInteger = -1) as UByte
Dim NID as Integer PTR = ColAddX(V_Collection, V_ToItem)
If NID = 0 Then Return 1
Dim TID as Integer PTR
TID = Allocate(sizeof(integer ptr))
TID = V_Value
NID[1] = Cast(Integer, TID)
Return 0
End Function



'--------------------------------------------------------------------------------------------------------------
Function ColAdd(ByRef V_Collection as Integer PTR, V_Value as String, V_ToItem as UInteger = -1) as UByte
Print V_Value
Dim NID as Integer PTR = ColAddX(V_Collection, V_ToItem)
If NID = 0 Then Return 1
Dim TID as Integer PTR
TID = Allocate(Len(V_Value) + sizeof(integer))
*Cast(integer ptr, TID) = Len(V_Value)
memcpy(TID + 1, strptr(V_Value), Len(V_Value))
NID[1] = Cast(Integer, TID)
Return 0
End Function



'##############################################################################################################
Function ColDel(ByRef V_Collection as Integer PTR, V_Item as UInteger) as UByte
If V_Collection = 0 Then Return 2
Dim NID as Integer PTR = V_Collection
Dim TID as Integer PTR
Dim X as UInteger
Do
    If NID = 0 Then Return 4
    X += 1
    If X >= V_Item Then
        If NID[2] = 0 Then V_Collection[0] = NID[0]
        TID = Cast(Integer PTR, NID[1]): If TID <> 0 Then DEALLOCATE(TID): NID[1] = 0
        TID = Cast(Integer PTR, NID[0]): If TID <> 0 Then TID[2] = NID[2]: NID[2] = 0
        TID = Cast(Integer PTR, NID[2]): If TID <> 0 Then TID[0] = NID[0]: NID[0] = 0
        DEALLOCATE(NID)
        Return 0
    End If
    NID = Cast(Integer PTR, NID[2])
Loop
Return 4
End Function



'##############################################################################################################
Function ColCount(ByRef V_Collection as Integer PTR) as UInteger
If V_Collection = 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim X as UInteger
Do
    If NID = 0 Then Exit Do
    X += 1: NID = Cast(Integer PTR, NID[2])
Loop
Return X
End Function



'##############################################################################################################
Function ColFind(ByRef V_Collection as Integer PTR, V_Match as Integer) as UInteger
If V_Collection = 0 Then Return 0
Dim NID as Integer PTR = V_Collection
Dim AID as Integer PTR
Dim X as UInteger
Do
    If NID = 0 Then Exit Do
    X += 1
    AID = Cast(Integer PTR, NID[1])
    If *AID = V_Match Then Return X
    NID = Cast(Integer PTR, NID[2])
Loop
Return 0
End Function