Eigene Komponente von TCustomControl > Eigenschaftseditor!

[cherry]

Hey.. schon wieder habe ich ein Problem...
und zwar liegt es diesmal irgendwie an der schrift!

Ich kann den Code zwar Kompilieren, wenn ich die Komponente jedoch auf die Form
ziehe, so gibts einen Fehler. Zugriffsverletzung...

führe ich FEFont.Create; nicht aus funktionierts.

Delphi-Quellcode:

unit EButton;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Graphics, Messages, Dialogs;

type
  TEnemyleftKind = (Button, ArrowRight, ArrowLeft, Ellipse, PNG);

  TEButton = class(TCustomControl)
  private
    { Private-Deklarationen }
    { Deklarationen der Variablen für die Propertys! }
    FEFont : TFont;
    FEColor : TColor;
    FEColorOver : TColor;
    FEColorDown : TColor;
    FEBrushStyle : TBrushStyle;
    FEBrushStyleOver : TBrushStyle;
    FEBrushStyleDown : TBrushStyle;
    FEPenColor : TColor;
    FEPenColorOver : TColor;
    FEPenColorDown : TColor;
    FEnemyleftKind : TEnemyleftKind;
    FEnemyleftKindOver : TEnemyleftKind;
    FEnemyleftKindDown : TEnemyleftKind;

    EMouseOver : Boolean;

    FEOnMouseDown : TNotifyEvent;
    FEOnMouseUp : TNotifyEvent;
    EMouseDown : Boolean;

    { Deklarationen der Procedures der Propertys
      Die folgenden Procedures verarbeiten erhaltene Propertywerte }

    { Die Zwei folgenden Prozeduren }
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetEFont(const Value: TFont);
    procedure SetEColor(const Value: TColor);
    procedure SetEColorOver(const Value: TColor);
    procedure SetEColorDown(const Value: TColor);
    procedure SetEBrushStyle(const Value: TBrushStyle);
    procedure SetEBrushStyleOver(const Value: TBrushStyle);
    procedure SetEBrushStyleDown(const Value: TBrushStyle);
    procedure SetEPenColor(const Value: TColor);
    procedure SetEPenColorOver(const Value: TColor);
    procedure SetEPenColorDown(const Value: TColor);

    procedure SetEOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SetEOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published-Deklarationen }

    { Propertys, Einstellungen die zur entwicklungszeit vorgenommen werden können.
      z.B. bei EFont und EColor [E für Enemyleft^^], werden standardmässige Eigenschafts-
      editoren angezeigt. Sprich Schrift / Farbeditor usw.
      write: geschrieben wird nicht einfach der "Wert" als solches, sonder über eine Prozedur.}

    property EFont: TFont read FEFont write SetEFont;
    property EColor: TColor read FEColor write SetEColor;
    property EColorOver: TColor read FEColorOver write SetEColorOver;
    property EColorDown: TColor read FEColorDown write SetEColorDown;
    property EBrushStyle : TBrushStyle read FEBrushStyle write SetEBrushStyle;
    property EBrushStyleOver : TBrushStyle read FEBrushStyleOver write SetEBrushStyleOver;
    property EBrushStyleDown : TBrushStyle read FEBrushStyleDown write SetEBrushStyleDown;
    property EPenColor : TColor read FEPenColor write SetEPenColor;
    property EPenColorOver : TColor read FEPenColorOver write SetEPenColorOver;
    property EPenColorDown : TColor read FEPenColorDown write SetEPenColorDown;
    property EnemyleftKind: TEnemyleftKind read FEnemyleftKind write FEnemyleftKind;
    property OnMouseDown: TNotifyEvent read FEOnMouseDown write FEOnMouseDown;
    property OnMouseUp: TNotifyEvent read FEOnMouseUp write FEOnMouseUp;

    { Diese Ereignisse wurden geerbt von TCustomControl und können
      deshald so simpel deklariert werden }
      
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseMove;
  end;

procedure Register;

implementation

procedure Register;
begin
  { Procedure wird bei der Komponenteninstallation verwendet! }
  RegisterComponents('enemyleft', [TEButton]);
end;

constructor TEButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 { Hier im Konstruktor wird das OnMouseDown/Up-Ereigniss der
   "oberen Klasse (inherited)"  überschrieben }
 inherited OnMouseDown := SetEOnMouseDown;
 inherited OnMouseUp := SetEOnMouseUp;
 Width:=75;
 Height:=25;
 FEFont.Create;
 FEColor:=clWhite;
 FEColorOver:=clAqua;
 FEColorDown:=clBlack;
 FEBrushStyle:=bsSolid;
 FEBrushStyleOver:=bsSolid;
 FEBrushStyleDown:=bsSolid;
 FEPenColor:=clRed;
 FEPenColorOver:=clBlue;
 FEPenColorDown:=clYellow;
 EMouseOver:=false;
 EMouseDown:=false;
end;

destructor TEButton.Destroy;
begin
 FEFont.Free;
 inherited Destroy;
end;

procedure TEButton.Paint;

 { Methode Paint wird überschrieben, die diversen if abfragen sind nötig um
   Den Button korrekt zu Zeichen, trifft das Ereignis MouseDown, oder RollOver
   zu, wird der Button anders gezeichnet als in ComponentState(Entwicklungsumgebung)
   oder wenn kein Ereignis zutrifft. }

begin
 inherited;//Zeichen Procedure des Vorfahren aufrufen.
 if (csDesigning in ComponentState) or (not EMouseOver) then
 begin
  {Zeichung eines Rahmens}
  Canvas.Brush.Color := FEColor;
  Canvas.Brush.Style := FEBrushStyle;
  Canvas.Pen.Color := FEPenColor;
  Canvas.Rectangle(0,0,width,height);//Rechteck zeichnen

  {Namen der Komponente in die Mitte schreiben}
  canvas.Font := FEFont;
  canvas.TextOut((width - Canvas.TextWidth(Name)) div 2,(height - Canvas.TextHeight(Name)) div 2,name);

  {Keine weitern Zeichnungen mehr ausführen}
  exit;//Verlässt die Procedure
 end
 else if (EMouseOver) then
 begin
  if (EMouseDown) then
  begin
   Canvas.Brush.Color := FEColorDown;
   Canvas.Brush.Style := FEBrushStyleDown;
   Canvas.Pen.Color := FEPenColorDown;
   Canvas.Rectangle(0,0,width,height);

   canvas.Font := FEFont;
   canvas.TextOut((width - Canvas.TextWidth(Name)) div 2,(height - Canvas.TextHeight(Name)) div 2,name);

   exit;
  end
  else
  begin
   Canvas.Brush.Color := FEColorOver;
   Canvas.Brush.Style := FEBrushStyleOver;
   Canvas.Pen.Color := FEPenColorOver;
   Canvas.Rectangle(0,0,width,height);

   canvas.Font := FEFont;
   canvas.TextOut((width - Canvas.TextWidth(Name)) div 2,(height - Canvas.TextHeight(Name)) div 2,name);

   exit;
  end;
 end;
end;

{ Proceduren (Selbsterklärens) }

procedure TEButton.CMMouseEnter(var Message: TMessage);
begin
 inherited;
 EMouseOver := true;
 RePaint;
end;

procedure TEButton.CMMouseLeave(var Message: TMessage);
begin
 inherited;
 EMouseOver := false;
 RePaint;
end;

procedure TEButton.SetEFont(const Value: TFont);
begin
 FEFont := Value;
 RePaint;
end;

procedure TEButton.SetEColor(const Value: TColor);
begin
 FEColor := Value;
 RePaint;
end;

procedure TEButton.SetEColorOver(const Value: TColor);
begin
 FEColorOver := Value;
 RePaint;
end;

procedure TEButton.SetEColorDown(const Value: TColor);
begin
 FEColorDown := Value;
 RePaint;
end;

procedure TEButton.SetEBrushStyle(const Value: TBrushStyle);
begin
 FEBrushStyle := Value;
 RePaint;
end;

procedure TEButton.SetEBrushStyleOver(const Value: TBrushStyle);
begin
 FEBrushStyleOver := Value;
 RePaint;
end;

procedure TEButton.SetEBrushStyleDown(const Value: TBrushStyle);
begin
 FEBrushStyleDown := Value;
 RePaint;
end;

procedure TEButton.SetEPenColor(const Value: TColor);
begin
 FEPenColor := Value;
 RePaint;
end;

procedure TEButton.SetEPenColorOver(const Value: TColor);
begin
 FEPenColorOver := Value;
 RePaint;
end;

procedure TEButton.SetEPenColorDown(const Value: TColor);
begin
 FEPenColorDown := Value;
 RePaint;
end;

{ Vor das Ereignis wird die Variable MouseDown, weleche einfluss auf
  auf die Procedure Paint hat auf true gesetzt. /
  Im Konstruktor wird mit "inherited OnMouseDown / UP := Proc" auf die jeweilige
  Procedure hingewiesen, die das Ereignis "steuert" }

procedure TEButton.SetEOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 EMouseDown := true;
 RePaint;
 if Assigned(FEOnMouseDown) then FEOnMouseDown(Sender);
end;

procedure TEButton.SetEOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 EMouseDown := false;
 RePaint;
 if Assigned(FEOnMouseUp) then FEOnMouseUp(Sender);
end;

end.