分析DFM文件生成程序界面[2]

    procedure getcontrol(p:twincontrol);  //根据分析dfm文件来生成组件类，其中有递归
    procedure correctts(ts:tstrings);     //将组件的一些属性去掉，这些属性无法由流化技术来生成
    function  strtocom(ts:tstrings):tcomponent; //根据组件类文本生成组件
    function  checkevent:boolean;   //检查是否事件属性
    function iscontrol(com:tcomponent):boolean;   //检查是否从tcotrol继承下来的
    procedure testshow(ts:tstrings);//在memo1中显示所有的类文本
    procedure delprop(ts:tstrings; bchar,echar:char); //消掉一些特定的属性，为correctts调用
  published
  end;

var
  form1: tform1;

implementation
  uses typinfo;

{$r *.dfm}
//字符串转化为组件
function tform1.strtocom(ts: tstrings): tcomponent;
var
  strstream: tstringstream;
  memstream: tmemorystream;
begin
  strstream := tstringstream.create(ts.text);
  try
    memstream := tmemorystream.create();
    try
      classes.objecttexttobinary(strstream, memstream);
      memstream.seek(0, sofrombeginning);
      result := memstream.readcomponent(nil);
    finally
      freeandnil(memstream);
    end;
  finally
    freeandnil(strstream);
  end;
end;
//打开dfm文件，并显示在memo1中，dfm文件有可能是二进制格式，
//也有可能是文本格式，所以这里要进行判断，并最终以文本格式打开
procedure tform1.button1click(sender: tobject);
var m:tmemorystream; s:tstringstream;
    f:array[1..6] of char; temps:string;
begin
  if opendialog1.execute then
  begin
    s := tstringstream.create('');
    m := tmemorystream.create();
    try
      m.loadfromfile(opendialog1.filename);
      m.position:=0;
      m.read(f,6);
      temps:=f;
      if temps='object' then//如果是文本格式
      begin
        m.position:=0;
        s.position:=0;
        s.copyfrom(m,0);
      end
      else begin//如果是二进制格式
        m.position:=16;
        classes.objectbinarytotext(m,s);
      end;
       s.position:=0;
       ss.text:=s.datastring;
       memo1.lines:=ss;
    finally
      s.free;
      m.free;
    end;
  end;
end;

//分析dfm文件，并生成组件类
procedure tform1.button2click(sender: tobject);
begin
  if l.count>0 then  tcomponent(l.items[0]).free;
    l.clear;
  curp:=0;
  getcontrol(nil);//这里用到了递归
end;

procedure tform1.formcreate(sender: tobject);
begin
   ss:=tstringlist.create;
   ts:=tstringlist.create;
   l:=tlist.create;
end;

procedure tform1.formdestroy(sender: tobject);
begin
   freeandnil(ss);
   if l.count>0 then  tcomponent(l.items[0]).free;
   freeandnil(l);
   freeandnil(ts);
end;
//生成组件
procedure tform1.getcontrol(p: twincontrol);
var con:tcomponent;
begin
  while curp<ss.count-1 do
  begin
    if (pos('end',ss[curp])>0) then
     begin inc(curp); break; end;
    ts.clear;
    ts.add(ss[curp]);
    inc(curp);
    while (curp<ss.count-1) do
    begin
      if (pos('end',ss[curp])>0) or(pos('object',ss[curp])>0) then break;
      if not checkevent then
        ts.add(ss[curp]);
      inc(curp);
    end;
    ts.add('end');
    correctts(ts);
    con:=strtocom(ts);
    testshow(ts);
    if iscontrol(con) then
      tcontrol(con).parent:=p;
    l.add(con);
    if con.classname='tform' then tform(con).show;
    if (pos('object',ss[curp])>0) then
      getcontrol(twincontrol(con));  //递归
    if (curp<ss.count-1) then