Abgeleitetes TImage - Delphi stürzt ab

[Andreas L.]

Hallo,
ich habe von TImage eine neue Komponente abgeleitet. Ziehe ich das Objekt zur DesignTime auf die Form, zeigt Delphi die Fehlermeldung

Zitat:

---------------------------
Gefahr
---------------------------
Stapelüberlauf - Speichern Sie Ihre Arbeit und starten Sie CodeGear Delphi für Microsoft Windows erneut
---------------------------
OK
---------------------------

. Nach einem Klick auf OK kann ich noch exakt einen Klick irgendwo in Delphi machen (egal wohin) und die IDE schließt sich automatisch (so schnell hat sich Delphi noch nie geschlossen...)

Wenn ich die Komponente zur RunTime erstelle, kommt zwar keine Meldung, aber das Image wird nicht angezeigt.

So sieht mein Code aus:

Delphi-Quellcode:

unit CsImage;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  { -------------------------------------------------------------------------- }
  { TCsImage ----------------------------------------------------------------- }
  { -------------------------------------------------------------------------- }
  TCsImage = class(TImage)
  private
    FPicture: TPicture;
    FHoverPicture: TPicture;
    FDisabledPicture: TPicture;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FDrawHovered: Boolean;
  protected
    procedure SetPicture(Value: TPicture);
    procedure SetHoverPicture(Value: TPicture);
    procedure SetDisabledPicture(Value: TPicture);
    function GetEnabled: Boolean; override;
    procedure SetEnabled(Value: Boolean); override;
    procedure HandleMouseEnter(Sender: TObject);
    procedure HandleMouseLeave(Sender: TObject);
    procedure RefreshPicture;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Picture: TPicture read FPicture write SetPicture;
    property DisabledPicture: TPicture read FDisabledPicture write SetDisabledPicture;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property HoverPicture: TPicture read FHoverPicture write SetHoverPicture;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

implementation

{ ---------------------------------------------------------------------------- }
{ TCsImage ------------------------------------------------------------------- }
{ ---------------------------------------------------------------------------- }
constructor TCsImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FPicture := TPicture.Create;
  FHoverPicture := TPicture.Create;
  FDisabledPicture := TPicture.Create;

  inherited OnMouseEnter := HandleMouseEnter;
  inherited OnMouseLeave := HandleMouseLeave;
end;

destructor TCsImage.Destroy;
begin
  FreeAndNil(FPicture);
  FreeAndNil(FHoverPicture);
  FreeAndNil(FDisabledPicture);

  inherited Destroy;
end;

procedure TCsImage.Loaded;
begin
  inherited Loaded;

  {if not (csDesigning in ComponentState) then
    SetPicture(FPicture);}
end;

procedure TCsImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);

  RefreshPicture;
end;

procedure TCsImage.SetHoverPicture(Value: TPicture);
begin
  FHoverPicture.Assign(Value);
end;

function TCsImage.GetEnabled: Boolean;
begin
  Result := inherited Enabled;
end;

procedure TCsImage.SetEnabled(Value: Boolean);
begin
  inherited SetEnabled(Value);

  RefreshPicture;
end;

procedure TCsImage.SetDisabledPicture(Value: TPicture);
begin
  FDisabledPicture.Assign(Value);

  RefreshPicture;
end;

procedure TCsImage.HandleMouseEnter(Sender: TObject);
begin

  FDrawHovered := True;
  RefreshPicture;

  if Assigned(FOnMouseEnter) then
    OnMouseEnter(Sender);
end;

procedure TCsImage.HandleMouseLeave(Sender: TObject);
begin
  FDrawHovered := False;
  RefreshPicture;

  if Assigned(FOnMouseLeave) then
    OnMouseLeave(Sender);
end;

procedure TCsImage.RefreshPicture;
begin

  if (not Enabled) and Assigned(FDisabledPicture) then
    inherited Picture.Assign(FDisabledPicture)
  else if FDrawHovered and Assigned(FHoverPicture) then
    inherited Picture.Assign(FHoverPicture)
  else
    inherited Picture.Assign(FPicture);

end;

end.

Wo könnte das Problem liegen?

[stahli]

Sieht nach einer Endlosschleife von SetXxxPicture und RefreshPicture aus.
Du solltest das im Designmodus ausschalten durch Prüfen einer Bildgleichheit oder mit einem Flag unterbrechen.

[Andreas L.]

So geht es leider auch nicht.

Delphi-Quellcode:

procedure TCsImage.SetPicture(Value: TPicture);
begin
  if FPicture <> Value then
  begin
    FPicture.Assign(Value);
    RefreshPicture;
  end;
end;

procedure TCsImage.SetHoverPicture(Value: TPicture);
begin
  if FHoverPicture <> Value then
    FHoverPicture.Assign(Value);
end;

function TCsImage.GetEnabled: Boolean;
begin
  Result := inherited Enabled;
end;

procedure TCsImage.SetEnabled(Value: Boolean);
begin
  if GetEnabled <> Value then
  begin
    inherited SetEnabled(Value);
    RefreshPicture;
  end;
end;

procedure TCsImage.SetDisabledPicture(Value: TPicture);
begin
  if FDisabledPicture <> Value then
  begin
    FDisabledPicture.Assign(Value);
    RefreshPicture;
  end;
end;

procedure TCsImage.HandleMouseEnter(Sender: TObject);
begin

  FDrawHovered := True;
  RefreshPicture;

  if Assigned(FOnMouseEnter) then
    OnMouseEnter(Sender);
end;

procedure TCsImage.HandleMouseLeave(Sender: TObject);
begin
  FDrawHovered := False;
  RefreshPicture;

  if Assigned(FOnMouseLeave) then
    OnMouseLeave(Sender);
end;

procedure TCsImage.RefreshPicture;
begin

  if (not Enabled) and Assigned(FDisabledPicture) then
    inherited Picture.Assign(FDisabledPicture)
  else if FDrawHovered and Assigned(FHoverPicture) then
    inherited Picture.Assign(FHoverPicture)
  else
    inherited Picture.Assign(FPicture);

end;

Wo könnte jetzt noch eine Endlosschleife entstehen?

[stahli]

Delphi-Quellcode:

procedure TCsImage.SetDisabledPicture(Value: TPicture);
 begin
   if FDisabledPicture <> Value then
   begin
     FDisabledPicture.Assign(Value);
     RefreshPicture;
   end;
 end;

FDisabledPicture wird in Deinem Fall IMMER ungleich Value sein, da Du Deinem privaten Feld NICHT Value zuweist, sondern nur die fremden BILDINHALTE in Dein privates Feld kopierst.
Es ist wohl eine etwas unkonventionelle Verfahrensweise, im Setter nur die Daten zu übernehmen - aber natürlich möglich.

Du könntest Dir MyLastValue merken (weißt dann aber auch nicht, ob noch das gleiche Bild enthalten ist).

Besser wäre ein doppeltes Refresh mit einem privaten Flag zu blockieren:

Delphi-Quellcode:

procedure TCsImage.RefreshPicture;
begin
  if RefreshFlag then
    Exit;
  RefreshFlag := True;
  if (not Enabled) and Assigned(FDisabledPicture) then
    inherited Picture.Assign(FDisabledPicture)
  else if FDrawHovered and Assigned(FHoverPicture) then
    inherited Picture.Assign(FHoverPicture)
  else
    inherited Picture.Assign(FPicture);
  RefreshFlag := False; 
end;

(sicherhaeitshalber vielleicht in try...finaly kapseln).


Ansonsten würde ich mal den Ablauf protokollieren (wann wird was aufgerufen), z.B. in eine Datei.

[Andreas L.]

Der Übeltäter war der Aufruf von inherited SetEnabled(Value); . Auch inherited Enabled := Value; veursacht den selben Fehler. Warum das nur so ist?

Folgender Code funktioniert einwandfrei

Delphi-Quellcode:

unit CsImage;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
  { -------------------------------------------------------------------------- }
  { TCsImage ----------------------------------------------------------------- }
  { -------------------------------------------------------------------------- }
  TCsImage = class(TImage)
  private
    FEnabled: Boolean;
    FPicture: TPicture;
    FHoverPicture: TPicture;
    FDisabledPicture: TPicture;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FDrawHovered: Boolean;
  protected
    procedure SetPicture(Value: TPicture);
    procedure SetHoverPicture(Value: TPicture);
    procedure SetDisabledPicture(Value: TPicture);
    procedure SetEnabled(Value: Boolean); override;
    procedure HandleMouseEnter(Sender: TObject);
    procedure HandleMouseLeave(Sender: TObject);
    procedure RefreshPicture;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Picture: TPicture read FPicture write SetPicture;
    property DisabledPicture: TPicture read FDisabledPicture write SetDisabledPicture;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property HoverPicture: TPicture read FHoverPicture write SetHoverPicture;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

implementation

{ ---------------------------------------------------------------------------- }
{ TCsImage ------------------------------------------------------------------- }
{ ---------------------------------------------------------------------------- }
constructor TCsImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FPicture := TPicture.Create;
  FHoverPicture := TPicture.Create;
  FDisabledPicture := TPicture.Create;

  FEnabled := True;

  inherited OnMouseEnter := HandleMouseEnter;
  inherited OnMouseLeave := HandleMouseLeave;
end;

destructor TCsImage.Destroy;
begin
  FreeAndNil(FPicture);
  FreeAndNil(FHoverPicture);
  FreeAndNil(FDisabledPicture);

  inherited Destroy;
end;

procedure TCsImage.Loaded;
begin
  inherited Loaded;

  if not (csDesigning in ComponentState) then
    SetPicture(FPicture);
end;

procedure TCsImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
  RefreshPicture;
end;

procedure TCsImage.SetHoverPicture(Value: TPicture);
begin
  FHoverPicture.Assign(Value);
end;

procedure TCsImage.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    //inherited Enabled := Value;
    FEnabled := Value;
    RefreshPicture;
  end;
end;

procedure TCsImage.SetDisabledPicture(Value: TPicture);
begin
  FDisabledPicture.Assign(Value);
  RefreshPicture;
end;

procedure TCsImage.HandleMouseEnter(Sender: TObject);
begin

  FDrawHovered := True;
  RefreshPicture;

  if Assigned(FOnMouseEnter) then
    OnMouseEnter(Sender);
end;

procedure TCsImage.HandleMouseLeave(Sender: TObject);
begin
  FDrawHovered := False;
  RefreshPicture;

  if Assigned(FOnMouseLeave) then
    OnMouseLeave(Sender);
end;

procedure TCsImage.RefreshPicture;
begin

  if (not Enabled) and (FDisabledPicture.Height > 0) then
    inherited Picture.Assign(FDisabledPicture)
  else if FDrawHovered and (FHoverPicture.Height > 0) and Enabled then
    inherited Picture.Assign(FHoverPicture)
  else
    inherited Picture.Assign(FPicture);

end;

end.

Danke dir Stahli

[stahli]

Ich habe nochmal reingesehen: Du führst ein neues privates Feld FEnabled ein. Im Setter setzt Du dann aber das Eltern.Enabled.

Du solltest Deine Klasse noch einmal etwas übderdenken und entschlacken.

Statt den klassischen Settern für die Images würde ich evtl. auch eher Methoden wie AssignHoverPicture(Value...) verwenden, da Du ja nicht das Feld überschreibst sondern nur dessen Inhalt neu definierst. Das würde m.E. die Verwendung Deiner Kompo übersichtlicher machen.
Allerdings könntest Du so nix zur Designzeit zuweisen. Da musst Du halt überlegen, was Du genau erreichen willst. Evtl. könntest Duch auch Deine Images nicht im Create erzeugen, sondern direkt eine Objektzuweisung vornehmen. Dann dürften diese Objekte aber nicht "unkontrolliert" an anderer Stelle freigegeben werden.
Insofern ist Deine Lösung auch nicht zwangsläufig schlecht, aber für Nutzer Deiner Kompo u.U. etwas überraschend und unerwartet.