学步园

This user defined array class can be used for manipulating all kinds of operations on arrays.  Put the Array class given below in a script library (Declaration event) and name it as "CLASS : Array"

This user defined array class can be used for manipulating all kinds of operations on arrays.  Put the Array class given below in a script library (Declaration event) and name it as "CLASS : Array" Public Class ArrayClass

	
'Declare Public Sub Replace( ParamReplaceTo As String, ParamReplaceWith As String )
	
	Private Arr As Variant
	Private UpperBound As Integer
	Private LowerBound As Integer
	Private Index As Integer
	Public DB As NotesDatabase
	Public tmpDoc As NotesDocument
	
	Sub New()
		Dim sess As New NotesSession	
		Set Me.dB = sess.CurrentDatabase
		Set Me.tmpDoc = New NotesDocument( Me.dB )		
	End Sub
	
	Private Function Explode( ParamValues As Variant ) As Variant		
		Dim explodedList As Variant		
		Me.tmpDoc.Values = ParamValues
		explodedList = Evaluate( | @Explode( ( Values ); "," ) |, Me.tmpDoc )
		Explode = explodedList
	End Function
	
	Public Function Intialize( ParamValues As Variant ) As Variant		
		Dim tmpArray As Variant				
		Dim i As Integer
		
		If Trim$( ParamValues ) = "" Then
			Intialize = ""
			Exit Function
		End If		
		
		Me.Arr = Explode( ParamValues )
		Intialize = Me.Arr		
	End Function
	
	Private Function Size() As Integer
		Size = Ubound( Me.Arr )
	End Function
	
	Public Function GetUpperBound()

 

 

As Integer
GetUpperBound = Ubound( Me.Arr )
End Function

Public Function GetLowerBound() As Integer
GetLowerBound = Lbound( Me.Arr )
End Function

Public Function Add( ParamValue As Variant ) As Variant
Dim newArray As Variant
newArray = Explode( ParamValue )
Me.Arr = Arrayappend(Arr, newArray )
Add = Me.Arr
End Function

Public Function AppendArray( ParamNewArray As Variant ) As Variant
Me.Arr = Arrayappend( Arr, ParamNewArray )
AppendArray = Me.Arr
End Function

Public Function RemoveAll() As Integer

If Isarray( Me.Arr ) Then
Erase Me.Arr
RemoveAll = True
Exit Function
End If

RemoveAll = False

End Function

Public Function RemoveIndex( ParamPos As Integer) As Variant
Dim arrSize As Integer
Dim tmp As Variant

arrSize = Size()
If ParamPos <= arrSize Then
'whenever the arrSize is bigger than 100 then Evaluate is used otherwise the arrays are looped for better performance
If arrSize >100 Then
Me.Arr( ParamPos ) = ""
Me.tmpDoc.Values = Me.Arr
tmp = Evaluate( | @Trim( Values ) |, Me.tmpDoc )
Me.Arr = tmp
Else
Dim cnt As Integer
Dim tmpArray() As Variant
Redim tmpArray( Ubound( Me.Arr ) - 1 )
For i = 0 To Ubound( Me.Arr )
If ParamPos <> i Then
tmpArray( cnt ) = Me.Arr( i )
cnt = cnt + 1
End If
Next
Me.Arr = tmpArray
End If

End If

RemoveIndex = Me.Arr
End Function

Public Function TrimNull() As Variant
Dim arrSize As Integer
Dim tmpArray() As Variant
Dim cnt As Integer

arrSize = Size()

For i = 0 To Ubound( Me.Arr )
If Me.Arr( i ) <> "" Then
Redim Preserve tmpArray( cnt ) As Variant
tmpArray( cnt ) = Me.Arr( i )
cnt = cnt + 1
End If
Next

If cnt = 0 Then
Redim Preserve tmpArray(0) As Variant
tmpArray( 0 ) = ""
End If
Me.Arr = tmpArray

TrimNull = Me.Arr
End Function

Public Function TrimAll() As Variant
'This function "empty" entries, eliminates duplicate, trailing and leading spaces
On Error Goto err_Handler
Me.Arr = Fulltrim( Me.Arr )
TrimAll = Me.Arr
Exit Function
err_Handler:
'After full trim if there are no elements in the array then we create an array with null value
Dim tmpArr(0) As Variant
tmpArr(0) = ""
Me.Arr = tmpArr
TrimAll = Me.Arr
Resume ok_Exit
ok_Exit:
End Function

Public Function Replace( ParamReplaceTo As Variant, ParamReplaceWith As Variant ) As Variant
Dim replaceTo As Variant
Dim replaceWith As Variant
replaceTo = Explode( ParamReplaceTo )
replaceWith = Explode ( ParamReplaceWith )
Me.Arr = Arrayreplace( Me.Arr, replaceTo, replaceWith )
Replace = Me.Arr
End Function

Public Function ReplaceIndex( ParamPos As Integer, ParamValue As Variant ) As Variant
'This function replaces the value in an particular index with a new value
If ParamPos <= Size() Then
Dim tmpArray As Variant
tmpArray = Me.Arr
tmpArray( ParamPos ) = ParamValue
Me.Arr = tmpArray
ReplaceIndex = Me.Arr
End If
End Function

Public Function GetIndex( ParamSearchString As Variant, ParamCaseFlag ) As Integer
On Error Goto err_Handler
Dim compareMode As Integer
Dim matchFound As Integer
Select Case ParamCaseFlag
Case 0:
compareMode = 5
Case 1:
compareMode = 4
End Select
GetIndex = Arraygetindex( Me.Arr, ParamSearchString, compareMode )
Exit Function

err_Handler:
GetIndex = -1
Resume ok_Exit
ok_Exit:
End Function

Public Function InsertValue( ParamValue As Variant, ParamPos As Integer ) As Variant
Dim arrSize As Integer
Dim i As Integer
Dim cnt As Integer

arrSize = Size()

If ParamPos > arrSize Then
Me.Arr( arrSize + 1 ) = ParamValue
Else
Redim Preserve tmpArray( arrSize + 1 ) As Variant
For i = 0 To arrSize + 1

If ParamPos = i Then
tmpArray( i ) = ParamValue
Else
tmpArray( i ) = Me.Arr( cnt )
cnt = cnt +1
End If
Next
Me.Arr = tmpArray
End If

InsertValue = Me.Arr
End Function

Public Function Unique ( ) As Variant
tmpDoc.Values = Me.Arr
Me.Arr = Evaluate( | @Unique( Values ) |, tmpDoc )
Unique = Me.Arr
End Function

Public Function Extract( ParamNoOfEntries As Integer ) As Variant
Dim arrSize As Integer
Dim startFrom As Integer
Dim endWith As Integer

arrSize = Size()

If Abs( ParamNoOfEntries ) >= arrSize Or Abs( ParamNoOfEntries ) = 0 Then
Extract = Me.Arr
Exit Function
End If

If arrSize <= 100 Then
Dim i As Integer
Dim tmpArray() As Variant

If  ParamNoOfEntries > 0 Then
startFrom = 0
endWith =  ParamNoOfEntries
Else
startFrom = arrSize - ( Abs ( ParamNoOfEntries )  - 1 )
endWith = arrSize
End If

Dim cnt As Integer
For i = startFrom To endWith
Redim Preserve tmpArray( cnt ) As Variant
tmpArray( cnt ) = Me.Arr( i )
cnt = cnt + 1
Next
Me.Arr = tmpArray
End If
Extract = Me.Arr

End Function

End Class