|
'-------------------------------------------------
' Searching, Sorting, and Multitasking Comparisons
'
' Written By Jeffrey B. Firestone
' Jeffrey B. Firestone Company
' jfirestone@jbfc.com
'
' May 29, 2004
'
' You may redistribute this control in binary and modified binary form as you please. You may
' use this control in commercial applications without need for external credit royalty free.
'
' However, you are restricted from releasing the source code in any modified fashion
' whatsoever.
'
' I MAKE NO PROMISES OR WARRANTIES ON THIS CODE/CONTROL. IF ANY DAMAGE OR PROBLEMS HAPPEN FROM ITS USE
' THEN YOU ARE RESPONSIBLE.
Option Strict On
Imports System.Windows.Forms
Imports VB = Microsoft.VisualBasic
Imports System.Random
Imports System.Data
Public Class ArrayListCollection
Implements IDisposable
Private m_frmMain As frmMain
Private m_IsInitialized As Boolean
Private m_IsRunning As Boolean
Private m_ArrayList As System.Collections.ArrayList
Private m_iColumnNumber As Integer
Private m_iRowNumber As Integer
#Region "Properties"
Public ReadOnly Property ClassDescription() As String
Get
ClassDescription = "Sorted List Collection"
End Get
End Property
Public Property frmMain() As Form
Get
frmMain = m_frmMain
End Get
Set(ByVal Value As Form)
m_frmMain = CType(Value, frmMain)
End Set
End Property
Public Property IsInitialized() As Boolean
Get
IsInitialized = m_IsInitialized
End Get
Set(ByVal Value As Boolean)
m_IsInitialized = Value
End Set
End Property
Public Property IsRunning() As Boolean
Get
IsRunning = m_IsRunning
End Get
Set(ByVal Value As Boolean)
m_IsRunning = Value
End Set
End Property
Public ReadOnly Property DataSize() As Integer
Get
If Not (m_ArrayList Is Nothing) Then
DataSize = m_ArrayList.Count
End If
End Get
End Property
#End Region
#Region "Publics"
Public Function RunProc(ByVal iColumnNumber As Integer, ByVal iRowNumber As Integer) As String
Dim strResults As String = ""
IsRunning = True
m_iColumnNumber = iColumnNumber
m_iRowNumber = iRowNumber
Select Case iColumnNumber
Case 0 : ShowData()
Case 1 : strResults = Create()
Case 2 : strResults = DatasetScan()
Case 3 : strResults = Find_1_Key_Field()
Case 4 : strResults = Find_All_NonKey_Values()
Case 5 : strResults = Find_n_Fields()
Case 6 : strResults = Sort()
End Select
IsRunning = False
Return strResults
End Function
Public Function Create() As String
Dim t As Double = VB.Timer()
m_ArrayList = Nothing
m_ArrayList = New System.Collections.ArrayList
For lCount As Integer = 0 To m_frmMain.Data_Size
Dim oTestData As TestData.TestDataStructure = m_frmMain.TestData.arTestData(lCount)
m_ArrayList.Add(oTestData)
Next
m_IsInitialized = True
t = VB.Timer() - t
Return CStr(IIf(m_frmMain.fCancel, ">", "")) & Format(t, "0.00")
End Function
Public Function DatasetScan() As String
Dim lUnique As Integer
Dim sUnique As String
Dim lNonUnique As Integer
Dim sNonUnique As String
If Not m_IsInitialized Or DataSize <> m_frmMain.Data_Size Then Create()
Dim t As Double = VB.Timer()
Dim lScanRepeat As Integer = m_frmMain.Scan_Repeat
For lScanCount As Integer = 0 To lScanRepeat
If m_frmMain.rbDoEvents.Checked Then Application.DoEvents()
If m_frmMain.fCancel Then Exit For
If lScanCount Mod Math.Max(lScanRepeat \ 10,1) = 0 Then m_frmMain.UpdateProgress(m_iRowNumber, m_iColumnNumber, (lScanCount * 100) \ lScanRepeat)
#If 1 Then
For Each oData As TestData.TestDataStructure In m_ArrayList
With oData
lUnique = .lUnique
sUnique = .sUnique
lNonUnique = .lNonUnique
sNonUnique = .sNonUnique
End With
If m_frmMain.fCancel Then Exit For
Next
#Else
For l As Integer = 0 To m_ArrayList.Count - 1
Dim oData As TestData.TestDataStructure = m_ArrayList.Item(l)
With oData
lUnique = .lUnique
sUnique = .sUnique
lNonUnique = .lNonUnique
sNonUnique = .sNonUnique
End With
If m_frmMain.fCancel Then Exit For
Next
#End If
Next
t = VB.Timer() - t
Return CStr(IIf(m_frmMain.fCancel, ">", "")) & Format(t, "0.00")
End Function
Public Function Find_1_Key_Field() As String
Dim s As String
Dim sFind As String
Dim lFind As Integer
Dim rndGen As New System.Random
If Not m_IsInitialized Or DataSize <> m_frmMain.Data_Size Then Create()
Dim t As Double = VB.Timer()
#Const BINARY_SEARCH = 1
#If BINARY_SEARCH Then
Dim oData As New TestData.TestDataStructure
' The BinarySearch() relies upon the array being sorted by the search field
Dim oTestData_sUniqueIComparer As New TestData.sUnique_IComparer
m_ArrayList.Sort(oTestData_sUniqueIComparer)
#End If
Dim lDataSize As Integer = m_frmMain.Data_Size
Dim lFindRepeat As Integer = m_frmMain.Find_Repeat
For lCount As Integer = 0 To lFindRepeat
If m_frmMain.rbDoEvents.Checked Then Application.DoEvents()
If m_frmMain.fCancel Then Exit For
If lCount Mod Math.Max(lFindRepeat \ 10, 1) = 0 Then m_frmMain.UpdateProgress(m_iRowNumber, m_iColumnNumber, (lCount * 100) \ lFindRepeat)
sFind = "Str" & CInt(rndGen.Next(lDataSize))
#If BINARY_SEARCH Then
oData.sUnique = sFind
Dim l As Integer = m_ArrayList.BinarySearch(oData, oTestData_sUniqueIComparer)
If l >= 0 Then s = oData.sUnique
#Else
For l As Integer = 0 To lDataSize
Dim oData As TestData.TestDataStructure = m_ArrayList.Item(l)
If StrComp(oData.sUnique, sFind, CompareMethod.Binary) = 0 Then s = oData.sUnique : Exit For
Next
#End If
Next
t = VB.Timer() - t
#If BINARY_SEARCH Then
oTestData_sUniqueIComparer = Nothing
' Return the sort order to the original value so that it does not alter the run times of the other test routines
Dim oTestData_lUniqueIComparer As TestData.lUnique_IComparer = New TestData.lUnique_IComparer
m_ArrayList.Sort(oTestData_lUniqueIComparer)
oTestData_lUniqueIComparer = Nothing
#End If
Return CStr(IIf(m_frmMain.fCancel, ">", "")) & Format(t, "0.00")
End Function
Public Function Find_All_NonKey_Values() As String
Dim lFound As Integer
Dim rndGen As New System.Random
If Not m_IsInitialized Or DataSize <> m_frmMain.Data_Size Then Create()
Dim t As Double = VB.Timer()
Dim lDataSize As Integer = m_frmMain.Data_Size
Dim lFindRepeat As Integer = m_frmMain.Find_Repeat
For lCount As Integer = 0 To lFindRepeat
If m_frmMain.rbDoEvents.Checked Then Application.DoEvents()
If m_frmMain.fCancel Then Exit For
If lCount Mod Math.Max(lFindRepeat \ 10, 1) = 0 Then m_frmMain.UpdateProgress(m_iRowNumber, m_iColumnNumber, (lCount * 100) \ lFindRepeat)
Dim lFind As Integer = CInt(rndGen.Next(CInt(lDataSize / 10)))
For l As Integer = 0 To m_ArrayList.Count - 1
Dim oData As TestData.TestDataStructure = DirectCast(m_ArrayList.Item(l), TestData.TestDataStructure)
If oData.lNonUnique = lFind Then
lFound = oData.lNonUnique
End If
Next
If m_frmMain.fCancel Then Exit For
Next
t = VB.Timer() - t
Return CStr(IIf(m_frmMain.fCancel, ">", "")) & Format(t, "0.00")
End Function
Public Function Find_n_Fields() As String
Dim s As String
Dim sFind As String
Dim lHits As Integer = 0
Dim rndGen As New System.Random
If Not m_IsInitialized Or DataSize <> m_frmMain.Data_Size Then Create()
Dim t As Double = VB.Timer()
Dim lDataSize As Integer = m_frmMain.Data_Size
Dim lFindRepeat As Integer = m_frmMain.Find_Repeat
For lCount As Integer = 0 To lFindRepeat
If m_frmMain.rbDoEvents.Checked Then Application.DoEvents()
If m_frmMain.fCancel Then Exit For
If lCount Mod Math.Max(lFindRepeat \ 10, 1) = 0 Then m_frmMain.UpdateProgress(m_iRowNumber, m_iColumnNumber, (lCount * 100) \ lFindRepeat)
sFind = "Str" & CInt(rndGen.Next(lDataSize))
For l As Integer = 0 To lDataSize
Dim oData As TestData.TestDataStructure = DirectCast(m_ArrayList.Item(l), TestData.TestDataStructure)
If StrComp(oData.sUnique, sFind, CompareMethod.Binary) = 0 AndAlso StrComp(oData.sNonUnique, "Second", CompareMethod.Binary) = 0 Then
lHits = lHits + 1
s = oData.sUnique
Exit For
End If
Next
Next
t = VB.Timer() - t
s = CStr(IIf(m_frmMain.fCancel, ">", "")) & Format(t, "0.00") & " (" & lHits & " recs)"
Return s
End Function
Public Function Sort() As String
If Not m_IsInitialized Or DataSize <> m_frmMain.Data_Size Then Create()
Dim t As Double = VB.Timer()
Dim oTestDataIComparer As New TestData.lNonUnique_IComparer
m_ArrayList.Sort(oTestDataIComparer)
oTestDataIComparer = Nothing
Dim lUnique As Integer
Dim sUnique As String
Dim lNonUnique As Integer
Dim sNonUnique As String
For l As Integer = 0 To m_ArrayList.Count - 1
Dim oData As TestData.TestDataStructure = DirectCast(m_ArrayList.Item(l), TestData.TestDataStructure)
With oData
lUnique = .lUnique
sUnique = .sUnique
lNonUnique = .lNonUnique
sNonUnique = .sNonUnique
End With
Next
t = VB.Timer() - t
Return CStr(IIf(m_frmMain.fCancel, ">", "")) & Format(t, "0.00")
End Function
Public Function ShowData() As Boolean
Dim frm As ShowData = New ShowData
With frm.dt.Columns
.Add(New DataColumn("lUnique", GetType(Integer)))
.Add(New DataColumn("sUnique", GetType(String)))
.Add(New DataColumn("lNonUnique", GetType(Integer)))
.Add(New DataColumn("sNonUnique", GetType(String)))
End With
If Not (m_ArrayList Is Nothing) Then
For l As Integer = 0 To m_ArrayList.Count - 1
Dim oData As TestData.TestDataStructure = DirectCast(m_ArrayList.Item(l), TestData.TestDataStructure)
With oData
Dim dr As DataRow
dr = frm.dt.NewRow
dr.BeginEdit()
dr.Item("lUnique") = .lUnique
dr.Item("sUnique") = .sUnique
dr.Item("lNonUnique") = .lNonUnique
dr.Item("sNonUnique") = .sNonUnique
dr.EndEdit()
frm.dt.Rows.Add(dr)
End With
Next
End If
With frm
.dg.DataSource = .dt
.Show()
frm.Text = ClassDescription
End With
End Function
#End Region
#Region "Dispose"
Public Sub Dispose() Implements System.IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If disposing Then
' Free dependent objects
m_ArrayList = Nothing
End If
' Free un-managed resources
' No managed resource here.
' Must be thread-safe here.
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
End Sub
#End Region
End Class
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
I am a Houston, Texas based software developer and consultant specializing in .NET and database system development.
I work with SQL Server, Oracle, MySQL, along with VB6, C#, and VB.NET.
I have provided consulting services to companies in the Houston area and beyond for over twenty years.
I can be reached via jfirestone@jbfco.com