unit1.pas

动态创建控件举例

{******************************************************************************}
{ @UnitName    : Unit1                                                         }
{ @Project     : Project1                                                      }
{ @Copyright   : Microsoft                                                     }
{ @Author      : T2607Z                                                        }
{ @CreateDate  : 2004-7-12 11:50:48                                            }
{ @LastUpdate  : 2004-7-12 11:50:48 by T2607Z                                  }
{ @Description :                                                               }
{ @Comment     :                                                               }
{ @History     :                                                               }
{******************************************************************************}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;

type
  CRefType = class of Tcontrol;
  TForm1 = class(TForm)
    Panel1: TPanel;
    RadioRBtn: TRadioButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    ButtonRBtn: TRadioButton;
    LabelRBtn: TRadioButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure RadioRBtnClick(Sender: TObject);
    procedure ButtonRBtnClick(Sender: TObject);
    procedure LabelRBtnClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
  private
    { Private declarations }
    ClassRef : CRefType;
    Counter : Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  RadioRbtn.Checked :=true;
  ClassRef := TRadioButton;
  Counter:=0;
end;

procedure TForm1.RadioRBtnClick(Sender: TObject);
begin
  ClassRef := TRadioButton;
end;

procedure TForm1.ButtonRBtnClick(Sender: TObject);
begin
   ClassRef:=TButton;
end;

procedure TForm1.LabelRBtnClick(Sender: TObject);
begin
  ClassRef:=TLabel;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  MyObj:Tcontrol;
  Myname:String;
begin
  MyObj:=ClassRef.Create(Self);
  MyObj.Parent :=Self;
  MyObj.Left :=x;
  Myobj.Top :=y;
  Inc(Counter);
  MyName := ClassRef.ClassName + IntToStr(Counter);
  Delete(MyName,1,1);
  MyObj.Name :=MyName;
  MyObj.Visible :=true;
end;

procedure TForm1.New1Click(Sender: TObject);
var
  i:integer;
begin
  for i:= ControlCount -1 downto 0 do
    if Controls[i].ClassName <> 'TPanel' then
      ConTrols[i].Free ;
  Counter:=0;
end;

procedure TForm1.Open1Click(Sender: TObject);
var
  S:TFileStream;
  New:TComponent;
begin
  if OpenDialog1.Execute then
  begin
    New1Click(self);{清除所有控件}
    s:= TFileStream.Create(OpenDialog1.FileName,fmopenRead );
    try
      While s.position < S.Size do
      Begin
        New:=S.ReadComponent(nil);
        InsertControl(new as TControl);
        Inc(Counter);
      End;
    finally
      s.Free ;
    end;
  end;
end;

procedure TForm1.SaveAs1Click(Sender: TObject);
var
  S:TFileStream;
  i:integer;
begin
  if SaveDialog1.Execute then
  begin
    S:=TfileStream.Create(SaveDialog1.FileName ,fmOpenWrite or fmCreate);
    try
      for i:=0 to ControlCount -1 do
      Begin
        if Controls[i].ClassName <>'TPanel' then
        s.WriteComponent(Controls[i]);
      End;
    finally
      s.Free ;
    end;
  end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  Application.MessageBox('动态创建控件举例！','帮助',mb_ok +MB_ICONINFORMATION )
end;
initialization
  registerclasses([TRadioButton,TButton,TLabel]);
end.