Форум
» Назад на решение задач по физике и термеху
Регистрация | Профиль | Войти | Забытый пароль | Присутствующие | Справка | Поиск

» Добро пожаловать, Гость: Войти | Регистрация
    Форум
    Информационные технологии
        Делфи
Отметить все сообщения как прочитанные   [ Помощь ]
» Добро пожаловать на форум "Информационные технологии" «

Переход к теме
<< Назад Вперед >>
Одна страница
Модераторы: paradise, KMA
  

Ler4onok


Новичок

Если можно,то комменты в коде оставить и код выслать на почту по адресу...ler4onok90@rambler.ru.....
procedure Ttrans.MakeWord;
var
pTLM,pTLM2:TListToMake;
p:Tlist;
i:integer;
begin
p:=Mylist;
pTLM:=ListToMake;
while p.sl<>'begin' do p:=p.next;
p:=p.next;
{разбить на слова}
while p.sl<>'end' do
begin
if ListToMake=nil then
begin
 new(ptlm);
 ptlm.ptr:=1;
 ptlm.info[1]:=p.sl;
 ListToMake:=ptlm;
end
 else
begin
 new(ptlm2);
 ptlm2.ptr:=1;
 ptlm2.info[1]:=p.sl;
 ptlm.next:=ptlm2;
 ptlm:=ptlm2;
end;
p:=p.next;
while (p.sl<>';') and (p.sl<>'of') do
begin
 inc(ptlm.ptr);
 ptlm.info[ptlm.ptr]:=p.sl;
 p:=p.next;
end;
 p:=p.next;
end;
{Разбили на слова}
ptlm.next:=nil;
end;



procedure Ttrans.perevod(w:byte; var st:array of string; var pt:byte);
var
opstek:array[1..50] of string;
ptropstek:byte;
symb:string;
i,j:byte;
str_out:array[1..200] of string;
l:integer;
start,fin:byte;
stek:string;

function prioritet(oper1,oper2:string):boolean;
begin
if oper1='=' then prioritet:=false;
if (oper1='/') then prioritet:=True;
if ((oper1='+') or (oper1='-')) and (oper2='/') then prioritet:=False;
if ((oper1='+') or (oper1='-')) and ((oper2='+') or(oper2='-')) then prioritet:=False;
if (oper1='(') then prioritet:=false;
if (oper1<>')') and (oper2='(') then prioritet:=false;
if  (oper1<>'(') and (oper2=')') then  prioritet:=true;
if (oper1='-') and ((oper2='+') or (oper2='-')) then prioritet:=true;
end;


begin

l:=0;
ptropstek:=0;
i:=w;
 while i<=pt do
begin
 if ((st[i-1]='=') or (st[i-1]='(')) and (st='-') then
  begin
   start:=i; fin:=pt;
   stek:=st[start+1];
   while start<=fin do
    begin
     st[fin+1]:=st[fin];
     dec(fin);
    end;
    st[start]:='0';
    inc(pt);
  end;
inc(i);
end;

l:=0;
ptropstek:=0;
i:=w;
while i<=pt do
begin
symb:=st;
if (symb<>'+') and (symb<>'-') and (symb<>'/') and (symb<>'=') and
(symb<>'(') and (symb<>')')  then
begin
 inc(l);
 str_out[l]:=symb;
end
else
begin
 while (ptropstek<>0) and prioritet(opstek[ptropstek],symb) do
  begin
   inc(l);
   str_out[l]:=opstek[ptropstek];
   dec(ptropstek);
  end;
   if (ptropstek=0) or (symb<>')') then
    begin
     inc(ptropstek);
     opstek[ptropstek]:=symb;
    end else dec(ptropstek);
  end;
   inc(i);
 end;

 while (ptropstek<>0) do
  begin
   inc(l);
   str_out[l]:=opstek[ptropstek];
   dec(ptropstek);
  end;
 for i:=1 to l do st:=str_out;
 pt:=l;


end;

procedure Ttrans.MekePostfix;
var
p:TListToMake;
i:integer;
m:integer;
//f:BOOLEAN;
st:array[0..200] of string;
pt,w:byte;
begin
p:=ListToMake;
while p<>nil do
 begin
  for i:=1 to p.ptr do st:=p.info;
  pt:=p.ptr;
  w:=1;
  //f:=false;
  if st[2]='=' then
    begin
     w:=1;
     perevod(w,st,pt);
     for i:=1 to pt do p.info:=st;
     p.ptr:=pt;
    end else
  if st[4]='=' then
   begin
    w:=3;
    perevod(w,st,pt);
    for i:=1 to pt do p.info[i+2]:=st;
    p.ptr:=pt+2;
   end;
p:=p.next;
end;
end;

procedure Ttrans.MakeVir(vir:array of string; ptr:byte);
var
a1,a2,op1:string;
i:integer;
start,fin:byte;

function oper(a,op,b:string):integer;
begin
 oper:=0;
 if op='+' then oper:=(strtoint(a)+strtoint(b)) else
 if op='-' then oper:=(strtoint(a)-strtoint(b)) else
 if op='/' then oper:=(round(strtoint(a)/strtoint(b)));
end;

begin
 if vir[1]=':' then
  begin
   for i:=3 to ptr-1 do
   if (vir<>'+') and (vir<>'/') and
    (vir<>'-') and (vir<>'=') then
    vir:=inttostr(findIDvl(vir));
   for i:=2 to ptr-1 do vir[i-2]:=vir;
    ptr:=ptr-2;
  end else
   for i:=1 to ptr-1 do
   if (vir<>'+') and (vir<>'/') and
    (vir<>'-') and (vir<>'=') then vir:=inttostr(findIDvl(vir));
  ptr:=ptr-1;

 //for i:=0 to ptr do form1.Memo2.Lines.Add(vir);
 //form1.Memo2.Lines.Add('---------');
 {begin_блок выполнения выражения vir}
 while true do
 begin
  i:=2;
  repeat
   a1:=vir[i-2];
   a2:=vir[i-1];
   op1:=vir;
   //showmessage(a1+a2+op1);
   inc(i);
  until (op1='+') or (op1='-') or (op1='/') or (op1='=');
  if op1<>'=' then
   begin
    vir[i-3]:=inttostr(oper(a1,op1,a2));
    {begin_сдвиг}
      start:=i-2;
      fin:=ptr;
      while start<fin do
       begin
        vir[start]:=vir[start+2];
        inc(start);
       end;
       ptr:=ptr-2;
   {end_сдвиг}
   end
  else begin
   writeID(vir[i-3],strtoint(vir[i-2]));
   break;
  end;

 end;
 {end_блок выполнения выражения vir}

end;


procedure Ttrans.RunSt(str:array of string);
var
i:integer;
a:string;
begin
i:=1;
if str[0]='write' then
while str<>')'do begin
if (str<>'(') and (str<>',') then
AboutBox.showmodal1(false,inttostr(findIDvl(str)));
inc(i);
end else
if str[0]='read' then
while str<>')'do begin
if (str<>'(') and (str<>',') then
begin
 a:=str;
 form1.Hide;
 AboutBox.showmodal;
 form1.Show;
 if prov_digit(perread) then
 WriteID(a,strtoint(perread));
end;
inc(i);
end;
end;

procedure Ttrans.Run;
var
p,p1:Tlisttomake;
ch:char;
a:integer;
begin
 p:=listtomake;
 while p<>nil do
  begin
   if (p.info[1]='write') or (p.info[1]='read') then runst(p.info) else
   if (p.info[1]='case') then
    begin
     a:=FindIDvl(p.info[2]);
     p:=p.next;
     while (p.info[1]<>'end_case') and (strtoint(p.info[1])<>a) do
      begin
       p:=p.next;
      end;
       if p.info[1]<>'end_case' then MakeVir(p.info,p.ptr);
       while p.info[1]<>'end_case' do p:=p.next;
    end else MakeVir(p.info,p.ptr);
   p:=p.next;
  end
end;

procedure Ttrans.interpritate;
var
p:TListToMake;
i:integer;
begin
MakeWord;{Сделать из слов предложения}
MekePostfix;{Сделать постфиксную запись выражений}
aboutbox.ClearAll;
Run;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
road:='';
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var

k:integer;
p:tlist;
begin
memo2.Lines.Clear;
pr:=Ttrans.init;
if pr.scaner and pr.parcer then
begin
pr.interpritate;
Memo2.Lines.Add('Упешная интерпритация');
end;
pr.distroy;
end;


procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
road:=OpenDialog1.FileName;
memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if savedialog1.Execute then
memo1.Lines.SaveToFile(savedialog1.FileName);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
WinExec(PChar('Project1.exe'),SW_ShowNormal);
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
if road<>'' then memo1.Lines.SaveToFile(road)
else
if savedialog1.Execute then
begin
 memo1.Lines.SaveToFile(savedialog1.FileName);
 road:=savedialog1.FileName;
end;
end;

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

procedure TForm1.N10Click(Sender: TObject);
begin
form2.show;
end;
procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
Aboutbox.ShowModal;
end;

end.

Всего сообщений: 7 | Присоединился: январь 2010 | Отправлено: 12 дек. 2010 17:48 | IP
Ler4onok


Новичок

спасибо,уже не надо....

Всего сообщений: 7 | Присоединился: январь 2010 | Отправлено: 14 дек. 2010 19:11 | IP

Эта тема закрыта, новые ответы не принимаются

Переход к теме
<< Назад Вперед >>
Одна страница

Форум работает на скрипте © Ikonboard.com