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;