unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    GroupBox2: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    BitBtn1: TBitBtn;
    GroupBox4: TGroupBox;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Memo2: TMemo;
    Label1: TLabel;
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure get_number;
    procedure check;
    procedure check_ID;
    function s8(num:string):string;
    function triada(tri:string):string;
    function s16(num:string):string;
    function tetrada(tet:string):string;
    function s10(num:string):string;
    procedure BitBtn2Click(Sender: TObject);


    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);



  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  number:string;
  tri:string;
  tet:string;
  resultat8:string;
  resultat16:string;
  check_number:boolean;
implementation

{$R *.dfm}

uses Unit2;



procedure TForm1.BitBtn1Click(Sender: TObject);
begin
memo2.Clear;
number:='';
check_number:=false;
get_number;


end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
showmessage('Название продукта: Перевод чисел'+#10#13+'Курсовой проект по дисциплине "Методы программирования" 4 семестр'+#10#13+'Разработчик: Перепечо Георгий (группа 042 "Компьютерная безопасность")'+#10#13+'Copyright 2012'+#169+' Все права защищены.');
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
showmessage('Данное программное обеспечение предназначено для перевода чисел из двоичной системы счисления в десятеричную, восьмеричную или шестнадцатеричную, по выбору пользователя.');
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
If messageBox(0,'Вы действительно хотите выйти?','Подтверждение',
mb_YesNo)=mrYes then begin
  application.Terminate;
end;
end;





procedure TForm1.check;  // Проверка направления перевода
begin

if radiobutton1.Checked=true then s8(number);
if radiobutton2.Checked=true then s10(number);
if radiobutton3.Checked=true then s16(number);
end;

procedure TForm1.check_ID;  //Проверка корректности исходных данных
var
i:integer;

begin
for i := 1 to length(number) do begin
  if (number[i]<>'1')and(number[i]<>'0') then begin
   showmessage('Ошибка в исходных данных! Присуствуют лишние символы');
   check_number:=true;
   exit;
  end;
end;
if check_number=false then begin
 label1.Visible:=true;
 check;
end;
end;

procedure TForm1.get_number;  //Получение одного числа
var
i:integer;
begin

for i:= 1 to length(memo1.Text)+1 do begin
if (i=length(memo1.Text)+1)or(memo1.Text[i]=',') then begin
check_ID; end
else begin number:=number+memo1.Text[i];

end;
end;
if check_number=false then begin
 memo1.Text:=memo2.Text;
 showmessage('Данные обработаны успешно!');
 end;
end;



procedure TForm1.Memo1Click(Sender: TObject);
begin
label1.Visible:=false;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
label1.Visible:=false;
end;

function TForm1.s10(num: string): string;   //Перевод в десятеричную систему счисления
var
 l:integer;
 i:integer;
 sum:real;
begin
 l:=length(num);
 sum:=0;
 for i:=1 to l do
 begin
  sum:=sum+strtoint(num[i])*(exp(ln(2)*(l-i)));
 end;
  // form2.Memo1.Text:=form2.Memo1.Text+floattostr(sum)+',';
  memo2.Text:=memo2.Text+number+' = '+floattostr(sum)+',';
 number:='';
 sum:=0;
end;

function TForm1.s16(num: string): string; //Перевод в шестнадцатеричную систему счисления
var
 i:integer;
 l:integer;
 k:integer;
begin
 l:=0;
 tet:='';
 while (length(num) mod 4)<>0 do
 begin
  num:='0'+num;  {Добавляем ноль в начало числа, для получения полной тетрады}
 end;
 for i:=1 to length(num)+1 do
 begin
  l:=l+1;
   if l<5 then begin
    tet:=tet+num[i]; {Записываем по одному символу двоичного кода}

   end
   else begin
       tetrada(tet);
    tet:='';
    tet:=tet+num[i];
    l:=1;
   end;
 end;
 memo2.Text:=memo2.Text+number+' = '+resultat16+',';
 resultat16:='';
 number:='';
end;

function TForm1.s8(num:string):string;  //Перевод в восьмеричную систему счисления
var
 i:integer;
 l:integer;
 k:integer;
begin

 l:=0;
 tri:='';
 while (length(num) mod 3)<>0 do
 begin
  num:='0'+num;  {Добавляем ноль в начало числа, для получения полной триады}
 end;
 for i:=1 to length(num)+1 do
 begin
  l:=l+1;
   if l<4 then begin
    tri:=tri+num[i]; {Записываем по одному символу двоичного кода}
   end
   else begin

    triada(tri);
    tri:='';
    tri:=tri+num[i];
    l:=1;
   end;
 end;
memo2.Text:=memo2.Text+number+' = '+resultat8+',';
 resultat8:='';
 number:='';
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
memo1.Font.Size:=memo1.Font.Size+1;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
memo1.Font.Size:=memo1.Font.Size-1;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Messagedlg('По умолчанию выбирается папка, в которой размещена программа. Иначе, папку нужно выбрать самостоятельно',mtinformation,[mbok],0);
end;

function TForm1.tetrada(tet: string): string;
var
 t16:string;
begin
 if tet='0000' then t16:='0';
 if tet='0001' then t16:='1';
 if tet='0010' then t16:='2';
 if tet='0011' then t16:='3';
 if tet='0100' then t16:='4';
 if tet='0101' then t16:='5';
 if tet='0110' then t16:='6';
 if tet='0111' then t16:='7';
 if tet='1000' then t16:='8';
 if tet='1001' then t16:='9';
 if tet='1010' then t16:='A';
 if tet='1011' then t16:='B';
 if tet='1100' then t16:='C';
 if tet='1101' then t16:='D';
 if tet='1110' then t16:='E';
 if tet='1111' then t16:='F';
 tet:='';
 resultat16:=resultat16+t16;

end;




function TForm1.triada(tri: string): string;
var
t8:string;
begin
 if tri='000' then t8:='0';
 if tri='001' then t8:='1';
 if tri='010' then t8:='2';
 if tri='011' then t8:='3';
 if tri='100' then t8:='4';
 if tri='101' then t8:='5';
 if tri='110' then t8:='6';
 if tri='111' then t8:='7';
  resultat8:=resultat8+t8;
 tri:='';
end;


end.