Hi Everybody,
Are there any functions / formulas to convert:
HEX number to Binary Number
and
Binary Number back to Hex
/***
*
* BaseToBase( <cInString>, <nInBase>, <nOutBase> ) --> cNewBaseValue
*
* Konvertiert einen Zahlenstring von einer Zahlenbasis in eine andere,
* wobei Basen von 2 bis 36 beutzt werden können
*
* Convert a numberstring from one base to another
*
*
*/
FUNCTION BaseToBase( xInString, nInBase, nOutBase )
LOCAL cInString := ""
LOCAL cDigits := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
LOCAL cNewBaseValue := ""
LOCAL i
LOCAL DecPos
LOCAL IntValue := 0
LOCAL FracValue := 0.000000000000000000
LOCAL FracProduct
LOCAL FracCounter
LOCAL IntProdStr
LOCAL FracOutStr
LOCAL IntOutString
LOCAL IntStr
LOCAL FracString
LOCAL FracLimit
LOCAL Block
LOCAL LChr
LOCAL Remainder
LOCAL Quotient
LOCAL NegSign
cInString := IIF (ValType(xInstring)="N", Str (Int(xInString),LenNum(xInString),0), xInString)
cInString := UPPER( ALLTRIM( cInString ) )
// Parameter prüfen
IF EMPTY( cInString ) .OR. VALTYPE( cInString ) <> "C" .OR. LEN( cInString ) > 19
cNewBaseValue := NIL
ELSE
nInBase := IF( EMPTY( nInBase ), 10, nInBase )
nOutBase := IF( EMPTY( nOutBase ), 10, nOutBase )
IF VALTYPE( nInBase ) <> "N" .OR. VALTYPE( nOutBase ) <> "N"
cNewBaseValue := NIL
ELSE
// Prüfen ob Zahlenbasis gültig
IF ( nInBase > 36 .OR. nOutBase > 36 .OR. nInBase < 2 .OR. nOutBase < 2 )
cNewBaseValue := NIL
ELSE
i := 1
DO WHILE i++ < LEN( cInString ) .AND. cNewBaseValue <> NIL
IF .NOT. SUBSTR( cInString, i, 1 ) $ ( SUBSTR( cDigits, 1, nInBase ) + "." )
cNewBaseValue := NIL
ENDIF
ENDDO
ENDIF
ENDIF
ENDIF
IF cNewBaseValue <> NIL
// Prüfen ob cInString negativ ist
NegSign := IF( SUBSTR( cInString, 1, 1 ) == "-", "-", "" )
IF .NOT. EMPTY( NegSign )
cInString := SUBSTR( ALLTRIM( SUBSTR( cInString, 2 ) ), 2 )
ENDIF
// Auffinden des Dezimalspunktes
DecPos := AT( ".", cInString )
IntStr := IF( DecPos > 1, SUBSTR( cInString, 1, DecPos - 1 ), IF( DecPos == 1, "0", cInString ) )
FracString := IF( DecPos > 0, SUBSTR( cInString, DecPos + 1 ), "0" )
// Konvertieren des Integerteils zur Basis 10
FOR i = LEN( IntStr ) TO 1 STEP -1
IntValue += ( AT( SUBSTR( IntStr, i, 1 ), cDigits) - 1) * ( nInBase ** ( LEN( IntStr ) - i ) )
NEXT
// Konvertieren des Dezimalsrests zur Basis 10
FOR i := 1 TO LEN( FracString )
FracValue += ( AT( SUBSTR( FracString, i, 1 ), cDigits ) - 1 ) * ( nInBase ** ( - i ) )
NEXT
// Berechnen des Ausgabestrings des Integerteils
Quotient := IntValue
IntOutString := ""
DO WHILE Quotient <> 0
Remainder := Quotient % nOutBase
Quotient := INT( Quotient / nOutBase )
IntOutString := SUBSTR( cDigits, Remainder + 1, 1 ) + IntOutString
ENDDO
IntOutString := IF( EMPTY( IntOutstring ), "0", IntOutString )
// Berechnen des Ausgabestrings
FracLimit := 19 - DecPos
FracProduct := FracValue
FracCounter := 1
FracOutStr := ""
// Da die folgenden WHILE-Bedingung den Ausdruck enthält:
// FracCounter++ < FracLimit .AND. FracProduct < 0.00000000000001
// braucht der Schleifenblock nicht ausgeführt werden, um nachfolgende
// Nullen zu entfernen
DO WHILE FracCounter++ < FracLimit .AND. FracProduct <> 0
IntProdStr := FracProduct * nOutBase
FracOutStr := FracOutStr + SUBSTR( cDigits, INT( IntProdStr ) + 1, 1 )
FracProduct := IntProdStr - INT( IntProdStr )
ENDDO
// Entfernen nachfolgender Nullen
Block:={ || LChr := RIGHT(FracOutStr, 1), ;
IF(LChr == "0", FracOutStr := SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1), 0), ;
IF(LChr == "0", EVAL(Block), FracOutStr) }
FracOutStr := EVAL( Block )
/* Der folgende Block benötigt mehr Speicher, ist aber kürzer:
Block := { |Str| IF(RIGHT(Str, 1) == "0", ;
EVAL(Block, SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1)), Str)}
*/
ENDIF
// Ausgabe
IF cNewBaseValue <> NIL
cNewBaseValue := IF( DecPos > 0, NegSign + IntOutString + "." + FracOutStr, IntOutString )
ENDIF
RETURN ( IIF (cNewBaseValue=nil,"Fehler",cNewBaseValue) )
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 85 guests