BitVector Library That Uses Simple Array of Longs

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Intermediate

Author: David Qualls

Version Compatibility: Visual Basic 6

More information:

This module and list of functions are designed for use with databases, but works anywhere an array of Longs is simpler to use than a full-blown class. Includes a complete selection of functions: get, set, clear, toggle, Xor, And, Or, toString, toBits, more. Also includes functions to prevent bit-scrambling while converting negative values. Thoroughly documented in comments.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Public bitsInitialized As Boolean Public Const SNOBITS As Integer = 0 Public Const SBIT0 As Integer = 1 Public Const SBIT1 As Integer = SBIT0 * 2 Public Const SBIT2 As Integer = SBIT1 * 2 Public Const SBIT3 As Integer = SBIT2 * 2 Public Const SBIT4 As Integer = SBIT3 * 2 Public Const SBIT5 As Integer = SBIT4 * 2 Public Const SBIT6 As Integer = SBIT5 * 2 Public Const SBIT7 As Integer = SBIT6 * 2 Public Const SBIT8 As Integer = SBIT7 * 2 Public Const SBIT9 As Integer = SBIT8 * 2 Public Const SBIT10 As Integer = SBIT9 * 2 Public Const SBIT11 As Integer = SBIT10 * 2 Public Const SBIT12 As Integer = SBIT11 * 2 Public Const SBIT13 As Integer = SBIT12 * 2 Public Const SBIT14 As Integer = SBIT13 * 2 Public Const SBIT15 As Integer = (Not 0) And (Not _ (SBIT0 Or SBIT1 Or SBIT2 Or SBIT3 Or SBIT4 Or SBIT5 Or SBIT6 Or SBIT7 Or _ SBIT8 Or SBIT9 Or SBIT10 Or SBIT11 Or SBIT12 Or SBIT13 Or SBIT14)) Public Const NOBITS As Long = 0 Public Const BIT0 As Long = 1 Public Const BIT1 As Long = BIT0 * 2 Public Const BIT2 As Long = BIT1 * 2 Public Const BIT3 As Long = BIT2 * 2 Public Const BIT4 As Long = BIT3 * 2 Public Const BIT5 As Long = BIT4 * 2 Public Const BIT6 As Long = BIT5 * 2 Public Const BIT7 As Long = BIT6 * 2 Public Const BIT8 As Long = BIT7 * 2 Public Const BIT9 As Long = BIT8 * 2 Public Const BIT10 As Long = BIT9 * 2 Public Const BIT11 As Long = BIT10 * 2 Public Const BIT12 As Long = BIT11 * 2 Public Const BIT13 As Long = BIT12 * 2 Public Const BIT14 As Long = BIT13 * 2 Public Const BIT15 As Long = BIT14 * 2 Public Const BIT16 As Long = BIT15 * 2 Public Const BIT17 As Long = BIT16 * 2 Public Const BIT18 As Long = BIT17 * 2 Public Const BIT19 As Long = BIT18 * 2 Public Const BIT20 As Long = BIT19 * 2 Public Const BIT21 As Long = BIT20 * 2 Public Const BIT22 As Long = BIT21 * 2 Public Const BIT23 As Long = BIT22 * 2 Public Const BIT24 As Long = BIT23 * 2 Public Const BIT25 As Long = BIT24 * 2 Public Const BIT26 As Long = BIT25 * 2 Public Const BIT27 As Long = BIT26 * 2 Public Const BIT28 As Long = BIT27 * 2 Public Const BIT29 As Long = BIT28 * 2 Public Const BIT30 As Long = BIT29 * 2 Public Const BIT31 As Long = (Not 0) And (Not _ (BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Or BIT5 Or BIT6 Or BIT7 Or _ BIT8 Or BIT9 Or BIT10 Or BIT11 Or BIT12 Or BIT13 Or BIT14 Or BIT15 Or _ BIT16 Or BIT17 Or BIT18 Or BIT19 Or BIT20 Or BIT21 Or BIT22 Or BIT23 Or _ BIT24 Or BIT25 Or BIT26 Or BIT27 Or BIT28 Or BIT29 Or BIT30)) Private Const BITS0thru4 As Long = BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Private Const BITS0thru7 As Long = BIT0 Or BIT1 Or BIT2 Or BIT3 Or BIT4 Or BIT5 Or BIT6 Or BIT7 Private Const BITS8thru15 As Long = BIT8 Or BIT9 Or BIT10 Or BIT11 Or BIT12 Or BIT13 Or BIT14 Or BIT15 Private Const BITS16thru23 As Long = BIT16 Or BIT17 Or BIT18 Or BIT19 Or BIT20 Or BIT21 Or BIT22 Or BIT23 Private Const BITS24thru31 As Long = BIT24 Or BIT25 Or BIT26 Or BIT27 Or BIT28 Or BIT29 Or BIT30 Or BIT31 Public Const BYTE0 As Long = BITS0thru7 Public Const BYTE1 As Long = BITS8thru15 Public Const BYTE2 As Long = BITS16thru23 Public Const BYTE3 As Long = BITS24thru31 Private Const strOne As String = "1" Public Bits(31) As Long Public SBits(15) As Integer Private testbitvect() As Long Private testbitvect2() As Long

Code:

Option Compare Binary
Option Explicit

' bits: A simple bitvector and bits conversion library.  The functions within
' this library allow an array of 32-Bit Ints to be treated as a bit vector.
'
' keywords: bit bits vector vectors bitvector bitvectors VB VBA VB-6.0 Visual Basic Applications VisualBasic
'
' David Qualls
' davidlqualls@yahoo.com
' August 2006
'
' Within this file, there are public definitions for:
' -  33 BITx constants (BIT0 thru BIT31 plus NOBITS), all of 32-bit integer type.
' -  4 BYTEx constants (BYTE0 thru BYTE3), all of 32-bit integer type.
' -  17 SBITx constants (SBIT0 thru SBIT15 plus SNOBITS), all of 16-bit (Short)integer type.
' -  One 32-bit integer array of single-bit values.
' -  One 16-bit integer array of single-bit values.
' -  The following functions:
' ----- single bit functions -----
'CAUTION: The single bit functions return either zero, or NON-ZERO.
'They DO NOT normally return 1 (unity).  Always test for non-zero;
'never for unity:
'RIGHT: "If _bit() Then"
'WRONG: "If _bit() = 1 Then"
' getbit      (bitvect() As Long, posn As Long) As Long
' setbit      (bitvect() As Long, posn As Long) As Long
' clearbit    (bitvect() As Long, posn As Long) As Long
' togglebit   (bitvect() As Long, posn As Long) As Long
' ----- all bits functions -----
' bitsClearAll(bitvect() As Long)
' bitsSetAll  (bitvect() As Long)
' bitsOrEq    (altered() As Long, source() As Long)
' bitsAndEq   (altered() As Long, source() As Long)
' bitsXorEq   (altered() As Long, source() As Long)
' bitsCompare (bv1() As Long, bv2() As Long) As Long
' bits2string (bitvect() As Long) As String
' string2bits (bitvect() As Long, bstr As String) As Long()
' ----- single integer functions -----
' promoteSBits(shortValue As Integer) As Long
' demoteHighBits(longValue As Long) As Integer
' demoteLowBits(longValue As Long) As Integer
' ----- information functions -----
' highestbit  (bitvect() As Long) As Long
' lowestbit   (bitvect() As Long) As Long
' ----- test function -----
' test_bits()
'
' Two private support functions are also defined here:
' bitsBinarySearch_Long(ByVal key As Long, realarray() As Long, ByVal nelem As Long) As Long
' intbits2string(intbit As Long) As String
'
' Prior to using any of these functions, the initialization function
' initializeBits() should (or must, depending on the function) be
' called one time.  The bitsInitialized public variable is available to
' test whether the initialization function has been called.  By using
' the construct:
'    If Not bitsInitialized Then Call initializeBits
' you can prevent re-loading the initialization function frequently.
'
' Bit vectors begin with BIT0, not BIT1.  All bits OFF is the constant
' NOBITS.  Higher order bits (BIT1 is higher order than BIT0, etc.)
' are numerically more significant (BIT1 > BIT0, etc.)  This affects
' the way bitsCompare() works.
'
' There are two requirements of the array of longs passed to any of these
' functions as the bitvect:
' 1: bitvect must not be zero length.  Thus, it must be Dimensioned (or
'    ReDimensioned) before  being passed to the function.
' 2: bitvect must be zero based (the first element must be at index zero).
' And there are two requirements of the 'bit-position' argument:
' 1: posn must not be negative (zero is fine however).
' 2: If bitvect is a static array, posn must never equal or exceed
'    32*(UBound(bitvect)+1) (although getbit() will succeed even if
'    posn is too large -- it just returns 0)
'
' Generally, bitvectors automatically expand to accomodate the action being
' taken on them.  Only the bit-altering functions (setbit, clearbit,
' togglebit, bitsOrEQ, bitsAndEq, and bitsXorEq, string2bits) automatically
' increase the length of a bit vector.  You are also free to alter the length
' yourself with no ill effects.
'
' In a class approach, we would store extra information about the bit array,
' and perhaps dynamically shorten it as appropriate.  This however would
' negate the advantages of being able to polymorphically treat an array of
' integers as a bit-vector.  To reduce the storage of a bit-vector, use:
'    If KeepMyBitVectorsShort = True Then
'       ReDim Preserve bitvect(0 To (highestbit(bitvect) \ 32))
'    End If
'

Sub initializeBits()
'{
   If bitsInitialized Then Exit Sub
   
   bitsInitialized = True
   
   SBits(0) = SBIT0
   SBits(1) = SBIT1
   SBits(2) = SBIT2
   SBits(3) = SBIT3
   SBits(4) = SBIT4
   SBits(5) = SBIT5
   SBits(6) = SBIT6
   SBits(7) = SBIT7
   SBits(8) = SBIT8
   SBits(9) = SBIT9
   SBits(10) = SBIT10
   SBits(11) = SBIT11
   SBits(12) = SBIT12
   SBits(13) = SBIT13
   SBits(14) = SBIT14
   SBits(15) = SBIT15
   
   Bits(0) = BIT0
   Bits(1) = BIT1
   Bits(2) = BIT2
   Bits(3) = BIT3
   Bits(4) = BIT4
   Bits(5) = BIT5
   Bits(6) = BIT6
   Bits(7) = BIT7
   Bits(8) = BIT8
   Bits(9) = BIT9
   Bits(10) = BIT10
   Bits(11) = BIT11
   Bits(12) = BIT12
   Bits(13) = BIT13
   Bits(14) = BIT14
   Bits(15) = BIT15
   Bits(16) = BIT16
   Bits(17) = BIT17
   Bits(18) = BIT18
   Bits(19) = BIT19
   Bits(20) = BIT20
   Bits(21) = BIT21
   Bits(22) = BIT22
   Bits(23) = BIT23
   Bits(24) = BIT24
   Bits(25) = BIT25
   Bits(26) = BIT26
   Bits(27) = BIT27
   Bits(28) = BIT28
   Bits(29) = BIT29
   Bits(30) = BIT30
   Bits(31) = BIT31
'}
End Sub 'initializeBits

Function getbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Returns zero if the indicated bit is off, NON-ZERO if on.

Dim indx As Long
   Dim ofst As Long
   
   indx = posn \ 32    ' Hopefully, basic is smart enough to convert this to posn >> 5
'  ofst = posn MOD 32
   ofst = posn And BITS0thru4
   
   If indx <= UBound(bitvect) Then
      getbit = bitvect(indx) And Bits(ofst)
   Else
      getbit = 0
   End If
'}
End Function 'getbit

Function setbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Sets indicated bit to one, or ON.
'  Returns the ORIGINAL bit status (zero or non-zero).

Dim indx As Long
   Dim ofst As Long
   
   indx = posn \ 32    ' Hopefully, basic is smart enough to convert this to posn >> 5
'  ofst = posn MOD 32
   ofst = posn And BITS0thru4
   
   If indx > UBound(bitvect) Then
      ReDim Preserve bitvect(0 To indx)
      bitvect(indx) = Bits(ofst)     ' turn bit on.
      setbit = 0                     ' previous value was definitely off.
   Else
      setbit = bitvect(indx) And Bits(ofst)        'get the current bit value
      bitvect(indx) = bitvect(indx) Or Bits(ofst)  'turn the bit ON
   End If
'}
End Function 'setbit

Function togglebit(bitvect() As Long, ByVal posn As Long) As Long
'{ Toggles the indicated bit.  OFF goes to ON, ON goes to OFF.
'  Returns the ORIGINAL bit status (zero or non-zero).

Dim indx As Long
   Dim ofst As Long
   
   indx = posn \ 32    ' Hopefully, basic is smart enough to convert this to posn >> 5
'  ofst = posn MOD 32
   ofst = posn And BITS0thru4
   
   If indx > UBound(bitvect) Then    ' bit is assumed off, need to set it.
      ReDim Preserve bitvect(0 To indx)
      bitvect(indx) = Bits(ofst)     ' was off, so turn it on.
      togglebit = 0                  ' previous value was definitely off.
   Else
      togglebit = bitvect(indx) And Bits(ofst)     'get the current bit value
      bitvect(indx) = bitvect(indx) Xor Bits(ofst) 'toggle the bit.
   End If
'}
End Function 'togglebit

Function clearbit(bitvect() As Long, ByVal posn As Long) As Long
'{ Sets indicated bit to zero, or OFF.
'  Returns the ORIGINAL bit status (zero or non-zero).

Dim indx As Long
   Dim ofst As Long
   
   indx = posn \ 32    ' Hopefully, basic is smart enough to convert this to posn >> 5
'  ofst = posn MOD 32
   ofst = posn And BITS0thru4
   
   If indx > UBound(bitvect) Then
      ReDim Preserve bitvect(0 To indx)
      clearbit = 0                   ' previous value was definitely off.
   Else
      clearbit = bitvect(indx) And Bits(ofst)      'get the current bit value
      bitvect(indx) = bitvect(indx) And (Not Bits(ofst)) 'turn the bit OFF
   End If
'}
End Function 'clearbit

Function highestbit(bitvect() As Long) As Long
'{ This function returns the most-significant on-bit of bitvect.
'  A value of -1 indicates no bits are on.

Dim indx  As Long
   Dim ofst  As Long
   Dim bvndx As Long
   
 ' Linearly search for the last (highest order) element in bitvect array
 ' with a non-zero value (at least one bit ON).
   indx = UBound(bitvect) + 1
   Do While indx <> 0
      indx = indx - 1
      If bitvect(indx) <> 0 Then Exit Do
   Loop
   bvndx = bitvect(indx)
   
   If bvndx = 0 Then          'exited naturally from the Do-loop above.
      highestbit = -1         'No bits are on.
      Exit Function
   ElseIf bvndx And BIT31 Then 'the sign bit is on. Would hose the bsearch algorithm!
      ofst = 31
   Else  ' a linear search will require 15.5 comparisons (on average).
         ' a binary search will require about 3.91 comparisons (on average).
         ' This difference probably justifies the function call and
         ' additional overhead of using a binary search.
      ofst = bitsBinarySearch_Long(bvndx, Bits, 31) ' don't include BIT31; can cause overflow!
      If Bits(ofst) <> bvndx Then ofst = ofst - 1
   End If
   
   highestbit = indx * 32 + ofst
'}
End Function 'highestbit

Function lowestbit(bitvect() As Long) As Long
'{ This function returns the least-significant on-bit of bitvect.
'  A value of -1 indicates no bits are on.

Dim indx    As Long
   Dim ofst    As Long
   Dim bytebit As Long
   Dim lval    As Long
   Dim bmask   As Long
   
 ' Linearly search for the first (lowest order) element in bitvect array
 ' with a non-zero value (at least one bit ON).
   indx = -1
   Do While indx < UBound(bitvect)
      indx = indx + 1
      If bitvect(indx) <> 0 Then Exit Do
   Loop
   lval = bitvect(indx)
   
   If lval = 0 Then      'exited naturally from the Loop above.
      lowestbit = -1     'No bits are on.
      Exit Function
   End If
   
 ' We have found an INT that has at least one bit on.  Locate that bit...
 ' Begin with a binary search for lowest order byte.
   If lval And (BYTE1 Or BYTE0) Then 'bit(s) are on in the low word.
  '{
      If lval And BYTE0 Then 'bit(s) are on in the low byte.
         bmask = BIT0
         ofst = 0
      Else                   'bit(s) must be in the high byte.
         bmask = BIT8
         ofst = 8
      End If
  '}
   Else                              'bit(s) must be in the high word.
  '{
      If lval And BYTE2 Then 'bit(s) are on in the low byte.
         bmask = BIT16
         ofst = 16
      Else                   'bit(s) must be in the high byte.
         bmask = BIT24
         ofst = 24
      End If
  '}
   End If
 ' and end with a linear search for lowest order bit within appropriate byte.
   For bytebit = 0 To 5                     '6 iterations
    ' If lval And BITS(ofst) Then Goto GOT_OFST  ' TOO SLOW.  multiplication is faster than array-lookup.
      If lval And bmask Then GoTo GOT_OFST  'skip the after-loop section.
      bmask = bmask * 2                     'would run-time error on iteration 7 if ofst=24!
   Next bytebit
 ' after-loop section.  Now bmask == BIT6, OR BIT14, OR BIT22, OR BIT30
   If lval And bmask Then     '7'th attempt. bmask is already in a register. Use it!
      bytebit = 6
   Else                       'We know it's not zero.  Only one possibility left!
      bytebit = 7
   End If
   
GOT_OFST:
   lowestbit = indx * 32 + ofst + bytebit
'}
End Function 'lowestbit

Function bitsClearAll(bitvect() As Long)
'{
   Dim indx As Long
   
 ' If For loops can truly run faster than this, then, well, I apologize
 ' for my thick-headedness.  I just can't seem to figure the semantics
 ' for both USING the index, AND comparing it to zero (which maps directly
 ' to a "jnz" machine instruction) from within a For-Next loop.
   indx = UBound(bitvect) + 1
   Do While indx <> 0
      indx = indx - 1
      bitvect(indx) = NOBITS
   Loop
'}
End Function

Function bitsSetAll(bitvect() As Long)
'{
   Dim indx As Long
   
   indx = UBound(bitvect) + 1
   Do While indx <> 0
      indx = indx - 1
      bitvect(indx) = Not NOBITS
   Loop
'}
End Function

Function bitsCompare(bv1() As Long, bv2() As Long) As Long
'{ Returns: a negative value if bv1 is numerically less than bv2,
'         : zero if bv1 is numerically equal to bv2,
'         : a positive value if bv1 is numerically greater than bv2,
'
   Dim indx1  As Long
   Dim indx2  As Long
   
   indx1 = UBound(bv1)
   indx2 = UBound(bv2)
   
   Do While indx1 > indx2
      If bv1(indx1) <> NOBITS Then 'bv1 > bv2
         bitsCompare = 1
         Exit Function
      End If
      indx1 = indx1 - 1
   Loop
   
   Do While indx2 > indx1
      If bv2(indx2) <> NOBITS Then 'bv2 > bv1
         bitsCompare = -1
         Exit Function
      End If
      indx2 = indx2 - 1
   Loop
 ' Now the two indices are equal. Arbitrarily pick indx1 to use.
 ' Look for the highest order elements that are not equal.
   Do
      If bv1(indx1) <> bv2(indx1) Then GoTo COMPARE_LONGS
      indx1 = indx1 - 1
   Loop While indx1 >= 0
 ' Normal exit: looped thru the entire array, and every element compared equal.
   bitsCompare = 0
   Exit Function
   
COMPARE_LONGS:
   If (bv1(indx1) And BIT31) Xor (bv2(indx1) And BIT31) Then 'they differ in BIT31
      If bv2(indx1) And BIT31 Then 'BIT31 of bv1 must have been OFF.
         bitsCompare = -1          'bv2 is greater.
      Else                         'BIT31 of bv2 is OFF.
         bitsCompare = 1           'bv1 is greater.
      End If
      Exit Function
   End If
 ' Now that the sign bit is handled, the rest is duck-soup since both
 ' values should be positive.  Granted this does ASSUME that 00000 - 01111
 ' (but with 32 bits, not 5) does not overflow.  Works fine in 2's complement.
 ' If unsure, just use the commented-out stuff INSTEAD OF the last line.
 
 ' If bv1(indx1) < bv2(indx1) Then
 '    bitsCompare = -1
 ' ElseIf bv1(indx1) > bv2(indx1) Then
 '    bitsCompare = 1
 ' Else                    ' bv1(indx1) == bv2(indx1)
 '    bitsCompare = 0
 ' End If
   
   bitsCompare = bv1(indx1) - bv2(indx1)
'}
End Function 'bitsCompare

Function bitsOrEq(bv1() As Long, bv2() As Long)
'{ Bitwise ORs bv1 and bv2 together, and stores the result in bv1

Dim ndx As Long
   Dim ub2 As Long
   
   ub2 = UBound(bv2)
   
   If UBound(bv1) < ub2 Then ReDim Preserve bv1(ub2)
   
  'Might benefit from a minlen analysis as in bitsXorEq, but this works.
   For ndx = 0 To ub2
      bv1(ndx) = bv1(ndx) Or bv2(ndx) 'past minlen is equivalent to: bv1(ndx) = bv2(ndx)
   Next ndx
'}
End Function 'bitsOrEq

Function bitsAndEq(bv1() As Long, bv2() As Long)
'{ Bitwise ANDs bv1 and bv2 together, and stores the result in bv1

Dim ndx As Long
   Dim minlen As Long 'lesser of the two vector lengths.
   Dim ub1 As Long, ub2 As Long
   
   ub1 = UBound(bv1)
   ub2 = UBound(bv2)
   
   If ub1 < ub2 Then
      minlen = ub1
      ReDim Preserve bv1(ub2) 'make bv1 same length as bv2
   Else
      minlen = ub2
   End If
   
   For ndx = 0 To minlen
      bv1(ndx) = bv1(ndx) And bv2(ndx)
   Next ndx
   
   If ub1 > minlen Then
      For ndx = ndx To ub1
         bv1(ndx) = NOBITS
      Next ndx
   End If
'}
End Function 'bitsAndEq

Function bitsXorEq(bv1() As Long, bv2() As Long)
'{ Bitwise XORs bv1 and bv2 together, and stores the result in bv1

Dim ndx As Long
   Dim minlen As Long 'lesser of the two vector lengths.
   Dim ub1 As Long, ub2 As Long
   
   ub1 = UBound(bv1)
   ub2 = UBound(bv2)
   
   If ub1 < ub2 Then
      minlen = ub1
      ReDim Preserve bv1(ub2) 'make bv1 same length as bv2
   Else
      minlen = ub2
   End If
   
   For ndx = 0 To minlen
      bv1(ndx) = bv1(ndx) Xor bv2(ndx)
   Next ndx
   
   If ub2 > minlen Then
      For ndx = ndx To ub2
         bv1(ndx) = bv2(ndx)
      Next ndx
   End If
'}
End Function 'bitsXorEq

Private Function intbits2string(intbit As Long) As String
'{
   Dim i As Long
   Dim bmask As Long
   
   intbits2string = "00000000000000000000000000000000"
   
   bmask = BIT0
   For i = 32 To 3 Step -1
      If intbit And bmask Then Mid(intbits2string, i, 1) = strOne
      bmask = bmask * 2 'this would throw an exception the 31'st time.
                        'multiplication is faster than retreiving values from BITS array.
   Next i
   If intbit And bmask Then Mid(intbits2string, 2, 1) = strOne
   If intbit And BIT31 Then Mid(intbits2string, 1, 1) = strOne
'}
End Function 'intbits2string

Function bits2string(bitvect() As Long) As String
'{
   Dim i As Long
   
   For i = UBound(bitvect) To 0 Step -1
      bits2string = bits2string & intbits2string(bitvect(i))
   Next i
'}
End Function

Function string2bits(bitvect() As Long, bstr As String) As Long()
'{ Converts a string of "1"s and "0"s (actually, any non-1's are treated as
'  zeros) into a bit vector and stores it in bitvect.  Most significant bits
'  appear leftmost within bstr.  bitvect must be dynamic (available for ReDim)
'  unless bstr will fit within the available length of bitvect.
'
'  Returns bitvect().

Dim indx As Long  'within bitvect
   Dim ofst As Long  'within each Long in bitvect
   Dim posn As Long  'within the input string bstr
   Dim lval As Long  'a long valued utility
'   Dim digit As String
   
   posn = Len(bstr) - 1
   indx = posn \ 32
   ofst = (posn And BITS0thru4) + 1
   
 ' If bitvect not big enough to hold bit-string,
   If indx > UBound(bitvect) Then
      ReDim bitvect(0 To indx)
   End If
   
 ' If bitvect has extra integers in it, make sure they're set to NOBITS.
   For lval = UBound(bitvect) To indx + 1 Step -1
      bitvect(lval) = NOBITS
   Next lval
   
   posn = 1
   Do While indx >= 0
      lval = NOBITS
      Do While ofst > 0
         ofst = ofst - 1
'digit = Mid(bstr, posn, 1)
         If 0 = StrComp(strOne, Mid(bstr, posn, 1)) Then lval = lval Or Bits(ofst)
         posn = posn + 1
      Loop
      bitvect(indx) = lval
      ofst = 32
      indx = indx - 1
   Loop
   
 ' comment out the following two lines if this is working correctly.
'   If posn - 1 <> Len(bstr) Then Debug.Print "ERROR 20"
'   Debug.Print bits2string(bitvect)
   
   string2bits = bitvect()
'}
End Function 'string2bits

Function promoteSBits(ByVal sval As Integer) As Long
'{
' This function safely converts a 16-Bit-flags value into a 32-bit value.
' Without this, if SBIT15 is set, the value will be interpreted to be negative,
' and all the bits will be scrambled during conversion using a 2's complement
' algorithm.

If sval < 0 Then
  '{
     'First scrub off BIT15; the negative flag.  This is NOT the same as simply
     'saying "sval = -sval" which uses 2's complement and scrambles the bits.
      sval = sval And (Not SBIT15) 'remove the negative flag.
      promoteSBits = sval     'now that it's positive, converts just fine.
      promoteSBits = promoteSBits Or BIT15 're-set that problem bit.
  '}
   Else
  '{
      promoteSBits = sval   'no problem promoting a positive value.
  '}
   End If
'}
End Function 'promoteSBits

Function demoteLowBits(ByVal lval As Long) As Integer
'{
' This function safely converts the lowest-order 16 bits of a 32-Bit-flags
' value into a 16-bit value.  Without this, if any bits beyond BIT14 are set,
' when the value is demoted to a 16-bit type, an overflow will occur.
' The highest-order 16 bits are just ignored.  If you need them, you'll need
' to call demoteHighBits

'First, scrub off ALL 16 higher-order bits.
   lval = lval And (BYTE1 Or BYTE0)
   
  'Now deal with that pesky sign bit.
   If lval And BIT15 Then 'casting to a 16-bit type will cause overflow.
  '{
      lval = lval And (Not BIT15)    'clear bit 15. Now it's positive.
      demoteLowBits = lval           'positives convert with no problems.
      demoteLowBits = demoteLowBits Or SBIT15 're-set bit 15.
  '}
   Else
  '{
      demoteLowBits = lval
  '}
   End If
'}
End Function 'demoteLowBits

Function demoteHighBits(ByVal lval As Long) As Integer
'{
' This function safely converts the highest-order 16 bits of a 32-Bit-flags
' value into a 16-bit value.  Without this, if BIT31 is set, during the
' shift to get the high word into the low word, because we HAVE TO USE
' DIVISION in stupid VB (instead of giving us unsigned types and bit shift
' operators: GAUSH! What were they thinking? IDIOT!), the bits will get
' scrambled.

'First deal with that pesky sign bit.
   If lval And BIT31 Then 'negative sign will cause bit scrambling.
  '{
      lval = lval And (Not BIT31)    'clear bit 31. Now it's positive.
      demoteHighBits = lval \ 65536  'right-shift 16 positions and demote.
      demoteHighBits = demoteHighBits Or SBIT15 'turn bit 31 back on.
  '}
   Else
  '{
      demoteHighBits = lval \ 65536
  '}
   End If
'}
End Function 'demoteHighBits

Function test_bits()
'{ Run the bitvector functions thru some tests.

ReDim testbitvect(0)
   ReDim testbitvect2(0)
   
   Dim bitstr  As String
   Dim bitstr2 As String
   Dim cntr    As Long
   Dim errflag As Boolean
     
   Call initializeBits
   
   Call string2bits(testbitvect, "")
   If bitsCompare(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 21": errflag = True
   If testbitvect(0) <> NOBITS Then Debug.Print "ERROR 21a": errflag = True
   Call string2bits(testbitvect, "1")
'   Debug.Print bits2string(testbitvect)
   If testbitvect(0) <> BIT0 Then Debug.Print "ERROR 23": errflag = True
   Call clearbit(testbitvect, 0)
   Call string2bits(testbitvect, "10000000000000000000000000000000")
   If testbitvect(0) <> BIT31 Then Debug.Print "ERROR 24": errflag = True
'   Debug.Print bits2string(testbitvect)
   Call clearbit(testbitvect, 31)
   Call string2bits(testbitvect, "100000000000000000000000000000000")
   If testbitvect(1) <> BIT0 Then Debug.Print "ERROR 24": errflag = True
'   Debug.Print bits2string(testbitvect)
   Call clearbit(testbitvect, 32)

If getbit(testbitvect, 5) Then Debug.Print "ERROR 1": errflag = True
   If getbit(testbitvect, 50) Then Debug.Print "ERROR 1a": errflag = True
   Call setbit(testbitvect, 50)
   If togglebit(testbitvect, 50) = 0 Then Debug.Print "ERROR 2": errflag = True
   Call togglebit(testbitvect, 31)
'   Debug.Print "Bit 31: " & bits2string(testbitvect)
   Call clearbit(testbitvect, 31)
   If getbit(testbitvect, 31) Then Debug.Print "ERROR 3": errflag = True
   Debug.Print "Bit cnt " & "9    |    8    |    7    |    6    |    5    |    4    |    3    |    2    |    1    |    0"
   Debug.Print "Bit cnt " & "543210987654321098765432109876543210987654321098765432109876543210987654321098765432109876543210"
   Call setbit(testbitvect, 64)
   Debug.Print "Bit 64: " & bits2string(testbitvect)
   Call setbit(testbitvect, 95)
   Debug.Print "+Bit 95:" & bits2string(testbitvect)
   Call setbit(testbitvect, 0)
   Debug.Print "+Bit 0 :" & bits2string(testbitvect)
   bitstr = bits2string(testbitvect)
   Call string2bits(testbitvect2, bitstr)
   Debug.Print "ditto  :" & bits2string(testbitvect2)
   If bitsCompare(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 22": errflag = True
   Call string2bits(testbitvect2, "1")
   If testbitvect2(2) <> NOBITS Or testbitvect2(1) <> NOBITS _
      Or testbitvect2(0) <> BIT0 Then Debug.Print "ERROR 25": errflag = True
   
   ReDim testbitvect2(0)
   If lowestbit(testbitvect) <> 0 Then Debug.Print "ERROR 4": errflag = True
   If highestbit(testbitvect) <> 95 Then Debug.Print "ERROR 5": errflag = True
   Call clearbit(testbitvect, 95)
   Call clearbit(testbitvect, 0)
   Call setbit(testbitvect, 31)
   Call setbit(testbitvect, 51)
   If lowestbit(testbitvect) <> 31 Then Debug.Print "ERROR 6": errflag = True
   If highestbit(testbitvect) <> 64 Then Debug.Print "ERROR 7": errflag = True
   Call clearbit(testbitvect, 64)
   Call clearbit(testbitvect, 31)
   Call clearbit(testbitvect, 51)
   If lowestbit(testbitvect) <> -1 Then Debug.Print "ERROR 8": errflag = True
   If highestbit(testbitvect) <> -1 Then Debug.Print "ERROR 9": errflag = True
   Call setbit(testbitvect, 31)
   Call setbit(testbitvect2, 32)
   If bitsCompare(testbitvect, testbitvect2) >= 0 Then Debug.Print "ERROR 10": errflag = True
   If bitsCompare(testbitvect2, testbitvect) <= 0 Then Debug.Print "ERROR 11": errflag = True
   Call clearbit(testbitvect2, 32)
   Call setbit(testbitvect2, 31)
   Call setbit(testbitvect2, 30)
   If bitsCompare(testbitvect, testbitvect2) >= 0 Then Debug.Print "ERROR 12": errflag = True
   If bitsCompare(testbitvect2, testbitvect) <= 0 Then Debug.Print "ERROR 13": errflag = True
   Call clearbit(testbitvect2, 31)
   If bitsCompare(testbitvect, testbitvect2) <= 0 Then Debug.Print "ERROR 14": errflag = True
   If bitsCompare(testbitvect2, testbitvect) >= 0 Then Debug.Print "ERROR 15": errflag = True
   Call clearbit(testbitvect2, 30)  'now testbitvect2 is all OFF.
   If bitsCompare(testbitvect, testbitvect2) <= 0 Then Debug.Print "ERROR 16": errflag = True
   If bitsCompare(testbitvect2, testbitvect) >= 0 Then Debug.Print "ERROR 17"
   ReDim testbitvect(0)
   If bitsCompare(testbitvect, testbitvect2) <> 0 Then Debug.Print "ERROR 18"
   If bitsCompare(testbitvect2, testbitvect) <> 0 Then Debug.Print "ERROR 19"
   
   ReDim testbitvect2(0)
   ReDim testbitvect(0)
   setbit testbitvect, 250
   setbit testbitvect, 127
   bitsOrEq testbitvect2, testbitvect
   If highestbit(testbitvect2) <> 250 _
    Or lowestbit(testbitvect2) <> 127 _
    Or bitsCompare(testbitvect, testbitvect2) <> 0 _
    Or UBound(testbitvect) <> UBound(testbitvect2) _
      Then Debug.Print "ERROR 70 (bitsOR)": errflag = True
   
   ReDim testbitvect2(0)
   ReDim testbitvect(0)
   setbit testbitvect, 250
   setbit testbitvect, 127
   bitsAndEq testbitvect2, testbitvect
   If highestbit(testbitvect2) <> -1 _
    Or lowestbit(testbitvect2) <> -1 _
    Or UBound(testbitvect) <> UBound(testbitvect2) _
      Then Debug.Print "ERROR 71 (bitsAND)": errflag = True
   
   ReDim testbitvect2(0)
   ReDim testbitvect(0)
   setbit testbitvect, 127
   setbit testbitvect2, 250
   setbit testbitvect2, 127
   setbit testbitvect2, 35
   bitsXorEq testbitvect2, testbitvect
   If highestbit(testbitvect2) <> 250 _
    Or lowestbit(testbitvect2) <> 35 _
    Or getbit(testbitvect2, 127) _
    Or UBound(testbitvect) = UBound(testbitvect2) _
      Then Debug.Print "ERROR 72 (bitsXOR)": errflag = True
   
   ReDim testbitvect2(0)
   ReDim testbitvect(0)
   For cntr = 0 To 99
      Call setbit(testbitvect2, cntr)
      If highestbit(testbitvect2) <> cntr Then Debug.Print "ERROR 40": errflag = True
      bitstr = bits2string(testbitvect2)
      If bitsCompare(string2bits(testbitvect, bitstr), testbitvect2) <> 0 Then Debug.Print "ERROR 41 at cntr=" & cntr: errflag = True
   Next cntr
   
   ReDim testbitvect2(0)
   ReDim testbitvect(0)
   For cntr = 99 To 0 Step -1
      Call setbit(testbitvect2, cntr)
      If lowestbit(testbitvect2) <> cntr Then Debug.Print "ERROR 42": errflag = True
      bitstr = bits2string(testbitvect2)
      If bitsCompare(string2bits(testbitvect, bitstr), testbitvect2) <> 0 Then Debug.Print "ERROR 43 at cntr=" & cntr: errflag = True
   Next cntr
   
   Call bitsClearAll(testbitvect)
   testbitvect(0) = promoteSBits(-1)
   Debug.Print bits2string(testbitvect)
   Debug.Print demoteHighBits(testbitvect(0)) & "(should have been 0)"
   Debug.Print demoteLowBits(testbitvect(0)) & "(should have been -1)"
   If demoteHighBits(testbitvect(0)) <> 0 Then errflag = True
   If demoteLowBits(testbitvect(0)) <> -1 Then errflag = True
   
   Call bitsClearAll(testbitvect)
   testbitvect(0) = promoteSBits(-32768)
   Debug.Print bits2string(testbitvect)
   Debug.Print demoteHighBits(testbitvect(0)) & "(should have been 0)"
   Debug.Print demoteLowBits(testbitvect(0)) & "(should have been -32768)"
   If demoteHighBits(testbitvect(0)) <> 0 Then errflag = True
   If demoteLowBits(testbitvect(0)) <> -32768 Then errflag = True

Call bitsClearAll(testbitvect)
   testbitvect(0) = promoteSBits(1)
   Debug.Print bits2string(testbitvect)
   Debug.Print demoteHighBits(testbitvect(0)) & "(should have been 0)"
   Debug.Print demoteLowBits(testbitvect(0)) & "(should have been 1)"
   If demoteHighBits(testbitvect(0)) <> 0 Then errflag = True
   If demoteLowBits(testbitvect(0)) <> 1 Then errflag = True

Debug.Print "End of tests for bitvector."
   If errflag Then
      Call MsgBox("Bit tests FAILED: Run in debug mode for detailed print-out.", vbOKOnly)
   Else
      Call MsgBox("Bit tests passed", vbOKOnly)
   End If
'}
End Function 'test_bits

Private Function bitsBinarySearch_Long(ByVal key As Long, realarray() As Long, ByVal nelem As Long) As Long
'{ I believe this algorithm may have the theoretic minimum number of iterations.
'  It has less than any other bsearch I've examined.
'  This is a modified binarySearch_Long that excludes negatives.  Don't
'  use it if any possibility of negative values exist.  It has been
'  specially tailored for use in the bitvector library.

Dim lft As Long, rht As Long
   Dim elm As Long        ' array element value
   Dim diff As Long
   
   bitsBinarySearch_Long = 0  ' in case nelem=0
   
   lft = 0
   rht = nelem             ' off the end of the array: by design!
   Do While lft < rht      ' automatically checks for zero len array.
  '{                       ' must exit loop when lft == rht.
   ' NOTE: The following will overflow if nelem > ~1 billion!
     bitsBinarySearch_Long = (rht + lft) \ 2
'    bitsBinarySearch_Long = lft + (rht - lft) \ 2 'good up to about 2 billion.

' See line 468 for a discussion about positives.  Since all values in
   ' this context are positive, it should work and not overflow.  Don't
   ' use this approach in general; instead use the commented out approach.
     diff = key - realarray(bitsBinarySearch_Long)
'    elm = realarray(bitsBinarySearch_Long)
'    If key < elm Then
     If diff < 0 Then
        rht = bitsBinarySearch_Long           ' rht always in 'already compared' state.
'    ElseIf key > elm Then
     ElseIf diff > 0 Then
        lft = bitsBinarySearch_Long + 1       ' lft always in 'not yet compared' state.
     Else                      ' Found it!
        Exit Function
     End If
  '}
   Loop
   bitsBinarySearch_Long = rht  ' or lft; doesn't matter.
'}
End Function