Error de herencia en diseño con subcomponente

[rastafarey]

Mi problema es el siguiente tengo un componente(el codigo al final) que tiro en una forma(form1) y todo funciona perfecto luego creo una nueva forma que herede de la anterior(tform2 = class(Tform1)) y cuando trato de acceder a la propiedad boton(es un sub componente) me arroja un error de diseño("Access violation at address 007C7B16 in module 'vcl70.bpl'. Read of address 00000004.") no se cuan es el problema y por que no me da el error en la forma1 y en form2 si .

Gracias de antenmano

A continuacion el codigo fuente.

unit Boton_lookup;

interface

uses
SysUtils, Classes, Controls, StdCtrls, Buttons, Messages, Types;

type
TBoton = class(TSpeedButton)
Public
Constructor Create(Padre: TComponent); Override;
End;

TBotonPosition = (bpArriba, bpAbajo, bpIzquierda, bpDerecha);

TBoton_lookup = class(TComboBox)
private
FBotonEspacio: Integer;
FBoton: TBoton;
FBotonPosition: TBotonPosition;
procedure SetBotonEspacio(const Value: Integer);
procedure SetBotonPosition(const Value: TBotonPosition);
protected
procedure SetParent(Padre: TWinControl); override;
procedure Notification(Componente: TComponent; Operacion: TOperation); override;
procedure SetName(const Value: TComponentName); override;
procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure CMEnabledchanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMBidimodechanged(var Message: TMessage); message CM_BIDIMODECHANGED;
public
{ Public declarations }
constructor Create(Padre: TComponent); override;
procedure SetBounds(ALeft,ATop,AWidth,AHeight: Integer); override;
procedure InstalarBotonInterno;
Published
property Boton: TBoton read FBoton;
property BotonPosition: TBotonPosition read FBotonPosition write SetBotonPosition;
property BotonEspacio: Integer read FBotonEspacio write SetBotonEspacio;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MisComponentes', [TBoton_lookup]);
end;

{ TBoton_lookup }

procedure TBoton_lookup.CMBidimodechanged(var Message: TMessage);
begin
inherited;
FBoton.BiDiMode := BiDiMode;
end;

procedure TBoton_lookup.CMEnabledchanged(var Message: TMessage);
begin
inherited;
FBoton.Enabled := Enabled;
end;

procedure TBoton_lookup.CMVisiblechanged(var Message: TMessage);
begin
inherited;
FBoton.Visible := Visible;
end;

constructor TBoton_lookup.Create(Padre: TComponent);
begin
inherited Create(Padre);
FBotonPosition := bpDerecha;
FBotonEspacio := 3;
InstalarBotonInterno;
end;

procedure TBoton_lookup.InstalarBotonInterno;
begin
If Assigned(FBoton) Then exit;
FBoton := TBoton.Create(Self);
FBoton.FreeNotification(Self);
//FBoton.FocusControl := Self;
end;

procedure TBoton_lookup.Notification(Componente: TComponent;
Operacion: TOperation);
begin
inherited Notification(Componente, Operacion);
If (Componente = FBoton) and (Operacion = opRemove) Then
FBoton := Nil;
end;

procedure TBoton_lookup.SetBotonEspacio(const Value: Integer);
begin
FBotonEspacio := Value;
SetBotonPosition(FBotonPosition);
end;

procedure TBoton_lookup.SetBotonPosition(const Value: TBotonPosition);
var
P: TPoint;
begin
If FBoton = Nil Then Exit;
FBotonPosition := Value;
Case Value Of
bpArriba: P := Point(Left, Top - FBoton.Height - FBotonEspacio);
bpAbajo: P := Point(Left, Top + Height + FBotonEspacio);
bpIzquierda : P := Point(Left - FBoton.Width - FBotonEspacio, Top + ((Height - FBoton.Height) div 2));
bpDerecha: P := Point(Left + Width + FBotonEspacio, Top + ((Height - FBoton.Height) div 2));
end;
FBoton.SetBounds(P.x, P.y, FBoton.Width, FBoton.Height);
end;

procedure TBoton_lookup.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SetBotonPosition(FBotonPosition);
end;

procedure TBoton_lookup.SetName(const Value: TComponentName);
begin
If (csDesigning In ComponentState) And ((FBoton.GetTextLen = 0) Or (CompareText(FBoton.Caption, Name) = 0)) Then
FBoton.Caption := Value;
inherited SetName(Value);
If csDesigning In ComponentState Then
Text := '';
end;

procedure TBoton_lookup.SetParent(Padre: TWinControl);
begin
inherited SetParent(Padre);
If FBoton = Nil Then exit;
FBoton.Parent := Padre;
FBoton.Visible := True;
end;

{ TBoton }

constructor TBoton.Create(Padre: TComponent);
begin
inherited Create(Padre);
Name := 'Subboton';
SetSubComponent(True);
end;

end.

[jachguate]

Hola rastafarey...

En realidad esperas que alguien lea todo este código?... y sin indentar?

Te sugiero que aprendas a utilizar la etiqueta code (link en mi firma).

Además, no explicas si para heredar del form, en tiempo de diseño, estas utilizando herencia visual, o simplemente estas sustituyendo el TForm por TForm1 en la declaración de la clase?

Hasta luego.

;)

[rastafarey]

No espero que lean todo el codigo symplemente que intalen el conponente y vean lo que pasa.

Ha al respecto la herencia es en tiempo de diseño osea herencia viasual.

Si me sugieres que uses las etiqueta CODE no se de que manera las uso por que no se donde esta lo que hay que resaltar o subrrayar o algo asi por que no se cual es el problema.

Si me das una idea de como enviar el mensaje te lo agradesco.

Gracias de antemano.

[roman]

Si me sugieres que uses las etiqueta CODE no se de que manera las uso

¿Y el enlace "Aprendé a usar la etiqueta CODE" en la firma del compañero jachguate no te dice algo?

// Saludos

[Al González]

¡Buen día a todos!

Rastafarey: Había leído antes tu mensaje, pero como no estaba muy claro, dejé su análisis para un día más desahogado.

Es probable que sólo te falte llamar al método SetSubComponent del componente botón enseguida de su creación. Es decir:

...
FBoton := TBoton.Create (Self);
FBoton.SetSubComponent (True);
...


Espero esto sea de utilidad. Seguimos en contacto.

Al González :).

[Al González]

Hola, han transcurrido nueve largos años, pero creo que vale la pena agregar un mensaje más a este hilo. Recientemente experimenté el mismo problema de subcomponentes en herencia visual; me decidí a intentar el encuentro de una solución y creo que he tenido suerte. :)

Primero decir que en el mismo 2004 se reportó esta anomalía en QualityCentral, es el reporte 7991 (http://qc.embarcadero.com/wc/qcmain.aspx?d=7991). Se trata de un defecto de fábrica que fue corregido en Delphi 2007. Lo que ahí comentó el autor del reporte no es del todo exacto, pero me sirvió para indagar más.

El siguiente código es una versión simplificada del componente con subcomponente que planteó rastafarey, pero ya sin ocurrir excepciones al expandir el subcomponente en el inspector de objetos. La solución es básicamente volver "no guardables" las propiedades que disparan el error, y guardarlas por nuestra cuenta.
Unit BotonLookup;

Interface

Uses
Buttons, Classes, StdCtrls, Controls;

Type
TBotonPosition = (bpArriba, bpAbajo, bpIzquierda, bpDerecha);

TBoton = Class (TSpeedButton)
Protected
{ Overridden methods }
Procedure DefineProperties (Filer :TFiler); Override;
Public
Constructor Create (Owner :TComponent); Override;
Published
{ Navegando en las propiedades mostradas por el inspector de
objetos, podemos notar que Glyph y NumGlyphs causan excepción
"access violation". Pero tal error ya no ocurre si les agregamos
la directiva "Stored False". El inconveniente de esto es que el
IDE ya no guarda por sí mismo el valor de esas propiedades en el
DFM, así que resulta necesario redefinir el método
DefineProperties para encargarnos de ello (ver más abajo). }
Property Glyph Stored False;
Property NumGlyphs Stored False;
End;

TBotonLookup = Class (TComboBox)
Protected
FBoton :TBoton;
FBotonEspacio :Integer;
FBotonPosition :TBotonPosition;

{ Static methods }
Procedure InstalarBotonInterno;
Procedure SetBotonPosition (Const Value :TBotonPosition);

{ Overridden methods }
Procedure SetParent (AParent :TWinControl); Override;
Public
Constructor Create (Owner :TComponent); Override;

{ Overridden methods }
Procedure SetBounds (ALeft, ATop, AWidth, AHeight :Integer);
Override;
Published
Property Boton :TBoton Read FBoton;
End;

{ Functions and procedures }

Procedure Register;

Implementation

Uses
TypInfo, Types;

{ TBoton }

Constructor TBoton.Create (Owner :TComponent);
Begin
Inherited Create (Owner);
Name := 'Subboton';
SetSubComponent (True);
End;

{ Protected overridden methods }

Type
TWriterAccess = Class (TWriter);
Procedure TBoton.DefineProperties (Filer :TFiler);
Begin
Inherited DefineProperties (Filer);

{ Si el IDE acaba de escribir en el DFM las propiedades "formalmente"
guardables, añadimos de forma manual las propiedades Glyph y
NumGlyphs. NOTA: TWriter.WriteProperty verifica si hay diferencia
respecto al "ancestor", así se evita guardar lo mismo que ya está en
la plantilla padre). }
If Filer Is TWriter Then
Begin
TWriterAccess (Filer).WriteProperty (
Self, GetPropInfo (Self, 'Glyph'));
TWriterAccess (Filer).WriteProperty (
Self, GetPropInfo (Self, 'NumGlyphs'));
End;
End;

{ TBotonLookup }

Constructor TBotonLookup.Create (Owner :TComponent);
Begin
Inherited Create (Owner);
FBotonPosition := bpDerecha;
FBotonEspacio := 3;
InstalarBotonInterno;
End;

{ Protected static methods }

Procedure TBotonLookup.InstalarBotonInterno;
Begin
If Assigned (FBoton) Then
Exit;

FBoton := TBoton.Create(Self);
End;

Procedure TBotonLookup.SetBotonPosition (Const Value :TBotonPosition);
Var
P :TPoint;
Begin
If FBoton = Nil Then
Exit;

FBotonPosition := Value;

Case Value Of
bpArriba : P := Point (Left, Top - FBoton.Height - FBotonEspacio);
bpAbajo : P := Point (Left, Top + Height + FBotonEspacio);
bpIzquierda : P := Point (Left - FBoton.Width - FBotonEspacio, Top +
((Height - FBoton.Height) div 2));
bpDerecha : P := Point (Left + Width + FBotonEspacio, Top +
((Height - FBoton.Height) div 2));
End;

FBoton.SetBounds (P.X, P.Y, FBoton.Width, FBoton.Height);
End;

{ Protected overridden methods }

Procedure TBotonLookup.SetParent (AParent :TWinControl);
Begin
Inherited SetParent (AParent);

If FBoton <> Nil Then
FBoton.Parent := AParent;
End;

{ Public overridden methods }

Procedure TBotonLookup.SetBounds (ALeft, ATop, AWidth, AHeight :Integer);
Begin
Inherited SetBounds (ALeft, ATop, AWidth, AHeight);
SetBotonPosition (FBotonPosition);
End;

{ Functions and procedures }

Procedure Register;
Begin
RegisterComponents ('MisComponentes', [TBotonLookup]);
End;

End.
Creo que podría servirle a otros programadores de componentes que estén usando versiones anteriores a la 2007.

Saludos.