Перевод чисел из одной системы счисления в другую

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    // Исходное число в десятичной системе счисления.
    // Десятичная точка обозначается знаком запятая: ','
    edDecimalNum: TEdit;
    // Число в заданной системе счисления,
    // получившееся в результате прербразования.
    edXNum: TEdit;
    // Число задающее основание системы счисления.
    edBase: TEdit;
    // Точность преобразования - количество знаков после запятой в результирующем
    // представлении числа.
    edPrecision: TEdit;
    // Кнопка по нажатию на которую происходит преобразование.
    BtnTranslate: TButton;
    //Ниже - надписи для перечисленных выше элементов.
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    // Обработчик события onClick для BtnTranslate.
    procedure BtnTranslateClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function IntToDigit(aVal : Byte) : String;
begin
  case aVal of
    0..9 : Result := IntToStr(aVal);
    10   : Result := 'A';
    11   : Result := 'B';
    12   : Result := 'C';
    13   : Result := 'D';
    14   : Result := 'E';
    15   : Result := 'F';
  end;
end;
 
function DecimalToXStr (aBase : Byte; Precision : Byte; aVal : Extended) : String;
var
  Val : Extended;
  IntVal : Int64;
  FracVal : Extended;
  StrInt : String;
  StrFrac : String;
  i : Integer;
begin
  // Получаем целую и дробную части числа.
  IntVal := Trunc(aVal);
  FracVal := Frac(aVal);
 
  //Переводим целую часть.
  StrInt := '';
  repeat
    StrInt := IntToDigit(IntVal mod aBase) + StrInt;
    IntVal := IntVal div aBase;
  until IntVal = 0;
 
  // Если дробная часть = 0, то перевод закончен.
  if FracVal = 0 then begin
    Result := StrInt;
    exit;
  end;
 
  //Переводим дробную часть. Точность - до Precision цифр после запятой.
  StrFrac := '';
  for i := 1 to Precision do begin
    Val := FracVal * aBase;
    StrFrac := StrFrac + IntToDigit(Trunc(Val));
    FracVal := Frac(Val);
    //Если дробная часть = 0, то перевод закончен.
    if FracVal = 0 then Break;
  end;
 
  Result := StrInt + ',' + StrFrac;
 
end;
 
procedure TForm1.BtnTranslateClick(Sender: TObject);
begin
  edXNum.Text := DecimalToXStr(
    StrToInt(edBase.Text),
    StrToInt(edPrecision.Text),
    StrToFloat(edDecimalNum.Text)
  );
end;
 
end.

unit uMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls
 
  ,Math;
 
type
  TfrmMain = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    edSrcBase: TEdit;
    edSrcNum: TEdit;
    edTrgPrecision: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    btnTransform: TButton;
    edTrgBase: TEdit;
    edTrgNum: TEdit;
    procedure btnTransformClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  frmMain: TfrmMain;
 
implementation
 
uses StrUtils;
 
{$R *.dfm}
 
//Определяет какая цифра соответствует числу.
function IntToDigit(aNum : Byte) : String;
const
  SelfName : String = 'IntToDigit.';
begin
  case aNum of
    0..9 : Result := IntToStr(aNum);
    10   : Result := 'A';
    11   : Result := 'B';
    12   : Result := 'C';
    13   : Result := 'D';
    14   : Result := 'E';
    15   : Result := 'F';
  else
    Raise Exception.Create(SelfName + ' Числу не сопоставлена цифра!');
  end;
end;
 
//Определяет какое число соответствует цифре.
function DigitToInt(aDigit : AnsiChar; aBase : Byte) : Byte;
const
  SelfName : String = 'DigitToInt.';
begin
  if aBase < 2 then
    Raise Exception.Create(SelfName + ' Основание системы счисления должно быть >= 2!')
  ;
  case aDigit of
    '0'..'9' : Result := StrToInt(aDigit);
    'A', 'a' : Result := 10;
    'B', 'b' : Result := 11;
    'C', 'c' : Result := 12;
    'D', 'd' : Result := 13;
    'E', 'e' : Result := 14;
    'F', 'f' : Result := 15;
  else
    Raise Exception.Create(SelfName + ' Неизвестный символ в представлении числа!');
  end;
  if Result > aBase - 1 then
    Raise Exception.Create(SelfName + ' В данной системе счисления нет такой цифры!')
  ;
end;
 
//По записи числа в системе счисления с онованием aBase, определяет само это число.
function XcimalStrToNumber(aStrXcimal : String; aBase : Byte) : Extended;
const
  SelfName : String = 'XcimalStrToNumber.';
var
  i, j      : Integer;
  StrInt    : String;
  StrFrac   : String;
  Pos1      : Integer;
 
  IntPart    : Extended;
  FracPart   : Extended;
begin
  if Length(aStrXcimal) = 0 then
    Raise Exception.Create(SelfName + ' Не задано число!')
  ;
 
  //Ищем десятичную точку. Она у нас обозначается знаком запятая: ','.
  Pos1 := Pos(',', aStrXcimal);
 
  //Определяем подстроку с записью целой части числа
  //и подстроку с записью дробной части.
  if Pos1 = 0 then begin
    //Значит число состоит только из целой части.
    StrInt := aStrXcimal;
    StrFrac := '';
  end else begin
    //Число имеет целую и дробную части.
    StrInt := LeftStr(aStrXcimal, Pos1 - 1);
    StrFrac := Copy(aStrXcimal, Pos1 + 1, Length(aStrXcimal) - Pos1);
  end;
 
  //Определяем значение целой части числа.
  IntPart := 0;
  for i := 1 to Length(StrInt) do begin
    //Порядок разряда = позиции разряда при отсчёте от нуля в направлении справа налево.
    j := Length(StrInt) - i;
    IntPart := IntPart + DigitToInt(StrInt[i], aBase) * Power(aBase, j);
  end;
 
  //Определяем значение дробной части числа.
  //В начале вычисляем значение аналогично тому, как это сделано для целой части:
  FracPart := 0;
  for i := 1 to Length(StrFrac) do begin
    j := Length(StrFrac) - i;
    FracPart := FracPart + DigitToInt(StrFrac[i], aBase) * Power(aBase, j);
  end;
  //Теперь учитываем экспоненциальную часть:
  FracPart := FracPart / Power(aBase, Length(StrFrac));
 
  //Получаем число, которое соответствует записи aStrXcimal
  //в системе счисления с основанием aBase.
  Result := IntPart + FracPart;
 
end;
 
//Преобразует запись числа в системе счисления с основанием aSrcBase в запись
//этого же числа в системе счисления с онованием aTrgBase.
//Преобразование производится с точностью до aTrgPrecision цифр после запятой
//в результирующем представлении числа.
function XcimalStrToYcimalStr (
  aSrcBase : Byte;
  aSrcNumStr : String;
  aTrgBase : Byte;
  aTrgPrecision : Byte
) : String;
var
  //Число соответствующее записи aSrcNumStr в системе счисления с основанием aSrcBase.
  SrcNum : Extended;
  //Целая часть, выделенная из числа SrcNum.
  IntPart : Int64;
  //Дробная часть, выделенная из числа SrcNum.
  FracPart : Extended;
  //Представление целой части числа SrcNum в системе счисления с основанием aTrgBase.
  StrInt : String;
  //Представление дробной части числа SrcNum в системе счисления с основанием aTrgBase.
  StrFrac : String;
  //Счетчик.
  i : Integer;
  //Для промежуточных вычислений.
  TempNum : Extended;
begin
 
  //Исходное число.
  SrcNum := XcimalStrToNumber(aSrcNumStr, aSrcBase);
 
  // Получаем целую и дробную части числа.
  IntPart := Trunc(SrcNum);
  FracPart := Frac(SrcNum);
 
  //Переводим целую часть.
  StrInt := '';
  repeat
    StrInt := IntToDigit(IntPart mod aTrgBase) + StrInt;
    IntPart := IntPart div aTrgBase;
  until IntPart = 0;
 
  // Если дробная часть = 0, то перевод закончен.
  if FracPart = 0 then begin
    Result := StrInt;
    exit;
  end;
 
  //Переводим дробную часть. Точность - до aTrgPrecision цифр после запятой.
  StrFrac := '';
  for i := 1 to aTrgPrecision do begin
    TempNum := FracPart * aTrgBase;
    StrFrac := StrFrac + IntToDigit(Trunc(TempNum));
    FracPart := Frac(TempNum);
    //Если дробная часть = 0, то перевод закончен.
    if FracPart = 0 then Break;
  end;
 
  Result := StrInt + ',' + StrFrac;
 
end;
 
procedure TfrmMain.btnTransformClick(Sender: TObject);
begin
  edTrgNum.Text := XcimalStrToYcimalStr(
    StrToInt(edSrcBase.Text),
    edSrcNum.Text,
    StrToInt(edTrgBase.Text),
    StrToInt(edTrgPrecision.Text)
  );
end;
 
end.

var
  N, R: integer;
  Bin: string;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  N := StrToInt(Edit1.Text);
  Label1.Caption := '';
  Bin := ' ';
  while N>0 Do
  begin
    R:=N mod 2;
    N:=N div 2;
    Bin := FloatToStr(R) + Bin;
  end;
  Label1.Caption := Bin;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  N := StrToInt(Edit1.Text);
  Label2.Caption := '';
  Bin := ' ';
  while N>0 Do
  begin
    R:=N mod 8;
    N:=N div 8;
    Bin := FloatToStr(R) + Bin;
  end;
  Label2.Caption := Bin;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  N := StrToInt(Edit1.Text);
  Label3.Caption := '';
  Bin := ' ';
  while N>0 Do
  begin
    R:=N mod 16;
    N:=N div 16;
    Bin := FloatToStr(R) + Bin;
  end;
  Label3.Caption := Bin;
end;
 
end.

procedure TForm1.Button3Click(Sender: TObject);
begin
  N := StrToInt(Edit1.Text);
  Label3.Caption := '';
  Bin := ' ';
  while N>0 Do
  begin
    R:=N mod 16;
    N:=N div 16;
    case R of
      0..9 : Bin := IntToStr(R) + Bin;
      10   : Bin := 'A' + Bin;
      11   : Bin := 'B' + Bin;
      12   : Bin := 'C' + Bin;
      13   : Bin := 'D' + Bin;
      14   : Bin := 'E' + Bin;
      15   : Bin := 'F' + Bin;
    end
  end;
  Label3.Caption := Bin;
end;