unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  aString = array[1..16] of string;
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function CharCount(Str: string):word;   //Считает кол-во символов строке
var
  leng: word;
begin
  leng := Length(Str);
  Result := leng;
end;






Procedure addingZero(var Str: string);   // дописывает нули в начале строки
var
  mant, i, l, length: integer;
  s: string;
  b,c: extended;
begin
  s := '';
  length := CharCount(Str);
  mant := length div 4;
  i := 4 * (mant+1) - length;
  for l := 1 to i Do
    begin
      Insert('0', S, 0); //(a,b,n)  вставляет строку а в строку b начинаю с позиции n
    end;
  Insert(S, Str, 0);
end;




Function get_aString():aString; // возвращает массив
var
  astr: aString;
begin
  astr[2]:='0001'; astr[5]:='0100'; astr[8]:='0111'; astr[11]:='1010';
  astr[3]:='0010'; astr[6]:='0101'; astr[9]:='1000'; astr[12]:='1011';
  astr[4]:='0011'; astr[7]:='0110'; astr[10]:='1001'; astr[13]:='1100';
  astr[14]:='1101'; astr[15]:='1110'; astr[16]:='1111'; astr[1]:='0000';
  Result := astr;
end;

Function decString(var Str: string): string;
var
  s: string;
begin
  s := Copy(Str, 0, 4);

  Delete(str, 1, 4);

  result := s;
end;



Function Translate(Str: string): string; // перевод из
var
  astr: aString; // массив из 16 эллементов
  i,iPos: word;//текущее положение указателя в строке Str
  s, newStr: string;
begin
  ipos := 0;
  astr := get_aString();
  addingZero(str);
  While(CharCount(Str) <> 0) do
  begin
    i:=0;
    s := decString(Str);
    while(s <> astr[i]) do  //цикл
    begin                   //поиска
       inc(i);              //элемента в массиве
    end;
    Dec(i);
    if( i < 10) then
                  begin
                    Insert(IntToStr(i), newStr, ipos);
                    ipos := ipos + 4;
                  end
                else
                  begin
                    case i of
                      10 : begin  Insert('A', newStr, ipos);  ipos := ipos + 4; end;
                      11 : begin  Insert('B', newStr, ipos);  ipos := ipos + 4; end;
                      12 : begin  Insert('C', newStr, ipos);  ipos := ipos + 4; end;
                      13 : begin  Insert('D', newStr, ipos);  ipos := ipos + 4; end;
                      14 : begin  Insert('E', newStr, ipos);  ipos := ipos + 4; end;
                      15 : begin  Insert('F', newStr, ipos);  ipos := ipos + 4; end;
                  end;

  end;
end;
Result := newStr;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
   if Key = #13 then Edit2.Text:=Translate(Edit1.Text);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text:=Translate(Edit1.Text);
end;

end.
