2009. április 4., szombat

Converting Integers to Base n


Problem/Question/Abstract:

How do I convert integers from Decimal to Base n and vice versa.

Answer:

Solve 1:

unit BaseFunctions;
{Unit for conversion functions Dec_To_Base and Base_To_Dec.}
{These functions are designed to convert integers from Decimal to Base n}
{They can be used to create serial numbers for Compaq, etc.}
{See below for usage.}
{Written by Dave Murray, Nov 2000.}

interface

uses
  SysUtils;

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

implementation

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, 0, To_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, 0, To_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}

end. {unit BaseFunctions}


Solve 2:

function Dec2Numb(N: Longint; A, B: Byte): string;
var
  C: Integer;
{$IFDEF RX_D4}
  Number: Cardinal;
{$ELSE}
  Number: Longint;
{$ENDIF}
begin
  if N = 0 then
    Result := '0'
  else
  begin
{$IFDEF RX_D4}
    Number := Cardinal(N);
{$ELSE}
    Number := N;
{$ENDIF}
    Result := '';
    while Number > 0 do
    begin
      C := Number mod B;
      if C > 9 then
        C := C + 55
      else
        C := C + 48;
      Result := Chr(C) + Result;
      Number := Number div B;
    end;
  end;
  if Result <> '' then
    Result := AddChar('0', Result, A);
end;

function Numb2Dec(S: string; B: Byte): Longint;
var
  I, P: Longint;
begin
  I := Length(S);
  Result := 0;
  S := UpperCase(S);
  P := 1;
  while (I >= 1) do
  begin
    if S[I] > '@' then
      Result := Result + (Ord(S[I]) - 55) * P
    else
      Result := Result + (Ord(S[I]) - 48) * P;
    Dec(I);
    P := P * B;
  end;
end;

Code from RXLib library.

Nincsenek megjegyzések:

Megjegyzés küldése