Funcao - hex para bin para int para roman

Top  Previous  Next

HEX -> Integer

--------------------------------------------------------------------------------

 

var

  i : integer

  s : string;

begin

  s := '$' + ThatHexString;

  i := StrToInt(a);

end;

 

 

function HexaToDecimal(Hexa:string):longint; 

const 

   ValoresHexa : array['A'..'F'of integer = (10,11,12,13,14,15); 

var 

   nDecimal : longint; 

   nIndex : byte; 

begin 

   nDecimal := 0

   Hexa := Uppercase(Hexa); 

   for nIndex := Length(Hexa) downto 1 do 

       if Hexa[nIndex] in ['0'..'9'

       then nDecimal := nDecimal + StrToInt(Hexa[nIndex]) * 

                        Trunc(Exp((Length(Hexa)-nIndex)*ln(16))) 

       else nDecimal := nDecimal + ValoresHexa[Hexa[nIndex]] * 

                        Trunc(Exp((Length(Hexa)-nIndex)*ln(16))); 

   HexaToDecimal := nDecimal; 

end;

 

--------------------------------------------------------------------------------

 

Dec To HEX

 

--------------------------------------------------------------------------------

 

HexString := Format('%0x',DecValue);

 

 

--------------------------------------------------------------------------------

 

ASCII to HEX / math

 

BytesToHexStr does this [0,1,1,0of byte would be converted to string := '30313130'; HexStrToBytes goes the other way. 

 

--------------------------------------------------------------------------------

 

unit Hexstr;

 

interface

uses String16, SysUtils;

 

Type

 PByte = ^BYTE;

 

procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);

procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);

procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);

 

implementation

procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);

Const

    HexChars : Array[0..15of Char = '0123456789ABCDEF';

var

    i, j: WORD;

begin

 SetLength(hHexStr, (InputLength * 2));

 FillChar(hHexStr, sizeof(hHexStr), #0);

 j := 1;

 for i := 1 to InputLength  do begin

    hHexStr[j] := Char(HexChars[pbyteArray^ shr  4]); inc(j);

    hHexStr[j] := Char(HexChars[pbyteArray^ and 15]); inc(j);

    inc(pbyteArray);

 end;

end;

 

procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);

var

 i: WORD;

 c: byte;

begin

 SetLength(Response, InputLength);

 FillChar(Response, SizeOf(Response), #0);

 for i := 0 to (InputLength - 1) do begin

   c := BYTE(hexbytes[i]) And BYTE($f);

   if c > 9 then

     Inc(c, $37)

   else

     Inc(c, $30);

   Response[i + 1] := char(c);

 end;{for}

end;

 

procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);

{pbyteArray must point to enough memory to hold the output}

var

 i, j: WORD;

 tempPtr: PChar;

 twoDigits : String[2];

begin

 tempPtr := pbyteArray;

 j := 1;

 for i := 1 to (Length(hHexStr) DIV 2) do begin

   twoDigits := Copy(hHexStr, j, 2); Inc(j, 2);

   PByte(tempPtr)^ := StrToInt('$' + twoDigits); Inc(tempPtr);

 end;{for}

end;

 

end.

 

 

--------------------------------------------------------------------------------

UNIT String16.

interface

{$IFNDEF Win32}

  procedure SetLength(var S: string; Len: Integer);

  procedure SetString(var Dst: string; Src: PChar; Len: Integer);

{$ENDIF}

implementation

{$IFNDEF Win32}

  procedure SetLength(var S: string; Len: Integer);

  begin

    if Len > 255 then

      S[0] := Chr(255)

    else

      S[0] := Chr(Len)

  end;

 

  procedure SetString(var Dst: string; Src: PChar; Len: Integer);

  begin

    if Len > 255 then

      Move(Src^, Dst[1], 255)

    else

      Move(Src^, Dst[1], Len);

    SetLength(Dst, Len);

  end;

{$ENDIF}

end.

 

 

--------------------------------------------------------------------------------

Convert binary to decimal

--------------------------------------------------------------------------------

 

function BinToInt(const Value: string): LongInt;

var

  i,Size: Integer;

begin

   Result := 0;

   Size   := Length(Value);

   for i := (Size - 1) downto 0 do

     Result := Result + Trunc(StrToInt(Copy(Value, Size - i, 1)) * Power(2,I));

end;

 

--------------------------------------------------------------------------------

Give this function any decimal value (1...3999), and it will return you a string containing the proper value in Roman notation.

 

--------------------------------------------------------------------------------

 

function DecToRoman( Decimal: LongInt ): String;

const

  Romans:  Array[1..13of String =

    ( 'I''IV''V''IX''X''XL''L''XC''C''CD''D''CM''M' );

 

  Arabics: Array[1..13of Integer = 

    ( 1459104050901004005009001000);

 

var 

  i: Integer;

  scratch: String;

begin

  scratch := '';

  for i := 13 downto 1 do

    while ( Decimal >= Arabics[i] ) do

    begin

      Decimal := Decimal - Arabics[i];

      scratch := scratch + Romans[i];

    end;

  Result := scratch;

end;

 

--------------------------------------------------------------------------------

 

Unix strings (Reading and Writing Unix Files)

 

This is a unit that I wrote for reading and writing Unix files. 

--------------------------------------------------------------------------------

 

unit StreamFile;

{

        Unix Stream File Interface

        Copyright 1996 by John Miano Software

        miano@worldnet.att.net

 

}

interface

 

Uses

  SysUtils ;

 

Procedure AssignStreamFile (var F : Text ; Filename : String) ;

 

implementation

 

Const

  BufferSize = 128 ;

 

Type

  TStreamBuffer = Array [1..High (Integer)] of Char ;

  TStreamBufferPointer = ^TStreamBuffer ;

 

  TStreamFileRecord = Record

    Case Integer Of

      1:

        (

          Filehandle : Integer ;

          Buffer : TStreamBufferPointer ;

          BufferOffset : Integer ;

          ReadCount : Integer ;

        ) ;

      2:

        (

          Dummy : Array [1 .. 32Of Char

        )

    End ;

 

 

Function StreamFileOpen (var F : TTextRec) : Integer ;

  Var

    Status : Integer ;

  Begin

  With TStreamFileRecord (F.UserData) Do

    Begin

    GetMem (Buffer, BufferSize) ;

    Case F.Mode Of

      fmInput:

        FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone) ;

      fmOutput:

        FileHandle := FileCreate (StrPas (F.Name)) ;

      fmInOut:

        Begin

        FileHandle := FileOpen (StrPas (F.Name), fmShareDenyNone Or 

fmOpenWrite or fmOpenRead) ;

        If FileHandle <> -1 Then

          status := FileSeek (FileHandle, 02) ; { Move to end of file. }

        F.Mode := fmOutput ;

        End ;

      End ;

    BufferOffset := 0 ;

    ReadCount := 0 ;

    F.BufEnd := 0 ;  { If this is not here it thinks we are at eof. }

    If FileHandle = -1 Then

      Result := -1

    Else

      Result := 0 ;

    End ;

  End ;

 

Function StreamFileInOut (var F : TTextRec) : Integer ;

  Procedure Read (var Data : TStreamFileRecord) ;

    Procedure CopyData ;

      Begin

      While (F.BufEnd < Sizeof (F.Buffer) - 2)

            And (Data.BufferOffset <= Data.ReadCount)

            And (Data.Buffer [Data.BufferOffset] <> #10) Do

        Begin

        F.Buffer [F.BufEnd] := Data.Buffer^ [Data.BufferOffset] ;

        Inc (Data.BufferOffset) ;

        Inc (F.BufEnd) ;

        End ;

      If Data.Buffer [Data.BufferOffset] = #10 Then

        Begin

        F.Buffer [F.BufEnd] := #13 ;

        Inc (F.BufEnd) ;

        F.Buffer [F.BufEnd] := #10 ;

        Inc (F.BufEnd) ;

        Inc (Data.BufferOffset) ;

        End ;

      End ;

 

    Begin

 

    F.BufEnd := 0 ;

    F.BufPos := 0 ;

    F.Buffer := '' ;

    Repeat

      Begin

      If (Data.ReadCount = 0Or (Data.BufferOffset > Data.ReadCount) Then

        Begin

        Data.BufferOffset := 1 ;

        Data.ReadCount := FileRead (Data.FileHandle, Data.Buffer^, BufferSize) 

;

        End ;

      CopyData ;

      End Until (Data.ReadCount = 0)

                Or (F.BufEnd >= Sizeof (F.Buffer) - 2) ;

    Result := 0 ;

    End ;

 

  Procedure Write (var Data : TStreamFileRecord) ;

    Var

      Status : Integer ;

      Destination : Integer ;

      II : Integer ;

    Begin

    With TStreamFileRecord (F.UserData) Do

      Begin

      Destination := 0 ;

      For II := 0 To F.BufPos - 1 Do

        Begin

        If F.Buffer [II] <> #13 Then

          Begin

          Inc (Destination) ;

          Buffer^[Destination] := F.Buffer [II] ;

          End ;

        End ;

      Status := FileWrite (FileHandle, Buffer^, Destination) ;

      F.BufPos := 0 ;

      Result := 0 ;

      End ;

    End ;

  Begin

  Case F.Mode Of

    fmInput:

      Read (TStreamFileRecord (F.UserData)) ;

    fmOutput:

      Write (TStreamFileRecord (F.UserData)) ;

    End ;

  End ;

 

Function StreamFileFlush (var F : TTextRec) : Integer ;

  Begin

  Result := 0 ;

  End ;

 

Function StreamFileClose (var F : TTextRec) : Integer ;

  Begin

  With TStreamFileRecord (F.UserData) Do

    Begin

    FreeMem (Buffer) ;

    FileClose (FileHandle) ;

    End ;

  Result := 0 ;

  End ;

 

Procedure AssignStreamFile (var F : Text ; Filename : String) ;

  Begin

  With TTextRec (F) Do

    Begin

    Mode := fmClosed ;

    BufPtr := @Buffer ;

    BufSize := Sizeof (Buffer) ;

    OpenFunc := @StreamFileOpen ;

    InOutFunc := @StreamFileInOut ;

    FlushFunc := @StreamFileFlush ;

    CloseFunc := @StreamFileClose ;

    StrPLCopy (Name, FileName, Sizeof(Name) - 1) ;

    End ;

  End ;

end.

 

--------------------------------------------------------------------------------

 

Decimals to binary 

 

From: cehjohnson@aol.com (CEHJohnson)

Yes, ironic that it's so difficult to find routines to convert from decimal to binary isn't it!

 

The following should work.(for negative numbers too)

 

--------------------------------------------------------------------------------

 

function DecToBinStr(n: integer): string;

 

var

  S: string;

  i: integer;

  Negative: boolean;

 

begin

  if n < 0 then Negative := true;

  n := Abs(n);

  for i := 1 to SizeOf(n) * 8 do

  begin

    if n < 0 then S := S + '1' else S := S + '0';

    n := n shl 1;

  end;

  Delete(S,1,Pos('1',S) - 1);//remove leading zeros

  if Negative then S := '-' + S;

  Result := S;

end;

 

--------------------------

 

function Dec_To_Base(nBase, nDec_Value, Lead_Zeros:integer; cOmit:string):string; 

{Function   : converts decimal integer to base n, max = Base36 

Parameters : nBase      = base number, ie. Hex is base 16 

              nDec_Value = decimal to be converted 

              Lead_Zeros = min number of digits if leading zeros required 

              cOmit      = chars to omit from base (eg. I,O,U,etc) 

Returns    : number in base n as string} 

var 

   Base_PChar : PChar; 

   Base_String : string; 

   To_Del, Modulus, DivNo : integer; 

   temp_string : string; 

   i, nLen, Len_Base : integer; 

begin 

     {initialise..} 

     Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';  {max = Base36} 

     To_Del := 0

     Modulus := 0

     DivNo := nDec_Value; 

     result := ''

     if (nBase > 36) then nBase := 36{max = Base36} 

     cOmit := UpperCase(cOmit); 

     {build string to fit specified base} 

     if not(cOmit = '') then begin 

        {iterate thru' ommited letters} 

        nLen := Length(cOmit); 

        for i := 1 to nLen do begin 

            To_Del := Pos(cOmit[i], Base_String); {find position of letter} 

            if (To_Del > 0) then begin 

               {remove letter from base string} 

               Len_Base := Length(Base_String); 

               temp_string := Copy(Base_String, 0To_Del - 1); 

               temp_string := temp_string + Copy(Base_String,To_Del + 1,Len_Base - To_Del); 

               Base_String := temp_string; 

               end{if To_Del>0..} 

            end{for i..} 

        end{if not cOmit=''..} 

     {ensure string is required length for base} 

     SetLength(Base_String, nBase); 

     Base_PChar := PChar(Base_String); 

     {divide decimal by base & iterate until zero to convert it} 

     while DivNo > 0 do begin 

           Modulus := DivNo mod nBase; {remainder is next digit} 

           result := Base_PChar[Modulus] + result; 

           DivNo := DivNo div nBase; 

           end{while..} 

     {fix zero value} 

     if (Length(result) = 0) then result := '0'

     {add required leading zeros} 

     if (Length(result) < Lead_Zeros) then 

        for i := 1 to (Lead_Zeros - Length(result)) do result := '0' + result; 

end{function Dec_To_Base} 

 

function Base_To_Dec(nBase:integer;cBase_Value, cOmit:string):integer; 

{Function   : converts base n integer to decimal, max = Base36 

Parameters : nBase       = base number, ie. Hex is base 16 

              cBase_Value = base n integer (as string) to be converted 

              cOmit       = chars to omit from base (eg. I,O,U,etc) 

Returns    : number in decimal as string} 

var 

   Base_PChar : PChar; 

   Base_String : string; 

   To_Del, Unit_Counter : integer; 

   temp_string : string; 

   i, nLen, Len_Base : integer; 

begin 

     {initialise..} 

     Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';  {max = Base36} 

     To_Del := 0

     Unit_Counter := nBase; 

     result := 0

     if (nBase > 36) then nBase := 36{max = Base36} 

     cOmit := UpperCase(cOmit); 

     cBase_Value := UpperCase(cBase_Value); {ensure uppercase letters} 

     {build string to fit specified base} 

     if not(cOmit = '') then begin 

        {iterate thru' ommited letters} 

        nLen := Length(cOmit); 

        for i := 1 to nLen do begin 

            To_Del := Pos(cOmit[i], Base_String); {find position of letter} 

            if (To_Del > 0) then begin 

               {remove letter from base string} 

               Len_Base := Length(Base_String); 

               temp_string := Copy(Base_String, 0To_Del - 1); 

               temp_string := temp_string + Copy(Base_String,To_Del + 1,Len_Base - To_Del); 

               Base_String := temp_string; 

               end{if To_Del>0..} 

            end{for i..} 

        end{if not cOmit=''..} 

     {ensure string is required length for base} 

     SetLength(Base_String, nBase); 

     Base_PChar := PChar(Base_String); 

     {iterate thru digits of base n value, each digit is a multiple of base n} 

     nLen := Length(cBase_Value); 

     if (nLen = 0) then result := 0 {fix zero value} 

     else begin 

          for i := 1 to nLen do begin 

              if (i = 1) then unit_counter := 1 {1st digit = units} 

              else if (i > 1) then unit_counter := unit_counter * nBase; {multiples of base} 

              result := result 

                     + ((Pos(Copy(cBase_Value, (Length(cBase_Value)+1)-i, 1), Base_PChar) - 1

                     * unit_counter); 

              end{for i:=1..} 

          end{else begin..} 

end{function Base_To_Dec}