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;
end;
end;
end;
dgMp.canvas.CopyRect(Rect,tmp.canvas,a);
end;
end;
procedure TMainPr.alRepaintExecute(Sender: TObject);
begin
if ready then begin
dgMP.Hide;
dgMp.Show;
end;
end;
procedure TMainPr.dgMPTopLeftChanged(Sender: TObject);
begin
PaintMP;
end;
procedure TMainPr.dgMPSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
var x,y,y1,y2:word;
Mr:integer;
begin
if not StepOver and Ready then begin
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;
if (x>0) and (x<=SymbNum) and (Arow>0) then begin
ii:=y1;
jj:=y2;
kk:=x;
cbStEd.ItemIndex:=y1;
cbMagStEd.ItemIndex:=y2;
cbSymbEd.ItemIndex:=x;
cbStEd.text:=cbStEd.items[y1];
cbMagStEd.text:=cbMagStEd.items[y2];
cbSymbEd.text:=cbSymbEd.items[x];
Mr:=Editing.ShowModal;
if mr=111 then begin
mp.cell[ii,jj,kk]:=Result;
PaintMP;
end;
end
else
if (y>0) and (x=SymbNum+1) then begin
changeGood(y1,y2);
if pc1.ActivePageIndex=0 then begin
tsAdd.Hide;
tsAdd.Show;
end;
end;
end;
end;
end;
procedure TMainPr.ChangeGood(i, j: integer);
begin
if MessageDlg('Выдействительно хотите изменить состояние ячейки',mtConfirmation,[mbOk,mbCancel],0)=mrOk
then mp.SetGood(i,j);
PaintMP;
end;
procedure TMainPr.alSaveExecute(Sender: TObject);
var tmp:Shortstring;
begin
if ready then begin
TMP := mmNotes.text;
sd1.initialdir:=initialdir+SaveDir;
if sd1.execute then begin
mp.savetofile(tmp,sd1.filename);
end;
end;
end;
procedure TMainPr.alLoadExecute(Sender: TObject);
label 1;
var c:integer;
note:string;
begin
od1.initialdir:=initialdir+savedir;
if ready then begin
c:=MessageDlg('Сохранить текущий МП-транслятор?',mtConfirmation,[mbYes,mbNo,mbCancel],0);
case c of
mrYes : begin
alSaveExecute(Sender);
end;
mrNo : begin
;
end;
mrCancel : begin
goto 1;
end;
end;
end;
if od1.Execute then begin
pc1.Enabled:=true;
Ready:=true;
MP:=TMPRasp.Create;
MP.LoadFromFile(od1.FileName,note);
mmNotes.text :=note;
plChain.Text:='';
tsAdd.Hide;
tsAdd.show;
tsEdit.Hide;
tsEdit.show;
tsCheck.hide;
tsCheck.show;
DrawSt:=true;
DrawMg:=true;
DrawSmb:=true;
TMP:=TBitmap.create;
dgMP.DefaultColWidth:=CellSize;
dgMP.DefaultRowHeight:=CellSize;
paintMP;
end;
1: end;
procedure TMainPr.FormCreate(Sender: TObject);
var s:string;
i:integer;
begin
Application.Title:='ОДМ. МП-транслятор';
s:=paramstr(0);
i:=length(s);
while s[i]<>'\' do
i:=i-1;
initialdir:=copy(s,1,i);
end;
procedure TMainPr.buStopTraceClick(Sender: TObject);
begin
if ready then begin
tsEdit.enabled:=true;
bucheck.Enabled:=true;
buSymbAdd.Enabled:=true;
buDelSymb.Enabled:=true;
buClear.Enabled:=true;
buNextStep.Enabled:=False;
buStopTrace.Enabled:=False;
plChain.enabled:=true;
StepOver:=False;
MP.Params:=TempParams.Params;
MP.Good:=TempParams.Good;
MP.cell:=TempParams.Cell;
if TraceResult then lbResult.caption:='ДОПУСК'
else lbResult.caption:='НЕТ ДОПУСКА';
PaintMP;
end;
end;
procedure TMainPr.FormResize(Sender: TObject);
begin
PaintMp;
end;
procedure TMainPr.SetTrace;
var i:integer;
s:string;
begin
plStData.caption:=MP.Stack.Data;
lbStep.Items.clear;
for i:=1 to Num1 do begin
case i of
1: begin
s:=inttostr(SymbI);
end;
2: begin
if SymbI>Length(Chain) then s:=LineEnd
else s:=Mp.Params.Symbols[ss];
end;
3: begin
s:='S'+inttostr(St);
end;
4: begin
s:=MP.Stack.Top;
end;
end;
lbStep.Items.Add(TracePar[i]+s);
end;
end;
procedure TMainPr.Step;
begin
With mp do begin
if (State<>Err) and (SymbI<=Length(Chain)) then begin
Ss:=SymbPos(Chain[SymbI]);
if Ss>0 then begin
tt:=MagSymbPos(Stack.Top);
St:=State;
With Cell[St,Tt,Ss] do begin
SetMag(Mag,Pushing);
State:=NextState;
if WithSymb then SymbI:=SymbI+1;
end;
Ss:=SymbPos(Chain[SymbI]);
tt:=MagSymbPos(Stack.Top);
St:=State;
end
Else State:=Err;
end;
If (State<>Err) and (SymbI=Length(Chain)+1) then begin
tt:=MagSymbPos(Stack.Top);
TraceResult:=Good[State,tt];
buNextStep.Enabled:=False;
end
else if State=Err then begin
lbResult.caption:='НЕТ ДОПУСКА';
buNextStep.Enabled:=False;
end;
end;
end;
procedure TMainPr.buNextStepClick(Sender: TObject);
var s:string;
begin
Step;
SetTrace;
PaintMp;
if buNextStep.Enabled=False then begin
if TraceResult then
s:='ДОПУСК '
else
s:='НЕТ ДОПУСКА';
MessageDlg(s+' цепочки',mtinformation,[mbOk],0);
lbResult.Caption:=S;
end;
end;
procedure TMainPr.alExitExecute(Sender: TObject);
begin
MainPr.Close;
end;
procedure TMainPr.alHelpExecute(Sender: TObject);
begin
Application.HelpCommand(HELP_finder,0);
end;
procedure TMainPr.N5Click(Sender: TObject);
begin
About.ShowModal;
end;
procedure TMainPr.Button1Click(Sender: TObject);
var MR:word;
begin
if ready then begin
with rgWhatAdd do begin
case ItemIndex of
0: begin WhatAdd:=St; Send:=''; end;
1: begin WhatAdd:=MgS; Send:=Mp.Params.MagSymbols; end;
2: begin WhatAdd:=Smb; Send:=Mp.Params.Symbols; end;
end;
end;
MR:=Adding.ShowModal;
if MR=100 then begin
with rgWhatAdd do begin
case ItemIndex of
0: begin
if not mp.AddState
thenMessageDlg('Невозможно добавить новое состояние!'
,mtWarning,[mbOk],0);
DrawSt:=True;
end;
1: begin
if not mp.AddMagState(res)
thenMessageDlg('Невозможно добавить новый магазинный символ!'
,mtWarning,[mbOk],0);
DrawMg:=True;
end;
2: begin
if not mp.AddSymb(res)
thenMessageDlg('Невозможно добавить новый символ!'
,mtWarning,[mbOk],0);
DrawSmb:=True;
end;
end;
PaintMp;
end;
end;
tsEdit.Hide;
tsEdit.Show;
end;
end;
end.