Приложение - Программное обеспечение КС

>

Листинг программы

Unit Prg_my;

Interface

Uses

Windows, SysUtils, Dialogs, ComCtrls;

Type

Pinfo =^info;

Serch = record

Maxy : integer;

INumer :word;

End;

Info =record

Sp1,sp2:string;

Sgn:char;

Md:string;

End;

Inf2 =record

S1:string;

Prior :word;

MyNum :word;

MyPar :word;

Sgn :char;

End;

Ary=array of info;

Ar2=array of inf2;

Procedure ClSk (lkS :string; var glS :string);

Procedure OpSk (ST0: string;V : byte;var ST1 :string);

Procedure Comt(i_St:string;var o_ST :string);

Procedure Check_STR(var Str: string;var Fl:boolean);

Procedure FormArr(var st:string;var Mas_Rec:Ary){ BuildTree(var st:string;var Mas_Rec:Ary)};

Function Extr(St: string;var i:word):string;

Function SupExtr(St: string;var i:word):string;

Procedure F_MulArr(var st:string;var Mar:Ary;var sSt:string);

Function Half(i:byte):byte;

Procedure SubZero(var SPT: string;const c:byte);

Procedure Sgnl(var S : string);

Function Cl(S0:string):word;

Procedure Comt2(inST:string;var outST :string);

Procedure SortArr(var B: ar2);

Implementation

Uses Tree, classes;

Procedure SortArr(var B: ar2);

Var i, j: word;

Tmp :inf2;

Begin

For i:=low(B) to High(B)-1 do

For j:=i+1 to High(B) do

If B[j].Prior<=b[i].Prior then

Begin

Tmp:=B[i];

B[i]:=B[j];

B[j]:=tmp;

End;

End;

Function SupExtr(St: string;var i:word):string;

Var tm_I:string;

Begin

Tm_I:=extr(ST, i);

While (ST[i]='/')or(ST[i]='*') do begin

Tm_I:=tm_I+Extr(ST, i);

End;

Result:=tm_I;

Finalize(tm_I);

End;

Procedure Comt2(inST:string;var outST :string);

Var i, j :word;

Tm_I:String;

Begin

I:=1;

J:=i;

Tm_I:=Supextr(inST, j);

If tm_I[1]<>'-' then begin

Tm_I:='+'+tm_I;

If inST[j]='-' then inST:='-'+inST;

End;

If (tm_I[1]='-')and(inST[j]='+') then delete(inST,1,1);

Delete(inST, i, length(tm_I));

Insert(tm_I, inST, length(inST)+1);

OutST:=inST;

End;

Procedure Comt(i_St:string;var o_ST :string);

Var i, j : word;

TmpS1,tmpS2 : string;

Sgn: char;

Begin

I:=1;

While i<=length(i_ST) do begin

J:=i;

TmpS1:=Supextr(i_ST, j);

If (i=1)and(tmpS1[i]<>'-') then tmpS1:='+'+tmpS1;

If j>= length(i_ST) then begin o_ST:=i_ST;exit;end;

TmpS2:=SupExtr(i_ST, j);

If (i=1)and(tmpS2[1]<>'-') then begin delete(tmpS2,1,1);end;

If (i=1)and(tmpS2[1]='-')and(tmpS1[1]='+') then begin i_ST:='!'+i_ST;inc(j);end;

If (i=1)and(tmpS2[1]<>'-')and(tmpS1[1]='-') then begin delete(i_ST,1,1);dec(j);end;

Begin

TmpS1:=tmpS2+tmpS1;

Delete(i_ST, i, length(tmpS1));

Insert(tmpS1,i_ST, i);

End;

I:=j;

End;

O_ST:=i_ST;

End;

Function Cl(S0:string):word;

Var i, j:word;

Begin

J:=0;

For i:=1 to length(S0) do begin

If S0[i]='(' then inc(j);

End;

Result:=j;

End;

Procedure ClSk (lkS :string; var glS :string);

Var List1: TStringList;

TmS : string;

I, j : word;

Begin

List1:=TStringList. Create;

I:=1;

While i<=length(lkS) do begin

J:=i;

TmS:=Extr(lkS, j);

List1.Add(tmS);

Inc(j);

I:=j;

End;

//Form1.memo2.lines. assign(list1);

List1.Free;

End;

Procedure Sgnl(var S: string);

Var j:word;

Begin

J:=1;

While j<>0 do begin

J:=Pos('+-',S);

If j<>0 then begin

Delete(S, j,2);

Insert('-',S, j);

End;

J:=Pos('-+',S);

If j<>0 then begin

Delete(S, j,2);

Insert('-',S, j);

End;

J:=Pos('--',S);

If j<>0 then begin

Delete(S, j,2);

Insert('+',S, j);

End;

End;

End;

Procedure OpSk (ST0: string;V : byte;var ST1 :string);

Var i, y, j, k, f, Sizer : word;

Tmp1,t0 : string;

TmpST, sgn : string;

Begin

I:=1;

J:=1;

TmpST:='';

ST1:=ST0;

Sizer:=length(ST0);

If (Pos('(',ST0)=1)or(Pos('+(',ST0)<>0)or(Pos('-(',ST0)<>0) then begin

While i<=length(ST0) do

Begin

If (i=1)and(ST0[i]='(') then begin

J:=i;

TmpST:=Extr(ST0,j);

If ST0[j] in ['*','/'] then break;

Delete(ST0,i, length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST, length(tmpST),1);

Insert(tmpST, ST0,i);

If Sizer<>length(ST0) then begin Sgnl(ST0);ST1:=ST0;exit;end;

End;

J:=1;

TmpST:='';

If (ST0[i]='(')and((i>1)and(ST0[i-1]in['+','-','('])) then

Begin

J:=i;

TmpST:=Extr(ST0,j);

If ST0[j] in ['*','/'] then break;

If ST0[i-1]='-' then

Subzero(tmpST,1);

Delete(ST0,i, length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST, length(tmpST),1);

Insert(tmpST, ST0,i);

If Sizer<>length(ST0) then begin Sgnl(ST0);ST1:=ST0;exit;end;

Dec(i);

End;

Inc(i);

End;

Sgnl(ST0);

If Sizer<>length(ST0) then begin ST1:=ST0;exit;end;

End;

//---------------------------

I:=1;

J:=1;

K:=1;

If (Pos('*(',ST0)<>0)or(Pos(')*',ST0)<>0) then begin

While i<=length(ST0) do begin

J:=i;

Tmp1:='';

TmpST:=Extr(ST0,j);

F:=j+1;

T0:=Extr(ST0,F);

If (t0[1]='(')and(ST0[j]='*')and(Pos('(',tmpST)=0) then begin

If tmpST[1] in ['-','+'] then begin delete(tmpST,1,1);inc(i);end;

Tmp1:=t0+ST0[j]+tmpST;

Delete(ST0,i, length(tmp1));

Insert(tmp1,ST0,i);

Tmp1 := t0;

T0 := tmpST;

TmpST:= tmp1;

Tmp1:='';

J:=i+length(tmpST);

End;

If (tmpST[1]='(') and (ST0[j]='*')and(ST0[i-1]<>'*') then begin

Repeat

Tmp1:=tmp1+Extr(ST0,j);

Until ST0[j]<>'*';

If ST0[i-1]='-' then begin

Subzero(tmpST,1);

End;

Delete(ST0,i, length(tmpSt));

Delete(tmpSt,1,1);

Delete(tmpSt, length(tmpSt),1);

K:=1;

Y:=0;

If (tmpST[k]in ['-','+']) then inc(k);

While k<=length(tmpST) do begin

If tmpST[k]='(' then inc(y);

If tmpST[k]=')' then dec(y);

If y=0 then begin

Case tmpSt[k] of

'+':begin insert(tmp1,tmpST, k);inc(k, length(tmp1));end;

'-':begin insert(tmp1,tmpST, k);inc(k, length(tmp1));end;

End;

End;

Inc(k);

End;

Insert(tmpST, ST0,i);

J:=i+length(tmpST)+length(tmp1);

If Sizer<>length(ST0) then begin Sgnl(ST0);ST1:=ST0;exit;end;

End;

Inc(j);

I:=j;

End;

Sgnl(ST0);

End;

If ST0[1]='+' then delete(ST0,1,1);

//------------

ST1:=ST0;

End;

Procedure OpenSK (ST0: string;V : byte;var ST1 :string);

Var i, j, T0,k : word;

TmpST : string;

Muler : string;

Begin

T0:=0;

I:=1;

Muler:='*XX';

While i<=length(ST0) do

Begin

If (ST0[i]='(')and((i=1)or(ST0[i-1]in['+','-','('])) then

Begin

TmpST:=Copy(ST0,i, length(ST0)+1-i);

J:=i;

TmpST:=Extr(ST0,j);

Delete(ST0,i, length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST, length(tmpST),1);

Insert(tmpST, ST0,i);

Dec(i);

//i:=j;

ST1:=ST0;

End;

If (ST0[i]='(')and(ST0[i-1]='*') then

Begin

J:=i;

TmpST:=Extr(ST0,j);

Delete(ST0,i, length(tmpST));

Delete(tmpST,1,1);

Delete(tmpST, length(tmpST),1);

K:=1;

If tmpST[k]='-' then inc(k);

While k<=length(tmpST) do begin

Case tmpST[k] of

'+':begin insert(muler, tmpST, k);inc(k, length(muler));end;

'-':begin insert(muler, tmpST, k);inc(k, length(muler));end;

End;

Inc(k);

End;

Insert(muler, tmpST, k);

Insert(tmpST, ST0,i);

ST1:=ST0;

End;

Inc(i);

End;

End;

Procedure SubZero (var SPT :string;const c:byte);

Var i, y : byte;

Begin

Y:=0;

For i:=1 to length(SPT) do begin

If SPT[i]='(' then inc(y);

If SPT[i]=')' then dec(y);

If y=1 then

Case SPT[i] of

'+':SPT[i]:='-';

'-':SPT[i]:='+';

End;

End;

If C=0 then begin

If SPT[2]<>'+' then insert('-',SPT,2)

Else delete(SPT,2,1);

End;

If C=1 then begin

If SPT[2]='+' then begin delete(SPT,2,1);

Insert('-',SPT,2);

End;

End;

End;

Function Half(i:byte):byte;

Begin

If i=1 then Half:=1

Else if (i mod 2)=1 then Result:=(i div 2)+1

Else Result:=(i div 2);

End;

Function Extr (St:string;var i:word):string;

Var tmp : string;

Ct, f : byte;

Begin

Ct:=0;

F:=0;

Repeat

If St[i]='(' then begin inc(ct);f:=1;end;

If St[i]=')' then begin dec(ct);end;

Tmp:=tmp+St[i];

INC(i);

Until not(St[i] in ['0'..'9','(','a'..'z'])and(f=0)or(ct=0)and(f=1);

Result:=tmp;

End;

Procedure FormArr (var st:string;var Mas_Rec:Ary);

Var from : byte;

Tmp1,tmp2,St1 : string;

Sgn, Z1 : char;

K : 0..10;

I:word;

Begin

If (length(st)=0) then begin exit;end;

K :=0;

St1 :='';

From :=1;

Repeat

I :=1;

Tmp1 :='';

Tmp2 :='';

If St[i]='+' then inc(i);

Tmp1:=Extr(St, i);

Mas_Rec[k].Md:='';

If i<=length(st) then

Begin

Sgn :=St[i];

Inc(i);

Tmp2:=Extr(St, i);

If St[i]='-' then dec(i);

Z1:=St[i];

If (z1 in ['*','/'])

Then

Begin

If (sgn in ['-','+'])then from:=length(tmp1)+1

Else tmp2:=tmp1+sgn+tmp2;

If sgn='-' then tmp2:=sgn+tmp2;

Mas_Rec[k].Md:=tmp2;

Repeat

Mas_Rec[k].Md:=Mas_Rec[k].Md+Extr(St, i);

Until not(st[i] in ['*','/'])or(i>=length(st));

I:=i-from;

End;

Mas_Rec[k].sp1:=tmp1;

Mas_Rec[k].sp2:=tmp2;

Mas_Rec[k].sgn:=sgn;

End

Else

Begin

Mas_Rec[k].sp1:=tmp1;

Mas_Rec[k].sp2:='0';

Mas_Rec[k].sgn:=sgn;

End;

Inc(k);

Delete(St, from, i);

I:=1;

From:=1;

Until i>length(st);

SetLength(Mas_Rec, k);

End;

//-----------------------------------------

Procedure Check_STR (var Str:String;var Fl:boolean);

Var

K, i : word;

Flag : Boolean;

Tmpstr : String;

Sign : array[0..50] of char;

Begin

K :=0;

Tmpstr :='0';

Flag :=true;

If str[1] in ['+','*','/'] then begin ShowMessage('Error in '+IntToStr(1));exit;end;

If str[length(str)] in ['+','*','/','-'] then begin ShowMessage('Error in '+IntToStr(length(str)));exit;end;

Try

For i:=1 to length(str) do

Begin

If (str[i] in ['0'..'9',',','a'..'z']) then tmpstr:=tmpstr+Str[i]

Else

Begin

Sign[k]:=Str[i];

If (sign[k]='(')and(tmpstr<>'0') then begin ShowMessage('Error in '+IntToStr(i));exit;end;

If (sign[k]=')')and(str[i+1] in ['0'..'9','a'..'z','('])and(i<length(str)) then begin ShowMessage('Error in '+IntToStr(i+1));exit;end;

If (sign[k]=')')and(str[i-1] in ['+','-','*','/'])and(i>1) then begin ShowMessage('Error in '+IntToStr(i-1));exit;end;

If (sign[k]='(')and(i<length(str))and(str[i+1] in ['+','*','/']) then begin ShowMessage('Error in '+IntToStr(i+1));exit;end;

If (sign[k] in ['+','-','*','/'])and(i<length(str))and(str[i+1] in ['+','-','*','/'])then begin ShowMessage('Error in '+IntToStr(i+1));exit;end;

Tmpstr:='0';

K:=k+1;

Flag:=not(Flag);

End;

End;

FL:=true;

Except

End;

End;

Procedure F_MulArr (var st:string;var Mar:Ary;var sSt:string);

Var from : byte;

Tmp1,tmp2,St1 : string;

Sgn, s2 : char;

K : 0..10;

I: word;

Begin

If (length(st)=0) then begin exit;end;

K :=0;

St1 :='';

From :=1;

Sst :='';

Repeat

I :=1;

Tmp1 :='';

Tmp2 :='';

Tmp1:=Extr(St, i);

If i<=length(st) then

Begin

Sgn :=St[i];

Inc(i);

Tmp2:=Extr(St, i);

MaR[k].sp1:=tmp1;

MaR[k].sp2:=tmp2;

MaR[k].sgn:=sgn;

S2:=st[i];

SSt:=sSt+s2;

End

Else

Begin

MaR[k].sp1:=tmp1;

MaR[k].sp2:='0';

MaR[k].sgn:=s2;

SSt:=sSt+s2;

End;

Inc(k);

Delete(St, from, i);

I:=1;

From:=1;

Until i>length(st);

SetLength(MaR, k);

End;

End.

Лексический анализ-----

Unit check;

Interface

Uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ComCtrls;

Type

TForm1 = class(TForm)

Edit1: TEdit;

Memo1: TMemo;

Button1: TButton;

Procedure Edit1KeyPress(Sender: TObject; var Key: Char);

Procedure FormCreate(Sender: TObject);

Procedure Button1Click(Sender: TObject);

Procedure Edit1Change(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

End;

Var

S:string[80];

GlobStr, tmp :string;

X, kol_sk, z:integer;

Form1: TForm1;

LevelTree:integer;

Implementation

Uses Tree;

{$R *.DFM}

Procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

Begin

If ord(key) = 13 then

Begin

Kol_sk:=0;

Z:=0;

S:=Edit1.Text;

Globstr:=Edit1.Text;

Memo1.Clear;

For x:=1 to Edit1.GetTextLen-1 do

Begin

//----------Два знака подряд--------------

If ((s[x] in ['+','-','*','/']) and (s[x+1] in ['+','-','*','/']))

Then

Begin

Tmp :='Два знака подряд - '+s[x]+s[x+1];

Memo1.Lines. Add(tmp);

End;

//----------Пустые скобки--------------

If (((s[x]='(') and (s[x+1]=')')) or ((s[x]=')') and (s[x+1]='(')))

Then

Begin

Tmp :='Пустые скобки (),)( - '+s[x]+s[x+1];

Memo1.Lines. Add(tmp);

End;

//----------Знак перед скобкой или знак после скобки--------------

If (((s[x]='(') and (s[x+1] in ['+','*','/'])) or ((s[x+1]=')') and (s[x]in ['+','-','*','/'])))

Then

Begin

Tmp :='Знак перед скобкой или знак после скобки - '+s[x]+s[x+1];

Memo1.Lines. Add(tmp);

End;

//----------Число перед скобкой или число после скобки--------------

If (((s[x]=')') and (s[x+1] in ['0'..'9'])) or ((s[x+1]='(') and (s[x]in ['0'..'9'])))

Then

Begin

Tmp :='Число перед скобкой или число после скобки - '+s[x]+s[x+1];

Memo1.Lines. Add(tmp);

End;

End;

For x:=1 to Edit1.GetTextLen do

Begin

//----------Недопустимый символ--------------

If s[x] in ['A'..'Z','a'..'z','+','-','*','/','(',')','0'..'9']

Then

Else

Begin

Tmp :='Недопустимый символ - '+s[x];

Memo1.Lines. Add(tmp);

End;

//---------количество скобок )---------------

If s[x]=')'

Then

Begin

Kol_sk :=kol_sk-1;

End;

//---------количество скобок (---------------

If s[x]='('

Then

Begin

Kol_sk :=kol_sk+1;

End;

//------------------------Закрывающая скобка без открывающей

If ((kol_sk < 0) and (z = 0)) then

Begin

Z:=z+1;

Tmp :='Закрывающая скобка без открывающей - ';

Memo1.Lines. Add(tmp);

End;

End;

If kol_sk <> 0 then

Begin

Tmp :='Не одинаковое количество откр. и закр. скобок - ';

Memo1.Lines. Add(tmp);

End;

If s[1] in ['+','*','/']

Then

Begin

Tmp :='Первый знак';

Memo1.Lines. Add(tmp);

End;

If s[Edit1.GetTextLen] in ['+','*','/','-']

Then

Begin

Tmp :='Последний знак - ';

Memo1.Lines. Add(tmp);

End;

If Memo1.GetTextLen =0 then

Begin

Memo1.Lines. Add('ВЫРАЖЕНИЕ СИСНТАКСИЧЕСКИ ВЕРНО!');

Button1.Enabled:=true;

End;

End;

End;

Procedure TForm1.FormCreate(Sender: TObject);

Begin

Button1.Enabled:=false;

Kol_sk:=0;

Z:=0;

For x:=1 to Edit1.GetTextLen

Do s[x]:=' ';

End;

Procedure TForm1.Button1Click(Sender: TObject);

Begin

Form2.Show;

Form2.BildClick(Sender);

End;

Procedure TForm1.Edit1Change(Sender: TObject);

Begin

Form1.Button1.Enabled:=false;

End;

End.

Построение дерева ------

Unit tree;

Interface

Uses

Windows, Messages, SysUtils, Forms, Dialogs,

StdCtrls, Buttons, Prg_my,

ComCtrls, ExtCtrls, Classes, Controls, Grids;

Type

Tlayer = record

Parent :word;

Str :string;

Sop :char;

End;

PTint=^word;

Tconv = class(TObject)

Layer: array[0..4] of Tlayer;

ActOper :char;

ActTimer :word;

Empty :boolean;

Procedure inCon(St1:string;sgn :char;Num :word);

Procedure Tik(var B :Ar2; ti :word);

Procedure cDraw(var Ts1,Ts2,TS3,Ts4: TStaticText);

End;

TForm2 = class(TForm)

Panel1: TPanel;

BitBtn1: TBitBtn;

LB1: TListBox;

TreeView1: TTreeView;

Button1: TButton;

Procedure FormCreate(Sender: TObject);

Procedure BildClick(Sender: TObject);

Procedure CloseClick(Sender: TObject);

Procedure OnMoClick(Sender: TObject);

Procedure Memo1KeyPress(Sender: TObject; var Key: Char);

Procedure BitBtn1Click(Sender: TObject);

Procedure Memo1Enter(Sender: TObject);

Procedure comClick(Sender: TObject);

Procedure FormClose(Sender: TObject; var Action: TCloseAction);

Procedure LB1Click(Sender: TObject);

Procedure BitBtn2Click(Sender: TObject);

Procedure BitBtn5Click(Sender: TObject);

Procedure BitBtn4Click(Sender: TObject);

Private

Procedure TreeBld(Ar: Ary;var TN:TTreeNode;Ssn:string);

Procedure BuildTree(Ar: Ary;var TN:TTreeNode);

Procedure Scobc(var swp:TTreeNode;ch_st:string);

Procedure BAll(BA_Str: string; var TN:TTreeNode; Ar :Ary);

Procedure BB2C( iNum :word);

Public

Flag:boolean;

Ar_Node: array[0..1] of TTreeNode;

G_str, op_str : string;

Cou_str: byte;

BigArray :TStringlist;

BigA :Ar2;

ACount : word;

Maximum: serch;

End;

Var

Form2: TForm2;

Conv: Tconv;

Pint: PTint;

Implementation

Uses check;

{$R *.DFM}

Procedure Tconv. cDraw(var Ts1,Ts2,TS3,Ts4: TStaticText);

Begin

TS1.Caption:=layer[0].Str;

TS2.Caption:=layer[1].Str;

TS3.Caption:=layer[2].Str;

Ts4.Caption:=layer[3].Str;

End;

Procedure Tconv. Tik(var B :Ar2; ti :word);

Var j: byte;

Gh: byte;

Begin

If actTimer>0 then dec(actTimer);

If (actOper in ['*','/'])and((ti) mod 2 =0) then exit;

For j:=4 downto 1 do begin

Layer[j]:=layer[j-1];

End;

Layer[0].Str:='';

Layer[0].Parent:=0;

Layer[0].sop:=#11;

Gh:=0;

If layer[4].Str<>'' then begin

Dec(B[layer[4].Parent].Prior);

If (layer[3].Str='')and(layer[3].Parent=0) then actOper:=#11;

For j:=0 to 3 do begin

If layer[j].sop='*' then gh:=2;

If layer[j].sop='/' then gh:=2;

End;

If gh=2 then actOper:='*';

If gh=0 then actOper:=#11;

Layer[4].Str:='';

Layer[4].Parent:=0;

Layer[4].sop:=#11;

End;

End;

Procedure Tconv. inCon(st1 :string;sgn: char;Num :word);

Begin

If (layer[0].Str='') then begin

Layer[0].Parent:=Num;

Layer[0].Str:=St1;

Layer[0].sop:=sgn;

Case sgn of

'+','-':inc(actTimer,4);

'/','*':begin inc(actTimer,8); actOper:='*'; end;

End;

End;

End;

Procedure TForm2.BB2C( iNum :word);

Var Item, Del :TTreeNode;

Tr:TTreeNodes;

I, j, mul, Icount :word;

Flg, Fl :boolean;

ChecFlag: boolean;

Ar0:Ary;

Begin

SetLength(BigA,25);

ChecFlag:=(iNum=0);

Item:=Form2.treeview1.Items[0];

Acount:=0;

New(Pint);

Bigarray. Clear;

Icount:=1;

Form2.treeview1.Visible:=false;

While Form2.treeview1.Items. Count>2 do begin

If Item. GetNext<> nil then Item:=Item. GetNext

Else item:=Form2.treeview1.Items[0];

If item. HasChildren then begin

If (not(item. Item[0].HasChildren))and(not(item. Item[1].HasChildren)) then begin

BigArray. Add(item. Item[0].text+item. text+item. Item[1].Text);

BigA[Acount].S1:=item. Item[0].text+item. text+item. Item[1].Text;

BigA[Acount].Prior:=0;

BigA[Acount].sgn:=item. text[1];

BigA[Acount].MyNum:=Acount;

Inc(Icount);

If item. item[0].Data<>nil then begin

PTint(item. item[0].Data)^:=Acount;

Inc(BigA[Acount].Prior);

End;

If item. item[1].data<>nil then begin

PTint(item. item[1].Data)^:=Acount;

Inc(BigA[Acount].Prior);

End;

Inc(Acount);

Del:=item;

Pint:=@(BigA[Acount-1].MyPar);

Del:=Form2.treeview1.items. InsertObject(del,'['+BigA[aCount-1].S1+']',pint);

Item. Delete;

Item:=del;

End;

End;

End;

Ball(GlobStr, AR_Node[0],Ar0);

Form2.treeview1.Visible:=true;

If Acount=0 then begin finalize(BigA);exit;end;

SetLength(BigA, Acount);

J:=0;

Flg:=true;

Fl:=True;

Conv. layer[0].Str:='';

Conv. actTimer:=0;

Mul:=1;

For i:=1 to 100 do begin

If (BigA[j].Prior=0)then begin

Flg:=(Conv. layer[0].Str='');

Conv. inCon(BigA[j].S1,BigA[j].sgn, BigA[j].MyPar);

If Flg then inc(j);

End;

If (conv. layer[0].Str='')and(conv. layer[1].Str='')and(conv. layer[2].Str='')and(conv. layer[3].Str='') then conv. actTimer:=0;

If (j>=ACount)and(conv. actTimer=0) then break;

If conv. actOper in['*','/'] then inc(mul);

If Fl and(conv. actOper in['*','/']) then begin mul:=2;Fl:=false; end;

If conv. actOper in['+','-'] then Fl:=true;

Conv. Tik(BigA, mul);

End;

If i<maximum. maxy then

Begin

Maximum. maxy:=i;

Maximum. iNumer:=iNum;

End;

Finalize(BigA);

End;

Procedure TForm2.Scobc(var swp:TTreeNode;ch_st:string);

Var TM_A: Ary;

Begin

Swp. text:='+';

Delete(ch_st,1,1);

Delete(ch_st, length(ch_st),1);

Setlength(TM_A,25);

FormArr(ch_st, TM_A);

BuildTree(TM_A, swp);

Finalize(TM_A);

End;

Procedure TForm2.BuildTree(Ar: Ary;var TN:TTreeNode);

Var TM_A, u_m: Ary;

Jk :byte;

SgnSt:string;

T_t, swpT:TTreeNode;

Begin

If high(Ar)=low(Ar) then

Begin

If Ar[low(Ar)].sp2='0' then

Begin

Tn. Text:=Ar[low(Ar)].sp1;

With Ar[low(Ar)] do begin

If (sp1[1]='-')and(sp1[2]='(') then

Begin

Delete(sp1,1,1);

SubZero(sp1,0);

End;

If sp1[1]='(' then Scobc(Tn, sp1);

End;

End

Else begin

If Ar[low(Ar)].Md<>'' then

Begin

SetLength(u_m,15);

F_MulArr(Ar[low(Ar)].Md, u_m, sgnSt);

Jk:=Half(length(sgnSt));

Tn. Text:=sgnst[jk];

TreeBld(u_m, Tn, sgnSt);

Finalize(u_m);

End

Else begin

Tn. Text:=Ar[low(Ar)].sgn;

With Ar[low(Ar)] do begin

SwpT:=Form2.TreeView1.Items. addChild(Tn, sp1);

If (sp1[1]='-')and(sp1[2]='(') then

Begin

Delete(sp1,1,1);

SubZero(sp1,0);

End;

If sp1[1]='(' then begin

Scobc(swpT, sp1);

End;

SwpT:=Form2.TreeView1.Items. addChild(Tn, sp2);

If sp2[1]='(' then begin

Scobc(swpT, sp2);

End;

End;

End;

End;

Exit

End

Else

Begin

TM_A:=Copy(Ar, low(Ar),((low(Ar)+high(Ar)) div 2)+1);

T_t:=Form2.TreeView1.Items. addChild(Tn,'+');

BuildTree(TM_A, t_t);

TM_A:=Copy(Ar,((low(Ar)+high(Ar)) div 2)+1,((low(Ar)+high(Ar)) div 2)+1);

T_t:=Form2.TreeView1.Items. addChild(Tn,'+');

BuildTree(TM_A, t_t);

Finalize(TM_A);

End;

End;

Procedure TForm2.TreeBld(Ar: Ary;var TN:TTreeNode;Ssn:string);

Var TM_A: Ary;

Jk, sco :byte;

LocSt:string;

T_t, swpT:TTreeNode;

Begin

If high(Ar)=low(Ar) then

Begin

If Ar[low(Ar)].sp2='0' then begin tn. Text:=Ar[low(Ar)].sp1;

If Ar[low(Ar)].sp1[1]='(' then

Scobc(Tn, Ar[low(Ar)].sp1);

End

Else begin

Tn. Text:=Ar[low(Ar)].sgn;

With Ar[low(Ar)] do begin

SwpT:=Form2.TreeView1.Items. addChild(Tn, sp1);

If (sp1[1]='-')and(sp1[2]='(') then

Begin

Delete(sp1,1,1);

SubZero(sp1,0);

End;

If sp1[1]='(' then begin

Scobc(swpT, sp1);

End;

SwpT:=Form2.TreeView1.Items. addChild(Tn, sp2);

If sp2[1]='(' then begin

Scobc(swpT, sp2);

End;

End;

End;

Exit

End

Else

Begin

Jk:=Half(length(SSn));

Sco:=((low(Ar)+high(Ar)) div 2)+1;

TM_A:=Copy(Ar, low(Ar),sco);

Locst:=Copy(SSn, low(Ar),((low(Ar)+high(Ar)) div 2)+1);

Sco:=((low(Tm_A)+high(Tm_A))div 2)+1;

T_t:=Form2.TreeView1.Items. addChild(Tn, locst[sco]);

TreeBld(TM_A, t_t, SSn);

//--------------------------------

Sco:=((low(Ar)+high(Ar)) div 2)+1;

TM_A:=Copy(Ar,((low(Ar)+high(Ar)) div 2)+1,sco);

Locst:=Copy(SSn, jk, high(Ar)+1);

Sco:=Half(length(locst));

T_t:=Form2.TreeView1.Items. addChild(Tn, locst[sco]);

TreeBld(TM_A, t_t, SSn);

End;

End;

Procedure TForm2.FormCreate(Sender: TObject);

Begin

Maximum. maxy:=1000;

Cou_str:=1;

Conv:=Tconv. Create;

Conv. actOper:=#11;

Conv. empty:=false;

BigArray:=TstringList. Create;

ACount:=0;

End;

Procedure TForm2.BildClick(Sender: TObject);

Var

A:Ary;

Lin:string;

Begin

Form2.TreeView1.Items. Clear;

Lin:=trim(Form1.Edit1.text);

Op_STR:=lin;

Lb1.Clear;

Lb1.Items. Add(lin);

AR_Node[0]:=Form2.TreeView1.Items. add(nil,'Корень дерева');

AR_Node[0]:=Form2.TreeView1.Items. add(AR_Node[0],'+');

Setlength(A,25);

FormArr(lin, A);

BuildTree(A, AR_Node[0]);

AR_Node[0].Expand(True);

Finalize(A);

Finalize(lin);

BitBtn1.Enabled:=true;

End;

Procedure TForm2.CloseClick(Sender: TObject);

Begin

Close;

End;

Procedure TForm2.OnMoClick(Sender: TObject);

Var STR: string;

Begin

Str:=trim(Form1.Edit1.Text);

End;

Procedure TForm2.Memo1KeyPress(Sender: TObject; var Key: Char);

Begin

If Key=#13 then

Begin

BildClick(Sender);

BitBtn1.SetFocus;

End;

End;

Procedure TForm2.BitBtn1Click(Sender: TObject);

Var A0 : Ary;

STR : string;

C0,c1 : byte;

Begin

STR:=trim(form1.Edit1.Text);

If Pos('(',STR)=0 then begin showmessage('Скобок больше нет');exit;end;

If STR='' then begin showmessage('Пустая строка');exit;end;

C0:=cl(STR);

C1:=length(STR);

Repeat

OpSK(STR,0,STR);

Until (c0<>cl(STR))or(c1<>length(STR));

Form1.Edit1.Text:=STR;

LB1.Items. Add(STR);

Inc(cou_str);

BALL(STR, AR_Node[1],A0);

//---------------------

Finalize(A0);

Finalize(STR);

End;

Procedure TForm2.BAll(BA_Str: string; var TN:TTreeNode; Ar :Ary);

Begin

Form2.TreeView1.Items. Clear;

TN:=Form2.TreeView1.Items. add(nil,':'+'Результат');

TN:=Form2.TreeView1.Items. add(TN,'+');

Setlength(Ar,25);

FormArr(BA_STR, Ar);

BuildTree(Ar, TN);

TN. Expand(True);

End;

Procedure TForm2.Memo1Enter(Sender: TObject);

Begin

BitBtn1.Enabled:=false;

End;

Procedure TForm2.comClick(Sender: TObject);

Var A0: Ary;

STR: string;

Data, res: string;

StrTmp, StrTmp1:string;

Begin

StrTmp:=Form1.Edit1.Text;

Repeat

Data :=Form1.Edit1.Text;

Comt2(data, res);

StrTmp1:=res;

Form1.Edit1.Text :=res;

LB1.Items. Add(res);

Comt(res, res);

LB1.Items. Add(res);

Until StrTmp = StrTmp1;

Finalize(A0);

Finalize(STR);

End;

Procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);

Begin

Conv. Free;

Bigarray. Free;

End;

Procedure TForm2.LB1Click(Sender: TObject);

Var i, K: word;

Ar0: Ary;

Loc_Str: string;

Begin

For i := 0 to (LB1.Items. Count - 1) do begin

If LB1.Selected[i] then

Begin

Loc_Str:=LB1.Items. Strings[i];

GlobStr:=loc_str;

K:=Pos(' ;',Loc_Str);

If k<>0 then delete(Loc_Str, k, length(loc_str)-(k-1));

Ball(Loc_Str, AR_Node[0],Ar0);

End;

End;

Finalize(Ar0);

Finalize(Loc_Str);

End;

Procedure TForm2.BitBtn2Click(Sender: TObject);

Begin

BB2c(0);

End;

Procedure TForm2.BitBtn5Click(Sender: TObject);

Begin

Close;

End;

Procedure TForm2.BitBtn4Click(Sender: TObject);

Var i, k: word;

Ar0:Ary;

Loc_Str: string;

Begin

If lb1.Items. Count=0 then exit;

For i:=0 to lb1.Items. Count-1 do begin

Loc_Str:=LB1.Items. Strings[i];

K:=Pos(' ;',Loc_Str);

If k<>0 then delete(Loc_Str, k, length(loc_str)-(k-1));

Ball(Loc_Str, AR_Node[0],Ar0);

BB2C(1);

End;

Finalize(Ar0);

Maximum. maxy:=1000;

End;

End.

Похожие статьи




Приложение - Программное обеспечение КС

Предыдущая | Следующая