Страница 2 из 2

Re: Заштриховка нестандартной области

Добавлено: 31 мар 2008, 22:38
somebody_now

Код: Выделить всё

procedure zakraska(stroka:string);
begin
with form1.canvas do begin
     brush.Style:=bsClear;
       Rectangle(x0-150,y0-200,x0+150,y0);
         Ellipse(x0-150-20,y0-75-25,x0+20,y0+75+25);
         Ellipse(x0-50,y0-150,x0+250,y0+150);
       end;
case strtoint(stroka) of
  1: with form1.Canvas do begin
          brush.Color:=clRed;
          floodfill(x0+50,y0+15,clBlack, fsBorder);
          end;
  10: with form1.Canvas do begin
          brush.Color:=clLime;
          floodfill(x0-50,y0+15,clBlack, fsBorder);
          end;
  11: with form1.Canvas do begin
          brush.Color:=clTeal;
          floodfill(x0,y0+15,clBlack, fsBorder);
          end;
  100: with form1.Canvas do begin
          brush.Color:=clYellow;
          floodfill(x0,y0-150,clBlack, fsBorder);
          end;
  101: with form1.Canvas do begin
          brush.Color:=clOlive;
          floodfill(x0+50,y0-15,clBlack, fsBorder);
          end;
  110: with form1.Canvas do begin
          brush.Color:=clFuchsia;
          floodfill(x0-50,y0-15,clBlack, fsBorder);
          end;
  111: with form1.Canvas do begin
          brush.Color:=clNavy;
          floodfill(x0,y0-15,clBlack, fsBorder);
          end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var x0,y0:integer;
inv:set of 'A'..'C';
op,notr,nmul,nslozh:integer;
p,kol,cl:integer;
sslozh,smul:integer;
pst,c,k1,k2:integer;
text,x,s,ss,z,ymul,yplus,q,sss,y,st,before,after,yekv,yimp,d,zam_d,a,str_skob:string; i,k,m,j:integer;
pstpl,c1,d1,u,v,sotr,umnpos,gr1,gr2,kotr:integer;
posumn:integer;
nekv,sekv,pstekv,c2,d2,ekvpos:integer;
nimp,simp,pstimp,c3,d3:integer;
sotkr,szakr,l1,l2:integer;
op_d,notr_d,nmul_d,nslozh_d,nimp_d,nekv_d,kotr_d:integer;
R:TRect;
begin

with form1.canvas do begin
  brush.Color:=clWhite;
  brush.Style:=bsSolid;
  with R do begin
    top:=200;
    left:=300;
    right:=1100;
    bottom:=900;
  end;
  fillrect(R);
end;
if length(edit1.text)=1 then begin
  if edit1.text='1' then edit1.Text:='A*(B~C)+^A*B*C'
else if edit1.text='2' then edit1.Text:='B*(A~C)+A*B*^C'
else if edit1.text='3' then edit1.Text:='A*(B~C)+A*^B*C'
else if edit1.text='4' then edit1.Text:='A*^(C~B)+A*B*C'
else if edit1.text='5' then edit1.Text:='A*^(C~B)+^A*B*C'
  else begin messagedlg('Некорректный ввод',mtError,[mbOK],0);
    edit1.Text:=''; exit; end;
end;
x:=UpperCase(edit1.Text);
label9.Visible:=true;
label9.Caption:='Проверяем для:   '+x;
groupbox2.Left:=25;
groupbox2.Top:=400;
stringgrid1.Visible:=true;
edit1.Text:='';

stringgrid1.cells[0,0]:='A';
stringgrid1.cells[1,0]:='B';
stringgrid1.cells[2,0]:='C';

zapst(form1.StringGrid1);

m:=length(x);  s:='';  ss:='';

//удаляем пробелы из строки перед анализом
j:=1;
while j<=m do begin
  p:=pos(' ',x);
  if p<>0 then begin
    delete(x,p,1);
    m:=m-1;
    end else break;
  j:=j+1;
end;


Re: Заштриховка нестандартной области

Добавлено: 31 мар 2008, 22:42
somebody_now

Код: Выделить всё

//ВСЕ ДЕЙСТВИЯ СО СКОБКАМИ
for i:=1 to length(x) do begin
  if x[i]='(' then inc(sotkr);
  if x[i]=')' then inc(szakr);
end;
if (sotkr<>szakr) or (sotkr>1) or (szakr>1) then begin
  messagedlg('Ââåäèòå êîððåêòíîå ÷èñëî ñêîáîê',mtError,[mbOK],0);
    edit1.Text:=''; exit; end;

    if (sotkr=1) and (szakr=1) then begin
d:=copy(x,pos('(',x)+1,pos(')',x)-pos('(',x)-1);
zapst(form1.StringGrid2);
stringgrid2.cells[0,0]:='A';
stringgrid2.cells[1,0]:='B';
stringgrid2.cells[2,0]:='C';
kolvo(d,op_d,notr_d,nmul_d,nslozh_d,nimp_d,nekv_d);
 //кол-во столбцов во 2-й таблице
otricanie(d,form1.StringGrid2,3,kotr_d);
stringgrid2.ColCount:=op_d+3;
analysis1_mul(form1.StringGrid2,nmul_d, d,length(d), 3+kotr_d);
analysis1_slozh(form1.StringGrid2,nslozh_d, d, length(d), 3+kotr_d+nmul_d);
analysis1_imp(form1.StringGrid2,nimp_d, d, length(d), 3+kotr_d+nmul_d+nslozh_d);
analysis1_ekv(form1.StringGrid2,nekv_d, d, length(d), 3+kotr_d+nmul_d+nslozh_d+nimp_d);
stringgrid2.Cells[stringgrid2.ColCount-1,0]:='('+stringgrid2.Cells[stringgrid2.ColCount-1,0]+')';
//end;

l1:=1 {?}; l2:=3+kotr;
label8.Caption:=inttostr(l1)+'   '+inttostr(l2)+'   '+inttostr(stringgrid2.ColCount);
while l1<>stringgrid2.ColCount do begin
  stringgrid1.Cells[l2,0]:=stringgrid2.Cells[l1,0];
inc(l1); inc(l2);
end;
d1:=pos('(',x); d2:=pos(')',x);
delete(x,d1,d2-d1+1); insert('D',x,d1);
label4.Caption:=x;

kolvo(x,op,notr,nmul,nslozh,nimp,nekv);
label5.Caption:=inttostr(op_d);
stringgrid1.ColCount:=op+3+op_d; //кол-во колонок первой таблицы
otricanie(x,form1.StringGrid1,3,kotr);

//1 анализатор

// все действия после скобок
analysis1_mul(form1.StringGrid1,nmul, x,length(x), l2);
analysis1_slozh(form1.StringGrid1,nslozh, x, length(x), nmul+l2);
analysis1_imp(form1.StringGrid1,nimp, x, length(x), nmul+nslozh+l2);
analysis1_ekv(form1.StringGrid1,nekv, x, length(x), nmul+nslozh+nimp+l2);

zam_d:=stringgrid2.cells[stringgrid2.colcount-1,0];
for i:=stringgrid1.ColCount-1 downto 0 do begin
p:=pos('D',stringgrid1.Cells[i,0]);
  if p<>0 then begin
a:=stringgrid1.Cells[i,0]; insert(zam_d,a,p+1);
delete(a,p,1);
stringgrid1.Cells[i,0]:=a;
end;
end;

//2 анализатор
//1)отрицания в скобках
if kotr>0 then
  for i:=3 to 3+kotr-1 do
    for j:=i-1 downto 0 do
      if copy(stringgrid1.Cells[i,0],2,1)=stringgrid1.Cells[j,0] then
        otr(form1.StringGrid1,j,i);
if notr_d>0 then
  for i:=3+kotr to 3+kotr+notr_d-1 do
    for j:=i-1 downto 0 do
      if copy(stringgrid1.Cells[i,0],2,1)=stringgrid1.Cells[j,0] then
        otr(form1.StringGrid1,j,i);

//заполнение резалтов действий скобок в таблицу
if nmul_d>0 then
  for i:=3+kotr+notr_d to 3+kotr+notr_d+nmul_d-1 do begin
    st:=stringgrid1.cells[i,0];
      for k:=length(st) downto 1 do
        if copy(st,k,1)='*' then begin umnpos:=k; break; end;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    mul(form1.StringGrid1,gr1,gr2,i);
  end;

if nslozh_d>0 then
  for i:=3+kotr+notr_d+nmul_d to 3+kotr+notr_d+nmul_d+nslozh_d-1 do begin
    st:=stringgrid1.cells[i,0];
      for k:=length(st) downto 1 do
        if copy(st,k,1)='+' then begin umnpos:=k; break; end;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    slozh(form1.StringGrid1,gr1,gr2,i);
  end;

if nimp_d>0 then
  for i:=3+kotr+notr_d+nmul_d+nslozh_d to 3+kotr+notr_d+nmul_d+nslozh_d+nimp_d-1 do begin
    st:=stringgrid1.cells[i,0];
      for k:=length(st) downto 1 do
        if copy(st,k,1)='>' then begin umnpos:=k; break; end;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    imp(form1.StringGrid1,gr1,gr2,i);
  end;

Re: Заштриховка нестандартной области

Добавлено: 31 мар 2008, 22:43
somebody_now

Код: Выделить всё

if nekv_d>0 then
  for i:=3+kotr+notr_d+nmul_d+nslozh_d+nimp_d to 3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d-1 do begin
    st:=stringgrid1.cells[i,0];
      for k:=length(st) downto 1 do
        if copy(st,k,1)='~' then begin ekvpos:=k; break; end;
    if st[1]='(' then before:=copy(st,2,ekvpos-2) else before:=copy(st,1,ekvpos-1);
    if st[length(st)]=')' then after:=copy(st,ekvpos+1,length(st)-ekvpos-1)
      else after:=copy(st,ekvpos+1,length(st)-ekvpos);
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    ekv(form1.StringGrid1,gr1,gr2,i);
  end;
end;
//2)аналогично,но с учётом скобок
[B][U]if nmul>0 then
  for i:=3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d to 3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul-1 do begin
    st:=stringgrid1.cells[i,0];
              if (pos('(',st)<>0) and (pos(')',st)<>0) then  begin
            str_skob:=copy(st,pos('(',st),pos(')',st)-pos('(',st)+1);
            insert('D',st,pos('(',st)); delete(st,pos('(',st),length(str_skob));
        for k:=length(st) downto 1 do
   if st[k]='*' then begin umnpos:=k; break; end;
      end;
      if (pos('(',st)<>0) and (pos(')',st)<>0) then
        if umnpos>pos('D',st) then umnpos:=umnpos+length(str_skob)-1;
      insert(str_skob,st,pos('D',st)); delete(st,pos('D',st),1);
      label7.Caption:=label7.caption{+inttostr(k)+}+'   '+inttostr(umnpos)+#13;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
     label7.Caption:=label7.caption+st+'   '+before+'   '+after+#13;
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    mul(form1.StringGrid1,gr1,gr2,i);
  end[/U];[/B]
//остальные действия
if nslozh>0 then
  for i:=3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul to 3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul+nslozh-1 do begin
    st:=stringgrid1.cells[i,0];
               if (pos('(',st)<>0) and (pos(')',st)<>0) then  begin
            str_skob:=copy(st,pos('(',st),pos(')',st)-pos('(',st)+1);
            insert('D',st,pos('(',st)); delete(st,pos('(',st),length(str_skob));
        end;
        for k:=length(st) downto 1 do begin
   if st[k]='+' then begin umnpos:=k; break; end;
      end;
      if umnpos>pos('D',st) then umnpos:=umnpos+length(str_skob)-1;
      insert(str_skob,st,pos('D',st)); delete(st,pos('D',st),1);
      label7.Caption:=label7.caption{+inttostr(k)+}+'   '+inttostr(umnpos)+#13;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    slozh(form1.StringGrid1,gr1,gr2,i);
  end;

Re: Заштриховка нестандартной области

Добавлено: 31 мар 2008, 22:44
somebody_now

Код: Выделить всё

//4)ïðèåõàëè - èìïëèêàöèè
if nimp>0 then
  for i:=3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul+nslozh to 3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul+nslozh+nimp-1 do begin
    st:=stringgrid1.cells[i,0];
              if (pos('(',st)<>0) and (pos(')',st)<>0) then  begin
            str_skob:=copy(st,pos('(',st),pos(')',st)-pos('(',st)+1);
            insert('D',st,pos('(',st)); delete(st,pos('(',st),length(str_skob));
        end;
        for k:=length(st) downto 1 do begin
   if st[k]='>' then begin umnpos:=k; break; end;
      end;
      if umnpos>pos('D',st) then umnpos:=umnpos+length(str_skob)-1;
      insert(str_skob,st,pos('D',st)); delete(st,pos('D',st),1);
      label7.Caption:=label7.caption{+inttostr(k)+}+'   '+inttostr(umnpos)+#13;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
     label7.Caption:=label7.caption+st+'   '+before+'   '+after+#13;
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    imp(form1.StringGrid1,gr1,gr2,i);
  end;
//5)à âîò òåïåðü íàðóøàòü ïîðÿäîê íå áóäåì: ýêâèâàëåíòíîñòè
if nekv>0 then
  for i:=3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul+nslozh+nimp to 3+kotr+notr_d+nmul_d+nslozh_d+nimp_d+nekv_d+nmul+nekv+nslozh+nimp-1 do begin
    st:=stringgrid1.cells[i,0];
              if (pos('(',st)<>0) and (pos(')',st)<>0) then  begin
            str_skob:=copy(st,pos('(',st),pos(')',st)-pos('(',st)+1);
            insert('D',st,pos('(',st)); delete(st,pos('(',st),length(str_skob));
        end;
        for k:=length(st) downto 1 do begin
   if st[k]='~' then begin umnpos:=k; break; end;
      end;
      if umnpos>pos('D',st) then umnpos:=umnpos+length(str_skob)-1;
      insert(str_skob,st,pos('D',st)); delete(st,pos('D',st),1);
      label7.Caption:=label7.caption{+inttostr(k)+}+'   '+inttostr(umnpos)+#13;
    before:=copy(st,1,umnpos-1);
    after:=copy(st,umnpos+1,length(st)-umnpos);
     label7.Caption:=label7.caption+st+'   '+before+'   '+after+#13;
      for j:=i-1 downto 0 do
        if before=stringgrid1.Cells[j,0] then begin
          gr1:=j; break; end;
      for j:=i-1 downto 0 do
        if after=stringgrid1.Cells[j,0] then begin
          gr2:=j; break; end;
    ekv(form1.StringGrid1,gr1,gr2,i);
  end;
//à òåïåðü øòóêàòóðèòü ôîðìó!
for i:=1 to srow-1 do
  if stringgrid1.Cells[stringgrid1.colcount-1,i]='1' then
    zakraska(stringgrid1.cells[0,i]+stringgrid1.cells[1,i]+stringgrid1.cells[2,i]);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
edit1.setfocus;
stringgrid1.Visible:=false;
end;

end.
Проблема в том,что он всё время по-разному интерпретирует действия и по-разному определяет текущий знак операции. Причину знаю, как исправить - пока не догадываюсь)