unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label3: TLabel;
    Label5: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    ListBox1: TListBox;
    StringGrid1: TStringGrid;
    Edit3: TEdit;
    Label8: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Init(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
 Form1: TForm1;
 R: Array [1..20,0..20,1..20,1..2] of String;
 Stack, T, VN, VT1, VT2, VZ: String;

implementation

{$R *.dfm}

procedure TForm1.Init(Sender: TObject);
var I: Integer;
begin
 with StringGrid1 do begin
  for I:=0 to RowCount-1 do Rows[I].Clear;
  Cells[0,0]:=Edit2.Text;  Cells[1,0]:='0'; Cells[2,0]:=Edit3.Text;  Cells[3,0]:=Edit2.Text;  Cells[4,0]:='0'+Edit3.Text; Cells[5,0]:='aa';
  Cells[0,1]:=Edit2.Text;  Cells[1,1]:='1'; Cells[2,1]:='0'; Cells[3,1]:='A'; Cells[4,1]:='^';    Cells[5,1]:='bb';
  Cells[0,2]:='A'; Cells[1,2]:='#'; Cells[2,2]:=Edit3.Text;  Cells[3,2]:='F'; Cells[4,2]:='^';    Cells[5,2]:='#';
  Cells[0,3]:=Edit2.Text;  Cells[1,3]:='0'; Cells[2,3]:='0'; Cells[3,3]:=Edit2.Text;  Cells[4,3]:='00';   Cells[5,3]:='aa';
  Cells[0,4]:='A'; Cells[1,4]:='1'; Cells[2,4]:='0'; Cells[3,4]:='A'; Cells[4,4]:='^';    Cells[5,4]:='bb';
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var I, J, K, L, M, N: Integer; SOut: String;
begin
 for I:=1 to 20 do
  for J:=0 to 20 do
   for K:=1 to 20 do begin
    R[I,J,K,1]:='';
    R[I,J,K,2]:='';
   end;
 VN:='';
 VT1:='';
 VT2:='';
 VZ:='';
 for N:=0 to StringGrid1.RowCount-1 do with StringGrid1 do
  if ((Cells[0,N]<>'') And (Cells[1,N]<>'') And (Cells[2,N]<>'') And
   (Cells[3,N]<>'') And (Cells[4,N]<>'') And (Cells[5,N]<>'')) then begin
   I:=Pos(Cells[0,N][1],VN);
   if I=0 then begin
    VN:=VN+Cells[0,N][1];
    I:=Length(VN);
   end;
   if (Cells[1,N]='#') then J:=0
   else begin
    J:=Pos(Cells[1,N][1],VT1);
    if J=0 then begin
     VT1:=VT1+Cells[1,N][1];
     J:=Length(VT1);
    end;
   end;
   K:=Pos(Cells[2,N][1],VZ);
   if K=0 then begin
    VZ:=VZ+Cells[2,N][1];
    K:=Length(VZ);
   end;
   M:=Pos(Cells[3,N][1],VN);
   if M=0 then begin
    VN:=VN+Cells[3,N][1];
    M:=Length(VN);
   end;
   for L:=1 to Length(Cells[4,N]) do
    if (Pos(Cells[4,N][L],VZ)=0) And (Cells[4,N][L]<>'^') then VZ:=VZ+Cells[4,N][L];
   R[I,J,K,1]:=VN[M]+Cells[4,N];
   for L:=1 to Length(Cells[5,N]) do
    if Pos(Cells[5,N][L],VT2)=0 then VT2:=VT2+Cells[5,N][L];
   R[I,J,K,2]:=Cells[5,N];
  end;
 if (Length(Edit2.Text)<>1) Or (Pos(Edit2.Text,VN)=0) then begin
  MessageDlg('Ошибка в задании начального состояния МП-преобразователя',mtError,[mbok],0);
  exit;
 end;
 if (Length(Edit3.Text)<>1) Or (Pos(Edit3.Text,VZ)=0) then begin
  MessageDlg('Ошибка в задании начального состояния магазина',mtError,[mbok],0);
  exit;
 end;
 ListBox1.Items.Clear;
 I:=Pos(Edit2.Text,VN);
 Stack:=Edit3.Text;
 T:=InputBox('Ввод данных','Введите переводимую цепочку символов','');
 SOut:='';
 while (Stack<>'') do begin
  if T='' then begin
   ListBox1.Items.Add('('+VN[I]+',#,'+Stack+','+SOut+')');
   J:=0;
  end
  else begin
   ListBox1.Items.Add('('+VN[I]+','+T+','+Stack+','+SOut+')');
   J:=Pos(T[1],VT1);
   if J=0 then begin
    MessageDlg('Посторонний символ в переводимой цепочке',mtError,[mbok],0);
    exit;
   end;
  end;
  K:=Pos(Stack[1],VZ);
  if R[I,J,K,1]='' then begin
   if T='' then T:='#';
   MessageDlg('Нет перехода из состояния <'+VN[I]+'> для символа <'+T[1]+'> и символа магазина <'+Stack[1]+'>',mtError,[mbok],0);
   exit;
  end;
  Delete(Stack,1,1);
  if R[I,J,K,1][2]<>'^' then Stack:=Copy(R[I,J,K,1],2,Length(R[I,J,K,1])-1)+Stack;
  if R[I,J,K,2]<>'#' then SOut:=SOut+R[I,J,K,2];
  I:=Pos(R[I,J,K,1][1],VN);
  if T<>'' then Delete(T,1,1);
 end;
 if Stack='' then Stack:='#';
 if T='' then ListBox1.Items.Add('('+VN[I]+',#,'+Stack+','+SOut+')')
         else ListBox1.Items.Add('('+VN[I]+','+T+','+Stack+','+SOut+')');
 if T<>'' then
  MessageDlg('Входная цепочка не прочитана полностью',mtError,[mbok],0)
 else
  if Pos(VN[I],Edit1.Text)=0 then
   MessageDlg('После прочтения цепочки МП не пришёл в конечное состояние',mtError,[mbok],0)
  else
   MessageDlg('Цепочка успешно переведена',mtInformation,[mbok],0)
end;

end.
