Einzelnen Beitrag anzeigen

Andreas L.

Registriert seit: 23. Mai 2011
Ort: Furth im Wald
308 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: Abgeleitetes TImage - Delphi stürzt ab

  Alt 29. Jun 2011, 20:30
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
Andreas Lauß
Blog
  Mit Zitat antworten Zitat