KB de Microsoft. Article ID: Q185554

Rutinas : 

- BitMask : devuelve una máscara empleada por las otras rutinas.
- BitSet : Pone un bit a uno o a cero.
- BitFlip : Cambia el estado de un bit.
- BitTest : Devuelve el estado de un bit.
- ArrayBitSet : Pone un bit a uno o a cero.
- ArrayBitFlip : Cambia el estado de un bit.
- ArrayBitTest : Devuelve el estado de un bit.

Las rutinas Array asumen 32 bits por elemento, comenzando con los bits del 0 al 31 en el primero, del 32 al 63 en el segundo, etc. La matriz no necesita comenzar en el elemento cero. 

Estas rutinas tienen uno a más de los siguientes parámetros :
- X : un long que contiene los 32 bits a manipular.
- A() : una matriz conteniendo los bits a manipular.
- Value : TRUE para poner un bit a uno y FALSE para ponerlo a cero.
- N : número que indica el bit a manipular. En el caso de una variable long va desde el 0 al 31. En el caso de una matriz va desde el 0 hasta el (numero de elementos * 32) -1. Si el valor de N está fuera del rango se ignora. En el caso de una función se devuelve FALSE.

Las funciones BitTest y ArrayBitTest devuelven TRUE (-1) si el bit está a 1 y FALSE (0) si está a 0.

Function BitMask(ByVal N As Long) As Long
Dim I As Long, Mask As Long

If N < 0 Or N > 31 Then
    BitMask = 0
    ElseIf N = 31 Then
        BitMask = &H80000000
    Else: Mask = 1
            For I = 1 To N
                Mask = Mask + Mask
            Next I
            BitMask = Mask
End If
End Function

Sub BitSet(X As Long, ByVal N As Long, ByVal Value As Boolean)
If Value Then
    X = X Or BitMask(N)
Else: X = X And Not BitMask(N)
End If
End Sub

Sub BitFlip(X As Long, ByVal N As Long)
X = X Xor BitMask(N)
End Sub

Function BitTest(X As Long, ByVal N As Long) As Boolean ' Return False if invalid N
BitTest = (X And BitMask(N)) <> 0
End Function

Sub ArrayBitSet(A() As Long, ByVal N As Long, ByVal Value As Boolean)
Dim Element As Integer
Element = N \ 32 + LBound(A)
If Element <= UBound(A) And N >= 0 Then
    BitSet A(Element), N Mod 32, Value
End If
End Sub

Sub ArrayBitFlip(A() As Long, ByVal N As Long)
Dim Element As Integer
Element = N \ 32 + LBound(A)
If Element <= UBound(A) And N >= 0 Then
    BitFlip A(Element), N Mod 32
End If
End Sub

Function ArrayBitTest(A() As Long, ByVal N As Long) As Boolean ' Returns False if invalid N.
Dim Element As Integer
Element = N \ 32 + LBound(A)
If Element <= UBound(A) And N >= 0 Then
    ArrayBitTest = BitTest(A(Element), N Mod 32)
Else
    ArrayBitTest = False
End If
End Function


Basándonos en estas rutinas de Microsoft es sencillo crearnos una para desplazar bits a la izquierda y a la derecha, similar a los operadores << y >> de C.

Function DesplazaLongIzda(ByVal numero As Long, pos As Long) As Long
Dim i As Long

For i = 31 To pos Step -1
   BitSet numero, i, BitTest(numero, i - pos)
Next i
For i = pos - 1 To 0 Step -1
    BitSet numero, i, False
Next i
DesplazaLongIzda = numero
End Function

Function DesplazaLongDcha(ByVal numero As Long, pos As Long) As Long
Dim i As Long

For i = 0 To 31 - pos
   BitSet numero, i, BitTest(numero, i + pos)
Next i
For i = 31 - pos To 31
    BitSet numero, i, False
Next i
DesplazaLongDcha = numero
End Function