Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [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:01.04.2009 08:24:53

'###################################################################################################################################
'# LL_INT_LinkedList Version: 2.00.0 - 30.03.2009
'###################################################################################################################################
'# Autor:   /_\ DeltaLab's Germany - Experimental Computing
'# Writer:  Martin Wiemann - Admin@MLN.ath.cx - IRC://MLN.ath.cx/#mln
'# Idea:    20:50:53 - 30.03.2009
'###################################################################################################################################
'# This sourcecode is open source! Full or parts of this source CAN copy. Do what u want!
'###################################################################################################################################





'###################################################################################################################################
Enum LL_DataType
    LL_DT_Unknown   = 0
    LL_DT_LL        = 1
    LL_DT_String    = 2
    LL_DT_UInteger  = 3
    LL_DT_Integer   = 4
    LL_DT_AnyPtr    = 5
End Enum
Type LL_INT_LinkedList
    V_Next          as LL_INT_LinkedList Ptr
    V_Prev          as LL_INT_LinkedList Ptr
    V_Root          as LL_INT_LinkedList Ptr
    V_Parent        as LL_INT_LinkedList Ptr
    V_ChildF        as LL_INT_LinkedList Ptr
    V_ChildL        as LL_INT_LinkedList Ptr

    V_DataType      as LL_DataType
    V_Data          as String
    V_DataX         as UInteger
End Type





#IFDEF LL_DEF_ThreadSafe
    '###################################################################################################################################
    Dim Shared LL_INT_Mutex                     as Any Ptr

    '-----------------------------------------------------------------------------------------------------------------------------------
    Sub LL_INT_Construct() Constructor
    LL_INT_Mutex = MutexCreate()
    End Sub

    '-----------------------------------------------------------------------------------------------------------------------------------
    Sub LL_INT_Destruct() Constructor
    MutexDestroy(LL_INT_Mutex)
    LL_INT_Mutex = 0
    End Sub
#ENDIF





'###################################################################################################################################
Public Function LL_DatatypeName(V_Datatype as LL_DataType) as String
Select Case V_Datatype
    Case LL_DT_Unknown:     Return "[Unknown]"
    Case LL_DT_LL:          Return "LinkedList"
    Case LL_DT_String:      Return "String"
    Case LL_DT_UInteger:    Return "UInteger"
    Case LL_DT_Integer:     Return "Integer"
    Case LL_DT_AnyPtr:      Return "Any Ptr"
    Case Else:              Return "[Unknown Datatype]"
End Select
End Function





'###################################################################################################################################
Private Function LL_INT_Item_Add(ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr, V_Parent as LL_INT_LinkedList Ptr, V_Root as LL_INT_LinkedList Ptr, V_Index as UInteger = 0) as LL_INT_LinkedList Ptr
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = RV_LF
Dim NPtr as LL_INT_LinkedList Ptr
If V_Index > 0 Then
    Do Until TPtr = 0
        C += 1
        If C = V_Index Then Exit Do
        TPtr = TPtr->V_Next
    Loop
    If TPtr <> 0 Then
        NPtr = CAllocate(SizeOf(LL_INT_LinkedList))
        NPtr->V_Next = TPtr
        NPtr->V_Prev = TPtr->V_Prev
        TPtr->V_Prev = NPtr
        If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = NPtr
        Return NPtr
    End If
End If
If NPtr = 0 Then
    If RV_LL <> 0 Then
        RV_LL->V_Next = CAllocate(SizeOf(LL_INT_LinkedList))
        RV_LL->V_Next->V_Prev = RV_LL
        RV_LL = RV_LL->V_Next
    Else
        RV_LL = CAllocate(SizeOf(LL_INT_LinkedList))
        RV_LF = RV_LL
    End If
    NPtr = RV_LL
End If
With *NPtr
    .V_Parent   = V_Parent
    .V_Root     = V_Root
End With
Return NPtr
End Function

'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_Get(V_LF as LL_INT_LinkedList Ptr, V_Index as UInteger) as LL_INT_LinkedList Ptr
If V_LF = 0 Then Return 0
If V_Index = 0 Then Return 0
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Do Until TPtr = 0
    C += 1
    If C = V_Index Then Exit Do
    TPtr = TPtr->V_Next
Loop
Return TPtr
End Function

'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LL_INT_Item_Del(ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr, V_Index as UInteger)
Dim TPtr as LL_INT_LinkedList Ptr = LL_INT_Item_Get(RV_LF, V_Index)
If TPtr = 0 Then Exit Sub
With *TPtr
    If .V_Next <> 0 Then .V_Next->V_Prev = .V_Prev
    If .V_Prev <> 0 Then .V_Prev->V_Next = .V_Next
    If RV_LF = TPtr Then RV_LF = TPtr->V_Next
    If RV_LL = TPtr Then RV_LL = TPtr->V_Prev
End With
DeAllocate(TPtr)
End Sub

'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LL_INT_Item_Clear(ByRef RV_LF as LL_INT_LinkedList Ptr, ByRef RV_LL as LL_INT_LinkedList Ptr)
Do Until RV_LF = 0
    RV_LL = RV_LF->V_Next
    LL_INT_Item_Clear(RV_LF->V_ChildF, RV_LF->V_ChildL)
    DeAllocate(RV_LF)
    RV_LF = RV_LL
Loop
End Sub

'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_Count(V_LF as LL_INT_LinkedList Ptr) as UInteger
If V_LF = 0 Then Return 0
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Do Until TPtr = 0
    C += 1
    TPtr = TPtr->V_Next
Loop
Return C
End Function

'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LL_INT_Item_GetIndex(V_LF as LL_INT_LinkedList Ptr, V_LC as LL_INT_LinkedList Ptr) as UInteger
If V_LF = 0 Then Return 0
If V_LC = 0 Then Return 0
Dim C as UInteger
Dim TPtr as LL_INT_LinkedList Ptr = V_LF
Do Until TPtr = 0
    C += 1
    If TPtr = V_LC Then Return C
    TPtr = TPtr->V_Next
Loop
Return 0
End Function







'|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

'###################################################################################################################################
Type LinkedList
    LLPtr                                   as LL_INT_LinkedList Ptr

    Declare Function    Item                (V_Index as UInteger) as LinkedList
    Declare Function    Index               () as UInteger
    Declare Function    DataType            () as LL_DataType
    Declare Function    Count               () as UInteger

    Declare Property    Text                () as String
    Declare Property    Text                (as String)
    Declare Property    UNum                () as UInteger
    Declare Property    UNum                (as UInteger)
    Declare Property    Num                 () as Integer
    Declare Property    Num                 (as Integer)
    Declare Property    AnyData             () as Any Ptr
    Declare Property    AnyData             (as Any Ptr)

    Declare Function    Add                 (V_String as String, V_Index as UInteger = 0) as LinkedList
    Declare Sub         Del                 (V_Index as UInteger)
    Declare Sub         Clear               ()

End Type





'###################################################################################################################################
Private Function LinkedList.Item(V_Index as UInteger) as LinkedList
Dim TLL as LinkedList
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
    If This.LLPtr = 0 Then Return TLL
#ENDIF
Dim TLPtr as LL_INT_LinkedList Ptr = LL_INT_Item_Get(This.LLPtr->V_ChildF, V_Index)
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
    MutexUnLock(LL_INT_Mutex)
    Return TLL
#ENDIF
Return TLL
End Function





'###################################################################################################################################
Private Property LinkedList.Text() as String
If This.LLPtr = 0 Then Return ""
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_String Then MutexUnLock(LL_INT_Mutex): Return ""
    Dim T as String = This.LLPtr->V_Data
    MutexUnLock(LL_INT_Mutex)
    Return T
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_String Then Return ""
    Return This.LLPtr->V_Data
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.Text(V_Value as String)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_String Then MutexUnLock(LL_INT_Mutex): Exit Property
    This.LLPtr->V_Data = V_Value
    MutexUnLock(LL_INT_Mutex)
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_String Then Exit Property
    This.LLPtr->V_Data = V_Value
#ENDIF
End Property

'-----------------------------------------------------------------------------------------------------------------------------------
Private Property LinkedList.UNum() as UInteger
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_UInteger Then MutexUnLock(LL_INT_Mutex): Return 0
    Dim T as UInteger = This.LLPtr->V_DataX
    MutexUnLock(LL_INT_Mutex)
    Return T
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_UInteger Then Return 0
    Return This.LLPtr->V_DataX
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.UNum(V_Value as UInteger)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_UInteger Then MutexUnLock(LL_INT_Mutex): Exit Property
    This.LLPtr->V_DataX = V_Value
    MutexUnLock(LL_INT_Mutex)
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_UInteger Then Exit Property
    This.LLPtr->V_DataX = V_Value
#ENDIF
End Property

'-----------------------------------------------------------------------------------------------------------------------------------
Private Property LinkedList.Num() as Integer
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_Integer Then MutexUnLock(LL_INT_Mutex): Return 0
    Dim T as Integer = Cast(Integer, This.LLPtr->V_DataX)
    MutexUnLock(LL_INT_Mutex)
    Return T
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_Integer Then Return 0
    Return Cast(Integer, This.LLPtr->V_DataX)
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.Num(V_Value as Integer)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_Integer Then MutexUnLock(LL_INT_Mutex): Exit Property
    This.LLPtr->V_DataX = Cast(UInteger, V_Value)
    MutexUnLock(LL_INT_Mutex)
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_Integer Then Exit Property
    This.LLPtr->V_DataX = Cast(UInteger, V_Value)
#ENDIF
End Property

'-----------------------------------------------------------------------------------------------------------------------------------
Private Property LinkedList.AnyData() as Any Ptr
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_Integer Then MutexUnLock(LL_INT_Mutex): Return 0
    Dim T as Any Ptr = Cast(Any Ptr, This.LLPtr->V_DataX)
    MutexUnLock(LL_INT_Mutex)
    Return T
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_Integer Then Return 0
    Return Cast(Any Ptr, This.LLPtr->V_DataX)
#ENDIF
End Property
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Property LinkedList.AnyData(V_Value as Any Ptr)
If This.LLPtr = 0 Then Exit Property
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr->V_DataType <> LL_DT_Integer Then MutexUnLock(LL_INT_Mutex): Exit Property
    This.LLPtr->V_DataX = Cast(UInteger, V_Value)
    MutexUnLock(LL_INT_Mutex)
#ELSE
    If This.LLPtr->V_DataType <> LL_DT_Integer Then Exit Property
    This.LLPtr->V_DataX = Cast(UInteger, V_Value)
#ENDIF
End Property





'###################################################################################################################################
Private Function LinkedList.Add(V_String as String, V_Index as UInteger = 0) as LinkedList
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
#ENDIF
Dim TLL as LinkedList
If This.LLPtr = 0 Then This.LLPtr = CAllocate(SizeOf(LL_INT_LinkedList))
Dim TLPtr as LL_INT_LinkedList Ptr
If This.LLPtr->V_Parent <> 0 Then
    TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr->V_Root, V_Index)
Else: TLPtr = LL_INT_Item_Add(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, This.LLPtr, This.LLPtr, V_Index)
End If
#IFDEF LL_DEF_ThreadSafe
    If TLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return TLL
#ELSE
    If TLPtr = 0 Then Return TLL
#ENDIF
TLPtr->V_DataType = LL_DT_String
TLPtr->V_Data = V_String
TLL.LLPtr = TLPtr
#IFDEF LL_DEF_ThreadSafe
    MutexUnLock(LL_INT_Mutex)
#ENDIF
Return TLL
End Function

'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LinkedList.Del(V_Index as UInteger)
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Exit Sub
#ELSE
    If This.LLPtr = 0 Then Exit Sub
#ENDIF
LL_INT_Item_Del(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL, V_Index)
#IFDEF LL_DEF_ThreadSafe
    MutexUnLock(LL_INT_Mutex)
#ENDIF
End Sub

'-----------------------------------------------------------------------------------------------------------------------------------
Private Sub LinkedList.Clear()
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Exit Sub
#ELSE
    If This.LLPtr = 0 Then Exit Sub
#ENDIF
LL_INT_Item_Clear(This.LLPtr->V_ChildF, This.LLPtr->V_ChildL)
#IFDEF LL_DEF_ThreadSafe
    MutexUnLock(LL_INT_Mutex)
#ENDIF
End Sub





'###################################################################################################################################
Private Function LinkedList.Index() as UInteger
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    If This.LLPtr = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
    If This.LLPtr->V_Parent = 0 Then MutexUnLock(LL_INT_Mutex): Return 0
    Dim C as UInteger = LL_INT_Item_GetIndex(This.LLPtr->V_Parent->V_ChildF, This.LLPtr)
    MutexUnLock(LL_INT_Mutex)
    Return C
#ELSE
    If This.LLPtr = 0 Then Return 0
    If This.LLPtr->V_Parent = 0 Then Return 0
    Return LL_INT_Item_GetIndex(This.LLPtr->V_Parent->V_ChildF, This.LLPtr)
#ENDIF
End Function

'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.Count() as UInteger
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    Dim C as UInteger = LL_INT_Item_Count(This.LLPtr->V_ChildF)
    MutexUnLock(LL_INT_Mutex)
    Return C
#ELSE
    If This.LLPtr = 0 Then Return 0
    Return LL_INT_Item_Count(This.LLPtr->V_ChildF)
#ENDIF
End Function

'-----------------------------------------------------------------------------------------------------------------------------------
Private Function LinkedList.DataType() as LL_DataType
If This.LLPtr = 0 Then Return 0
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    Dim C as LL_DataType = This.LLPtr->V_DataType
    MutexUnLock(LL_INT_Mutex)
    Return C
#ELSE
    If This.LLPtr = 0 Then Return 0
    Return This.LLPtr->V_DataType
#ENDIF
End Function





'###################################################################################################################################
Public Sub LL_Destroy(V_LL as LinkedList)
If V_LL.LLPtr = 0 Then Exit Sub
#IFDEF LL_DEF_ThreadSafe
    MutexLock(LL_INT_Mutex)
    LL_INT_Item_Clear(V_LL.LLPtr->V_ChildF, V_LL.LLPtr->V_ChildL)
    DeAllocate(V_LL.LLPtr)
    V_LL.LLPtr = 0
    MutexUnLock(LL_INT_Mutex)
#ELSE
    LL_INT_Item_Clear(V_LL.LLPtr->V_ChildF, V_LL.LLPtr->V_ChildL)
    DeAllocate(V_LL.LLPtr)
    V_LL.LLPtr = 0
#ENDIF
End Sub