UNIT CONVUNIT;
{ CONVUNIT UNIT 1.1 }
{ Copyright (C) 1997 HЖkon Stordahl }
{ E-mail : stordahl@usa.net }
{ Homepage: http://stordahl.home.ml.org/ }
INTERFACE
FUNCTION DEC2BIN(DEC: LONGINT): STRING;
FUNCTION BIN2DEC(BIN: STRING): LONGINT;
FUNCTION DEC2HEX(DEC: LONGINT): STRING;
FUNCTION HEX2DEC(HEX: STRING): LONGINT;
FUNCTION DEC2OCT(DEC: LONGINT): STRING;
FUNCTION OCT2DEC(OCT: STRING): LONGINT;FUNCTION BIN2HEX(BIN: STRING): STRING;
FUNCTION HEX2BIN(HEX: STRING): STRING;
FUNCTION DEC2BASEN(BASE: INTEGER; DEC: LONGINT): STRING;
{ This function converts numbers from decimal (Base 10 notation) to
different systems of notation. Valid systems are from Base 2 notation
to Base 36 notation }
FUNCTION BASEN2DEC(BASE: INTEGER; NUM: STRING): LONGINT;
{ This function converts numbers from different systems of notation
to decimal (Base 10 notation). Valid systems are from Base 2 notation
to Base 36 notation }
IMPLEMENTATION
FUNCTION DEC2BIN(DEC: LONGINT): STRING;
VAR
BIN : STRING;
I, J: LONGINT;
BEGIN
IF DEC = 0 THEN BIN := '0'
ELSE
BEGIN
BIN := '';
I := 0;
WHILE (1 SHL (I + 1)) < =DEC DO I := I + 1;
{ (1 SHL (I + 1)) = 2^(I + 1) }
FOR J := 0 TO I DO
BEGIN
IF (DEC SHR (I - J)) = 1 THEN BIN := BIN + '1'
{ (DEC SHR (I - J)) = DEC DIV 2^(I - J) }
ELSE BIN := BIN + '0';
DEC := DEC AND ((1 SHL (I - J)) - 1);
{ DEC AND ((1 SHL (I - J)) - 1) = DEC MOD 2^(I - J) }
END;
END;
DEC2BIN := BIN;
END;
FUNCTION BIN2DEC(BIN: STRING): LONGINT;
VAR
J : LONGINT;
Error: BOOLEAN;
DEC : LONGINT;
BEGIN
DEC := 0;
Error := False;
FOR J := 1 TO Length(BIN) DO
BEGIN
IF (BIN[J] < > '0') AND (BIN[J] < > '1') THEN Error := True;
IF BIN[J] = '1' THEN DEC := DEC + (1 SHL (Length(BIN) - J));
{ (1 SHL (Length(BIN) - J)) = 2^(Length(BIN)- J) }
END;
IF Error THEN BIN2DEC := 0
ELSE BIN2DEC := DEC;
END;
FUNCTION DEC2HEX(DEC: LONGINT): STRING;
CONST
HEXDigts: STRING[16] = '0123456789ABCDEF';
VAR
HEX : STRING;
I, J: LONGINT;
BEGIN
IF DEC = 0 THEN HEX := '0'
ELSE
BEGIN
HEX := '';
I := 0;
WHILE (1 SHL ((I + 1) * 4)) < =DEC DO I := I + 1;
{ 16^N = 2^(N * 4) }
{ (1 SHL ((I + 1) * 4)) = 16^(I + 1) }
FOR J := 0 TO I DO
BEGIN
HEX := HEX + HEXDigts[(DEC SHR ((I - J) * 4)) + 1];
{ (DEC SHR ((I - J) * 4)) = DEC DIV 16^(I - J) }
DEC := DEC AND ((1 SHL ((I - J) * 4)) - 1);
{ DEC AND ((1 SHL ((I - J) * 4)) - 1) = DEC MOD 16^(I - J) }
END;
END;
DEC2HEX := HEX;
END;
FUNCTION HEX2DEC(HEX: STRING): LONGINT;
FUNCTION Digt(Ch: CHAR): BYTE;
CONST
HEXDigts: STRING[16] = '0123456789ABCDEF';
VAR
I: BYTE;
N: BYTE;
BEGIN
N := 0;
FOR I := 1 TO Length(HEXDigts) DO
IF Ch = HEXDigts[I] THEN N := I - 1;
Digt := N;
END;
CONST
HEXSet: SET OF CHAR = ['0'..'9', 'A'..'F'];
VAR
J : LONGINT;
Error: BOOLEAN;
DEC : LONGINT;
BEGIN
DEC := 0;
Error := False;
FOR J := 1 TO Length(HEX) DO
BEGIN
IF NOT (UpCase(HEX[J]) IN HEXSet) THEN Error := True;
DEC := DEC + Digt(UpCase(HEX[J])) SHL ((Length(HEX) - J) * 4);
{ 16^N = 2^(N * 4) }
{ N SHL ((Length(HEX) - J) * 4) = N * 16^(Length(HEX) - J) }
END;
IF Error THEN HEX2DEC := 0
ELSE HEX2DEC := DEC;
END;
FUNCTION DEC2OCT(DEC: LONGINT): STRING;
CONST
OCTDigts: STRING[8] = '01234567';
VAR
OCT : STRING;
I, J: LONGINT;
BEGIN
IF DEC = 0 THEN OCT := '0'
ELSE
BEGIN
OCT := '';
I := 0;
WHILE (1 SHL ((I + 1) * 3)) < =DEC DO I := I + 1;
{ 8^N = 2^(N * 3) }
{ (1 SHL (I + 1)) = 8^(I + 1) }
FOR J := 0 TO I DO
BEGIN
OCT := OCT + OCTDigts[(DEC SHR ((I - J) * 3)) + 1];
{ (DEC SHR ((I - J) * 3)) = DEC DIV 8^(I - J) }
DEC := DEC AND ((1 SHL ((I - J) * 3)) - 1);
{ DEC AND ((1 SHL ((I - J) * 3)) - 1) = DEC MOD 8^(I - J) }
END;
END;
DEC2OCT := OCT;
END;
FUNCTION OCT2DEC(OCT: STRING): LONGINT;
CONST
OCTSet: SET OF CHAR = ['0'..'7'];
VAR
J : LONGINT;
Error: BOOLEAN;
DEC : LONGINT;
BEGIN
DEC := 0;
Error := False;
FOR J := 1 TO Length(OCT) DO
BEGIN
IF NOT (UpCase(OCT[J]) IN OCTSet) THEN Error := True;
DEC := DEC + (Ord(OCT[J]) - 48) SHL ((Length(OCT) - J) * 3);
{ 8^N = 2^(N * 3) }
{ N SHL ((Length(OCT) - J) * 3) = N * 8^(Length(OCT) - J) }
END;
IF Error THEN OCT2DEC := 0
ELSE OCT2DEC := DEC;
END;
FUNCTION BIN2HEX(BIN: STRING): STRING;
FUNCTION SetHex(St: STRING; VAR Error: BOOLEAN): CHAR;
VAR
Ch: CHAR;
BEGIN
IF St = '0000' THEN Ch := '0'
ELSE IF St = '0001' THEN Ch := '1'
ELSE IF St = '0010' THEN Ch := '2'
ELSE IF St = '0011' THEN Ch := '3'
ELSE IF St = '0100' THEN Ch := '4'
ELSE IF St = '0101' THEN Ch := '5'
ELSE IF St = '0110' THEN Ch := '6'
ELSE IF St = '0111' THEN Ch := '7'
ELSE IF St = '1000' THEN Ch := '8'
ELSE IF St = '1001' THEN Ch := '9'
ELSE IF St = '1010' THEN Ch := 'A'
ELSE IF St = '1011' THEN Ch := 'B'
ELSE IF St = '1100' THEN Ch := 'C'
ELSE IF St = '1101' THEN Ch := 'D'
ELSE IF St = '1110' THEN Ch := 'E'
ELSE IF St = '1111' THEN Ch := 'F'
ELSE Error := True;
SetHex := Ch;
END;
VAR
HEX : STRING;
I : INTEGER;
Temp : STRING[4];
Error: BOOLEAN;
BEGIN
Error := False;
IF BIN = '0' THEN HEX := '0'
ELSE
BEGIN
Temp := '';
HEX := '';
IF Length(BIN) MOD 4 < > 0 THEN
REPEAT
BIN := '0' + BIN;
UNTIL Length(BIN) MOD 4 = 0;
FOR I := 1 TO Length(BIN) DO
BEGIN
Temp := Temp + BIN[I];
IF Length(Temp) = 4 THEN
BEGIN
HEX := HEX + SetHex(Temp, Error);
Temp := '';
END;
END;
END;
IF Error THEN BIN2HEX := '0'
ELSE BIN2HEX := HEX;
END;
FUNCTION HEX2BIN(HEX: STRING): STRING;
VAR
BIN : STRING;
I : INTEGER;
Error: BOOLEAN;
BEGIN
Error := False;
BIN := '';
FOR I := 1 TO Length(HEX) DO
CASE UpCase(HEX[I]) OF
'0': BIN := BIN + '0000';
'1': BIN := BIN + '0001';
'2': BIN := BIN + '0010';
'3': BIN := BIN + '0011';
'4': BIN := BIN + '0100';
'5': BIN := BIN + '0101';
'6': BIN := BIN + '0110';
'7': BIN := BIN + '0111';
'8': BIN := BIN + '1000';
'9': BIN := BIN + '1001';
'A': BIN := BIN + '1010';
'A': BIN := BIN + '1011';
'C': BIN := BIN + '1100';
'D': BIN := BIN + '1101';
'E': BIN := BIN + '1110';
'F': BIN := BIN + '1111';
ELSE Error := True;
END;
IF Error THEN HEX2BIN := '0'
ELSE HEX2BIN := BIN;
END;
FUNCTION Potens(X, E :LONGINT): LONGINT;
VAR
P, I : LONGINT;
BEGIN
P := 1;
IF E = 0 THEN P := 1
ELSE FOR I := 1 TO E DO P := P * X;
Potens := P;
END;
FUNCTION DEC2BASEN(BASE: INTEGER; DEC: LONGINT): STRING;
{ This function converts numbers from decimal (Base 10 notation) to
different systems of notation. Valid systems are from Base 2 notation
to Base 36 notation }
CONST
NUMString: STRING = '0123456789ABCDEFGHAIJKLMNOPQRSTUVWXYZ';
VAR
NUM : STRING;
I, J: INTEGER;
BEGIN
IF (DEC = 0) OR (BASE < 2) OR (BASE > 36) THEN NUM := '0'
ELSE
BEGIN
NUM := '';
I := 0;
WHILE Potens(BASE, I + 1) < =DEC DO I := I + 1;
FOR J := 0 TO I DO
BEGIN
NUM := NUM + NUMString[(DEC DIV Potens(BASE, I - J)) + 1];
DEC := DEC MOD Potens(BASE, I - J);
END;
END;
DEC2BASEN := NUM;
END;
FUNCTION BASEN2DEC(BASE: INTEGER; NUM: STRING): LONGINT;
{ This function converts numbers from different systems of notation
to decimal (Base 10 notation). Valid systems are from Base 2 notation
to Base 36 notation }
FUNCTION Digt(Ch: CHAR): BYTE;
CONST
NUMString: STRING = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
VAR
I: BYTE;
N: BYTE;
BEGIN
N := 0;
FOR I := 1 TO Length(NUMString) DO
IF Ch = NUMString[I] THEN N := I - 1;
Digt := N;
END;
CONST
NUMSet: SET OF CHAR = ['0'..'9', 'A'..'Z'];
VAR
J : INTEGER;
Error: BOOLEAN;
DEC : LONGINT;
BEGIN
DEC := 0;
Error := False;
IF (BASE < 2) OR (BASE > 36) THEN Error := True;
FOR J := 1 TO Length(NUM) DO
BEGIN
IF (NOT (UpCase(NUM[J]) IN NUMSet)) OR (BASE < Digt(NUM[J]) + 1) THEN Error
:= True;
DEC := DEC + Digt(UpCase(NUM[J])) * Potens(BASE, Length(NUM) - J);
END;
IF Error THEN BASEN2DEC := 0
ELSE BASEN2DEC := DEC;
END;
END.
|
Главная
Каталог файлов
