Eigene Komponente von TCustomControl > Eigenschaftseditor!

[cherry]

Hello..
Dem Wochenend näher kommend, poste ich hier mal mein aktueller Code:

Delphi-Quellcode:

///////////////////////////////////////////////////////////////////////////////
// TEButton.pas - EnemyleftButton
//
// Ein Button abgeleitet von TCustomControl.
// TEButton bietet alle Eigenschaften und Ereignisse die
// wir bereits vom herkömmlichen TButton kennen. Darüber hinaus
// hat man grafisch mehr Mäglichkeiten. Farbe, Form...
//
// Diese OpenSource Komponente ist noch nicht fertig entwickelt!
//
///////////////////////////////////////////////////////////////////////////////
// (C) 2006, Enemyleft
/////////////////////////////////////////////////////////////////////////////// 
// ReleaseNotes:
// v1.0 beta - 21.04.06 - Enemyleft
/////////////////////////////////////////////////////////////////////////////// 

unit EButton;

interface

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

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

  TEButton = class(TCustomControl)
  private
    { Private-Deklarationen }
    FEFont : TFont;
    FEFontOver : TFont;
    FEFontDown : TFont;
    FEColor : TColor;
    FEColorOver : TColor;
    FEColorDown : TColor;
    FEBrushStyle : TBrushStyle;
    FEBrushStyleOver : TBrushStyle;
    FEBrushStyleDown : TBrushStyle;
    FEPenColor : TColor;
    FEPenColorOver : TColor;
    FEPenColorDown : TColor;
    FEOnFocusedShow : Boolean;
    FEOnFocusedColor : TColor;
    FEnemyleftKind : TEnemyleftKind;
    FEnemyRoundedW : Integer;
    FEnemyRoundedH : Integer;

    FCaption: String;

    FOnMouseDown : TNotifyEvent;
    FOnMouseUp : TNotifyEvent;

    EMouseOver : Boolean;
    EMouseDown : Boolean;

    isCaption : Boolean;

    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetEFont(const Value: TFont);
    procedure SetEFontOver(const Value: TFont);
    procedure SetEFontDown(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 SetEOnFocusedShow(const Value: Boolean);
    procedure SetEOnFocusedColor(const Value: TColor);
    procedure SetEnemyRoundedW(const Value: Integer);
    procedure SetEnemyRoundedH(const Value: Integer);
    procedure SetCaption(const Value: String);
  protected
    { Protected-Deklarationen }
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyPress(var Key: Char); override;

    procedure PaintButton;
    procedure PaintRounded;
    procedure PaintArrowRight;
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published-Deklarationen }
    property EFont: TFont read FEFont write SetEFont;
    property EFontOver: TFont read FEFontOver write SetEFontOver;
    property EFontDown: TFont read FEFontDown write SetEFontDown;
    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 EOnFocusedShow: Boolean read FEOnFocusedShow write SetEOnFocusedShow;
    property EOnFocusedColor: TColor read FEOnFocusedColor write SetEOnFocusedColor;
    property EnemyRoundedWidth: Integer read FEnemyRoundedW write SetEnemyRoundedW;
    property EnemyRoundedHeight: Integer read FEnemyRoundedH write SetEnemyRoundedH;

    property Caption: String read FCaption write SetCaption;

    property Anchors;
    property Action;
    property BiDiMode;
    //property Cancel;
    //property Constrains;
    //property Default;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    //property ModalResult;
    property ParentBiDiMode;
    //***property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;

    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

  end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('enemyleft', [TEButton]);
end;

constructor TEButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 DoubleBuffered := True;
 FEFont := TFont.Create;
 FEFontOver := TFont.Create;
 FEFontDown := TFont.Create;
 FEColor:=clWhite;
 FEColorOver:=clSilver;
 FEColorDown:=clGray;
 FEBrushStyle:=bsSolid;
 FEBrushStyleOver:=bsSolid;
 FEBrushStyleDown:=bsSolid;
 FEPenColor:=clSilver;
 FEPenColorOver:=clGray;
 FEPenColorDown:=clSilver;
 Width:=75;
 Height:=25;
 EMouseOver:=false;
 EMouseDown:=false;
 FEOnFocusedShow:=true;
 FEOnFocusedColor:=clAqua;
 FEnemyRoundedW:=5;
 FEnemyRoundedH:=5;
 TabStop:=True;
 isCaption:=false;
end;


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

procedure TEButton.Paint;
begin
 inherited;
 if (not isCaption) then
  SetCaption(Name);
 isCaption:=true;

 if FEnemyleftKind = Button then
  PaintButton
 else if FEnemyleftKind = Rounded then
  PaintRounded
 else if FEnemyleftKind = ArrowRight then
  PaintArrowRight;
 exit;
end;

procedure TEButton.PaintButton;
begin
 if (csDesigning in ComponentState) or (not EMouseOver) then
 begin
  Canvas.Brush.Color := FEColor;
  Canvas.Brush.Style := FEBrushStyle;
  Canvas.Pen.Color := FEPenColor;
  Canvas.Rectangle(0,0,width,height);
  Canvas.Font.Assign(Self.FEFont);
  Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
 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.Assign(Self.FEFontDown);
   Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
  end
  else
  begin
   Canvas.Brush.Color := FEColorOver;
   Canvas.Brush.Style := FEBrushStyleOver;
   Canvas.Pen.Color := FEPenColorOver;
   Canvas.Rectangle(0,0,width,height);
   Canvas.Font.Assign(Self.FEFontOver);
   Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
  end;
 end;
 if (Focused) then
 begin
  if (FEOnFocusedShow) then
  begin
   Canvas.Pen.Color := FEOnFocusedColor;
   Canvas.Brush.Style := bsClear;
   Canvas.Rectangle(1,1,width-1,height-1);
  end;
 end;
end;

procedure TEButton.PaintRounded;
begin
 if (csDesigning in ComponentState) or (not EMouseOver) then
 begin
  Canvas.Brush.Color := FEColor;
  Canvas.Brush.Style := FEBrushStyle;
  Canvas.Pen.Color := FEPenColor;
  Canvas.RoundRect(0,0,width,height,FEnemyRoundedW,FEnemyRoundedH);
  Canvas.Font.Assign(Self.FEFont);
  Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
 end
 else if (EMouseOver) then
 begin
  if (EMouseDown) then
  begin
   Canvas.Brush.Color := FEColorDown;
   Canvas.Brush.Style := FEBrushStyleDown;
   Canvas.Pen.Color := FEPenColorDown;
   Canvas.RoundRect(0,0,width,height,FEnemyRoundedW,FEnemyRoundedH);
   Canvas.Font.Assign(Self.FEFontDown);
   Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
  end
  else
  begin
   Canvas.Brush.Color := FEColorOver;
   Canvas.Brush.Style := FEBrushStyleOver;
   Canvas.Pen.Color := FEPenColorOver;
   Canvas.RoundRect(0,0,width,height,FEnemyRoundedW,FEnemyRoundedH);
   Canvas.Font.Assign(Self.FEFontOver);
   Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
  end;
 end;
 if (Focused) then
 begin
  if (FEOnFocusedShow) then
  begin
   Canvas.Pen.Color := FEOnFocusedColor;
   Canvas.Brush.Style := bsClear;
   Canvas.RoundRect(1,1,width-1,height-1,FEnemyRoundedW,FEnemyRoundedH);
  end;
 end;
end;

procedure TEButton.PaintArrowRight;
var
 Points: array[1..4] of TPoint;
begin
 if (csDesigning in ComponentState) or (not EMouseOver) then
 begin
  Points[1]:=Point(0,height div 4);
  Points[2]:=Point(width,height div 4);
  Points[3]:=Point(width,height);
  Points[4]:=Point(width,height div 2);
  Canvas.Brush.Color := FEColor;
  Canvas.Brush.Style := FEBrushStyle;
  Canvas.Pen.Color := FEPenColor;
  Canvas.Polygon(Points);
  //Canvas.RoundRect(0,0,width,height,FEnemyRoundedW,FEnemyRoundedH);
  Canvas.Font.Assign(Self.FEFont);
  Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
 end
 else if (EMouseOver) then
 begin
  if (EMouseDown) then
  begin
   Canvas.Brush.Color := FEColorDown;
   Canvas.Brush.Style := FEBrushStyleDown;
   Canvas.Pen.Color := FEPenColorDown;
   Canvas.RoundRect(0,0,width,height,FEnemyRoundedW,FEnemyRoundedH);
   Canvas.Font.Assign(Self.FEFontDown);
   Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
  end
  else
  begin
   Canvas.Brush.Color := FEColorOver;
   Canvas.Brush.Style := FEBrushStyleOver;
   Canvas.Pen.Color := FEPenColorOver;
   Canvas.RoundRect(0,0,width,height,FEnemyRoundedW,FEnemyRoundedH);
   Canvas.Font.Assign(Self.FEFontOver);
   Canvas.TextOut((width - Canvas.TextWidth(Caption)) div 2,(height - Canvas.TextHeight(Caption)) div 2,Caption);
  end;
 end;
 if (Focused) then
 begin
  if (FEOnFocusedShow) then
  begin
   Canvas.Pen.Color := FEOnFocusedColor;
   Canvas.Brush.Style := bsClear;
   Canvas.RoundRect(1,1,width-1,height-1,FEnemyRoundedW,FEnemyRoundedH);
  end;
 end;
end;

procedure TEButton.DoEnter;
begin
 inherited;
 Invalidate;
end;

procedure TEButton.DoExit;
begin
 inherited;
 Invalidate;
end;

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.Assign(Value);
 RePaint;
end;

procedure TEButton.SetEFontOver(const Value: TFont);
begin
 FEFontOver.Assign(Value);
 RePaint;
end;

procedure TEButton.SetEFontDown(const Value: TFont);
begin
 FEFontDown.Assign(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;

procedure TEButton.SetEOnFocusedShow(const Value: Boolean);
begin
 FEOnFocusedShow := Value;
 RePaint;
end;

procedure TEButton.SetEOnFocusedColor(const Value: TColor);
begin
 FEOnFocusedColor := Value;
 RePaint;
end;

procedure TEButton.SetEnemyRoundedW(const Value: Integer);
begin
 FEnemyRoundedW := Value;
 RePaint;
end;

procedure TEButton.SetEnemyRoundedH(const Value: Integer);
begin
 FEnemyRoundedH := Value;
 RePaint;
end;

procedure TEButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if (Button=mbLeft) then
 begin
  EMouseDown := true;
  RePaint;
  if Assigned(FOnMouseDown) then FOnMouseDown(Self);
 end;
end;

procedure TEButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 EMouseDown := false;
 RePaint;
 if Assigned(FOnMouseUp) then FOnMouseUp(Self);
end;

procedure TEButton.SetCaption(const Value: String);
begin
 FCaption := Value;
 RePaint;
end;

procedure TEButton.KeyPress(var Key: Char);
begin
 if (Key=#13) then
  Click;
end;

end.

Natürlich mit einer Frage verbunden...

1f) Ich will die Eigenschaft Default zur verfügung stellen.
Da diese Eigenschaft in keinem Vorgänger vorkommt, muss ich diese
selber programmieren. (Ist der Button Default reagiert er auf den Tastendruck Enter,
egal welche Komponente Fokusiert ist).

Wie Fange ich alle Tastenereignisse ab?

2f) Wie man in meinem Beispiel sieht, versuche ich die standard Caption auf den Komponentennamen zu setzen,
so wie ich es jetzt habe funktionierts. Einzige Nebenwirkung: Setzt man den Button auf ein Formular/Frame, dann
ist die Caption im OBJEKTINSPEKTOR erst gesetzt wenn man eine andere einstellung fokusiert. Zudem ists in meinem
Beispiel schlecht/kompliziert gemacht.

Wie setzte ich nun die standard Caption korrekt?

3f) Ich bin auch dankbar für jeden sonstige Tipp!

Sachen die ich anders machen sollte?

Grüsse
Enamyleft