ufrmmain.pas

演示delphi在运行环境中自动生成控件的例子

unit uFrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, TeeProcs, TeEngine, Chart, DbChart, DBGrids,
  ExtCtrls, DBCtrls, Grids, OleCtrls, MapXLib_TLB, Buttons,
  IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer,
  IdHTTPServer;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  TypInfo, activex;

//控件复制函数
//返回新创健的组件对象
//需要uses TypInfo; 类 
function CopyComponent(mSource: TComponent; mParent: TComponent; mOwner: TComponent): TComponent;
var
  vComponent: TComponent;
  I: Integer;
  vMemoryStream: TMemoryStream;
  vReader: TReader;
  vPropList: PPropList;
  vPropInfo: PPropInfo;
begin
  Result := nil;

  vMemoryStream := TMemoryStream.Create;
  vReader := TReader.Create(vMemoryStream, 256);
  try
    try
      vMemoryStream.WriteComponent(mSource);
      vMemoryStream.Position := 0;
      vReader.Parent := mParent;
      vComponent := vReader.ReadRootComponent(nil);

      for I := 0 to GetPropList(mSource, vPropList) - 1 do begin
        vPropInfo := vPropList^[I];
        if vPropInfo^.PropType^.Kind = tkMethod then
          SetMethodProp(vComponent, vPropInfo^.Name, GetMethodProp(mSource, vPropInfo^.Name));
      end;
      Result := vComponent;
    except
      Result := nil;
    end;
  finally
    vReader.Free;
    vMemoryStream.Free;
  end;

  if mSource is TWinControl then
    for I := 0 to TWinControl(mSource).ControlCount - 1 do
      if CopyComponent(TWinControl(mSource).Controls[I], vComponent, mOwner) = nil then Exit;

end;{CopyComponent}


procedure TForm1.Button1Click(Sender: TObject);
var a: TTabSheet;
begin
  RegisterClasses([TTabSheet, TMemo, tbutton, tpagecontrol, tmap]);
  a := CopyComponent(TabSheet1, PageControl1, Self) as TTabSheet;
  a.Caption := inttostr( gettickcount );
  UnRegisterClasses([TTabSheet, TMemo, tbutton, tpagecontrol, tmap]);
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
    showMessage( 'hello!' );
end;


end.