(*//
标题:复制元件
说明:支持复制子元件和事件;此函数难度比较大;强烈推荐
设计:Zswang
日期:2002-01-25
支持:wjhu111@21cn.com
//*)
////////Begin Source
uses
TypInfo;
function CopyComponent(mSource: TComponent; mParent: TComponent;
mOwner: TComponent): Boolean; { 返回复制元件是否成功 }
var
vComponent: TComponent;
I: Integer;
vMemoryStream: TMemoryStream;
vReader: TReader;
vPropList: PPropList;
vPropInfo: PPropInfo;
begin
Result := False;
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;
except
Result := True;
Exit;
end;
finally
vReader.Free;
vMemoryStream.Free;
end;
if mSource is TWinControl then
for I := 0 to TWinControl(mSource).ControlCount - 1 do
if not CopyComponent(TWinControl(mSource).Controls[I],
vComponent, mOwner) then Exit;
Result := True;
end; { CopyComponent }
////////End Source
///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterClasses([TTabSheet, TMemo, TEdit, TLabel, TButton]);
CopyComponent(TabSheet1, PageControl1, Self);
UnRegisterClasses([TTabSheet, TMemo, TEdit, TLabel, TButton]);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage('Hello Worlds!');
end;
///////End Demo