ucreateform.pas

一个模拟Delphi的快速开发环境RAD

unit uCreateForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,Buttons,DsgnIntf,ToolIntf,TypInfo, ExtCtrls, Mask, Grids,
  FileCtrl, ComCtrls, Menus;

type
  TFCreateForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    ParseLine:Integer;
    SourceList: TStringList;
    ParentComponent: TWinControl;
    ExistsParent: Boolean;
    procedure CreateComponent(ComponentClass:TComponentClass);
    function  UniqueName(comp:TComponent):string;
    function  TryName(const Test:string;Comp:TComponent):Boolean;
    procedure ReadProperty(Component:TComponent;PropInfo:PPropInfo;ValueStr:string);
    procedure ParserForm(SourceList:TStringList);
    procedure ReadClass;
  public
    { Public declarations }
    procedure OpenForm(const FileName:string);
  end;

var
  FCreateForm: TFCreateForm;

implementation

uses Udebug, Proxy;


{$R *.DFM}

procedure TFCreateForm.OpenForm(const FileName:string);
var
   Input,TempStream,Output:TMemoryStream;
   Form:TForm;
begin
    Form:=TForm.Create(self);
    Input:=TMemoryStream.Create;
    Input.LoadFromFile(FileName);
    TempStream:=TMemoryStream.Create;
    TempStream.LoadFromFile(FileName);
    Output:=TMemoryStream.Create;
    ObjectResourceToText(Input,Output);
    Output.SaveToFile('c:\imsi\Test.dfm');
    SourceList.LoadFromFile('c:\imsi\Test.dfm');
   // ParserForm(SourceList);
    ReadClass;
    TempStream.ReadComponentRes(form);
    Input.Free;
    OutPut.Free;
    TempStream.Free;
    Form.Show;
end;

procedure TFCreateForm.ParserForm(SourceList:TStringList);
begin
    while True do
    begin
        Inc(ParseLine);
        if ParseLine>=SourceList.Count then Break ;
        if Pos('TButton',SourceList[ParseLine])>0 then CreateComponent(TButton)
        else if Pos('TLabel',SourceList[ParseLine])>0 then CreateComponent(TLabel)
        else if Pos('TBitBtn',SourceList[ParseLine])>0 then CreateComponent(TBitBtn)
        else if Pos('TPanel',SourceList[ParseLine])>0 then CreateComponent(TPanel)
        else if Pos('TMemo',SourceList[ParseLine])>0 then CreateComponent(TMemo)
        else if Pos('TCheckBox',SourceList[ParseLine])>0 then CreateComponent(TCheckBox)
        else if Pos('TRadioButton',SourceList[ParseLine])>0 then CreateComponent(TRadioButton)
        else if Pos('TSpeedButton',SourceList[ParseLine])>0 then CreateComponent(TSpeedButton)
        else if Pos('TMaskEdit',SourceList[ParseLine])>0 then CreateComponent(TMaskEdit)
        else if Pos('TStringGrid',SourceList[ParseLine])>0 then CreateComponent(TStringGrid)
        else if Pos('TFileListBox',SourceList[ParseLine])>0 then CreateComponent(TFileListBox)
        else if Pos('TDirectoryListBox',SourceList[ParseLine])>0 then CreateComponent(TDirectoryListBox)
        else if Pos('TDriveComboBox',SourceList[ParseLine])>0 then CreateComponent(TDriveComboBox)
        else if Pos('TTreeView',SourceList[ParseLine])>0 then CreateComponent(TTreeView)
        else if Pos('TListView',SourceList[ParseLine])>0 then CreateComponent(TListView)
        else if Pos('TPageControl',SourceList[ParseLine])>0 then CreateComponent(TPageControl)
        else if Pos('TGroupBox',SourceList[ParseLine])>0 then CreateComponent(TGroupBox)
        else if Pos('TListBox',SourceList[ParseLine])>0 then CreateComponent(TListBox)
        else if Pos('TComboBox',SourceList[ParseLine])>0 then CreateComponent(TComboBox)
        else if Pos('TMainMenu',SourceList[ParseLine])>0 then CreateComponent(TMainMenu)
        else if Pos('TPopupMenu',SourceList[ParseLine])>0 then CreateComponent(TPopupMenu)
        else if Pos('TEdit',SourceList[ParseLine])>0 then CreateComponent(TEdit)
    end;
end;

procedure TFCreateForm.ReadClass;
begin
    while True do
    begin
        Inc(ParseLine);
        if ParseLine>=SourceList.Count then Break ;
        if Pos('TButton',SourceList[ParseLine])>0 then RegisterClass(TButton)
        else if Pos('TLabel',SourceList[ParseLine])>0 then RegisterClass(TLabel)
        else if Pos('TBitBtn',SourceList[ParseLine])>0 then RegisterClass(TBitBtn)
        else if Pos('TPanel',SourceList[ParseLine])>0 then RegisterClass(TPanel)
        else if Pos('TMemo',SourceList[ParseLine])>0 then RegisterClass(TMemo)
        else if Pos('TCheckBox',SourceList[ParseLine])>0 then RegisterClass(TCheckBox)
        else if Pos('TRadioButton',SourceList[ParseLine])>0 then RegisterClass(TRadioButton)
        else if Pos('TSpeedButton',SourceList[ParseLine])>0 then RegisterClass(TSpeedButton)
        else if Pos('TMaskEdit',SourceList[ParseLine])>0 then RegisterClass(TMaskEdit)
        else if Pos('TStringGrid',SourceList[ParseLine])>0 then RegisterClass(TStringGrid)
        else if Pos('TFileListBox',SourceList[ParseLine])>0 then RegisterClass(TFileListBox)
        else if Pos('TDirectoryListBox',SourceList[ParseLine])>0 then RegisterClass(TDirectoryListBox)
        else if Pos('TDriveComboBox',SourceList[ParseLine])>0 then RegisterClass(TDriveComboBox)
        else if Pos('TTreeView',SourceList[ParseLine])>0 then CreateComponent(TTreeView)
        else if Pos('TListView',SourceList[ParseLine])>0 then RegisterClass(TListView)
        else if Pos('TPageControl',SourceList[ParseLine])>0 then RegisterClass(TPageControl)
        else if Pos('TGroupBox',SourceList[ParseLine])>0 then RegisterClass(TGroupBox)
        else if Pos('TListBox',SourceList[ParseLine])>0 then RegisterClass(TListBox)
        else if Pos('TComboBox',SourceList[ParseLine])>0 then RegisterClass(TComboBox)
        else if Pos('TMainMenu',SourceList[ParseLine])>0 then RegisterClass(TMainMenu)
        else if Pos('TPopupMenu',SourceList[ParseLine])>0 then RegisterClass(TPopupMenu)
        else if Pos('TEdit',SourceList[ParseLine])>0 then RegisterClass(TEdit)
    end;
end;

procedure TFCreateForm.CreateComponent(ComponentClass:TComponentClass);
var
   Component:TComponent;
   Control:TControl;
   PropList:PPropList;
   Count:Integer;
   I,Position1:Integer;
   ValueStr:string;
   Info:PTypeInfo;
begin
  Component := ComponentClass.Create(Self);
  if Component is TControl then
  begin
    Control := TControl(Component);
    Control.Name:=UniqueName(Component);
  end
  else begin
    { Create a wrapper control for nonvisual components. }
    Control := TWrapperControl.Create(Self, Component);
    Control.Name:=UniqueName(Component);
  end;
  if ExistsParent then begin
       Control.Parent := ParentComponent;
       ExistsParent:=False;
  end
  else
       Control.Parent:=Self;
    Count:=GetPropList(Component.ClassInfo,tkProperties,nil);
    GetMem(PropList,Count*SizeOf(PPropList));
    GetPropList(Component.ClassInfo,tkProperties,PropList);
    DebugForm.Memo2.Lines.Add(Component.ClassName);
    while True do begin
        Inc(ParseLine);
        if (ParseLine>=SourceList.Count) then  Break;
        if (Pos('end',SourceList[ParseLine])>0) then  Break ;
        if (Pos('object',SourceList[ParseLine])>0) then begin
            Dec(ParseLine);
            ExistsParent:=True;
            ParentComponent:=TWinControl(Control);
            Break;
        end
        else begin
          for I:=0 to Count-1 do
            if Pos(PropList^[I].Name,SourceList[ParseLine])>0 then begin
               Position1:=Pos('=',SourceList[ParseLine]);
               ValueStr:=Copy(SourceList[ParseLine],Position1+1,Length(SourceList[ParseLine]));
               ReadProperty(Component,PropList^[I],Trim(ValueStr));
            end;
        end;
    end;
    FreeMem(PropList,Count*SizeOf(PPropList));

end;

{哪欺惩飘 捞抚捞 蜡老茄瘤 抛胶飘 秦焊绊, 父老 蜡老窍促搁 True甫 府畔窍绊, 酒聪搁
 False甫 府畔茄促.}
function TFCreateForm.TryName(const Test:string;Comp:TComponent):Boolean;
var
   I:Integer;
begin
    Result:=False;
    for I:=0 to Comp.ComponentCount-1 do
        if CompareText(Comp.Components[I].Name,Test) =0 then Exit;
    Result:=True;
end;

{钎霖 胆颇捞狼 盔蘑阑 荤侩窍咯 哪欺惩飘俊 措茄 蜡老茄 捞抚阑 积己茄促. 溜 <鸥涝><箭磊>
 屈侥阑 荤侩窍绰单, <鸥涝>篮 哪欺惩飘狼 努贰胶 捞抚俊辑 'T'甫 猾 巴捞绊, <箭磊>绰
 捞抚阑 窜老窍霸 父甸扁 困茄 沥荐捞促.}
function TFCreateForm.UniqueName(comp:TComponent):string;
var
   I:Integer;
   Fmt:string;
begin
    if Comp.ClassName[1] in ['t','T'] then
        Fmt:=Copy(Comp.ClassName,2,255)+'%d'
    else Fmt:=Comp.ClassName+'%d';
    if Comp.Owner=nil then begin
       {家蜡磊啊 绝栏骨肺 葛电 捞抚捞 悼老窍促. 1阑 荤侩茄促.}
       Result:=Format(Fmt,[1]);
       Exit;
    end
    else begin
       {蜡老茄 捞抚捞 唱棵 锭鳖瘤 , 啊瓷茄 箭磊甫 葛滴 矫氰茄促.}
       for I:=1 to High(Integer) do begin
           Result:=Format(Fmt,[I]);
           if TryName(Result,Comp.Owner) then Exit;
       end;
    end;
    {捞巴篮 柳楼肺 惯积窍瘤绰 臼绰促. 荤侩磊啊 捞抚阑 父甸扁 傈俊 促弗 巴阑
     角青沁阑 版快牢单, 窜瘤 版快俊 瘤唱瘤 臼绰促.}
    raise Exception.CreateFmt('Cannot create unique name for %s.',[Comp.ClassName]);
end;

procedure TFCreateForm.FormCreate(Sender: TObject);
begin
   SourceList:=TStringList.Create;
   ExistsParent:=False;
   ParseLine:=1;
end;

procedure TFCreateForm.ReadProperty(Component:TComponent;PropInfo:PPropInfo;
           ValueStr:string);
var
   Info:PTypeInfo;
begin
    Info:=PropInfo.PropType^;
    if Info^.Kind = tkInteger then
          SetOrdProp(Component,PropInfo,StrToInt(ValueStr))
    else if (Info^.Kind = tkEnumeration) then
           SetOrdProp(Component,PropInfo,GetEnumValue(Info,ValueStr))
    else if (Info^.Kind = tkChar) then
           SetOrdProp(Component,PropInfo,Ord(ValueStr[1]))
    else if (Info^.Kind = tkString) or (Info^.Kind=tkLString) then
           SetStrProp(Component,PropInfo,Copy(ValueStr,2,Length(ValueStr)-2));
end;

procedure TFCreateForm.FormShow(Sender: TObject);
begin
    DebugForm.Show;
end;

end.