[KatieK]

Вот что-то накрапала.....
Мб проверить будет проще..

Код:

unit UnitBLR;

interface

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

type
  TForm1 = class(TForm)
    LblPvja: TLabel;
    LblYV: TLabel;
    LblKV: TLabel;
    CmdInput: TButton;
    CmdProcess: TButton;
    CmdExit: TButton;
    EdPVJA: TEdit;
    ListBoxYV: TListBox;
    ListBoxPar: TListBox;
    Label1: TLabel;
    ClearButton: TButton;
    procedure FormActivate(Sender: TObject);
    procedure CmdInputClick(Sender: TObject);
    procedure CmdProcessClick(Sender: TObject);
    procedure CmdExitClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Pvja, oldpvja: String;
implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
 EdPvja.SetFocus;
end;

procedure TForm1.CmdInputClick(Sender: TObject);
begin
 Pvja:=EdPvja.Text;
 CmdProcess.SetFocus;
end;

procedure TForm1.CmdProcessClick(Sender: TObject);
Type
 T_YV=Array[1..40] Of Integer;
 T_Par=array[1..40] of string;
Var
  Par: T_Par;
  YV: T_YV;
  Ksl: Integer;
  I,Kv: Integer;
Procedure Lan (PVJA: String; {ПВЯ}
       Var YV: T_YV; {Упр. вектор}
       Var Par: T_Par; {Пар. вектор}
       Var Ksl: Integer; {К-во расшифрованных слов ПВЯ}
       Var Kv: Integer);
       {Блок лексического разбора}
       Var   Slov: Array[1..3] of String;   {Терминальный словарь}
   Kts: Integer;                            {К-во эл-тов в терминальном словаре}
   Sost: Integer;                           {Состояние системы}
   Stroka: String;                          {Рабочие переменные}
   J,L,Nom,Ls,Ln: Integer;
   f: boolean;
begin
  Kv:=0; Ksl:=0; Sost:=0;
  Slov[1]:='replace'; Slov[2]:='with'; Slov[3]:='for';
  J:=1; Ln:=Length(PVJA);  oldpvja:=pvja;
  f:=false;

  While (J<=Ln) And (Kv=0) Do
  begin
   Stroka:=Copy(PVJA, J, Ln-J+1);

    Case Sost of
    0: begin    {Поиск разделителя}
        If Copy(Stroka, 1, 1) = ' ' Then
          J:= J + 1
        else
        begin
          if copy(stroka,1,7)=slov[1] then
          begin
             ksl:=ksl+1; yv[ksl]:=1; j:=j+7; sost:=1;
          end
          else kv:=2;
        end;
       end;

     1: begin
          if copy (stroka,1,1)=' ' then
            begin
              sost:=2; j:=j+1;
            end
          else
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end;
        end;

     2: begin
          if copy(stroka,1,1)=' ' then
            begin
              j:=j+1; sost:=3;
            end
          else
            if copy(stroka,1,4)=slov[2] then
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end
            else
            begin
              par[ksl]:=par[ksl]+copy(stroka,1,1); j:=j+1;
            end;
        end;

     3: begin
          if copy(stroka,1,1)=' ' then
            begin
              sost:=4; j:=j+1;
            end
          else
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end;
        end;

    4: begin    {Поиск разделителя}
        If Copy(Stroka, 1, 1) = ' ' Then
          J:= J + 1
        else
        begin
          if copy(stroka,1,4)=slov[2] then
          begin
             ksl:=ksl+1; yv[ksl]:=2; j:=j+4; sost:=5;
          end
          else kv:=4;
        end;
       end;

     5: begin
          if copy (stroka,1,1)=' ' then
            begin
              sost:=6; j:=j+1;
            end
          else
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end;
        end;

     6: begin
          if copy(stroka,1,1)=' ' then
            begin
              j:=j+1; sost:=7;
            end
          else
            if copy(stroka,1,3)=slov[3] then
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end
            else
            begin
              par[ksl]:=par[ksl]+copy(stroka,1,1); j:=j+1;
            end;
        end;

     7: begin
          if copy(stroka,1,1)=' ' then
            begin
              sost:=8; j:=j+1;
            end
          else
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end;
        end;

    8: begin    {Поиск разделителя}
        If Copy(Stroka, 1, 1) = ' ' Then
          J:= J + 1
        else
        begin
          if copy(stroka,1,3)=slov[3] then
          begin
             ksl:=ksl+1; yv[ksl]:=3; j:=j+3; sost:=9;
          end
          else kv:=6;
        end;
       end;

     9: begin
          if copy (stroka,1,1)=' ' then
            begin
              sost:=10; j:=j+1;
            end
          else
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end;
        end;

     10: begin
          if copy(stroka,1,1)=' ' then
            begin
              j:=j+1;// sost:=11;
            end
          else
            if copy(stroka,1,3)=slov[3] then
            begin
              insert(' ',pvja,j); ln:=ln+1;
              EdPvja.Text:=Pvja; f:=true;
            end
            else
            begin
              par[ksl]:=par[ksl]+copy(stroka,1,1); j:=j+1;
            end;
        end;



    end;{Case}
  end; {While }

  If (Sost = 0) And (Kv = 0) Then Kv:=1;
  If (Sost = 4) And (Kv = 0) Then Kv:=3;
  If (Sost = 8) And (Kv = 0) Then Kv:=5;

  if f then
  begin
    EdPvja.Text:=Pvja;
  end;
  ClearButton.SetFocus;
end; {Procedure}




Procedure San ( YV: T_YV;  Ksl: Integer;
                            Var Kv:Integer);
begin
end;
Procedure Yprava ( YV: T_YV;  Ksl: Integer; Var Kv:Integer);
begin
end;
begin
 Lan (Pvja,YV,Par,Ksl,Kv);
 For I:= 1 To Ksl Do ListBoxYv.AddItem(IntToStr(Yv[i]),ListBoxYv);
 for i:=1 to ksl do ListBoxPar.AddItem((Par[i]),ListBoxPar);
 LblKv.Caption := LblKv.Caption + ' ' + IntToStr(Kv);
 San (YV,Ksl,Kv);
 Yprava (YV,Ksl,Kv);
end;

procedure TForm1.CmdExitClick(Sender: TObject);
begin
 Close;
end;

procedure TForm1.ClearButtonClick(Sender: TObject);
begin
 LblKv.Caption:='Код возврата: ';
 EdPVJA.Text:='';
 ListBoxYV.Clear;
 ListBoxPar.Clear;
 EdPvja.Font.Color:=clWindowText;
 EdPvja.SetFocus;
end;

end.