上QQ阅读APP看本书，新人免费读10天
设备和账号都新为新人
2.5 演示类基类的实现
2.5.1 基类的成员说明
demo直接继承tpersistent，其私有成员如下：
demo=class(tpersistent) private vg,pg,sys,cvg:Tstringgrid; ftxt,ptxt:text; run:boolean; help:tlabel; img:timage; input:tedit; pvar:array[1..21] of memonode;
其中vg用来显示静态变量，pg用来显示算法代码，sys用来显示系统工作栈，cvg用来显示数组，ptxt中存放算法源代码，ftxt中存放脚本文件代码，help是用来显示注释的标签，img用来显示动态变化的图形，input用来输入算法所需参数，pvar用来存放动态结点信息，其结构是一个记录：
memonode=record
used:boolean;
x,y,fnum:integer;
pname:string;
value:array[1..5] of string;
end;
demo类的公开方法在前面已说明，下面对主要方法的实现进行说明。
2.5.2 算法代码的填充
在运行算法的真正可执行代码时，把算法代码放入demo.txt中，它们是一行一行的字符，未必是可执行的。执行时根据脚本中的行号点亮相应行，表示执行的就是此行算法。根据实际算法的执行流程逐步执行。代码如下：
procedure demo.fillprogram;
var i:integer;
s:string;
begin
i:=pg.rowcount;
pg.Cells [0,0]:='行号';
pg.Cells [1,0]:='语句';
reset(ptxt);
while not eof(ptxt) do
begin
i:=i+1;
pg.RowCount :=i;
readln(ptxt,s);
pg.Cells [0,i-1]:=inttostr(i-1);
pg.Cells [1,i-1]:=s;
end;
closefile(ptxt);
end;
2.5.3 脚本行的解释
脚本语言以行为单位，首先读取行号，调用activestate(i)点亮相应行，然后分别解释后面以分号分隔的字符串，根据不同的符号调用相应的方法。代码如下：
procedure demo.runoneline;
var s,s1:string;
x,y,i:integer;
begin
if run then
begin
if not eof(ftxt) then
begin
readln(ftxt,s);
y:=pos(']',s);
i:=strtoint(copy(s,1,y-1));
if (i>0)and(i<pg.RowCount ) then activestate(i);
s:=copy(s,y+1,length(s)-y);
x:=pos(';',s);
while x>1 do
begin
s1:=copy(s,1,x-1);
s:=copy(s,x+1,length(s)-x);
case s1[1] of
'#':varallocation(copy(s1,2,length(s1)-1));
'*':begin
x:=pos('=',s1);
changevar(copy(s1,2,x-2),copy(s1,x+1,length(s1)-x));
end;
'@':cvallocation(copy(s1,2,length(s1)-1));
'$':begin
x:=pos('=',s1);
changecv(copy(s1,2,x-2),copy(s1,x+1,length(s1)-x));
end;
'/':help.Caption :=copy(s1,2,length(s1)-1);
'<':push(copy(s1,2,length(s1)-1));
'>':pop;
'&':begin
x:=pos('.',s1);
newnode(copy(s1,2,x-2),strtoint(copy(s1,x+1,length(s1)-x)));
end;
'~':freenode(copy(s1,2,length(s1)-1));
'!':begin
x:=pos('=',s1);
y:=pos('.',s1);
setdatavalue(copy(s1,2,y-2),strtoint(copy(s1,y+1,x-y-1)),
copy(s1,x+1,length(s1)-x));
end;
'^':begin
x:=pos('=',s1);
ptop(copy(s1,2,x-2),copy(s1,x+1,length(s1)-x));
end;
'?':drawspecial(img,copy(s1,2,length(s1)-1));
'%':cleargraph;
end;
x:=pos(';',s);
end;
end
else begin closefile(ftxt) ; run:=false;end;
end ;
2.5.4 简单静态变量的分配与变化
简单静态变量包括单个变量和一维数组，简单静态变量的分配要求一次进行，传入demo.varallocation(varstr: string)；参数varstr要求用逗号分隔。代码如下：
procedure demo.varallocation(varstr: string);
var i,x:integer;
s:string;
begin
vg.Cells [0,0]:='变量名';
vg.Cells [1,0]:='变量值';
vg.RowCount:=1;
i:=vg.RowCount ;
varstr:=varstr+',';
x:=pos(',',varstr);
while x>0 do
begin
i:=i+1; vg.RowCount :=i;
s:=copy(varstr,1,x-1);
varstr:=copy(varstr,x+1,length(varstr)-x);
vg.Cells [0,i-1]:=s;
vg.Cells [1,i-1]:='';
x:=pos(',',varstr);
end;
end;
下面是对简单静态变量赋值和改变值时调用的方法，根据变量名找到变量后修改其值：
procedure demo.changevar(vn, vv: string);
var i:integer;
begin
i:=1;
while (vg.cells[0,i]<>vn)and(i<vg.RowCount-1 ) do
i:=i+1;
if i<vg.RowCount then
begin
vg.Row :=i;
vg.Cells [1,i]:=vv;
end;
end;
2.5.5 二维数组的分配与值的修改
用二维表格能较好地显示二维数组的数据，设计时把二维数组分成两部分，分配时，逗号前的部分显示在表格最左列，代表行号；逗号后的部分显示在第一行，代表列号。代码如下：
procedure demo.cvallocation(s: string);
//s='demo[5,5]xyz[4,3]'
var i,x,y,j,r,c:integer;
s1:string;
begin
cvg.RowCount:=1;
i:=0;
x:=pos(']',s);
while x>0 do
begin
s1:=copy(s,1,x);
s:=copy(s,x+1,length(s)-x);
x:=pos('[',s1);
y:=pos(',',s1);
r:=strtoint(copy(s1,x+1,y-x-1));
c:=strtoint(copy(s1,y+1,length(s1)-y-1));
if cvg.RowCount =1
then cvg.RowCount:=r+1
else begin i:=cvg.RowCount;
cvg.RowCount:=cvg.RowCount+r+1;
end;
if c>cvg.ColCount then cvg.ColCount :=c+1;
for j:=1 to c do cvg.Cells [j,i]:=inttostr(j)+']';
for j:=0 to r do
begin
cvg.Cells [0,i]:=copy(s1,1,x)+inttostr(j);
i:=i+1;
end;
x:=pos(']',s);
end;
end;
改变值时，用逗号前的部分在表格第一列查找行号，用逗号后的部分在第一行查找列号：
procedure demo.changecv(vn, vv: string);
var i,x,y:integer;
s:string;
begin
x:=pos(',',vn);
y:=pos(']',vn);
s:=copy(vn,1,x-1);
x:=strtoint(copy(vn,x+1,y-x-1));
i:=0;
while (cvg.cells[0,i]<>s)and(i<cvg.RowCount-1 ) do
i:=i+1;
if i<cvg.RowCount then
begin
cvg.Row :=i;
cvg.Col :=x;
cvg.Cells [x,i]:=vv;
end;
end;
2.5.6 系统工作栈的入栈及出栈
设计时设定sys表格的行数，把sys.Row的值初始化为0，首次压栈时，直接放入最下一行，非首次压栈要判断是否到表格的顶端，即判断栈是否已满，如果栈已满，可以扩大栈的容量，把原来的数据依次下移。代码如下：
var i:integer;
begin
if sys.row=0
then sys.Row:=sys.RowCount -1
else if sys.row=1
then begin
sys.RowCount :=sys.RowCount+1;
for i:=sys.rowcount-2 downto 1 do
sys.Cells[0,i+1]:= sys.Cells[0,i];
end
else sys.Row:=sys.Row-1;
sys.Cells [0,sys.Row]:=s;
end;
出栈时，如果栈非空，只要清除栈的最顶行即可，如果栈中只有一行值，应设置栈为
空的标志，即对sys.Row 赋值0。
procedure demo.pop;
begin
if sys.row>0
then begin
sys.Cells [0,sys.Row]:='';
if sys.row<sys.RowCount-1
then sys.Row :=sys.Row +1
else sys.Row :=0;
end;
end;
2.5.7 指针类型的结点申请
模仿操作系统中内存的动态管理方法对内存进行管理，用静态记录数组模拟系统内存。申请结点时，在数组中登记相应信息，首先查找第一个未用的单元，并设置分配标志。由于申请空间是把内存单元的地址与变量名联系起来，因此用变量名申请时，变量名可能指向某一结点，这时应把指向原结点的指针擦去。另外，可能有多个指针变量指向同一个结点，在本系统中结点的pname域内存放的就是以逗号分隔的多个指针变量名。下面代码中的函数getadd(vname)用来返回指针变量vname指向的结点的地址(实际是数组的下标)，根据返回值来判断指针变量vname是否存在。最后在填充结点信息后，通过drawnode(i)在画布上用图形显示出结点。代码如下：
procedure demo.newnode(vname: string; fn: integer);
var i,old:integer;
begin
i:=1;
while pvar[i].used do i:=i+1;
pvar[i].used :=true;
old:=getadd(vname);
if (old>0) then
begin
if pos(',',pvar[old].pname )=0
then begin
pvar[old].pname:='';
img.Canvas.Pen.Mode :=pmnot;
drawarrow(pvar[old].x+40,pvar[old].y-30,
pvar[old].x+40,pvar[old].y);
img.Canvas.TextOut(pvar[old].x+42,
pvar[old].y-30,DupeString(' ',6));
img.Canvas.Pen.Mode :=pmcopy;
end
else begin
if pos(vname+',',pvar[old].pname )>0
then delete(pvar[old].pname,pos(vname+',',
pvar[old].pname ),length(vname+',') )
else delete(pvar[old].pname,pos(','+vname,
pvar[old].pname ),length(vname+',') );
img.Canvas.TextOut(pvar[old].x+42,
pvar[old].y-30,DupeString(' ',6));
img.Canvas.TextOut(pvar[old].x+42,
pvar[old].y-30,pvar[old].pname );
end;
end;
pvar[i].pname :=vname;
pvar[i].fnum :=fn;
pvar[i].x:=0;
drawnode(i);
end;
2.5.8 指针变量相互赋值
由于结点的地址是用数组的下标来表示的，因此相互赋值就是把相应的数组下标放入结点的指针域。
为了方便起见，在脚本语言中对指针变量赋值时用'0'代表空值。由于赋值号的右面可以是指针变量也可以是结点的指针域或者是数值串(直接地址)，所以，先判断赋值号右面是否为空，再判断是否为结点的指针域。如果是结点的指针域，则先找到结点，再取指针域的值为地址；否则，直接用getadd(qexp)得到地址，或者由数值串直接得到地址。
找到赋值号后的地址，下一步就是画箭头表示指针。根据赋值号左面是指针变量还是结点的指针域又分为两种情况，前者只需在指向新结点的指针中加以标识即可，当然要擦去原指向箭头(如果指针变量原来就存在的话)；后者则要从结点指针域画出指向新结点的指针，擦去原来的指针。代码如下：
procedure demo.ptop(pexp, qexp: string);
var x,y,x1,x2,y1,y2,i:integer;
qs,oldr:string;
begin
if qexp='0'
then x:=0
else begin
x:=pos('.',qexp);
if x=0
then begin //p ponit to no.x node
x:=getadd(qexp);
if x=0 then x:=strtoint(qexp);
end
else begin
qs:=copy(qexp,1,x-1);
x:=strtoint(copy(qexp,x+1,length(qexp)-x));
x:=strtoint(getfieldvalue(qs,x));
end;
end;
y:=pos('.',pexp);
if y>0
then begin //对结点指针域赋值
qs:=copy(pexp,1,y-1);
y:=strtoint(copy(pexp,y+1,length(pexp)-y));
oldr:=getfieldvalue(qs,y);
if (oldr<>'')and (oldr<>'0')
then begin //显示箭头，先擦去原来指向的箭头
img.Canvas.Pen.Mode :=pmnot;
i:=getadd(qs);
x1:=pvar[i].x+40*(y-1)+20 ;
y1:=pvar[i].y+20;
x2:=pvar[strtoint(oldr)].x;
y2:=pvar[strtoint(oldr)].y;
drawarrow(x1,y1,x2,y2);
img.Canvas.Pen.Mode :=pmcopy;
end;
setpointvalue(qs,y,inttostr(x));
end
else begin //对指针变量赋值
i:=getadd(pexp);
if i>0 then
begin //修改原指针
if pos(',',pvar[i].pname )=0
then begin
pvar[i].pname:='';
img.Canvas.Pen.Mode :=pmnot;
drawarrow(pvar[i].x+40,pvar[i].y-30,pvar[i].x+40,pvar[i].y);
img.Canvas.TextOut(pvar[i].x+42,pvar[i].y-30,
DupeString(' ',6));
img.Canvas.Pen.Mode :=pmcopy;
end
else begin
if pos(pexp+',',pvar[i].pname )>0
then delete(pvar[i].pname,pos(pexp+',',
pvar[i].pname ),length(pexp+',') )
else delete(pvar[i].pname,pos(','+pexp,
pvar[i].pname ),length(pexp+',') );
img.Canvas.TextOut(pvar[i].x+42,pvar[i].y-30,
DupeString(' ',6));
img.Canvas.TextOut(pvar[i].x+42,
pvar[i].y-30,pvar[i].pname )
end;
end;
if x=0
then //drawnil(pexp);
else
begin
if pvar[x].pname =''
then pvar[x].pname := pexp
else pvar[x].pname :=pvar[x].pname+','+pexp;
//画指针
drawarrow(pvar[x].x+40,pvar[x].y-30,pvar[x].x+40,pvar[x].y);
img.Canvas.TextOut(pvar[x].x+42,pvar[x].y-30,pvar[x].pname )
end;
end;
end;
2.5.9 对结点的数据域、指针域赋值
对结点的数据域赋值就是在表示结点的方框中显示数据，代码如下：
procedure demo.setdatavalue(vname: string; fn: integer; value: string);
var i:integer;
begin
i:=getadd(vname);
if i>0
then begin
pvar[i].value[fn]:=value;
img.Canvas.TextOut(pvar[i].x+(fn-1)*40+5,pvar[i].y+10 ,value);
end;
end;
对结点的指针域赋值就是在表示结点的方框之间用带箭头的线段表示指针的指向，代码如下：
procedure demo.setpointvalue(vname: string; fn: integer; value: string); var i,x1,x2,y1,y2:integer; begin i:=getadd(vname); if i>0 then begin pvar[i].value[fn]:=value; if value='0' then img.Canvas.TextOut(pvar[i].x+(fn-1)*40+15,pvar[i].y+10 ,'^') else begin //显示箭头 x1:=pvar[i].x+40*(fn-1)+20 ; y1:=pvar[i].y+20; x2:=pvar[strtoint(value)].x; y2:=pvar[strtoint(value)].y; drawarrow(x1,y1,x2,y2); end; end; end;