VBspeed / Array / SliceLng
VBspeed © 2000-10, updated: 27-Nov-2001
SliceLng

The Definition
Function SliceLng
The Slice function creates a new array from a selected section of an array. The original array is unaffected. SliceLng does the job on arrays of Longs.
Declaration: 
Function SliceLng( _
    SourceArray() As Long, _
    TargetArray() As Long, _
    Optional ByVal Start As Long = 0, _
    Optional ByVal Count As Long = -1, _
    Optional ByVal Exclude As Boolean = False) _
As Boolean
Arguments:
SourceArrayRequired. One-dimensional array.
TargetArrayRequired. One-dimensional array that will hold the returned slice.
StartOptional. Start index of slice to be returned.
CountOptional. Number of elements in returned slice.
ExcludeOptional. If true the result is inverted: returned is the source array minus the specified sub-array.
(return)Function returns True if TargetArray is not empty.
Special Cases:
Count = 0
  if not Exclude
    return empty array
  else
    return SourceArray

Count < 0
  if not Exclude
    return Start to ubound(SourceArray)
  else
    return exclusion of (Start to ubound(SourceArray))

Start < lbound(SourceArray)
  set Start = lbound(SourceArray)

Start > ubound(SourceArray)
  if not Exclude
    TargetArray = empty array
  else
    TargetArray = SourceArray
Use this function (VB5/6-compatible) to verify the correctness of your code.


The Charts
Calls
 fRet = SliceLng(alSrc(), alTrg(), lStart, lCount, fExclude)
Call 1 alSrc(): array of longs with 100 elements
lStart = 50: lCount = 1: fExclude = False
Call 2 alSrc(): array of longs with 100 elements
lStart = 0: lCount = -1: fExclude = False
Call 3 alSrc(): array of longs with 10000 elements
lStart = 5000: lCount = 1: fExclude = False
Call 4 alSrc(): array of longs with 10000 elements
lStart = 0: lCount = -1: fExclude = False
 VB5
CodeAuthorDopingNotes
SliceLng01 Ratmoler  
SliceLng02 Ratmoler  
SliceLng03 Ratmoler  
Call 1
11.003.511µs
31.485.192µs
21.274.455µs
Call 2
31.498.530µs
21.126.419µs
11.005.713µs
Call 3
11.003.511µs
31.475.173µs
21.264.434µs
Call 4
31.67708µs
21.00424µs
11.00423µs
 VB6
CodeAuthorDopingNotes
SliceLng01 Ratmoler  
SliceLng02 Ratmoler  
SliceLng03 Ratmoler  
Call 1
11.003.375µs
31.645.532µs
21.485.011µs
Call 2
31.318.346µs
21.046.674µs
11.006.388µs
Call 3
11.003.012µs
31.685.059µs
21.544.637µs
Call 4
31.64698µs
21.00427µs
11.00425µs
Conclusions
Mail your code! How to read all those numbers


The Code
SliceLng01
submitted 13-Nov-2001 by Ratmoler Hamstak  
Doping: none
Public Function SliceLng01( _
    SourceArray() As Long, _
    TargetArray() As Long, _
    Optional ByVal Start As Long = 0, _
    Optional ByVal Count As Long = -1, _
    Optional ByVal Exclude As Boolean = False) _
As Boolean
' by Ratmoler HAMSTAK, hamstak@hotmail.com, 20011113

Dim lBoundSourceArray As Long
Dim uBoundSourceArray As Long

Dim lBoundTargetArray As Long
Dim uBoundTargetArray As Long

Dim Offset As Long

Dim lenTargetArray As Long

Dim x As Long

On Error GoTo exit_SliceLng01

    lBoundSourceArray = LBound(SourceArray)
    uBoundSourceArray = UBound(SourceArray)
    lBoundTargetArray = lBoundSourceArray

    If Start < lBoundSourceArray Then
        Start = lBoundSourceArray
    ElseIf Start > uBoundSourceArray Then
        If Exclude Then
            Exclude = False
            Start = lBoundSourceArray
            Count = uBoundSourceArray - lBoundSourceArray + 1
        Else
           Erase TargetArray
           Exit Function
        End If
    End If

    If Count < 0 Then
        Count = uBoundSourceArray - Start + 1
    ElseIf Count = 0 Then
        If Exclude Then
           Exclude = False
           Start = lBoundSourceArray
           Count = uBoundSourceArray - Start + 1
        Else
           Erase TargetArray
           Exit Function
        End If
    End If

    If Start + Count > uBoundSourceArray Then
        If Start = lBoundSourceArray Then
           If Exclude Then
               Erase TargetArray
               Exit Function
           Else
               Count = uBoundSourceArray - lBoundSourceArray + 1
           End If
        Else
            Count = uBoundSourceArray - Start + 1
        End If
    End If

    If Exclude Then

        uBoundTargetArray = uBoundSourceArray - Count

        ReDim TargetArray(lBoundTargetArray To uBoundTargetArray)

        If Start > lBoundSourceArray Then
            For x = lBoundSourceArray To Start - 1
                TargetArray(x) = SourceArray(x)
            Next
        End If

        If (Start + Count - 1) < uBoundSourceArray Then
            For x = Start To uBoundTargetArray
                TargetArray(x) = SourceArray(x + Count)
            Next
        End If

    Else    ' Specified segment (start,Count) to be returned

        Offset = Start - lBoundSourceArray

        uBoundTargetArray = lBoundSourceArray + Count - 1
        If uBoundTargetArray > uBoundSourceArray Or uBoundTargetArray < lBoundTargetArray Then
            uBoundTargetArray = uBoundSourceArray - Offset
        End If

        ReDim TargetArray(lBoundTargetArray To uBoundTargetArray)

        For x = lBoundTargetArray To uBoundTargetArray
            TargetArray(x) = SourceArray(x + Offset)
        Next

    End If

    SliceLng01 = True

exit_SliceLng01:

End Function
Author's comments:
Donald's comments:

top | charts


SliceLng02
submitted 24-Nov-2001 by Ratmoler Hamstak  
Doping: API (cf. Dope'n'Declarations) 
Public Function SliceLng02( _
    SourceArray() As Long, _
    TargetArray() As Long, _
    Optional ByVal Start As Long = 0, _
    Optional ByVal Count As Long = -1, _
    Optional ByVal Exclude As Boolean = False _
  ) As Boolean
  ' by Ratmoler HAMSTAK, hamstak@hotmail.com, 20011124
  
  Dim lBoundSourceArray As Long
  Dim uBoundSourceArray As Long
  
  Dim lBoundTargetArray As Long
  Dim uBoundTargetArray As Long
  
  Dim Offset As Long
  
  Dim lenTargetArray As Long
  
  Dim x As Long
  
  On Error GoTo exit_SliceLng02
  
  lBoundSourceArray = LBound(SourceArray)
  uBoundSourceArray = UBound(SourceArray)
  lBoundTargetArray = lBoundSourceArray
  
  If Start < lBoundSourceArray Then
    Start = lBoundSourceArray
  ElseIf Start > uBoundSourceArray Then
    If Exclude Then
      Exclude = False
      Start = lBoundSourceArray
      Count = uBoundSourceArray - lBoundSourceArray + 1
    Else
      Erase TargetArray
      Exit Function
    End If
  End If
  
  If Count < 0 Then
    Count = uBoundSourceArray - Start + 1
  ElseIf Count = 0 Then
    If Exclude Then
      Exclude = False
      Start = lBoundSourceArray
      Count = uBoundSourceArray - Start + 1
    Else
      Erase TargetArray
      Exit Function
    End If
  End If
  
  If Start + Count > uBoundSourceArray Then
    If Start = lBoundSourceArray Then
      If Exclude Then
        Erase TargetArray
        Exit Function
      Else
        Count = uBoundSourceArray - lBoundSourceArray + 1
      End If
    Else
      Count = uBoundSourceArray - Start + 1
    End If
  End If
  
  If Exclude Then
    
    uBoundTargetArray = uBoundSourceArray - Count
    
    ReDim TargetArray(lBoundTargetArray To uBoundTargetArray)
    
    If Start > lBoundSourceArray Then
      CopyMemory _
          ByVal VarPtr(TargetArray(lBoundTargetArray)), _
          ByVal VarPtr(SourceArray(lBoundSourceArray)), _
          VarPtr(SourceArray(Start)) - VarPtr(SourceArray(lBoundSourceArray))
    End If
    
    If (Start + Count - 1) < uBoundSourceArray Then
      CopyMemory _
          ByVal VarPtr(TargetArray(Start)), _
          ByVal VarPtr(SourceArray(Start + Count)), _
          VarPtr(TargetArray(uBoundTargetArray)) - VarPtr(TargetArray(Start)) + 4
    End If
    
  Else    ' Specified segment (start,Count) to be returned
    
    Offset = Start - lBoundSourceArray
    
    uBoundTargetArray = lBoundSourceArray + Count - 1
    If uBoundTargetArray > uBoundSourceArray Or uBoundTargetArray < lBoundTargetArray Then
      uBoundTargetArray = uBoundSourceArray - Offset
    End If
    
    ReDim TargetArray(lBoundTargetArray To uBoundTargetArray)
    
    CopyMemory _
        ByVal VarPtr(TargetArray(lBoundTargetArray)), _
        ByVal VarPtr(SourceArray(lBoundTargetArray + Offset)), _
        VarPtr(TargetArray(uBoundTargetArray)) - VarPtr(TargetArray(lBoundTargetArray)) + 4
    
  End If
  
  SliceLng02 = True
  
exit_SliceLng02:
  
End Function
Author's comments :
Donald's comments :

top | charts


SliceLng03
submitted 27-Nov-2001 by Ratmoler Hamstak  
Doping: API (cf. Dope'n'Declarations) 
Public Function SliceLng03( _
    SourceArray() As Long, _
    TargetArray() As Long, _
    Optional ByVal Start As Long = 0, _
    Optional ByVal Count As Long = -1, _
    Optional ByVal Exclude As Boolean = False) _
    As Boolean
' by Ratmoler HAMSTAK, hamstak@hotmail.com, 20011127
  
  Dim lBoundSourceArray As Long
  Dim uBoundSourceArray As Long
  Dim lBoundTargetArray As Long
  Dim uBoundTargetArray As Long
  
  Dim ptrSourceArray1 As Long
  Dim ptrSourceArray2 As Long
  Dim ptrTargetArray1 As Long
  Dim ptrTargetArray2 As Long
  
  Dim lngLengthSegment1 As Long
  Dim lngLengthSegment2 As Long
  
  On Error GoTo exit_SliceLng03
  
  lBoundSourceArray = LBound(SourceArray)
  uBoundSourceArray = UBound(SourceArray)
  
  If Exclude Then
    
    If Count < 0 Then Count = uBoundSourceArray - lBoundSourceArray + 1
    
    If Start > lBoundSourceArray Then
      ptrSourceArray1 = VarPtr(SourceArray(lBoundSourceArray))
      If Start + Count - 1 < uBoundSourceArray Then
        lngLengthSegment1 = VarPtr(SourceArray(Start)) - ptrSourceArray1
        ptrSourceArray2 = ptrSourceArray1 + lngLengthSegment1 + (Count * 4)
        lngLengthSegment2 = VarPtr(SourceArray(uBoundSourceArray)) - ptrSourceArray2 + 4
      Else
        If Start > uBoundSourceArray Then
          lngLengthSegment1 = VarPtr(SourceArray(uBoundSourceArray)) - ptrSourceArray1 + 4
        Else
          lngLengthSegment1 = VarPtr(SourceArray(Start)) - ptrSourceArray1
        End If
      End If
    Else
      If lBoundSourceArray + Count > uBoundSourceArray Then
        Erase TargetArray
        Exit Function
      Else
        ptrSourceArray1 = VarPtr(SourceArray(lBoundSourceArray + Count))
        lngLengthSegment1 = VarPtr(SourceArray(uBoundSourceArray)) - ptrSourceArray1 + 4
      End If
    End If
    
    Count = (lngLengthSegment1 + lngLengthSegment2) \ 4
    uBoundTargetArray = lBoundTargetArray + Count - 1
    
  Else
    
    If Count = 0 Or Start > uBoundSourceArray Then
      Erase TargetArray
      Exit Function
    End If
    
    If Start > lBoundSourceArray Then
      ptrSourceArray1 = VarPtr(SourceArray(Start))
    Else
      Start = lBoundSourceArray
      ptrSourceArray1 = VarPtr(SourceArray(lBoundSourceArray))
    End If
    
    If Start + Count > uBoundSourceArray Or Count < 0 Then
      Count = uBoundSourceArray - Start + 1
    End If
    
    uBoundTargetArray = lBoundTargetArray + Count - 1
    lngLengthSegment1 = Count * 4
    
  End If
  
  lBoundTargetArray = lBoundSourceArray
  
  ReDim TargetArray(lBoundTargetArray To uBoundTargetArray)
  
  ptrTargetArray1 = VarPtr(TargetArray(lBoundTargetArray))
  
  CopyMemory _
      ByVal ptrTargetArray1, _
      ByVal ptrSourceArray1, _
      lngLengthSegment1
  
  If lngLengthSegment2 > 0 Then
    
    ptrTargetArray2 = ptrTargetArray1 + lngLengthSegment1
    
    CopyMemory _
        ByVal ptrTargetArray2, _
        ByVal ptrSourceArray2, _
        lngLengthSegment2
    
  End If
  
  SliceLng03 = True
  
exit_SliceLng03:
  
End Function
Author's comments :
Donald's comments :

top | charts



VBspeed © 2000-10 by Donald Lessau