Este componente muestra como trabajar con una lista de objetos neutros mediante arreglos o arrays, asi como crear un objeto mediante la clase, o bien el nombre de clase desde una cadena
Código Delphi
[-]
unit caja;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,extctrls,typinfo;
type TCaja = class(TScrollBox)
public
objetos : array of TObject;
procedure Add(AClass : TPersistentClass);
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
end;
procedure Register;
implementation
constructor TCaja.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
setlength(objetos,0);
end;
destructor TCaja.Destroy;
var
i : integer;
begin
for i := High(objetos) downto 0 do
objetos[i].Free;
setlength(objetos,0);
inherited Destroy;
end;
procedure TCaja.Add(AClass : TPersistentClass);
var
ComponentMetaClass : TComponentClass;
l : integer;
j : integer;
w : TControl;
begin
registerclass(AClass);
ComponentMetaClass := TComponentClass(AClass);
l := length(objetos);
setlength(objetos,l+1);
objetos[l] := ComponentMetaClass.Create(self);
if objetos[l] is TControl then
begin
w := objetos[l] as TControl;
w.Name := w.ClassName + inttostr(l);
for j := l - 1 downto 0 do
if objetos[j] is TControl then
begin
w.Top := (objetos[l-1] as TControl).Top + (objetos[l-1] as TControl).Height+5;
break;
end;
w.Parent := self;
w.Left := 10;
end;
end;
procedure Register;
begin
RegisterComponents('test', [TCaja]);
end;
end.
y un ejemplo de uso
Código Delphi
[-]
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
for i := 0 to 10000 do
begin
Caja1.Add(TDBGrid);
Caja1.Add(TShape);
Caja1.Add(TButton);
Application.ProcessMessages;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
registerclasses([TLabel,TDBGrid,TShape,TQuickRep]);
try
Caja1.Add(GetClass(InputBox('clase','clase (tiene que estar previamente registrada en la aplicación)','TLabel')));
except
MessageDLG('probablemente esta clase no esta registrada',mtError,[mbOk],0);
end;
end;