Приложение - Программное обеспечение КС
>
Листинг программы
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.
Похожие статьи
-
В процессе разработки интерфейса уделялось большое внимание его упрощению для того, чтобы пользователь с минимальными знаниями и навыками в работе с...
-
Файл-модуль unit1.pas Unit Unit1; Interface Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, XPMan,...
-
Описание разработанных модулей В разработанной программе имеется 5 модулей. Главный модуль "Program. cs" предназначен для запуска главного окна...
-
На вход программе подается строка, каждый символ которой ходе работы программы станет элементом алфавита. Положение символа в строке определяет его...
-
Объект ориентированный класс программирование Цель Работы - изучить методику создания одномерных динамических символьных массивов при помощи...
-
Исходный код решения по автоматизации тестов - Тестирование программного обеспечения
Using OpenQA. Selenium; Using OpenQA. Selenium. Chrome; Using OpenQA. Selenium. Support. UI; Using System; Using System. Collections. Generic; Using...
-
1. Изучение теоретических аспектов использования: MS Word, MS Excel, MS Access, Paint и Photoshop... (ППО) Часть 1 : Руководство по выполнению...
-
Поскольку клиентская часть представляет собой приложение на базе операционной системы Android, то для ее разработки был выбран рекомендуемый...
-
Алгоритм для обновления дан на рис.6. Для каждого предмета е в t отыскивается Hashi. Если е найдено хэше кластера, то увеличиваем на 1 его sup в Btreei....
-
В этой главе представлено описание инструментов и методов, использованных при написании кода программы. Инструменты разработки серверной части Для...
-
Версионность базы данных - Программное обеспечение для пропускной системы на основе технологии NFC
С ростом приложения существует проблема обновления схемы базы данных с сохранением внесенных данных. Если информация в базе данных не может быть легко...
-
Описание API сервера - Программное обеспечение для пропускной системы на основе технологии NFC
Таблица 8 Описание API URL Метод Параметры Возвращает Вариант /login POST Phone - form-data JSON {'token', 'id'} - ID пользователя и токен Успех Password...
-
Особенностью архитектуры REST является отсутствия хранения состояния на сервере. Для того, чтобы не передавать пользовательские логин и пароль каждый...
-
Особенностью API для коммуникации с СКУД является то, что авторизация методов происходит не с помощью токена, а с помощью проверки IP адреса клиента на...
-
Базовый интерфейс двоичного дерева поиска состоит из трех операций: - FIND(K) -- поиск узла, в котором хранится пара (key, value) с key = K. - INSERT(K,...
-
Для того, чтобы избежать копирования карты доступа злоумышленниками был введен защитный механизм. Механизм основан на использовании алгоритма RSA....
-
Заключение - Программное обеспечение для пропускной системы на основе технологии NFC
Обеспечение удобной пропускной системы - важная и актуальная задача. Появление новых технологий, таких как NFC и HCE, позволяет решить эту проблему. В...
-
Модернизация обобщенного алгоритма кластеризации состоит в использовании вместо обычных бинарных деревьев сбалансированных бинарных деревьев(B+ tree)....
-
Первым шагом при начале работе над учебным проектом является определение ролей участников данного проекта. Данный этап является одним из наиболее важных,...
-
Для разработки программного обеспечения использован язык Java. Разработка проводилась в среде Eclipse Ganymede 3.2. В качестве СУБД для тестирования...
-
Анализ безопасности - Программное обеспечение для пропускной системы на основе технологии NFC
Для обеспечения безопасности системы было решено использовать протокол HTTPS для связи клиента и сервера. Использование протокола HTTPS для коммуникации...
-
В данной части работы будут рассмотрены основные бизнес-процессы этапа разработки программного обеспечения в рамках учебных проектов в университете. В...
-
Длительные учебные проекты по разработке ПО, такие как курсовые работы или задания по какому-либо курсу программирования, обычно разбиваются на набор...
-
Данный процесс отражает регламент работ по разработке программных продуктов в рамках учебных проектов, который будет использован при создании исполяемой...
-
В данной части работы будет рассмотрено моделирование спроектированного ранее бизнес-процесса. Выбор инструмента моделирования бизнес-процессов Сейчас на...
-
В качестве инструмента моделирования был выбран программный продукт RunaWFE. Данный продукт позволяет не только создать модель бизнес-процесса, но и...
-
Рис. 9 Пример B+ дерева, связывающего ключи 1-7 с данными d1-d7. Связи (выделены красным) позволяют быстро обходить дерево в порядке возрастания ключей....
-
Тенденции рынка финансово-экономического программного обеспечения - Финансово-экономические системы
Когда речь заходит о возможности (необходимости) спроектировать автоматизированную модель управления предприятием, то появляются новые термины. В Росси...
-
Таблица В.1. Определение ролей проектной команды Роль Зона ответственности Задачи Менеджер проекта Отвечает за управление проектом, за то, что ожидания...
-
Постановка задачи на разработку программного обеспечения Для того чтобы предлагаемая схема была интегрирована в САПР, который не имеет функции интеграции...
-
Поскольку сетевые системы продолжают развиваться по сложности, новые учебные программы и учебные пособия появляются, чтобы облегчить преподавание и...
-
Заключение - Методика моделирования основных процессов разработки программного обеспечения
В рамках данной работы был рассмотрен процесс разработки ПО как части учебных проектов в НИУ ВШЭ - Пермь. Учебные проекты отличаются от реальных,...
-
Разделение программы на модули до некоторой степени позволяет уменьшить ее сложность... Однако гораздо важнее тот факт, что внутри модульной программы...
-
Обеспечение совместимости программного обеспечения в корпоративных системах В некоторых технических областях существуют жесткие требования к...
-
В современных условиях, условиях жесткой конкуренции, очень важно гарантировать высокое качество процесса конструирования ПО. Такую гарантию дает...
-
Программное обеспечение (ПО) - Комплекс программ: обеспечивающих обработку или передачу данных; предназначенных для многократного использования и...
-
На сегодняшний день уже практически невозможно представить нашу повседневную жизнь без компьютерной техники. Интернет предоставляет нам безграничные...
-
Меры и средства программно-технического уровня. В рамках современных ИС должны быть доступны, по крайней мере, следующие механизмы безопасности:...
-
Adobe Dreamweaver Adobe Dreamweaver - это HTML-редактор от компании Adobe, который на сегодняшний день очень известный. Первая его версия была выпущена в...
-
Программное обеспечение промежуточного уровня (middleware) Является основной концепцией по организации программного обеспечения распределенных систем...
Приложение - Программное обеспечение КС