Convert('ABC01','0123456789ABCDEF','01234567')

// Модуль для работы с натуральными числами в различных системах исчисления

 

// Далее, если говорится, что Система Исчисления (СИ) задается строкой (CharSet)

// то имеется в виду, что эта строка содержит символы требуемой СИ, начиная с нуля

// Примеры CharSet (стандартный вид)

// Двоичная          - '01'

// Восьмиричная      - '01234567'

// Десятичная        - '0123456789'

// Шестнадцатиричная - '0123456789ABCDEF'

// Можно использовать и нестандартные виды, например для двоичной 'ab', а для

// троичной 'abc' - данному модулю все равно.

 

// "-Ричность" СИ ограничена только наличием доступных различных символов.

// Работа с числами в определенной СИ производится как со строками, потому величина

// чисел значения почти не имеет, но это отрицательно сказывается на времени работы

// функций (особенно на умножении).

unit MyUnit;

 

interface

 

function Convert(Num, SetIn, SetOut: String): String;

function MySum (Num1, Num2, CharSet: String): String;

function MyMulti (Num1, Num2, CharSet: String): String;

function MyOrd(A: Char; CharSet: String): Integer;

function MyChr(Num: Integer; CharSet: String): Char;

 

implementation

 

// Функция возвращает позицию символа A в строке CharSet (начиная с 0)

function MyOrd(A: Char; CharSet: String): Integer;

var

  i: Integer;

begin

  Result := 0;

  for i := 1 to Length(CharSet) do

  begin

    if CharSet[i] = A then begin

      Result := i-1;

      exit;

    end

  end;

end;

 

// Функция возвращает символ из строки CharSet по номеру Num (~CharSet[Num+1])

function MyChr(Num: Integer; CharSet: String): Char;

begin

  Result := CharSet[Num mod Length(CharSet) + 1];

end;

 

// Функция возвращает число без ведущих нулей, то есть ShortNum('0000123')='123'

function ShortNum(Num, CharSet: String): String;

var

  k, j: Integer;

begin

  Result := '';

  k := 1;

  while Num[k] = MyChr(0, CharSet) do

    k := k + 1;

  for j := k to Length(Num) do Result := Result + Num[j];

end;

 

// Функция выполняет сложение двух чисел Num1 и Num2 в СИ, задаваемой CharSet

function MySum (Num1, Num2, CharSet: String): String;

var

  i, Pos, Add, L, L_CharSet: Integer;

  N1 , N2 , O, Res: String;

begin

 

  // Далее потребуется что бы первое число по длине было не менее второго,

  // если не так, то меняем местами

  if Length(Num1)>=Length(Num2) then

  begin

    N1 := Num1;

    N2 := Num2;

  end

  else

  begin

    N1 := Num2;

    N2 := Num1;

  end;

 

  L:= Length(N1);

  L_CharSet := Length(CharSet);

  O:=MyChr(0, CharSet); // 0 - в СИ, определяемой CharSet

 

  //Уравнняем второе до длины первого нулями справа: 10 = 010

  for i := Length(N2) to L-1 do

    N2 := O + N2;

 

  Add:=0;

 

  //Суммирование с младших разрядов, Add - добавка от предыдущих разрядов

  // для следующего. Напр. для 10-чной СИ: 9+7 - Add = 1, 4+5 - Add=0

  for i := L downto 1 do

  begin

    Pos := MyOrd(N1[i], CharSet)+MyOrd(N2[i], CharSet) + Add;

    Add := 0;

    while Pos >= L_CharSet do

     begin

     Pos := Pos mod L_CharSet;

     Add := Add + 1;

     end;

 

  Res := MyChr(Pos, CharSet) + Res;

  end;

 

If Add<>0

   then Result := MyChr(Add, CharSet) + Res

   else Result := Res;

end;

 

// Функция выполняет умножение двух чисел Num1 и Num2 в СИ, задаваемой CharSet

function MyMulti (Num1, Num2, CharSet: String): String;

var

  i, e, Res, N1, N2: String;

begin

  N1 := ShortNum(Num1, CharSet);

  N2 := ShortNum(Num2, CharSet);

 

  i :='';

  Res := '';

 

  //e - единица СИ, определяемая CharSet

  e := MyChr(1,CharSet);

 

  //Умножение Num1 на Num2 - это Num1 сложеное Num2 раз в СИ, определяемой CharSet

  while (i <> N2) do

  begin

    Res := MySum(Res, N1, CharSet);

    i := MySum(i, e, CharSet);

  end;

 

  Result := Res;

end;

 

// Функция выполняет преобразование одноразрядного числа A, заданного

// в СИ, определяемой SetIn, в число в СИ, определяемой SetOut

function f0(A: Char; SetIn, SetOut: String): String;

var

  Pos, j, L: Integer;

  Res: String;

begin

  L := Length(SetOut);

  Pos := MyOrd(A, SetIn);

 

  for j := 1 To Pos div (L-1) do

    Res := MySum(Res, MyChr(L-1, SetOut), SetOut);

 

  Result := MySum(Res, MyChr(Pos mod (L-1), SetOut), SetOut);

end;

 

// Функция выполняет преобразование числа Num, заданного

// в СИ, определяемой SetIn, в число в СИ, определяемой SetOut

function Convert(Num, SetIn, SetOut: String): String;

var

  Base, Multiplier, N, Res: String;

  i: Integer;

begin

  // Num = MultilplierN * Base^N + ... + Multiplier0 * Base^0

  // Base - основание СИ, это всегда <последний символ CharSet>+<нулевой символ> ~ 10

  // MultiplierI - множитель при соответствующей степени

  // Напр. для 10-чной СИ  -  123 = 1 * 10^2 + 2 * 10^1 + 3 * 10^0

  // Тут Base = 10, Multiplier = {1, 2, 3}

 

  Base := MySum(f0(MyChr(Length(SetIn)-1, SetIn), SetIn, SetOut), MyChr(1, SetOut), SetOut);

  N := MyChr(1, SetOut); // = Base^0, потом будем домножать на Base (в соотв. СИ)

  Res := '';

 

  // Обрабатываем входящее число с хвоста

  for i := Length(Num) downto 1 do

  begin

    Multiplier := f0(Num[i], SetIn, SetOut);

    Res := MySum(Res, MyMulti(Multiplier, N, SetOut), SetOut);

    N := MyMulti(Base, N, SetOut);

  end;

 

  Result := Res;

end;

 

end.

const

  CharSetIn  = '0123456789ABCDEF';

  CharSetOut = '01';

 

// Пример конвертирует число FFA из 16-ричной СИ в двоичную

Convert('FFA',CharSetIn,CharSetOut);

 

 

// CharSet = "01234567" - 8-ми ричная система исчисления

// MyChr(0) = "0", MyChr(7) = "7", MyChr(8) = "0"

// Всегда: A = Ai*Base^i + ... + A1*Base + A0, где Ai in CharSet

// Base = MyChr(Len(CharSet)-1) + 1 ~ 10 (соотв. СИ)

 

// РЕАЛИЗОВАННЫЕ ФУНКЦИИ

// Convert - преобразование числа из одной СИ в другую

// f0 - преобразование одного символа исходной СИ в другую (впомогат.)

// MySum - сумма двух чисел в некоторой СИ

// MyMult - произведение двух чисел в некоторой СИ

// MyChr - по номеру возвращает символ

// MyOrd - по символу возвращает номер в CharSet

 

//**MyOrd**************************************************************

function MyOrd(A: Char; CharSet: String): Integer;

var i: Integer;

begin

Result:=0;

for i:=1 to Length(CharSet) do

  begin

  if CharSet[i]=A then

     begin

     Result:=i-1;

     exit;

     end

  end;

end;

 

//**MyChr**************************************************************

function MyChr(Num: Integer; CharSet: String): Char;

begin

Result := CharSet[Num mod Length(CharSet) + 1];

end;

 

//**MySum************************************************************

function MySum (A, B, CharSet: String): String;

var

  i, Pos, Add, L, L_CharSet: Integer;

  AA,BB, O, Res: String;

begin

if Length(A)>=Length(B)

   then begin AA:=A; BB:=B; end

   else begin AA:=B; BB:=A; end;

 

L:= Length(AA);

L_CharSet := Length(CharSet);

O:=MyChr(0, CharSet);

 

for i := Length(BB) to L-1 do

BB := O + BB;

 

Add:=0;

for i:= L downto  1 do

  begin

  Pos := MyOrd(AA[i], CharSet)+MyOrd(BB[i],CharSet) + Add;

  Add := 0;

  While Pos >= L_CharSet do

     begin

     Pos := Pos mod L_CharSet;

     Add := Add+1;

     end;

 

  Res := MyChr(Pos, CharSet) + Res;

  end;

 

If Add<>0

   then Result := MyChr(Add, CharSet) + Res

   else Result:=res;

end;

 

//**MyMulti************************************************************

function MyMulti (A, B, CharSet: String): String;

var

  i, e, Res, AA, BB: String;

  j, k: Integer;

begin

AA:='';BB:='';

k:=1; while A[k]=MyChr(0,CharSet) do k:=k+1; for j:=k to Length(A) do AA:=AA+A[j];

k:=1; while B[k]=MyChr(0,CharSet) do k:=k+1; for j:=k to Length(B) do BB:=BB+B[j];

 

i :=''; Res := '';

 

e:=MyChr(1,CharSet);

while (i<>BB) do

  begin

  Res := MySum(Res, AA, CharSet);

  i := MySum(i,e,CharSet);

  end;

Result:= Res;

end;

 

//**f0****************************************************************

function f0(A: Char; SetIn, SetOut: String): String;

var

  Pos, j, L: Integer;

  Res: String;

begin

L := Length(SetOut);

Pos := MyOrd(A,SetIn);

For j := 1 To Pos div (L-1) do

Res := MySum( Res,MyChr(L-1,SetOut),SetOut);

Result := MySum(Res,MyChr(Pos mod (L-1),SetOut),SetOut);

end;

 

//**Convert************************************************************

function Convert(A, SetIn, SetOut: String): String;

var

  Base, Multiplier, N, Res: String;

  i: Integer;

begin

Base := MySum(f0(MyChr(Length(SetIn)-1,SetIn),SetIn,SetOut),MyChr(1,SetOut),SetOut);

N:=MyChr(1,SetOut);

Res:='';

 

for i:= Length(A) downto 1 do

  begin

  Multiplier := f0(A[i],SetIn,SetOut);

  Res := MySum(Res,MyMulti(Multiplier,N,SetOut),SetOut);

  N := MyMulti(Base,N,SetOut);

  end;

 

Result := Res;

end;