VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Bit_Vec"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit
DefInt A-Z
Const CLASS_NAME = "Bit_Vec"
Const CLASS_VERSION = "100"
Const vbErrSubscriptOutOfRange = 9
Const BITS_PER_ELEMENT = 8
Private mBits() As Byte
Private mNumElements As Long
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
Erase mBits
End Sub
Public Property Let NumElements(NewValue As Long)
mNumElements = NewValue
ReDim Preserve mBits(mNumElements \ BITS_PER_ELEMENT)
End Property
Public Property Get NumElements() As Long
NumElements = mNumElements
End Property
'------------------------------------------------------
'-- METHODS
'------------------------------------------------------
Public Sub ClearAll()
Dim i As Long
'-- Set bit values in BITS_PER_ELEMENT chunks for speed
For i = LBound(mBits) To UBound(mBits)
mBits(i) = &H0
Next i
End Sub
Public Sub ClearBit(Index As Long)
'-- Set Bit(Index) value to 0
Dim ArrayIdx As Long
Dim Bit As Long
Call ValidateIndex(Index)
ArrayIdx = Index \ BITS_PER_ELEMENT
Bit = Index Mod BITS_PER_ELEMENT
'Debug.Print "Clearing ArrayIdx:"; ArrayIdx, " Bit:"; Bit
mBits(ArrayIdx) = mBits(ArrayIdx) And (Not (2 ^ Bit))
End Sub
Public Function GetBit(Index As Long) As Integer
'-- Returns 0 or 1
Call ValidateIndex(Index)
If IsBitSet(Index) Then
GetBit = 1
Else
GetBit = 0
End If
End Function
Public Function IsBitSet(Index As Long) As Boolean
Dim ArrayIdx As Long
Dim Bit As Long
Call ValidateIndex(Index)
ArrayIdx = Index \ BITS_PER_ELEMENT
Bit = Index Mod BITS_PER_ELEMENT
'Debug.Print "Testing ArrayIdx:"; ArrayIdx, " Bit:"; Bit
If mBits(ArrayIdx) And 2 ^ Bit Then
IsBitSet = True
Else
IsBitSet = False
End If
End Function
Public Sub SetAll()
Dim i As Long
'-- Set bit values in BITS_PER_ELEMENT chunks for speed
For i = LBound(mBits) To UBound(mBits)
mBits(i) = &HFF
Next i
End Sub
Public Sub SetBit(Index As Long)
'-- Set Bit(Index) value to 1
Dim ArrayIdx As Long
Dim Bit As Long
Call ValidateIndex(Index)
ArrayIdx = Index \ BITS_PER_ELEMENT
Bit = Index Mod BITS_PER_ELEMENT
'Debug.Print "Setting ArrayIdx:"; ArrayIdx, " Bit:"; Bit
mBits(ArrayIdx) = mBits(ArrayIdx) Or 2 ^ Bit
End Sub
Public Sub ToggleBit(Index As Long)
'-- Toggle the value of Bit(Index)
Call ValidateIndex(Index)
If IsBitSet(Index) Then
Call ClearBit(Index)
Else
Call SetBit(Index)
End If
End Sub
Private Sub ValidateIndex(Index As Long)
'-- Our bounds checking code is aware that this is
' a 0 based array of bits.
If (Index < 0) Or (Index > (mNumElements - 1)) Then
RaiseError vbErrSubscriptOutOfRange
End If
End Sub
'------------------------------------------------------
'-- ERRORS
'------------------------------------------------------
' .GetErrorDesc
Private Function GetErrorDesc(ErrCode As Long) As String
Dim Desc As String
Select Case ErrCode
Case vbErrSubscriptOutOfRange
Desc = "Subscript out of Range"
Case Else
Desc = "Unknown error"
End Select
GetErrorDesc = Desc
End Function
' .RaiseError
Private Sub RaiseError(ErrCode As Long)
Err.Raise Number:=vbObjectError + ErrCode, _
Source:=CLASS_NAME & " " & CLASS_VERSION, _
Description:=GetErrorDesc(ErrCode)
End Sub
