[Back to STRINGS SWAG index]  [Back to Main SWAG index]  [Original]

{$R-}
UNIT HexWrite;
(**) INTERFACE (**)
TYPE HexString = String[9];
  BinString = String[32];

  FUNCTION HexByte(B : Byte) : HexString;
  FUNCTION HexShortInt(S : ShortInt) : HexString;
  FUNCTION HexWord(W : Word) : HexString;
  FUNCTION HexInteger(I : Integer) : HexString;
  FUNCTION HexLongInt(L : LongInt) : HexString;
  FUNCTION HexPointer(VAR P) : HexString;

  FUNCTION BinByte(B : Byte) : BinString;
  FUNCTION BinShortInt(S : ShortInt) : BinString;
  FUNCTION BinWord(W : Word) : BinString;
  FUNCTION BinInteger(I : Integer) : BinString;
  FUNCTION BinLongInt(L : LongInt) : BinString;

  FUNCTION NumBin(B : BinString) : LongInt;
  FUNCTION ANumBin(B : BinString) : LongInt;
(**) IMPLEMENTATION (**)
CONST
  HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  BinNibbles : ARRAY[0..15] OF ARRAY[0..3] OF Char = (
    '0000', '0001', '0010', '0011',
    '0100', '0101', '0110', '0111',
    '1000', '1001', '1010', '1011',
    '1100', '1101', '1110', '1111');

  FUNCTION HexByte(B : Byte) : HexString;
  VAR Temp : HexString;
  BEGIN
    Temp[0] := #2;
    Temp[1] := HexDigits[B SHR 4];
    Temp[2] := HexDigits[B AND $F];
    HexByte := Temp;
  END;

  FUNCTION HexShortInt(S : ShortInt) : HexString;
  BEGIN HexShortInt := HexByte(Byte(S)); END;

  FUNCTION HexWord(W : Word) : HexString;
  VAR Temp : HexString;
  BEGIN
    Temp[0] := #4;
    Temp[1] := HexDigits[W SHR 12];
    Temp[2] := HexDigits[(W SHR 8) AND $F];
    Temp[3] := HexDigits[(W SHR 4) AND $F];
    Temp[4] := HexDigits[W AND $F];
    HexWord := Temp;
  END;

  FUNCTION HexInteger(I : Integer) : HexString;
  BEGIN HexInteger := HexWord(Word(I)); END;

  FUNCTION HexLongInt(L : LongInt) : HexString;
  VAR Temp : HexString;
  BEGIN
    Temp[0] := #8;
    Temp[1] := HexDigits[L SHR 28];
    Temp[2] := HexDigits[(L SHR 24) AND $F];
    Temp[3] := HexDigits[(L SHR 20) AND $F];
    Temp[4] := HexDigits[(L SHR 16) AND $F];
    Temp[5] := HexDigits[(L SHR 12) AND $F];
    Temp[6] := HexDigits[(L SHR 8) AND $F];
    Temp[7] := HexDigits[(L SHR 4) AND $F];
    Temp[8] := HexDigits[L AND $F];
    HexLongInt := Temp;
  END;

  FUNCTION HexPointer(VAR P) : HexString;
  VAR
    Temp : HexString;
    L    : LongInt ABSOLUTE P;
  BEGIN
    Temp := HexLongInt(L);
    Move(Temp[5], Temp[6], 4);
    Temp[5] := ':';
    Inc(Temp[0]);
    HexPointer := Temp;
  END;

  FUNCTION BinByte(B : Byte) : BinString;
  VAR Temp : BinString;
  BEGIN
    Temp[0] := #8;
    Move(BinNibbles[B SHR 4], Temp[1], 4);
    Move(BinNibbles[B AND $F], Temp[5], 4);
    BinByte := Temp;
  END;

  FUNCTION BinShortInt(S : ShortInt) : BinString;
  BEGIN BinShortInt := BinByte(Byte(S)); END;

  FUNCTION BinWord(W : Word) : BinString;
  VAR Temp : BinString;
  BEGIN
    Temp[0] := #16;
    Move(BinNibbles[W SHR 12], Temp[1], 4);
    Move(BinNibbles[(W SHR 8) AND $F], Temp[5], 4);
    Move(BinNibbles[(W SHR 4) AND $F], Temp[9], 4);
    Move(BinNibbles[W AND $F], Temp[13], 4);
    BinWord := Temp;
  END;

  FUNCTION BinInteger(I : Integer) : BinString;
  BEGIN BinInteger := BinWord(Word(I)); END;

  FUNCTION BinLongInt(L : LongInt) : BinString;
  VAR Temp : BinString;
  BEGIN
    Temp[0] := #32;
    Move(BinNibbles[L SHR 28], Temp[1], 4);
    Move(BinNibbles[(L SHR 24) AND $F], Temp[5], 4);
    Move(BinNibbles[(L SHR 20) AND $F], Temp[9], 4);
    Move(BinNibbles[(L SHR 16) AND $F], Temp[13], 4);
    Move(BinNibbles[(L SHR 12) AND $F], Temp[17], 4);
    Move(BinNibbles[(L SHR 8) AND $F], Temp[21], 4);
    Move(BinNibbles[(L SHR 4) AND $F], Temp[25], 4);
    Move(BinNibbles[L AND $F], Temp[29], 4);
    BinLongInt := Temp;
  END;

  FUNCTION NumBin(B : BinString) : LongInt;
  VAR Accum, Power : LongInt;
    P : Byte;
  BEGIN
    Power := 1; Accum := 0;
    FOR P := length(B) DOWNTO 1 DO
      BEGIN
        IF B[P] = '1' THEN Inc(Accum, Power);
        Power := PoweR SHL 1;
      END;
    NumBin := Accum;
  END;

  FUNCTION ANumBin(B : BinString) : LongInt; Assembler;
  ASM
    LES DI, B
    XOR CH, CH
    MOV CL, ES:[DI]
    ADD DI, CX
    MOV AX, 0
    MOV DX, 0
    MOV BX, 1
    MOV SI, 0
    @LOOP:
      CMP BYTE PTR ES:[DI],'1'
      JNE @NotOne
        ADD AX, BX   {add power to accum}
        ADC DX, SI
      @NotOne:
      SHL SI, 1      {double power}
      SHL BX, 1
      ADC SI, 0
      DEC DI
    LOOP @LOOP
  END;

END.

[Back to STRINGS SWAG index]  [Back to Main SWAG index]  [Original]