VBspeed / VB6 to VB5 / Filter
VBspeed © 2000-10, updated: 25-Sep-2000
Filter


The Definition
Function Filter
Returns a zero-based array containing a subset of a string array based on a specified filter criteria.
Native to VB6, but not to VB5.
Declaration:
Filter(SourceArray, Match[, Include[, Compare]])
Arguments:
SourceArrayRequired. One-dimensional array of strings to be searched.
MatchRequired. String to search for.
The comparison is True if Match is the same or part of SourceArray(index).
IncludeOptional. Boolean value indicating whether to return substrings that include or exclude Match. If Include is True, Filter returns the subset of the array that contains Match as a substring. If Include is False, Filter returns the subset of the array that does not contain Match as a substring.
By default, Include is set to True.
CompareOptional. Numeric value indicating the kind of string comparison to use.
Remarks:
It's tricky to emulate Filter in VB5 since VB5 functions cannot return arrays. The nearest you can get is to return a Variant that *holds* an array. This works well, but you won't be happy with a Variant array when you're out for speed.
It's much easier and much faster to redesign Filter as to return its results in an array argument. Therefore i propose a 2nd definition below, FilterB.
Function FilterB
Returns a zero-based array containing a subset of a string array based on a specified filter criteria. This array is returned in an argument.
The function itself returns Ubound(TargetArray), or -1 if TargetArray is not bound (empty array) which is the case if no matches have been found.
Declaration:
Filter(SourceArray, Match, TargetArray[, Include[, Compare]])
Arguments:
SourceArrayRequired. One-dimensional array of strings to be searched.
TargetArrayRequired. One-dimensional array of strings that will hold the returned substrings.
Does not have to be bound before calling FilterB.
If no matches have been found, TargetArray is returned empty (ie. erased, unbound).
MatchRequired. String to search for.
The comparison is True if Match is the same or part of SourceArray(index).
IncludeOptional. Boolean value indicating whether to return substrings that include or exclude Match. If Include is True, TargetArray returns the subset of the array that contains Match as a substring. If Include is False, TargetArray returns the subset of the array that does not contain Match as a substring.
By default, Include is set to True.
CompareOptional. Numeric value indicating the kind of string comparison to use.
You may use this function (VB5/6-compatible) to verify the correctness of your emulation code.


The Charts
Calls
  Filter VB6: TargetArray = Filter(SourceArray, Match)
FilterB: lRet = FilterB(SourceArray, Match, TargetArray)
Call 1 SourceArray = array of 1000 elements containing the numbers from 1 thru 1000 (as strings)
Match = "9" (by the way, 271 elements containing the digit 9 will be found)
 VB5
CodeAuthorDopingNotes
FilterVB6  
FilterB01 Donald  
FilterB02 Keith  
Call 1
   
21.011,305Ás
11.001,288Ás
 VB6
CodeAuthorDopingNotes
Filter VB6  
FilterB01 Donald  
FilterB02 Keith  
Call 1
31.562,143Ás
21.001,380Ás
11.001,373Ás
Notes & Conclusions
Wasn't too hard to beat VB6's native Filter. Very tight race between FilterB01 and FilterB02, the differenes are too small to be significant.
Note that in IDE FilterB02 is clearly faster, but P-Code doesn't count, right?
Mail your code! How to read all those numbers


The Code
FilterB01
submitted 19-Sep-2000 by Donald Lessau  
Doping: none
Public Function FilterB01(SourceArray() As String, _
    Match As String, _
    TargetArray() As String, _
    Optional Include As Boolean = True, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As Long

' by Donald, donald@xbeat.net, 20000918
' returns Ubound(TargetArray), or -1 if TargetArray is not bound (empty array)
    
    Dim i As Long
    
    ' make maximal space
    ReDim TargetArray(UBound(SourceArray) - LBound(SourceArray))
    
    FilterB01 = -1
    
    For i = LBound(SourceArray) To UBound(SourceArray)
      If Len(SourceArray(i)) Then
        If Include = CBool(InStr(1, SourceArray(i), Match, Compare)) Then
          FilterB01 = FilterB01 + 1
          TargetArray(FilterB01) = SourceArray(i)
        End If
      Else
        ' we want a match if Source and Match are both ""
        ' but InStr does not work on zero-length strings, so:
        If Include = Not CBool(Len(Match)) Then
          FilterB01 = FilterB01 + 1
          ' is "" anyway, so we spare this line:
          ''TargetArray(FilterB01) = SourceArray(i)
        End If
      End If
    Next
    
    ' erase or shrink
    If FilterB01 = -1 Then
      Erase TargetArray
    Else
      ReDim Preserve TargetArray(FilterB01)
    End If
    
End Function
Author's comments :
Donald's comments :

top | charts


FilterB02
submitted 25-Sep-2000 by Keith Matzen  
Doping: none
Public Function FilterB02(sSourceArray() As String, _
                          sMatch As String, _
                          sTargetArray() As String, _
                          Optional bInclude As Boolean = True, _
                          Optional lCompare As VbCompareMethod = vbBinaryCompare) As Long
 
' by Donald, donald@xbeat.net, 20000918
' Modified by Keith, kmatzen@ispchannel.com
' returns Ubound(sTargetArray), or -1 if sTargetArray is not bound (empty array)
    
   Dim lNdx      As Long
   Dim lLo       As Long
   Dim lHi       As Long
   Dim lLenMatch As Long
   
   lLenMatch = Len(sMatch)
   lLo = LBound(sSourceArray)
   lHi = UBound(sSourceArray)
   ReDim sTargetArray(lHi - lLo) 'make maximal space
   
   FilterB02 = -1
   
   If lLenMatch Then
      If bInclude Then              'Need a match
         For lNdx = lLo To lHi
            If Len(sSourceArray(lNdx)) >= lLenMatch Then
               If InStr(1, sSourceArray(lNdx), sMatch, lCompare) Then
                  FilterB02 = FilterB02 + 1
                  sTargetArray(FilterB02) = sSourceArray(lNdx)
               End If
            End If
         Next
      Else                          'Need a mismatch
         For lNdx = lLo To lHi
            Select Case Len(sSourceArray(lNdx))
               Case Is < lLenMatch 'Can't match
                  FilterB02 = FilterB02 + 1
                  sTargetArray(FilterB02) = sSourceArray(lNdx)
               Case Else
                  If InStr(1, sSourceArray(lNdx), sMatch, lCompare) = 0 Then
                     FilterB02 = FilterB02 + 1
                     sTargetArray(FilterB02) = sSourceArray(lNdx)
                  End If
            End Select
         Next
      End If
   ElseIf bInclude Then             'Include all
      For lNdx = lLo To lHi
         FilterB02 = FilterB02 + 1
         sTargetArray(FilterB02) = sSourceArray(lNdx)
      Next
   End If
   
   ' erase or shrink
   If FilterB02 = -1 Then
      Erase sTargetArray
   Else
      ReDim Preserve sTargetArray(FilterB02)
   End If
    
End Function
Author's comments :
Donald's comments :

top | charts




VBspeed © 2000-10 by Donald Lessau