Developing.ru

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

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    Label8: TLabel;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Label9: TLabel;
    StringGrid2: TStringGrid;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const srow=9;
const x0=700;    //центр новой системы координат для рисунка
const y0=600;    

procedure to2(c:integer; var r:string);
var z,ss:integer;
begin
r:=''; ss:=2;
  while c>0 do begin
    z:=c mod ss;
    case z of
      0: r:='0'+r;
      1: r:='1'+r;
    end;
  c:=c div ss;
  end;
end;

procedure zapst(obj:TStringGrid);
var nc,i,j:integer; a:string;
begin
nc:=0;
  while nc<8 do begin
    for i:=1 to 3 do begin
    to2(nc,a);
      for j:=1 to 3-length(a) do a:='0'+a;
    obj.cells[i-1,nc+1]:=a[i];
    end;
  inc(nc);
  end;
end;

procedure kolvo(y:string; var kol_op:integer; var kol_otr:integer; var kol_mul:integer; var kol_slozh:integer; var kol_imp:integer; var kol_ekv:integer);
var i:integer;
begin
kol_op:=0; kol_otr:=0; kol_mul:=0; kol_slozh:=0;  kol_ekv:=0; kol_imp:=0;
for i:=1 to length(y) do begin
  if y[i] in ['*','+','>','^','~'] then kol_op:=kol_op+1;
    if y[i]='*' then inc(kol_mul);
    if y[i]='+' then inc(kol_slozh);
    if y[i]='^' then inc(kol_otr);
    if y[i]='~' then inc(kol_ekv);
    if y[i]='>' then inc(kol_imp);
end;
end;

procedure otricanie(y:string; obj:TStringgrid; kol:integer; var kolvo_otr:integer);
var inv:set of 'A'..'C';
i,u:integer;
begin
inv:=[]; u:=0; kolvo_otr:=0;
for i:=1 to length(y)-1 do    //смотрим отрицания
  if y[i]='^' then
    if (y[i+1]='A') or (y[i+1]='B') or (y[i+1]='C') then begin
//проверяем "лишние"
      if y[i+1] in inv then begin inc(u); continue end else inv:=inv+[y[i+1]];
    obj.cells[kol,0]:=y[i]+y[i+1];
     inc(kol); inc(kolvo_otr);
    end;
obj.ColCount:=obj.ColCount-u;
end;

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

procedure analysis1_mul(obj:TStringGrid; smul:integer; ymul:string; k:integer; kol:integer);
var pst,i,c,d,k1,k2:integer;
begin
  while smul>0 do begin
k1:=0; k2:=0;
  pst:=pos('*',ymul); c:=pst-1; d:=pst+1;
  for i:=d to k do begin
    if (copy(ymul,i,1)='*') or (copy(ymul,i,1)='+') or (copy(ymul,i,1)='~') or (copy(ymul,i,1)='>') then begin k2:=i-1; break end
    else k2:=k; end;
  if pst=1 then begin
  k1:=1;
  obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(ymul,k1,k2-k1+1);
delete(ymul,k1,k2-k1+1);
if (pos('+',ymul)=1) or (pos('~',ymul)=1) or (copy(ymul,i,1)='>') then delete(ymul,1,1);
inc(kol); dec(smul); continue
  end else
    for i:=c downto 1 do
     if (copy(ymul,i,1)='*') or (copy(ymul,i,1)='+') or (copy(ymul,i,1)='~') or (copy(ymul,i,1)='>') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(ymul,k1,k2-k1+1);
delete(ymul,k1,k2-k1+1);
if (pos('+',ymul)=1) or (pos('~',ymul)=1) or (copy(ymul,i,1)='>') then delete(ymul,1,1);
inc(kol); dec(smul);
end;
end;

procedure analysis1_slozh(obj:TStringGrid; sslozh:integer; yplus:string; k:integer; kol:integer);
var k1,k2,c,d,pst,i:integer;
begin
while sslozh>0 do begin
k1:=0; k2:=0;
  pst:=pos('+',yplus); c:=pst-1; d:=pst+1;
  for i:=d to k do
    if (copy(yplus,i,1)='+') or (copy(yplus,i,1)='~') or (copy(yplus,i,1)='>') then begin k2:=i-1; break end
    else k2:=k;
  if pst=1 then begin
  k1:=1;
  obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(yplus,k1,k2-k1+1);
delete(yplus,k1,k2-k1+1);
if (pos('~',yplus)=1) or (pos('>',yplus)=1) then delete(yplus,1,1);
inc(kol); dec(sslozh); continue
  end else
    for i:=c downto 1 do
     if (copy(yplus,i,1)='+') or (copy(yplus,i,1)='~') or (copy(yplus,i,1)='>') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(yplus,k1,k2-k1+1);
delete(yplus,k1,k2-k1+1);
if (pos('~',yplus)=1) or (pos('>',yplus)=1) then delete(yplus,1,1);
inc(kol); dec(sslozh);
end;
end;

procedure analysis1_imp(obj:TStringGrid; simp:integer; yimp:string; k:integer; kol:integer);
var k1,pst,k2,c,d,i:integer;
begin
while simp>0 do begin
k1:=0; k2:=0;
  pst:=pos('>',yimp); c:=pst-1; d:=pst+1;
  for i:=d to k do
    if (copy(yimp,i,1)='~') or (copy(yimp,i,1)='>') then begin k2:=i-1; break end
    else k2:=k;
form1.label3.caption:=inttostr(c)+'  '+inttostr(d);
  if pst=1 then begin
  k1:=1;
obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(yimp,k1,k2-k1+1);
delete(yimp,k1,k2-k1+1);
if (pos('~',yimp)=1) then delete(yimp,1,1);
inc(kol); dec(simp); continue
  end else
    for i:=c downto 1 do
     if (copy(yimp,i,1)='~') or (copy(yimp,i,1)='>') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(yimp,k1,k2-k1+1);
delete(yimp,k1,k2-k1+1);
if (pos('~',yimp)=1) then delete(yimp,1,1);
inc(kol); dec(simp);
end;
end;

procedure analysis1_ekv(obj:TStringGrid; sekv:integer; yekv:string; k:integer; kol:integer);
var k1,k2,c,d,pst,i:integer;
begin
    while sekv>0 do begin
k1:=0; k2:=0;
  pst:=pos('~',yekv); c:=pst-1; d:=pst+1;
  for i:=d to k do
    if (copy(yekv,i,1)='~') then begin k2:=i-1; break end
    else k2:=k;
  if pst=1 then begin
  k1:=1;
  obj.cells[kol,0]:=obj.cells[kol-1,0]+copy(yekv,k1,k2-k1+1);
delete(yekv,k1,k2-k1+1);
inc(kol); dec(sekv); continue
  end else
    for i:=c downto 1 do
     if (copy(yekv,i,1)='~') then begin k1:=i+1; break; end
      else k1:=1;
obj.cells[kol,0]:=copy(yekv,k1,k2-k1+1);
delete(yekv,k1,k2-k1+1);
inc(kol); dec(sekv);
end;
end;