|
Nein, hier geht es nicht um Gerstensaft einer gewissen Weltmarke
- damit wir uns nicht falsch verstehen. Es geht vielmehr darum, wie
Sie mit den kleinsten Bausteinen der binären Computer-Welt, den
Bits, in Visual Basic operieren können. Das Grundwissen, was Bits
sind, und ein paar mathematische Kenntnisse in diesem Zusammenhang
muss ich allerdings voraussetzen - Ihnen dies hier vermitteln zu
wollen, würde einfach den Rahmen eines KnowHow-Tipps sprengen.
Ich will Ihnen aber zeigen, wie Sie Bits in einer Zahl setzen und
löschen können, und wie Sie prüfen können, ob Bits gesetzt sind.
Und als Anwendung der folgenden Funktionen werden Sie dazu weitere
Funktionen vorfinden, die eine Zahl in eine Binär-String umsetzen,
und natürlich diesen auch wieder in eine Zahl zurück verwandeln.
Beginnen wir mit der einfachsten Aufgabenstellung, dem Setzen
eines Bits in einer Zahl des Datentyps Byte (wie gesagt, das
Verständnis der Grundlagen und der zugrunde liegenden Arithmetik
setze ich voraus):
Public Sub SetBitB(Value As Byte, ByVal Position As Byte)
Select Case Position
Case 0 To 7
Value = Value Or 2 ^ Position
Case Else
Err.Raise 6
End Select
End Sub
Da Bits gewöhnlich mit 0 beginnend gezählt werden,
erstreckt sich beim Datentyp Byte der Bereich der
möglichen Werte für die Positionsangabe des betreffenden Bits von
0 bis 7. Übergeben Sie einen Wert außerhalb
dieses Bereichs, wird ein Fehler ausgelöst - der Einfachheit halber
der VB-eigene Fehler Nummer 6 für einen Überlauf.
Ein Bit löschen Sie mit der Umkehrung der Oder-Verknüpfung, mit
"And Not":
Public Sub ClearBitB(Value As Byte, ByVal Position As Byte)
Select Case Position
Case 0 To 7
Value = Value And Not 2 ^ Position
Case Else
Err.Raise 6
End Select
End Sub
Die Prüfung erfolgt mit einer And-Verknüpfung:
Public Function BitB(ByVal Value As Byte, ByVal Position As Byte) _
As Boolean
Select Case Position
Case 0 To 7
BitB = CBool(Value And 2 ^ Position)
Case Else
Err.Raise 6
End Select
End Function
Sie werden vermuten, dass die entsprechenden Funktionen für die
beiden anderen ganzzahligen Datentypen Integer und Long im Prinzip
genau so aussehen dürften. Da haben Sie recht, im Prinzip. Nur
haben wir es bei diesen mit Datentypen zu tun, die im Gegensatz zum
Datentyp Byte auch negative Werte enthalten können. In Sachen Bits
bedeuten negative Zahlenwerte jedoch nichts anderes, als dass das
höchste Bit gesetzt ist (Integer: Bit 15, Long: Bit
31). Die Operation 2 ^ Position mit der
höchsten Bit-Nummer als Position lässt Visual Basic jedoch einen
Laufzeitfehler melden. Aber da wir diesen einen Fall problemlos
heraussieben können, brauchen wir die Operation nicht, sondern
können direkt den entsprechenden (negativen) Wert verwenden. Der
Einfachheit halber verwenden wir die hexadezimale Schreibweise.
Die Funktionen für den Datentyp Integer:
Public Sub SetBitI(Value As Integer, ByVal Position As Byte)
Select Case Position
Case 0 To 14
Value = Value Or 2 ^ Position
Case 15
Value = Value Or &H8000
Case Else
Err.Raise 6
End Select
End Sub
Public Sub ClearBitI(Value As Integer, ByVal Position As Byte)
Select Case Position
Case 0 To 14
Value = Value And Not 2 ^ Position
Case 15
Value = Value And Not &H8000
Case Else
Err.Raise 6
End Select
End Sub
Bei der Prüfung, ob das höchste Bit gesetzt ist, genügt der
Test, ob die übergebene Zahl negativ ist:
Public Function BitI(ByVal Value As Integer, ByVal Position As Byte) _
As Boolean
Select Case Position
Case 0 To 14
BitI = CBool(Value And 2 ^ Position)
Case 15
BitI = CBool(Value < 0)
Case Else
Err.Raise 6
End Select
End Function
Und die Funktionen für den Datentyp Long:
Public Sub SetBitL(Value As Long, ByVal Position As Byte)
Dim nVal As Variant
Select Case Position
Case 0 To 30
Value = Value Or 2 ^ Position
Case 31
Value = Value Or &H80000000
Case Else
Err.Raise 6
End Select
End Sub
Public Sub ClearBitL(Value As Long, ByVal Position As Byte)
Select Case Position
Case 0 To 30
Value = Value And Not 2 ^ Position
Case 31
Value = Value And Not &H80000000
Case Else
Err.Raise 6
End Select
End Sub
Public Function BitL(ByVal Value As Long, ByVal Position As Byte) _
As Boolean
Select Case Position
Case 0 To 30
BitL = CBool(Value And 2 ^ Position)
Case 31
BitL = CBool(Value < 0)
Case Else
Err.Raise 6
End Select
End Function
Mit den bisher gezeigten Funktionen können Sie einzelne Bits
manipulieren bzw. prüfen. Wenn wir die Funktionen nun so erweitern,
dass sie als Parameter statt einer einzigen Positionsangabe ein
Parameter-Array (ParamArray) erwarten, können Sie beliebig viele
Positionen übergeben. Parameter-Arrays haben jedoch den kleinen
Nachteil, dass sie nicht dynamisch zur Laufzeit zusammengestellt
werden können. Damit Sie sowohl fest-codierte Parameter-Arrays als
auch dynamisch erstellte Arrays verwenden können, prüfen die
Funktionen zunächst, ob im ersten Element selbst ein Array
enthalten ist. Ist dies der Fall, werden die Elemente dieses Arrays
als Positionsangaben verwendet, und alle weiteren Elemente des
Parameter-Arrays werden ignoriert.
Selbstverständlich können sowohl ein Parameter-Array als auch
ein dynamisches Array beliebig viele Positionsangaben enthalten,
sogar die gleiche Positionsangabe mehrfach. Das schadet zwar nichts,
macht aber auch keinen Sinn, da ein einmal gesetztes oder
gelöschtes Bit ein gesetztes bzw. gelöschtes Bit beibt.
Für den Datentyp Byte sehen die Funktionen zum Löschen und
Setzen von Bits so aus (für die beiden anderen Datentypen sehen die
Funktionen analog dazu aus und sind darum nicht hier im Text
aufgeführt, aber in dem herunterladbaren Modul enthalten):
Public Sub SetBitsB(Value As Byte, ParamArray Positions() _
As Variant)
Dim i As Integer
If UBound(Positions) = 0 Then
If IsArray(Positions(0)) Then
For i = 0 To UBound(Positions(0))
SetBitB Value, Positions(0)(i)
Next 'i
Exit Sub
End If
End If
For i = 0 To UBound(Positions)
SetBitB Value, Positions(i)
Next 'i
End Sub
Public Sub ClearBitsB(Value As Byte, ParamArray Positions() _
As Variant)
Dim i As Integer
If UBound(Positions) = 0 Then
If IsArray(Positions(0)) Then
For i = 0 To UBound(Positions(0))
ClearBitB Value, Positions(0)(i)
Next 'i
Exit Sub
End If
End If
For i = 0 To UBound(Positions)
ClearBitB Value, Positions(i)
Next 'i
End Sub
Die Prüfung, ob Bits gesetzt sind, ist über mehrere Positionen
hinweg ebenfalls möglich. Aber hier ist es sinnvoll, verschiedene
Prüfungsvarianten zu offerieren. Zunächst die einfachste Variante,
die prüft, ob irgendein Bit an einer der übergebenen Positionen
gesetzt ist. Sie kehrt zurück, sobald sie auf das erste gesetzte
Bit trifft, da ja damit die Bedingung schon erfüllt ist:
Public Function BitsBOr(ByVal Value As Byte, _
ParamArray Positions() As Variant) As Boolean
Dim i As Integer
If UBound(Positions) = 0 Then
If IsArray(Positions(0)) Then
For i = 0 To UBound(Positions(0))
If BitB(Value, Positions(0)(i)) Then
BitsBOr = True
Exit Function
End If
Next 'i
Exit Function
End If
End If
For i = 0 To UBound(Positions)
If BitB(Value, Positions(i)) Then
BitsBOr = True
Exit Function
End If
Next 'i
End Function
Interessanter ist schon die Frage, ob die Bits an allen
übergebenen Positionen gesetzt sind. Diese Funktion wird verlassen,
sobald die Prüfung eines einzelnen Bits falsch ergibt, da ja dann
die Bedingung schon nicht mehr erfüllt werden kann, egal wie viele
Bits an den verbleibenden Positionen noch gesetzt sein mögen. Wird
gar keine Position übergeben, ist das Resultat logischerweise
ebenfalls falsch.
Public Function BitsBAnd(ByVal Value As Byte, _
ParamArray Positions() As Variant) As Boolean
Dim i As Integer
If UBound(Positions) = -1 Then
Exit Function
ElseIf UBound(Positions) = 0 Then
If IsArray(Positions(0)) Then
For i = 0 To UBound(Positions(0))
If Not BitB(Value, Positions(0)(i)) Then
Exit Function
End If
Next 'i
Exit Function
End If
End If
For i = 0 To UBound(Positions)
If Not BitB(Value, Positions(i)) Then
Exit Function
End If
Next 'i
BitsBAnd = True
End Function
Nun bleibt noch die Prüfung, ob exakt an allen übergebenen
Positionen, und eben nur an diesen, die Bits gesetzt sind oder nicht
gesetzt sind. Hier sieht die innere Technik ein wenig anders aus.
Zunächst werden zunächst in einer neuen Zahl die zu prüfenden
Bits gesetzt. Das Ergebnis ergibt sich aus dem Vergleich dieser Zahl
mit der zu prüfenden Zahl - nur wenn beide gleich sind, sind exakt
die betreffenden Bits gesetzt.
Public Function BitsBOnly(ByVal Value As Byte, _
ParamArray Positions() As Variant) As Boolean
Dim nMask As Byte
Dim i As Integer
If UBound(Positions) = -1 Then
Exit Function
ElseIf UBound(Positions) = 0 Then
If IsArray(Positions(0)) Then
For i = 0 To UBound(Positions(0))
SetBitB nMask, Positions(0)(i)
Next 'i
Exit Function
End If
End If
For i = 0 To UBound(Positions)
SetBitB nMask, Positions(i)
Next 'i
BitsBOnly = CBool(Value = nMask)
End Function
Kommen wir nun zu den versprochenen Funktionen zur Konvertierung
von Zahlen in Binärstrings und zurück, die Gebrauch von den
vorgestellten Bit-Funktionen machen.
Die Funktion zur Umwandlung einer Dezimalzahl in einen
Binärstring prüft einfach, ob die entsprechenden Bits gesetzt
sind. Ist ein Bit gesetzt, wird die "0" an
der entsprechenden Stelle eines vorbereiteten Strings aus Nullen in
der Anzahl der maximalen Bit-Zahl gegen eine "1"
ausgetauscht. Das Verfahren ist erheblich schneller, als einen
String von Position zu Position aufzubauen und dabei jeweils eine
"0" oder "1" davor zu
hängen. Brauchen Sie die eventuell führenden Nullen nicht, lassen
Sie den optionalen Parameter DoFormat weg. Die führenden Nullen
werden dann gekappt. Setzen Sie ihn auf True, erhalten Sie den
vollen String.
Public Function DecBToBin(ByVal Value As Byte, _
Optional ByVal DoFormat As Boolean) As String
Dim i As Integer
Dim nBin As String
nBin = String$(8, "0")
For i = 0 To 7
If BitL(Value, i) Then
Mid$(nBin, 8 - i, 1) = "1"
End If
Next
If DoFormat Then
DecBToBin = nBin
Else
i = InStr(nBin, "1")
If i Then
DecBToBin = Mid$(nBin, i)
Else
DecBToBin = "0"
End If
End If
End Function
Die Umkehrung der Verwandlung eines Binär-Strings in eine
Dezimalzahl prüft einfach von hinten nach vorne, ob in dem String
an der jeweiligen Position eine "1" steht und
setzt dementsprechend das betreffende Bit.
Public Function BinToDecB(Bin As String) As Byte
Dim i As Integer
Dim nDec As Byte
Dim nPos As Integer
If Len(Bin) > 7 Then
Err.Raise 6
Else
For i = Len(Bin) To 1 Step -1
If Mid$(Bin, i, 1) = "1" Then
SetBitB nDec, nPos
End If
nPos = nPos + 1
Next 'i
End If
BinToDecB = nDec
End Function
Die Funktionen für die Datentypen Integer und Long entsprechen
wieder diesen beiden Funktionen und sind daher hier nicht
dargestellt, aber im herunterladbaren Modul enthalten.
|