Announcement

Stanley Durham · 16 Aug 2009, 10:38 AM

test/sample app

Code:

#PBForms CREATED V1.51
'pbwin 9
$TestSource = "FLLListTest.bas"
$TestTitle = "File Based: Long/Long ~ Key/Value List Test"
#Compile Exe "FLLListTest.exe"
#Dim All
#Optimize Speed
#Include Once "..\FLLList1.inc"
#PBForms BEGIN INCLUDES
#If Not %Def(%WINAPI)
    #Include Once "WIN32API.INC"
#EndIf
#Include Once "PBForms.INC"
#PBForms END INCLUDES
#PBForms BEGIN CONSTANTS
%Dlg1    =  101
%BtnTest = 1002
%Lbx1    = 1001
#PBForms END CONSTANTS
Declare CallBack Function ShowDlg1Proc()
Declare Function ShowDlg1(ByVal hParent As Dword) As Long
#PBForms DECLARATIONS
Global lbx As LBxI
Global tmr As TimerI
Function PBMain()
    ShowDlg1 %HWND_Desktop
End Function
Sub BtnTest(ByVal hDlg As Long)
    Local i, Count, hNode, hDel As Long
    Local file As String : file = "FLLList.dat"
    Local s As String
    Local t As FLLListT
    '
    lbx.Clear(2)
    Count = 100000
    '
    If IsFile(file) Then Kill file
    '
    If IsFalse FLLList_Create(t, file) Then Exit Sub
    '
    lbx.Add("add "+Format$(Count, "#,")+" items")
    tmr.Start()
    For i = 1 To Count
        FLLList_Add(t, i, i)
    Next i
    lbx.Add(tmr.Get())
    '
    lbx.Add("")
    lbx.Add("Count = " + Format$(FLLList_Count(t)))
    '
    lbx.Add("")
    lbx.Add("close and reopen file")
    FLLList_Close t
    If IsFalse FLLList_Open(t, file) Then Exit Sub
    '
    lbx.Add("")
    lbx.Add("traverse all "+Format$(Count, "#,")+" items")
    lbx.Add("    make sure data correct")
    i = 0
    tmr.Start()
    hNode = FLLList_First(t)
    While hNode
        Incr i
        If FLLList_GetKeyAt(t, hNode) <> i Or FLLList_GetValueAt(t, hNode) <> i Then
            ? "fail at: " + Format$(i) : Exit Loop
        End If
        hNode = FLLList_Right(t, hNode)
    Wend
    lbx.Add(tmr.Get())
    '
    ' =============
    '
    lbx.Add("")
    lbx.Add("insert after file already expanded")
    hNode = FLLList_First(t)
    While hNode
        FLLList_DeleteAt t, hNode
        hNode = FLLList_First(t)
    Wend
    lbx.Add("add "+Format$(Count, "#,")+" items")
    tmr.Start()
    For i = 1 To Count
        FLLList_Add(t, i, i)
    Next i
    lbx.Add(tmr.Get())
    '
    '
    lbx.Add("")
    lbx.Add("traverse all "+Format$(Count, "#,")+" items")
    lbx.Add("    without testing data")
    tmr.Start()
    hNode = FLLList_First(t)
    While hNode
        hNode = FLLList_Right(t, hNode)
    Wend
    lbx.Add(tmr.Get())
    '
    '=========================
    '
    '
    lbx.Add("")
    lbx.Add("clear list - add 5 items")
    FLLList_Clear t
    For i = 1 To 5
        FLLList_Add(t, i, i)
    Next i
    '
    lbx.Add("")
    lbx.Add("traverse forward")
    lbx.Add("  changing Key/Value as we go")
    hNode = FLLList_First(t)
    While hNode
        FLLList_SetKeyAt t, hNode, FLLList_GetKeyAt(t, hNode) * 100
        FLLList_SetValueAt t, hNode, FLLList_GetValueAt(t, hNode) * 10000
        s = "  Key = "
        s += Format$(FLLList_GetKeyAt(t, hNode))
        s += " | "
        s += "Value = "
        s += Format$(FLLList_GetValueAt(t, hNode))
        lbx.Add(s)
        hNode = FLLList_Right(t, hNode)
    Wend
    lbx.Add("traverse backward")
    hNode = FLLList_Last(t)
    While hNode
        s = "  Key = "
        s += Format$(FLLList_GetKeyAt(t, hNode))
        s += " | "
        s += "Value = "
        s += Format$(FLLList_GetValueAt(t, hNode))
        lbx.Add(s)
        hNode = FLLList_Left(t, hNode)
    Wend
    '
    lbx.Add("")
    lbx.Add("insert value before 100, 300 and 500")
    FLLList_Insert(t, 111, 11111)
    hNode = FLLList_First(t)
    While hNode
        If FLLList_GetKeyAt(t, hNode) = 300 Then
            FLLList_InsertAt(t, hNode, 333, 33333)
        ElseIf FLLList_GetKeyAt(t, hNode) = 500 Then
            FLLList_InsertAt(t, hNode, 555, 55555)
        End If
        hNode = FLLList_Right(t, hNode)
    Wend
    hNode = FLLList_First(t)
    While hNode
        s = "  Key = "
        s += Format$(FLLList_GetKeyAt(t, hNode))
        s += " | "
        s += "Value = "
        s += Format$(FLLList_GetValueAt(t, hNode))
        lbx.Add(s)
        hNode = FLLList_Right(t, hNode)
    Wend
    '
    lbx.Add("")
    lbx.Add("delete 111, 333, 555")
    hNode = FLLList_First(t)
    While hNode
        hDel = hNode
        'can't delete node while sitting on it (if you want to continue traversing)
        hNode = FLLList_Right(t, hNode)
        If FLLList_GetKeyAt(t, hDel) = 111 Or FLLList_GetKeyAt(t, hDel) = 333 Or FLLList_GetKeyAt(t, hDel) = 555 Then
            FLLList_DeleteAt t, hDel
        End If
    Wend
    hNode = FLLList_First(t)
    While hNode
        s = "  Key = "
        s += Format$(FLLList_GetKeyAt(t, hNode))
        s += " | "
        s += "Value = "
        s += Format$(FLLList_GetValueAt(t, hNode))
        lbx.Add(s)
        hNode = FLLList_Right(t, hNode)
    Wend
    '
    '
    ' - close list
    FLLList_Close t
    '
    lbx.Add("")
    lbx.Add("done...")
End Sub
CallBack Function ShowDlg1Proc()
    Select Case As Long CbMsg
        Case %WM_InitDialog
             lbx = Class "LBxC"
             lbx.INI(Cb.Hndl, %Lbx1)
             lbx.SetHorizontal(1000)
             tmr = Class "TimerC"
        Case %WM_NCActivate
            Static hWndSaveFocus As Dword
            If IsFalse CbWParam Then
                hWndSaveFocus = GetFocus()
            ElseIf hWndSaveFocus Then
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            End If
        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
#PBForms BEGIN DIALOG %Dlg1->->
    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, %Lbx1, , 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, %Lbx1, %WM_SETFONT, hFont1, 0
#PBForms END DIALOG
    Dialog Show Modal hDlg, Call ShowDlg1Proc To lRslt
#PBForms BEGIN CLEANUP %Dlg1
    DeleteObject hFont1
#PBForms END CLEANUP
    Function = lRslt
End Function
Class LBxC
    Instance meHDlg As Long
    Instance meID As Long
    Interface LBxI
        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

Announcement

Forum Guidelines

FLLList1.inc, File Based: Long List

PBWin/PBCC FLLList1.inc, File Based: Long List

Comment