Fehler durch SubProperties

[.chicken]

Also meine Komponente "MenuButton" funktionierte eigentlich schon recht gut aber irgendwie wollte ich die Eigenschaften etwas ordnen, weswegen ich SubProperties verwenden wollte.
Habe das nun versucht aber jetzt funktionierts nimmer richtig!

Ich denke es liegt daran dass ich den Constructor der SubProperties nicht überschreiben kann und somit zB das Bild vom Glyph nicht richtig initialisiert wird.

Also wenn ich ein Bild bei Glyph angebe im OI dann wird es erstens nicht gemalt und zweitens tritt dann ein Fehler beim kompilieren auf:
"Access violation at address 400272D6 in module 'rtl70.bpl'. Read of address 00000001."

Und der Font wird auch net übernommen von TFontCaption!

Was mache ich falsch?

Delphi-Quellcode:

unit MenuButton;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Messages, Graphics, Types;

type
  TCenter = (cNone, cVertical, cHorizontal, cBoth);
  TBevelStyle = (bNone, bRaised, bLowered, bInsideLowered, bInsideRaised);
  TGlyphStyle = (gsLeft, gsTop, gsRight, gsBottom);

  TMyBevel = class(TPersistent)
  Private
    FStyle,
    FHoverStyle,
    FClickStyle: TBevelStyle;
    FShadow,
    FHighlight: TColor;
    FWidth: Integer;
  Public
  Published
    property Style: TBevelStyle read FStyle write FStyle;
    property HoverStyle: TBevelStyle read FHoverStyle write FHoverStyle;
    property ClickStyle: TBevelStyle read FClickStyle write FClickStyle;
    property Shadow: TColor read FShadow write FShadow;
    property Highlight: TColor read FHighlight write FHighlight;
    property Width: Integer read FWidth write FWidth;
  end;

  TGlyph = class(TPersistent)
  Private
    FStyle: TGlyphStyle;
    FPicture: TPicture;
  Public
    constructor Create;
    destructor Destroy; override;
  Protected
  Published
    property Style: TGlyphStyle read FStyle write FStyle;
    property Picture: TPicture read FPicture write FPicture;
  end;

  TFontCaption = class(TPersistent)
  Private
    FFont: TFont;
    FText: String;
  Public
    constructor Create;
    destructor Destroy; override;
  Protected
  Published
    property Font: TFont read FFont write FFont;
    property Text: String read FText write FText;
  end;

  TMenuButton = class(TCustomPanel)
  private
    FHover,
    FClicked,
    FAutoSize: Boolean;
    FCaption: TFontCaption;
    FColor: TColor;
    FGlyph: TGlyph;
    FCenter: TCenter;
    FOnClick,
    FOnMouseEnter,
    FOnMouseLeave: TNotifyEvent;
    FBevel: TMyBevel;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure SetCaption(Value: TFontCaption);
    procedure SetColor(Value: TColor);
    procedure SetGlyph(Value: TGlyph);
    procedure SetBevel(Value: TMyBevel);
    procedure SetCenter(Value: TCenter);
  protected
    procedure SetAutoSize(Value: Boolean); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    property Hover: Boolean read FHover write FHover;
    property Clicked: Boolean read FClicked write FClicked;
  published
    property Bevel: TMyBevel read FBevel write SetBevel;
    property Center: TCenter read FCenter write SetCenter;
    property Caption: TFontCaption read FCaption write SetCaption;
    property Color: TColor read FColor write SetColor;
    property Glyph: TGlyph read FGlyph write SetGlyph;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Eigene', [TMenuButton]);
end;

constructor TMenuButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoSize := False;
  FHover := False;
  FClicked := False;
  FColor := clBtnFace;;
  FBevel := TMyBevel.Create;
  FBevel.Highlight := clBtnHighlight;
  FBevel.Shadow := clBtnShadow;
  FBevel.Style := bLowered;
  FBevel.HoverStyle := bRaised;
  FBevel.ClickStyle := bLowered;
  FBevel.Width := 1;
  FGlyph := TGlyph.Create;
  FGlyph.FPicture := TPicture.Create;
  FCaption := TFontCaption.Create;
  FCaption.FFont := TFont.Create;
  FCaption.Text := 'MenuButton';
end;

constructor TGlyph.Create;
begin
  inherited Create;
  FPicture := TPicture.Create;
end;

constructor TFontCaption.Create;
begin
  inherited Create;
  FFont := TFont.Create;
end;

destructor TMenuButton.Destroy;
begin
  FGlyph.FPicture.Free;
  FGlyph.Free;
  FCaption.FFont.Free;
  FCaption.Free;
  FBevel.Free;
  inherited Destroy;
end;

destructor TGlyph.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

destructor TFontCaption.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TMenuButton.Paint;
var
  ARect: TRect;
  GlyphPos,
  TextPos,
  TeSize,
  GlSize,
  AllSize: TPoint;
  ActiveBevel: TBevelStyle;
begin
  if Assigned(Glyph.Picture.Graphic) then
  begin
    GlSize.X := Glyph.Picture.Graphic.Width;
    GlSize.Y := Glyph.Picture.Graphic.Height;
    case Glyph.Style of
      gsBottom, gsTop: GlSize.Y := GlSize.Y + 1;
      gsRight, gsLeft: GlSize.X := GlSize.X + 1;
    end;
  end
  else
  begin
    GlSize.X := 0;
    GlSize.Y := 0;
  end;
  TeSize.X := Canvas.TextWidth(FCaption.Text);
  TeSize.Y := Canvas.TextHeight(FCaption.Text);

  if Glyph.Style in [gsLeft, gsRight] then
  begin
    AllSize.X := TeSize.X + GlSize.X + BevelWidth * 2 + 4;
    if TeSize.Y < GlSize.Y then
      AllSize.Y := GlSize.Y + BevelWidth * 2 + 4
    else
      AllSize.Y := TeSize.Y + BevelWidth * 2 + 4;
  end
  else
  begin
    if TeSize.X < GlSize.X then
      AllSize.X := GlSize.X + BevelWidth * 2 + 4
    else
      AllSize.X := TeSize.X + BevelWidth * 2 + 4;
    AllSize.Y := GlSize.Y + TeSize.Y + BevelWidth * 2 + 4;
  end;

  if (AutoSize = True) then
  begin
    Width := AllSize.X;
    Height := AllSize.Y;
  end;

  Case Center of
    cHorizontal: Left := Parent.Width div 2 - Width div 2;
    cVertical: Top := Parent.Height div 2 - Height div 2;
    cBoth: begin
            Left := Parent.Width div 2 - Width div 2;
            Top := Parent.Height div 2 - Height div 2;
           end;
  end;

  ARect := Rect(0, 0, Width, Height);
  Canvas.Brush.Color := Color;
  Canvas.Pen.Color := Color;
  Canvas.Rectangle(ARect);
  if (Clicked = True) AND (Hover = True) then
    ActiveBevel := Bevel.ClickStyle
  else
  if Hover = True then
    ActiveBevel := Bevel.HoverStyle
  else
    ActiveBevel := Bevel.Style;

  case Glyph.Style of
    gsLeft:   begin
                GlyphPos.X := Width div 2 - (GlSize.X + TeSize.X) div 2;
                GlyphPos.Y := Height div 2 - GlSize.Y div 2;
                TextPos.X := GlyphPos.X + GlSize.X;
                TextPos.Y := Height div 2 - TeSize.Y div 2;
              end;
    gsRight:  begin
                GlyphPos.X := Width div 2 - (GlSize.X + TeSize.X) div 2 + TeSize.X + 1;
                GlyphPos.Y := Height div 2 - GlSize.Y div 2;
                TextPos.X := GlyphPos.X - TeSize.X;
                TextPos.Y := Height div 2 - TeSize.Y div 2;
              end;
    gsTop:    begin
                GlyphPos.X := Width div 2 - GlSize.X div 2;
                GlyphPos.Y := Height div 2 - (GlSize.Y + TeSize.Y) div 2;
                TextPos.X := Width div 2 - TeSize.X div 2;
                TextPos.Y := GlyphPos.Y + GlSize.Y;
              end;
    gsBottom: begin
                GlyphPos.X := Width div 2 - GlSize.X div 2;
                GlyphPos.Y := Height div 2 - (GlSize.Y + TeSize.Y) div 2 + TeSize.Y + 1;
                TextPos.X := Width div 2 - TeSize.X div 2;
                TextPos.Y := GlyphPos.Y - TeSize.Y;
              end;
  end;

  Canvas.Draw(GlyphPos.X, GlyphPos.Y, Glyph.Picture.Graphic);
  Canvas.TextOut(TextPos.X, TextPos.Y, FCaption.Text);

  case ActiveBevel of
    bRaised: Frame3D(Canvas, ARect, Bevel.Highlight, Bevel.Shadow, Bevel.Width);
    bLowered: Frame3D(Canvas, ARect, Bevel.Shadow, Bevel.Highlight, BevelWidth);
    bInsideRaised: begin
                    Frame3D(Canvas, ARect, Bevel.Highlight, Bevel.Shadow, Bevel.Width);
                    Frame3D(Canvas, ARect, Bevel.Shadow, Bevel.Highlight, Bevel.Width);
                   end;
    bInsideLowered: begin
                    Frame3D(Canvas, ARect, Bevel.Shadow, Bevel.Highlight, Bevel.Width);
                    Frame3D(Canvas, ARect, Bevel.Highlight, Bevel.Shadow, Bevel.Width);
                   end;
  end;
end;

procedure TMenuButton.CMMouseEnter(var Msg: TMessage);
begin
  if (csDesigning in ComponentState) = False then
  begin
    Hover := True;
    Repaint;
    if Assigned(FOnMouseEnter) then
      FOnMouseEnter(self);
  end;
end;
procedure TMenuButton.CMMouseLeave(var Msg: TMessage);
begin
  if (csDesigning in ComponentState) = False then
  begin
    Hover := False;
    Repaint;
    if Assigned(FOnMouseLeave) then
      FOnMouseLeave(self);
  end;
end;

procedure TMenuButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  Clicked := False;
  Repaint;
end;
procedure TMenuButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  Clicked := True;
  Repaint;
  if (Assigned(FOnClick)) AND (Hover = True) then
    FOnClick(self);
end;

procedure TMenuButton.SetColor(Value: TColor);
begin
  FColor := Value;
  Repaint;
end;
procedure TMenuButton.SetGlyph(Value: TGlyph);
begin
  FGlyph.Assign(Value);
  Repaint;
end;
procedure TMenuButton.SetAutoSize(Value: Boolean);
begin
  FAutoSize := Value;
  Repaint;
end;
procedure TMenuButton.SetCenter(Value: TCenter);
begin
  FCenter := Value;
  Repaint;
end;
procedure TMenuButton.SetBevel(Value: TMyBevel);
begin
  FBevel := Value;
  Repaint;
end;
procedure TMenuButton.SetCaption(Value: TFontCaption);
begin
  FCaption := Value;
  Canvas.Font := Caption.Font;
  Repaint;
end;

end.

[Gremlin]

Du erstellst im Create deines MenuButtons die Attribute der SubClasses zusätzlich im constructor und gibst diese im destructor noch einmal frei. Deine SubClasses sind für die Erstellung und das Freigeben Ihrer Daten verantwortlich, nicht deine Klasse TMenuButton.

Delphi-Quellcode:

constructor TMenuButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  [...]
  FGlyph := TGlyph.Create;
  FGlyph.FPicture := TPicture.Create; 
  [...]

constructor TGlyph.Create;
begin
  inherited Create;
  FPicture := TPicture.Create;
end;

Delphi-Quellcode:

destructor TMenuButton.Destroy;
begin
  FGlyph.FPicture.Free;
  FGlyph.Free; 
  [...]

destructor TGlyph.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

Deine "Setter"-Proceduren überschreiben die Attribute der SubClasses (Bevel, Glyph, Caption). Du solltest diese besser zuweisen (zb. über Einzelattribute oder eine geeignte Assign-Methode)

[.chicken]

Hm ok zum ersten:
Da is mirn Fehler unterlaufen, habe beides einmal ausprobiert und dann wohl vergessen das eine zu löschen!

Und zum zweiten: Könnteste das nochmal genauer erläutern? Also ich glaub ich verstehe grob was du meinst aber nich wie ichs umsetzen soll!


Danke!

[.chicken]

*push*