Rutinas de manipulación de bits

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.

Codigo:


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.

Codigo:


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