48240 (Программа–конструктор для построения МП–транслятора по его параметрам с последующей проверкой задаваемых пользователем цепочек), страница 3

procedure ChangeGood(i,j:integer);

procedure dgMPDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure alRepaintExecute(Sender: TObject);

procedure dgMPTopLeftChanged(Sender: TObject);

procedure dgMPSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure alSaveExecute(Sender: TObject);

procedure alLoadExecute(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure buStopTraceClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure Step;

procedure SetTrace;

procedure buNextStepClick(Sender: TObject);

procedure alExitExecute(Sender: TObject);

procedure alHelpExecute(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainPr: TMainPr;

MP:TMPRasp;

Color1:Integer=clRed;

Color2:Integer=clWhite;

Color3:Integer=clYellow;

Color4:Integer=clFuchsia;

implementation

uses EditUn, AboutUn;

const CellSize=60;

LineEnd='¶';

drx=4;

dry=4;

Ready:boolean=false;

StepOver:boolean=false;

Num1=4;

TracePar:array [1..Num1] of String=

('Номер символа в строке : ',

'Символ : ',

'Текущее состояние : ',

'Верхний символ магазина : ');

SaveDir='Save';

PicturesDir='Pictures';

var DrawSt,DrawMg,DrawSmb:boolean;

tmp:TBitmap;

TempParams:TSaveMP;

initialdir:string;

St,tt,ss:word;

TraceResult:boolean;

SymbI:integer;

Chain:string;

{$R *.DFM}

procedure TMainPr.FormClose(Sender: TObject; var Action: TCloseAction);

var MDR:integer;

begin

if Ready then begin

MDR:=MessageDlg('Сохранить текущий МП-транслятор?',mtConfirmation,[mbYes,mbNo,mbCancel],0);

if MDR<>MrCancel then begin

if MDR=mrYes then alSaveExecute(Sender);

Mp.Del;

Mp.Free;

TMP.free;

Ready:=false;

end

else Action:=caNone;

end;

end;

procedure TMainPr.tsAddShow(Sender: TObject);

var i,j:byte;

begin

if Ready then begin

with mp.params do begin

sgGood.ColCount:=MagSymbNum+1;

sgGood.RowCount:=StateNum+1;

for j:=1 to StateNum do

sgGood.cells[0,j]:='S'+inttostr(j);

for i:=1 to MagSymbNum do begin

sgGood.cells[i,0]:=MagSymbols[i];

for j:=1 to StateNum do begin

if MP.Good[j,i] then

sgGood.Cells[i,j]:='Доп.'

else

sgGood.Cells[i,j]:='Отв.'

end;

end;

end;

lbStNum.caption:=inttostr(Mp.Params.StateNum);

lbFirstSt.caption:=inttostr(Mp.Params.StartingState);

sgMagList.colcount:=mp.Params.MagSymbNum;

sgSymbList.colcount:=mp.Params.SymbNum+1;

sgMagStart.ColCount:=length(mp.params.StartingMagState);

for i:=1 to mp.Params.MagSymbNum do begin

sgMagList.Cells[i-1,0]:=mp.Params.MagSymbols[i];

end;

if Mp.Params.SymbNum=0 then sgSymbList.Cells[0,0]:=LineEnd

else

for i:=1 to mp.Params.SymbNum do begin

sgSymbList.Cells[i,0]:=mp.Params.Symbols[i];

end;

for i:=1 to Length(mp.Params.StartingMagState) do begin

sgMagStart.Cells[i-1,0]:=mp.Params.StartingMagState[i];

end;

end;

end;

procedure TMainPr.tsEditShow(Sender: TObject);

var i:byte;

begin

if Ready then begin

With MP.Params do begin

sgStartMag.ColCount:=length(StartingMagState);

for i:=1 to Length(StartingMagState) do begin

sgStartMag.Cells[i-1,0]:=StartingMagState[i];

end;

if DrawSt then begin

cbStartingSt.items.clear;

for i:=1 to StateNum do begin

cbStartingst.items.add('S'+inttostr(i));

end;

cbStEd.items.clear;

cbStartingst.ItemIndex:=StartingState-1;

cbStartingst.text:=cbStartingst.items[cbStartingst.ItemIndex];

for i:=1 to StateNum do begin

cbStEd.items.add('S'+inttostr(i));

end;

cbStEd.ItemIndex:=StartingState-1;

cbStEd.text:=cbStEd.items[cbStEd.ItemIndex];

end;

if DrawMg then begin

cbMagStEd.items.clear;

for i:=1 to MagSymbNum do begin

cbMagStEd.items.add(MagSymbols[i]);

end;

cbMagStEd.text:=cbMagStEd.items[0];

end;

if DrawSmb then begin

cbSymbEd.items.clear;

for i:=1 to SymbNum do begin

cbSymbEd.items.add(Symbols[i]);

end;

cbSymbEd.text:=cbSymbEd.items[0];

end;

end;

DrawSt:=false;

DrawMg:=false;

DrawSmb:=false;

end;

end;

procedure TMainPr.buStartAddClick(Sender: TObject);

var MR:word;

begin

if ready then begin

WhatAdd:=MgA;

Send:=copy(Mp.Params.MagSymbols,2,Length(Mp.Params.MagSymbols));

MR:=Adding.ShowModal;

if MR=100 then begin

MP.Params.StartingMagState:=Mp.Params.StartingMagState+res;

end;

tsEdit.Hide;

tsEdit.Show;

end;

end;

procedure TMainPr.buStartDelClick(Sender: TObject);

begin

if ready then begin

if length(Mp.Params.StartingMagState)>1 then begin

Mp.Params.StartingMagState:=

copy(Mp.Params.StartingMagState,1,Length(Mp.Params.StartingMagState)-1);

end;

tsEdit.Hide;

tsEdit.Show;

end;

end;

procedure TMainPr.alCreateNewExecute(Sender: TObject);

label 1;

var c:word;

begin

if not ready then begin

Ready:=true;

1: MP:=TMPRasp.Create;

lbResult.Caption:='';

mmNotes.Clear;

Mp.Init;

tsAdd.Hide;

tsAdd.show;

DrawSt:=true;

DrawMg:=true;

DrawSmb:=true;

TMP:=TBitmap.create;

mmNotes.text :='';

plChain.Text:='';

dgMP.DefaultColWidth:=CellSize;

dgMP.DefaultRowHeight:=CellSize;

paintMP;

end

else begin

c:=MessageDlg('Сохранить файл?',mtConfirmation,[mbYes,mbNo,mbCancel],0);

case c of

mrYes : begin

alSaveExecute(Sender);

goto 1;

end;

mrNo : begin

goto 1;

end;

mrCancel : begin

;

end;

end;

end;

end;

procedure TMainPr.cbStartingStChange(Sender: TObject);

begin

if ready then begin

if cbStartingSt.ItemIndex<>-1 then

Mp.Params.StartingState:=cbStartingSt.ItemIndex+1;

end;

end;

procedure TMainPr.buCellEditClick(Sender: TObject);

var MR:integer;

begin

if ready then begin

ii:=cbStEd.ItemIndex+1;

if length(trim(cbMagStEd.text))=1 then

jj:=mp.MagSymbPos(cbMagStEd.text[1]);

if length(trim(cbSymbEd.text))=1 then

kk:=mp.SymbPos(cbSymbEd.text[1]);

if (ii>0) and (jj>0) and (kk>0) then begin

Mr:=Editing.ShowModal;

if mr=111 then begin

PaintMP;

mp.cell[ii,jj,kk]:=temp;

end;

end

else

MessageDlg('Неверно определена ячейка!'

,mtWarning,[mbOk],0);

end;

end;

procedure TMainPr.sgGoodSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

begin

ChangeGood(ARow,ACol);

sgGood.Hide;

sgGood.Show;

end;

procedure TMainPr.buSymbAddClick(Sender: TObject);

var MR:Integer;

begin

if ready then begin

WhatAdd:=SmbA;

Send:=copy(Mp.Params.Symbols,1,Length(Mp.Params.Symbols));

MR:=Adding.ShowModal;

if MR=100 then begin

plChain.Text:=plChain.Text+res;

lbResult.Caption:='';

end;

tsCheck.Hide;

tsCheck.Show;

end;

end;

procedure TMainPr.buDelSymbClick(Sender: TObject);

begin

plChain.Text:=copy(plChain.Text,1,Length(plChain.Text)-1);

lbResult.Caption:='';

end;

procedure TMainPr.buClearClick(Sender: TObject);

begin

plChain.Text:='';

lbResult.Caption:='';

end;

procedure TMainPr.buCheckClick(Sender: TObject);

var s:string;

i:integer;

ok:boolean;

begin

if Ready then begin

s:=plChain.Text;

if Length(s)=0 then begin

MessageDlg('Не введена цепочка',mtWarning,[mbOk],0);

plChain.SetFocus;

end

else begin

ok:=true;

for i:=1 to length(s) do begin

if pos(s[i],MP.Params.Symbols)=0 then ok:=false;

end;

if ok then begin

case rgCheck.ItemIndex of

0: begin

if Mp.CheckChain(s) then

s:='ДОПУСК '

else

s:='НЕТ ДОПУСКА';

MessageDlg(s+' цепочки',mtinformation,[mbOk],0);

lbResult.Caption:=S;

end;

1: begin

if plChain.Text<>'' then begin

tsEdit.enabled:=false;

bucheck.Enabled:=false;

buSymbAdd.Enabled:=false;

buDelSymb.Enabled:=false;

buClear.Enabled:=false;

buNextStep.Enabled:=True;

buStopTrace.Enabled:=True;

plChain.enabled:=false;

StepOver:=True;

plStData.Caption:='';

TempParams.Params:=Mp.Params;

TempParams.Good:=Mp.Good;

TempParams.cell:=Mp.Cell;

lbStep.Items.Clear;

With MP do begin

SymbI:=1;

TraceResult:=false;

State:=Params.StartingState;

Chain:=plChain.Text;

Stack.Init(Params.StartingMagState);

Ss:=SymbPos(Chain[SymbI]);

tt:=MagSymbPos(Stack.Top);

St:=State;

end;

SetTrace;

PaintMP;

end;

end;

end;

end

else begin

MessageDlg('Некоторые символы строки не соответствуют алфавиту',mtWarning,[mbOk],0);

plChain.SetFocus;

end;

end;

end;

end;

procedure TMainPr.PaintMP;

begin

if Ready then

with MP.Params do begin

dgMP.ColCount:=SymbNum+3;

dgMp.RowCount:=StateNum*MagSymbNum+1;

dgMP.hide;

dgMP.Show;

end;

end;

procedure TMainPr.dgMPDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

var a:trect;

x,y,y1,y2:word;

s,D:string;

TC:TMPCell;

begin

if ready then begin

a.Left:=1;

a.Top:=1;

a.Right:=CellSize;

a.Bottom:=CellSize;

tmp.Height:=Cellsize;

tmp.width:=Cellsize;

x:=Acol-1;

y:=ARow;

with mp.params do begin

if y mod MagSymbNum = 0 then

y1:=y div MagSymbNum

else y1:=(y div MagSymbNum)+1;

if y mod MagSymbNum = 0 then

y2:=MagSymbNum

else y2:=y mod MagSymbNum;

with tmp.canvas do begin

if (Acol<2) or (Arow=0) then

Brush.Color:=Color1

else

if (x=Symbnum+1) then

Brush.Color:=Color4

else

Brush.Color:=Color2;

Rectangle(a);

if StepOver and ( ((y1=st) and (y2=tt) and (x=ss) and (x>0))

or ((y1=st) and (y2=tt) and (ss=0) and (x=Length(Symbols)+1) ))

then begin

Brush.Color:=Color3;

Rectangle(a);

end;

if (Arow=0) and (acol>1) then begin

if (x<=SymbNum) then

TextOut((tmp.Width-TextWidth(Symbols[x])) div 2,

(tmp.Height-TextHeight(Symbols[x])) div 2,Symbols[x])

else TextOut((tmp.Width-TextWidth(LineEnd)) div 2,

(tmp.Height-TextHeight(LineEnd)) div 2, LineEnd);

end;

if (Acol=0) and (arow>0) then begin

TextOut((tmp.Width-TextWidth('S'+inttostr(y1))) div 2,

(tmp.Height-TextHeight('S')) div 2,'S'+inttostr(y1));

end;

if (Acol=1) and (arow>0) then begin

TextOut((tmp.Width-TextWidth(MagSymbols[y2])) div 2,

(tmp.Height-TextHeight(MagSymbols[y2])) div 2,MagSymbols[y2]);

end;

if (Acol>1) and (arow>0) then begin

if (x>SymbNum) then begin

if MP.Good[y1,y2] then s:='Доп.'

else s:='Отв.';

TextOut((tmp.Width-TextWidth(s)) div 2,

(tmp.Height-TextHeight(s)) div 2,s);

end

else begin

TC:=MP.Cell[y1,y2,x];

if tc.NextState=Err then begin

s:='Ошибка';

TextOut((tmp.Width-TextWidth(s)) div 2,

(tmp.Height-TextHeight(s)) div 2,s);

end

else begin

MoveTo(0,tmp.height div 3);

Lineto(tmp.width div 2,2*tmp.height div 3);

LineTo(tmp.width,tmp.height div 3);

Moveto(tmp.width div 2,2*tmp.height div 3);

Lineto(tmp.width div 2,tmp.height-14);

Moveto(0,tmp.height-14);

Lineto(tmp.width,tmp.height-14);

if MP.Cell[y1,y2,x].WithSymb then s:='П'

else s:='Д';

TextOut(tmp.Width-(TextWidth(s)+drx),

tmp.Height-(TextHeight(s)+dry)-14,s);

s:='S'+inttostr(TC.NextState);

TextOut(drx,tmp.Height-(TextHeight(s)+dry)-12,s);

s:=editing.cbWhatDo.Items[tc.mag];

if length(s)>1 then s:=copy(editing.cbWhatDo.Items[tc.mag],1,3)+'.';

TextOut((tmp.Width-(TextWidth(s)))div 2,dry+TextHeight(s),s);

s:=tc.Pushing;

TextOut((tmp.Width-(TextWidth(s)))div 2,dry,s);

D:=tc.Vihod;

TextOut((tmp.Width-TextWidth(D)) div 2 ,tmp.Height-14,D);

end;

end;