Error de herencia en diseño con subcomponente

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