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
Leave a comment: