Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Crear objetos mediante su clase (https://www.clubdelphi.com/foros/showthread.php?t=80891)

coso 06-12-2008 00:37:15

Crear objetos mediante su clase
 
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;


La franja horaria es GMT +2. Ahora son las 17:58:00.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi