Error de herencia en diseño con subcomponente
 

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.

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.

;)

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.

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

// Saludos

¡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:
Espero esto sea de utilidad. Seguimos en contacto.

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. 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.

Código Delphi [-]
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.