StringListC.inc - String Linked List Class - Hybrid COM Object

[Stanley Durham]

Dynamic String Linked List Class

implementation:
Long Linked List of pointers to hybrid string objects.

these classes use an error handler: ErrT (in download source)
local e as ErrT
o.Initialize(e)

this is necessary to trap a memory allocation failure

hybrid object needs internal memory allocated before use:
o.Alloc()
internal memory must be freed before object goes out of scope:
o.Free()

Source: StringListC.zip: Dynamic String Linked List Class. > http://deadtheorywalking.com/pb.aspx
public domain - use at own risk
need to download all files to compile

[Stanley Durham]

'PB 5/9 .02
'StringListC.inc
'
'   String Linked List Class - Hybrid COM Object
'
'   implementation:
'       long list of hybrid string object handles - LongListC.inc, StringC.inc
'
#Include Once "LongListC.inc"
#Include Once "StringC.inc"
'
Macro StringListC_ErrStatus(exitWhat) = If pe = %null Or @pe.err Then Exit exitWhat
Macro StringListC_ExitIf(test, message, exitWhat)
    If test Then
        Err_Set @pe, %ErrUndefined, "StringListC.inc", "StringListC", "StringListI", FuncName$, message
        Exit exitWhat
    End If
End Macro
'
Class StringListC
    Instance pe As ErrT Ptr
    Instance cList As LongListI
    Instance cNode As LongListNodeI
    Instance cStr As StringI
    '
    Class Method Create()
        cList = Class "LongListC"
        cNode = Class "LongListNodeC"
        cStr = Class "StringC"
    End Method
    '
    Interface StringListI : Inherit IUnknown
        '
        Method Initialize(e As ErrT)
            'set error handler
            pe = VarPtr(e)
            cList.Initialize(e)
            cNode.Initialize(e)
            cStr.Initialize(e)
        End Method
        '
        Method Alloc()
            'allocate new instance
            StringListC_ErrStatus(Method)
            cList.Alloc()
        End Method
        '
        Method Free()
            'free instance
            StringListC_ErrStatus(Method)
            If cList.Ptr Then
                me.Clear()
                cList.Free()
            End If
        End Method
        '
        Property Get Ptr() As Long
            'get current instance
            StringListC_ErrStatus(Property)
            Property = cList.Ptr
        End Property
        '
        Property Set Ptr(ByVal hMem As Long)
            'set current instance
            StringListC_ErrStatus(Property)
            cList.Ptr = hMem
        End Property
        '
        Method Count() As Long
            'get cList item count
            StringListC_ErrStatus(Method)
            Method = cList.Count()
        End Method
        '
        Method Clear()
            'delete all items
            StringListC_ErrStatus(Method)
            '
            Local node As LongListNodeCT Ptr
            node = cList.First()
            While node
                cStr.Ptr = @node.value
                cStr.Free() : If @pe.err Then Exit Method
                @node.value = %null
                node = cList.Next(node)
            Wend
            cList.Clear()
        End Method
        '
        Method Add(In ByRef v As String)
            'append value to end of cList
            StringListC_ErrStatus(Method)
            cStr.Alloc()
            cStr.Str = v
            cList.Add(cStr.Ptr)
        End Method
        '
        Method Insert(In ByRef v As String)
            'insert value in front of cList
            StringListC_ErrStatus(Method)
            cStr.Alloc()
            cStr.Str = v
            cList.Insert(cStr.Ptr)
        End Method
        '
        Method Remove(ByVal hNode As Long)
            'remove node from cList
            StringListC_ErrStatus(Method)
            cStr.Ptr = cList.GetValueAt(hNode) : If @pe.err Then Exit Method
            cStr.Free()
            cList.Remove(hNode)
        End Method
        '
        Method First() As Long
            'move to first item in cList - return node handle
            StringListC_ErrStatus(Method)
            Method = cList.First()
        End Method
        '
        Method Last() As Long
            'move to last item in cList - return node handle
            StringListC_ErrStatus(Method)
            Method = cList.Last()
        End Method
        '
        Method Previous(ByVal hNode As Long) As Long
            'move to node befor hNode - return node handle
            StringListC_ErrStatus(Method)
            Method = cList.Previous(hNode)
        End Method
        '
        Method Next(ByVal hNode As Long) As Long
            'move to node after hNode - return node handle
            StringListC_ErrStatus(Method)
            Method = cList.Next(hNode)
        End Method
        '
        Method GetValueAt(ByVal hNode As Long) As String
            'get node's value
            StringListC_ErrStatus(Method)
            cStr.Ptr = cList.GetValueAt(hNode)
            Method = cStr.Str
        End Method
        '
        Method SetValueAt(ByVal hNode As Long, In ByRef v As String)
            'set node's value
            StringListC_ErrStatus(Method)
            cStr.Ptr = cList.GetValueAt(hNode)
            cStr.Str = v
        End Method
        '
        Method Compare(ByVal hNode As Long, In ByRef v As String, Opt ByVal upperCase As Long) As Long
            'node's Value with v
            'Value = v : Method = 0
            'Value < v : Method < 0
            'Value > v : Method > 0
            StringListC_ErrStatus(Method)
            cStr.Ptr = cList.GetValueAt(hNode)
            Method = cStr.Compare(v, upperCase)
        End Method
        '
        Method InsertBefore(ByVal hNode As Long, In ByRef v As String)
            'insert new value before hNode
            StringListC_ErrStatus(Method)
            cStr.Alloc()
            cStr.Str = v
            cList.InsertBefore(hNode, cStr.Ptr)
        End Method
        '
        Method InsertAfter(ByVal hNode As Long, In ByRef v As String)
            'insert new value after hNode
            StringListC_ErrStatus(Method)
            cStr.Alloc()
            cStr.Str = v
            cList.InsertAfter(hNode, cStr.Ptr)
        End Method
        '
        Method RemovePrevoius(ByVal hNode As Long)
            'remove value before node - error if left node null
            cNode.Ptr = hNode
            cNode.Ptr = cNode.Prev : If @pe.err Then Exit Method
            cStr.Ptr = cNode.Value : If @pe.err Then Exit Method
            cStr.Free()
            cList.RemovePrevoius(hNode)
        End Method
        '
        Method RemoveNext(ByVal hNode As Long)
            'remove value after node - error if right node null
            cNode.Ptr = hNode
            cNode.Ptr = cNode.Next : If @pe.err Then Exit Method
            cStr.Ptr = cNode.Value : If @pe.err Then Exit Method
            cStr.Free()
            cList.RemoveNext(hNode)
        End Method
        '
    End Interface
    '
End Class
'

[Stanley Durham]

test/sample - need to download all files to compile

'PB 9
%ErrHaltActive = 1
$TestSource = "StringListC.bas"
$TestTitle = "String List Class Test"
#Compile Exe "StringListC.exe"
#Dim All
#Optimize Speed
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "PBForms.INC"
#Include "StringListC.inc"
'
%Dlg1    =  101
%BtnTest = 1002
%Lbx     = 1001
'
Global lbx As ListBoxI
Global tmr As TimerI
'
Sub BtnTest(ByVal hDlg As Long)
    Local hNode As Long
    Local e As ErrT
    Local list As StringListI : list = Class "StringListC" : list.Initialize(e)
    '
    lbx.Clear(2)
    '
    list.Alloc()
    '
    '
    lbx.Add("")
    lbx.Add("add a few items to list")
    lbx.Add("add, B") : list.Add("B")
    lbx.Add("add, C") : list.Add("C")
    lbx.Add("add, D") : list.Add("D")
    lbx.Add("insert, A") : list.Insert("A")
    '
    lbx.Add("")
    lbx.Add("traverse forward")
    hNode = list.First()
    While hNode
        lbx.Add(list.GetValueAt(hNode))
        hNode = list.Next(hNode)
    Wend
    '
    lbx.Add("")
    lbx.Add("traverse backward")
    lbx.Add("   modify as we go")
    hNode = list.Last()
    While hNode
        list.SetValueAt(hNode, list.GetValueAt(hNode) + " modified")
        lbx.Add(list.GetValueAt(hNode))
        hNode = list.Previous(hNode)
    Wend
    '
    lbx.Add("")
    lbx.Add("move to first item in list") : hNode = list.First()
    lbx.Add("insert ""a"" before") : list.InsertBefore(hNode, "a")
    lbx.Add("insert ""aaa"" after") : list.InsertAfter(hNode, "aaa")
    lbx.Add("")
    lbx.Add("move to last item in list") : hNode = list.Last()
    lbx.Add("insert ""d"" before") : list.InsertBefore(hNode, "d")
    lbx.Add("insert ""ddd"" after") : list.InsertAfter(hNode, "ddd")
    '
    lbx.Add("")
    lbx.Add("traverse forward")
    hNode = list.First()
    While hNode
        lbx.Add(list.GetValueAt(hNode))
        hNode = list.Next(hNode)
    Wend
    '
    '
    lbx.Add("")
    lbx.Add("move to second item in list") : hNode = list.First() : hNode = list.Next(hNode)
    lbx.Add("remove item before and after")
    list.RemovePrevoius(hNode)
    list.RemoveNext(hNode)
    lbx.Add("")
    lbx.Add("move to second item from end") : hNode = list.Last() : hNode = list.Previous(hNode)
    lbx.Add("remove item before and after")
    list.RemovePrevoius(hNode)
    list.RemoveNext(hNode)
    '
    lbx.Add("")
    lbx.Add("traverse forward")
    hNode = list.First()
    While hNode
        lbx.Add(list.GetValueAt(hNode))
        hNode = list.Next(hNode)
    Wend
    '
    '
    list.Free()
    '
    lbx.Add("")
    lbx.Add("done...")
End Sub
'
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_InitDialog
             lbx = Class "ListBoxC"
             lbx.INI(Cb.Hndl, %Lbx)
             lbx.SetHorizontal(1000)
             tmr = Class "TimerC"
        Case %WM_Command
            Select Case As Long CbCtl
                Case %BtnTest
                    If CbCtlMsg = %BN_Clicked Or CbCtlMsg = 1 Then
                        BtnTest(Cb.Hndl)
                    End If
            End Select
    End Select
End Function
Function ShowDlg1(ByVal hParent As Dword) As Long
    Local lRslt  As Long
    Local hDlg   As Dword
    Local hFont1 As Dword
    Dialog New hParent, $TestTitle, 67, 61, 341, 241, %WS_Popup _
        Or %WS_Border Or %WS_DlgFrame Or %WS_Caption Or %WS_SysMenu Or _
        %WS_MinimizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame _
        Or %DS_3DLook Or %DS_NoFailCreate Or %DS_SetFont, _
        %WS_Ex_ControlParent Or %WS_Ex_Left Or %WS_Ex_LtrReading Or _
        %WS_Ex_RightScrollbar, To hDlg
    Control Add ListBox, hDlg, %Lbx, , 5, 5, 330, 210, %WS_Child Or _
        %WS_Visible Or %WS_HScroll Or %WS_VScroll Or %LBS_Notify Or _
        %LBS_NoIntegralHeight, %WS_Ex_ClientEdge Or %WS_Ex_Left Or _
        %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar
    Control Add Button,  hDlg, %BtnTest, "Test", 275, 220, 60, 15
    hFont1 = PBFormsMakeFont("Courier New", 9, 400, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)
    Control Send hDlg, %Lbx, %WM_SETFONT, hFont1, 0
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
    DeleteObject hFont1
    Function = lRslt
End Function
Class ListBoxC
    Instance meHDlg As Long
    Instance meID As Long
    Interface ListBoxI
        Inherit IUnknown
        Method INI(ByVal hDlg As Long, ByVal Id As Long)
            meHDlg = hDlg
            meID = Id
        End Method
        Method SetHorizontal(ByVal Count As Long)
            Local hCntrl&
            Control Handle meHDlg, meID To hCntrl&
            SendMessage hCntrl&, %LB_SETHORIZONTALEXTENT, Count, 0
        End Method
        Method Clear(Opt doEventsCount As Long)
            ListBox Reset meHDlg, meID
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
        Method Add(ByVal s As String, Opt doEventsCount As Long) As String
            ListBox Add meHDlg, meID, s
            If VarPtr(doEventsCount) Then me.DoEventsCount(doEventsCount)
        End Method
    End Interface
    Class Method DoEventsCount(ByVal Count As Long)
        Local i As Long
        For i = 1 To Count
            Dialog DoEvents
        Next i
    End Method
End Class
Class TimerC
    Instance meTime As Double
    Interface TimerI
        Inherit IUnknown
        Method Start()
            meTime = Timer
        End Method
        Method Get() As String
            Method = "    Time: " + Format$(Timer - meTime, "###.###############")
        End Method
    End Interface
End Class