PDA

Ver la Versión Completa : ¿alguien conoce el uso de la clase TOwnerCollection?


fredo
01-08-2005, 15:50:05
¿alguien conoce el uso de la clase TOwnerCollection?, quisiera saber su uso.
de ante mano gracias. :confused:

dec
01-08-2005, 15:55:44
Hola,

Creo que tiene que ver con el desarrollo de componentes, fundamentalmente, por lo que puede leerse en la ayuda de Delphi para dicha clase:


TOwnedCollection is a collection that maintains information about its owner.

Unit

Classes

Description

By maintaining information about its owner, TOwnedCollection lets the Object Inspector display the collection's name at design time.

Note: This information is not part of TOwnedCollection’s public interface.

New collection classes should descend from TOwnedCollection. By descending from TOwnedCollection, the derived class does not need to add anything in order to appear in the Object Inspector. Classes that descend directly from TCollection must implement a GetOwner method if they are to appear in the Object Inspector.

delphi.com.ar
01-08-2005, 16:00:42
Simplemente es una colección con dueño....

Si no me equivoco apareció en Delphi 5 o 6, mayormente los componentes que tenían alguna colección como propiedad (Por ejemplo DBGrid.Columns), declaraban su propia propiedad Owner, simplemente para desde la propiedad poder acceder al componente y para que este la tenga en su lista de objetos hijos.

Saludos!

fredo
01-08-2005, 16:36:28
tengo una clase de tipo TCollectionItem, la cual al crearse un item crea a la vez un componente derivado de la clase TLabel, en un panel (mi componente que hereda de TCustomPanel), el problema es que al grabar, cerrar y abrir de nuevo el formulario, aparece un error de que el componente ya existe, he visto el archivo DFM y no sale ningun Name Repetido.... Alguno sabe por donde va la cosa....

Gracias por sus prontas respuestas.

delphi.com.ar
01-08-2005, 16:50:04
¿Le estas poniendo nombre a los componentes creados en runtime?..... ¿Podríamos ver algo de código?

fredo
01-08-2005, 16:57:32
aqui esta lo que llevo del fuente

delphi.com.ar
01-08-2005, 17:02:13
aqui esta lo que llevo del fuente
O el proyecto esta muy verde, o se te olvido subirlo! :D

fredo
01-08-2005, 17:04:46
type
{ Forward declarations }
TRegistros = class;
THojaTexto = Class;
TRegistro = Class;
{ Tipos }


THojaTexto = class(TCustomPanel)
private
{ Private declarations }
FColorRegilla,FColorDetalle:TColor;
FMuestraRegilla:Boolean;
FDataDetalle,
FDataCompania,
FDataDocumento:TDataSource;
FFilas,
FColumnas,
FTopeBandaTitulo,
FTopeBandaDetalle,
FTopeBandaFinal,
FIntervaloX,FIntervaloY:Integer;
FRegistros:TRegistros;
procedure SetFilas(Valor:Integer);
procedure SetIntervalo(Valor:Integer);
procedure SetColumnas(Valor:Integer);
procedure SetColor(Color:TColor);
Procedure SetColorDetalle(Color:TColor);
procedure SetMuestraRegilla(Mostrar:Boolean);
procedure SetTopeBandaTitulo(Tope:Integer);
procedure SetTopeBandaDetalle(Tope:Integer);

Function GetRegistros:TRegistros;
protected
{ Protected declarations }
procedure Paint;override;
function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
procedure Limpiar(color: TColor);
procedure DibujarBorde(color: TColor);
procedure DibujarHoja(columnas,filas:integer;Regilla:Boolean;Color:TColor);
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property OnClick;
Property OnDBLClick;
Property OnEnter;
Property OnExit;
Property OnKeyPress;
Property OnKeyUp;
property ColorRegilla: TColor read FColorRegilla write SetColor default $00FEFAF1;
property ColorDetalle: TColor read FColorDetalle write SetColorDetalle;
property Filas: Integer read FFilas write SetFilas default 50;
property Columnas: Integer read FColumnas write SetColumnas default 80;
Property MuestraRegilla:Boolean read FMuestraRegilla write SetMuestraRegilla default true;
property Registros:TRegistros Read GetRegistros write FRegistros;
property DatosCompania:TDataSource read FDataCompania write FDataCompania;
property DatosDocumentos:TDataSource read FDataDocumento write FDataDocumento;
property DatosDetalle:TDataSource Read FDataDetalle Write FDataDetalle default nil;
property TopeBandaTitulo:Integer read FTopeBandaTitulo write SetTopeBandaTitulo default 10;
property TopeBandaDetalle:Integer read FTopeBandaDetalle write SetTopeBandaDetalle default 30;
property Align;
property Anchors;
property IntervaloX:Integer read FIntervaloX write SetIntervalo;
property IntervaloY:Integer read FIntervaloY write SetIntervalo;
end;

TRegistro = Class(TGraphicControl)
private
FNombreRegistro:String;
FValor:String;
FLargoMax,
FX,
FY,
FBanda,
FTipo_Dato:Integer;
FOrigen:Integer;
FHojaTexto:THojaTexto;
FRegistros:TRegistros;
FDataSource:TDataSource;
Protected
procedure Paint; override;
Public
Constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
Published
Property OnClick;
Property OnDBLClick;
Property Valor:String read FValor write FValor;
Property LargoMax:Integer read FLargoMax write FLargoMax;
Property X:Integer read FX write FX;
Property Y:Integer read FY write FY;
Property Banda:Integer read FBanda write FBanda;
Property Tipo_Dato:Integer read FTipo_Dato write FTipo_Dato;
Property Origen:Integer read FOrigen write FOrigen;
Property DataSource:TDataSource read FDataSource write FDataSource;
end;

TItemRegistros = class(TCollectionItem)
private
FName:TComponentName;
FRegistro:TRegistro;
Procedure SetRegistro(Value:TRegistro);
Public
function GetDisplayName: string; override;
constructor Create(Collection:TCollection); override;
destructor Destroy; override;
Procedure Assign(Source:TPersistent);override;
Published
property Name:TComponentName read FName write FName;
property Registro:TRegistro read FRegistro write FRegistro;
end;

TRegistros = Class(TCollection)
private
FOwner:TPersistent;
FHoja:THojaTexto;
function GetItem(Index:Integer):TRegistro;
Procedure SetItem(Index:Integer;Value:TRegistro);
function GetOwner:TPersistent;override;
function GetCount:Integer;
Procedure SetHoja(Value:THojaTexto);

Public
constructor Create(Owner:TPersistent);
destructor Destroy; override;
Function Add:TItemRegistros;
property Items[Index:Integer]:TRegistro read Getitem write SetItem; default;
published
Property HojaTexto:THojaTexto read FHoja write SetHoja;
property NRegistros: Integer read GetCount;
end;


procedure Register;

implementation

procedure Register;
begin
RegisterComponents('PackAdmin', [THojaTexto]);
RegisterComponents('PackAdmin', [TRegistro]);
end;

//********************* G E N E R A L ***********************************

//******* I T E M S R E G I S T R O S ********************************

Procedure TItemRegistros.Assign(Source:TPersistent);
Begin
if source is TRegistro
then
Begin
FRegistro:=TRegistro(Source);
end
else Inherited Assign(Source);
end;

Procedure TItemRegistros.SetRegistro(Value:TRegistro);
Begin
if value <> FRegistro then
Begin
FRegistro:=value;
end;
end;

constructor TItemRegistros.Create(Collection:TCollection);
Begin
inherited;
FName:='Campo'+Inttostr(TRegistros(Collection).NRegistros);
Assign(TRegistro.Create(TRegistros(Collection).FHoja.Owner));
with FRegistro do
Begin
Name:=TRegistros(Collection).FHoja.Name +'Campo'+Inttostr(TRegistros(Collection).NRegistros);
Parent:=TRegistros(Collection).FHoja;
Width:=(FRegistro.FLargoMax*TRegistros(Collection).FHoja.FIntervaloX);
Height:=TRegistros(Collection).FHoja.FIntervaloY+1;
Top:=((FRegistro.FY-1)*TRegistros(Collection).FHoja.FIntervaloY)+1;
Left:=((FRegistro.FX-1)*TRegistros(Collection).FHoja.FIntervaloX);
end;
end;

destructor TItemRegistros.Destroy;
Begin
inherited;
Self.FRegistro.Destroy;
end;

function TItemRegistros.GetDisplayName:string;
begin

if Self.FName <> ''
then Result:=Self.FName
else Result:='Error Libre';
end;




//****************** T R E G I S T R O S **************

Procedure TRegistros.SetHoja(Value:THojaTexto);
var i:Integer;
Begin
if value <> FHoja
then
Begin
FHoja:=value;
end;
end;

constructor TRegistros.create(Owner:TPersistent);
Begin
Fowner:=owner;
FHoja:= THojaTexto(Owner);
inherited Create(TItemRegistros);
end;

destructor TRegistros.Destroy;
Begin
inherited Destroy;
end;

function TRegistros.GetItem(Index:Integer):TRegistro;
begin
result:=TRegistro(inherited GetItem(Index));
end;

Procedure TRegistros.SetItem(Index:Integer;Value:TRegistro);
begin
TItemRegistros(inherited Items[index]).FRegistro:=Value;
end;

Function TRegistros.GetOwner:Tpersistent;
begin
result:=Fowner;
end;

Function TRegistros.Add:TItemRegistros;
begin
result:=TItemRegistros(Inherited Add);
end;

function TRegistros.GetCount: Integer;
begin
Result :=self.Count;
end;


//********************T R E G I S T R O**********************************

Constructor TRegistro.Create(AOwner:TComponent);
Begin
inherited Create(AOwner);
FValor:='';
FLargoMax:=15;
FX:=1;
FY:=1;
FBanda:=1;
FTipo_Dato:=0;
FOrigen:=0;
Width:=0;//FLargoMax*FHojaTexto.FIntervaloX ;
Height:=0;//1*FHojaTexto.FIntervaloY;
end;

destructor TRegistro.Destroy;
Begin
inherited Destroy;
end;

procedure TRegistro.Paint;
var Rec:TRect;
Begin
with Canvas do
begin
Brush.Color := clBlack;
Brush.Style := bsSolid;
FillRect(ClientRect);
Rec:=ClientRect;
FillRect(Rect(0, 0, Width, Height));
Font.Color := ClWhite;
TextOut(0,0,name);
end;
end;



//******* T H O J A T E X T O ******************

constructor THojaTexto.Create(AOwner : TComponent);
Begin
inherited Create(AOwner);
FRegistros:=TRegistros.Create(Self);
FColorRegilla:=$00FEFAF1;
FColorDetalle:=$00F8DA94;
FMuestraRegilla:=true;
FFilas:=50;
FColumnas:=80;
Height := 100;
Width := 100;
FTopeBandaTitulo:=10;
FTopeBandaDetalle:=30;
FTopeBandaFinal:=10;
FDataDetalle:=nil;
FDataCompania:=nil;
FDataDocumento:=nil;
end;



Function THojaTexto.GetRegistros:TRegistros;
Begin
Result:=FRegistros;
end;

procedure THojaTexto.SetIntervalo(Valor:Integer);
Begin
exit;
end;

Procedure THojaTexto.SetFilas(Valor:Integer);
Begin
if valor <> FFilas
then
Begin
FFilas:=valor;
Repaint;
end;
end;

Procedure THojaTexto.SetColumnas(Valor:Integer);
Begin
if valor <> FColumnas
then
Begin
FColumnas:=valor;
Repaint;
end;
end;

Procedure THojaTexto.SetColor(Color:Tcolor);
Begin
if FColorRegilla <> Color then
Begin
FColorRegilla:=Color;
Repaint;
end;
end;

Procedure THojaTexto.SetColorDetalle(Color:Tcolor);
Begin
if FColorDetalle <> Color then
Begin
FColorDetalle:=Color;
Repaint;
end;
end;

procedure THojaTexto.SetMuestraRegilla(Mostrar:Boolean);
Begin
if Mostrar <> FMuestraRegilla
then
Begin
FMuestraRegilla:=Mostrar;
Repaint;
end;
end;

function THojaTexto.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
result := inherited CanResize(NewWidth, NewHeight);
if result then
begin
if NewWidth < FFilas then
NewWidth := FFilas;

if NewHeight < FColumnas then
NewHeight := FColumnas;
end;
end;


procedure THojaTexto.SetTopeBandaTitulo(Tope:Integer);
Begin
if tope <> FTopeBandaTitulo
then
Begin
FTopeBandaTitulo:=Tope;
RePaint;
end;
end;

procedure THojaTexto.SetTopeBandaDetalle(Tope:Integer);
Begin
if tope <> FTopeBandaDetalle
then
Begin
FTopeBandaDetalle:=Tope;
RePaint;
end;
end;

procedure THojaTexto.Paint;
Begin
DibujarHoja(FColumnas,FFilas,FMuestraRegilla,FColorRegilla);
DibujarBorde(FColorRegilla);
end;


procedure THojaTexto.Limpiar(color: TColor);
begin
Canvas.Brush.Color := color;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(0, 0, Width, Height));
end;


procedure THojaTexto.DibujarBorde(color: TColor);
begin
Canvas.Pen.Color := color;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(0, 0, Width, Height);
end;

procedure THojaTexto.DibujarHoja(columnas,filas:integer;Regilla:Boolean;Color:TColor);
var ancho, alto, i, j, x, y: integer;
margenX, margenY, margenAcumX, margenAcumY: integer;
sobraX, sobraY: integer;

Begin
Limpiar(clWhite);
Canvas.Pen.Color := color;
Canvas.Pen.Style := psInsideFrame ;
Canvas.Pen.Width:=1;

ancho := Width div columnas;
alto := Height div filas;

FIntervaloX:=ancho;
FIntervaloY:=alto;

sobraX := Width mod columnas;
margenX := 1;
margenAcumX := 0;

if Regilla then
Begin
for i:=1 to columnas do
begin
if sobraX = 0
then margenX := 0;

x := (i-1) * ancho + margenX + margenAcumX;
sobraY := Height mod filas;
margenY := 1;
margenAcumY := 0;

for j:=1 to filas do
begin
if sobraY = 0
then margenY := 0;

y := (j-1) * alto + margenY + margenAcumY;
if (FTopeBandaTitulo < j) and ((FTopeBandaDetalle+FTopeBandaTitulo) > j)
Then
Begin
// ***************** Dibuja Zona Detalle ******************
Canvas.Brush.Color:=FColorDetalle; // amarillo
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect(x, y, ancho + margenX + x, alto + margenY + y));
Canvas.Brush.Style:=BsClear;
If (FTopeBandaTitulo+1) = j
then
begin
Canvas.Pen.Color := clBlack;
Canvas.Rectangle(x, y, ancho + margenX + x, alto + margenY + y);
end;
end
else
Begin
Canvas.Pen.Color := color;
Canvas.Rectangle(x, y, ancho + margenX + x, alto + margenY + y);
end;

if sobraY > 0
then Dec(sobraY);
Inc(margenAcumY, margenY);
end;

Inc(margenAcumX, margenX);
if sobraX > 0
then Dec(sobraX);
end;
end;
end;

destructor THojaTexto.Destroy;
begin
FRegistros.Free;
inherited;
end;

end.

fredo
01-08-2005, 17:14:47
este es el codigo sorri por la equivocaciones...

delphi.com.ar
01-08-2005, 17:40:09
Yo cambiaría un par de detalles sutiles:

type
TItemRegistros = class(TCollectionItem)
private
FRegName: string;
public
function GetDisplayName: string; override;
published
property RegName: string Read FRegName Write FRegName;
end;

implementation

function TItemRegistros.GetDisplayName: string;
begin
if RegName = '' then
Result := Format('%s [%d]', [ClassName, Index])
else
Result := RegName;
end;


¿El nombre tiene alguna funcionalidad mas que ser mostrado en tiempo de diseño?...

delphi.com.ar
01-08-2005, 17:59:48
De casualidad vi otro detalle, que no tendría nada que ver con el problema anterior, en la parte:

procedure TItemRegistros.Assign(Source: TPersistent);
begin
if Source is TRegistro then
FRegistro := TRegistro(Source)
else
inherited Assign(Source);
end;

Esta no es la idea de los métodos assign, la idea es que copie los valores no las referencias:

procedure TItemRegistros.Assign(Source: TPersistent);
begin
if Source is TRegistro then
with TRegistro(Source) do
begin
FRegistro.RegName := RegName;
FRegistro.Registro.Assign(Registro); {Tendrías que implementar este método en TRegistro}
end
else
inherited Assign(Source);
end;


Saludos!

fredo
01-08-2005, 18:05:56
si queda mejor como dices tu, pero sigue apareciendo el erro, al parecer hay un problema en el orden de creacion de los componentes, al cerra y abrir, trata de cargar primero la propiedad registros, ahi aun no existe el Registro por lo cual marca fallo, tengo que ver como cambiar el orden de creacion, primero los registros, luego el item.... gracias por darte la lata de leer el codigo.

tratare de corregir eso