' ------------------------------------------------------------- ' Beschreibung: ' ----------------------------------------------------- ' IEEE Standard 754 Floating Point Numbers ' ' Umrechnung FloatingPoint - Normalzahl ' ' (c)2003 by Urs Dietrich ' ' ----------------------------------------------------- ' Ein Beispiel: ' ' Eingabe: @rÀ ' ASCII-Werte: 64, 114, 192 ' ASCII-Wetrte in Binär umgewandelt: ' 01000000, 01110010, 11000000 ' Diese Aneinandergereiht und auf 64bit ergänzt: ' 0100000001110010110000000000000000000000000000000000000000000000 ' ' Aufteilung: ' Bit1 (ganz Rechts): Vorzeichen (0=+, 1=-) ' Bit2-11: Exponent ' Rest: Mantisse ' ' Exponent: ' 10000000111(bin) = 1031(dec), das Minus Bias(=1027) -> Exponent = 8 ' ' Mantisse: ' 0010110000000000000000000000000000000000000000000000 ' in Hex: 2C0000000000 ' Dem Hexwert eine 1 voranstellen: 12C0000000000 ' Dann in Dec umwandeln: 5277655813324800 ' Diesen Wert solange durch 2 dividieren, bis der Wert < 2 ist ' -> 1.171875 ' ' Jetzt alles zusammenfügen: ' Mantisse * 2^Exponent ' 1.171875 * 2^8 ' = 300 ' ' Der gesuchte Wert ist also 300!! ' ----------------------------------------------------- Option Explicit Hauptfunktion: Public Function FloatingPointToDec(AsciiString As String) As Long ' Übergeben wird ein String mit ASCII Zeichen Dim Vorzeichen As Integer Dim exponent As Long Dim exponentDec As Long Dim exponentBin As String Dim mantisse As Double Dim mantisseDec As Double Dim mantisseBin As String Dim mantisseHex As String Dim tempBin As String Dim tempLänge As Long Dim tempAscii As String Dim anzZeichen As Long Dim arZeichen() Dim i As Integer Dim Resultat As Long ' Die Basis ist immer 2!! Const basis = 2 ' Bei Double Precision wird mit 64bit = 8Byte gearbeitet Const anzByte = 8 ' Die Bias ist bei 64bit 1023, bei 32bit 127 Const Bias = 1023 ReDim arZeichen(0 To anzByte - 1) anzZeichen = Len(AsciiString) For i = 0 To anzZeichen - 1 ' ASCII Code des Zeichens ermitteln tempAscii = Asc(Mid(AsciiString, i + 1, 1)) ' den ASCII Code in das Binärsystem umwandeln tempAscii = DezToBin(tempAscii) tempLänge = Len(tempAscii) ' Vorne mit 0 Auffüllen, bis die länge von einem Byte (8bit) ' erreicht ist While tempLänge < 8 tempAscii = "0" & tempAscii tempLänge = Len(tempAscii) Wend arZeichen(i) = tempAscii Next i ' Die restlichen Bytes mit dem Wert 0 auffüllen, ' damit die 64bit erreicht werden For i = anzZeichen To anzByte - 1 tempAscii = "00000000" arZeichen(i) = tempAscii Next i tempBin = Join(arZeichen, "") ' alle 8Byte aneinanderreihen Vorzeichen = Mid(tempBin, 1, 1) ' Vorzeichen ' Der Exponent wird aus den bits 2-12 zusammengesetzt exponentBin = Mid(tempBin, 2, 11) ' Dieser wird in eine Dezimale Zahl umgewandelt exponentDec = BinToDez(exponentBin) ' Bias vom Exponent subtrahieren exponent = exponentDec - Bias ' Die Mantisse besteht aus den restlichen Zeichen... mantisseBin = Mid(tempBin, 13) ' ...die in das Hex-System umgewandelt werden mantisseHex = BinToHex(mantisseBin) ' Dann wird vor den Hex-Wert eine 1 geschrieben mantisseHex = "1" & mantisseHex ' Die Nullen am Schluss können in diesem speziellen ' Fall gestrichen werden, weil anschliessend ' durch 2 dividiert wird, und jede Stelle im Hex ja ' den Faktor 16^x hat, und 16/2 aufgeht While Right$(mantisseHex, 1) = "0" mantisseHex = Mid$(mantisseHex, 1, Len(mantisseHex) - 1) Wend ' Und der Wert wieder in das Dezimalsystem umgewandelt mantisseDec = HexToDez(mantisseHex) ' Nun wird die Zahl so lange durch 2 dividiert, ' bis sie < 2 ist While mantisseDec >= 2 mantisseDec = mantisseDec / 2 Wend ' Das ist nun die gesuchte mantisse mantisse = mantisseDec ' Schlussendliche Formel Resultat = mantisse * 2 ^ exponent If Vorzeichen = 1 Then ' Nun wird allenfalls noch das Vorzeichen ' gesetzt (nur bei 1 (=-)) Resultat = "-" & Resultat End If FloatingPointToDec = Resultat End Function Hilfsfunktionen Private Function BinToDez(ByVal Number As String) As Long ' Binär-Dezimal-Umrechnung Dim Länge As Integer Dim Multiplikator As Integer Dim i As Integer ' Anzahl Stellen der eingegebenen Zahl ermitteln Länge = Len(Number) Multiplikator = 1 For i = Länge To 1 Step -1 ' Dezimalzahl wird zusammengesetzt BinToDez = BinToDez + CInt(Mid(Number, i, 1)) * Multiplikator Multiplikator = Multiplikator * 2 Next i End Function Private Function BinToHex(Number As String) As String ' Binär-Hex - Umrechnung Dim Länge As Integer Dim tempBin As String Dim tempHex As String Dim tempDec As Variant Dim hex As String Dim i As Integer Länge = Len(Number) While Länge >= 4 tempDec = 0 tempBin = Right(Number, 4) Number = Left(Number, Len(Number) - 4) For i = 1 To 4 tempDec = tempDec + Mid(tempBin, 5 - i, 1) * 2 ^ (i - 1) Next i Select Case tempDec Case 10 tempDec = "A" Case 11 tempDec = "B" Case 12 tempDec = "C" Case 13 tempDec = "D" Case 14 tempDec = "E" Case 15 tempDec = "F" End Select hex = tempDec & hex Länge = Len(Number) Wend BinToHex = hex End Function Private Function DezToBin(Number) As String ' Dezimal-Binär-Umrechnung Dim Rest As Double Dim Digit As Byte Dim erha Rest = Number Do Digit = Rest Mod 2 ' Aktuelle Zahl DezToBin = CStr(Digit) & DezToBin ' Den Rest korrekt abrunden If Digit = 1 Then Rest = Rest / 2 Rest = Rest - 0.5 Else Rest = Rest / 2 End If Loop Until Rest = 0 End Function Private Function HexToDez(ByVal Number As String) As Long ' Hex -Dezimal - Umrechnung Dim Länge As Integer Dim Multiplikator As Long Dim i As Integer Dim Currentpos As String Dim CurrentInt As Long Länge = Len(Number) Multiplikator = 1 For i = Länge To 1 Step -1 Currentpos = Mid(Number, i, 1) ' Buchstaben müssen in Zahlen umgewandelt werden Select Case LCase(Currentpos) Case Is = "a" CurrentInt = 10 Case Is = "b" CurrentInt = 11 Case Is = "c" CurrentInt = 12 Case Is = "d" CurrentInt = 13 Case Is = "e" CurrentInt = 14 Case Is = "f" CurrentInt = 15 Case Else If Asc(Currentpos) >= 48 And Asc(Currentpos) <= 57 Then CurrentInt = CInt(Currentpos) Else MsgBox "Zahl ist ungültig!", vbCritical Exit Function End If End Select HexToDez = HexToDez + (CurrentInt * Multiplikator) Multiplikator = Multiplikator * 16 Next i End Function Beispiel: MsgBox FloatingPointToDec(txtFP.Text) wobei in txtFP die Zeichenfolge steht, deren ASCII Werte umgerechnet werden sollen. Dieser Tipp wurde bereits 24.176 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |