|
Registriert seit: 14. Nov 2005 561 Beiträge RAD-Studio 2009 Ent |
#29
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. ![]() 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
Ist das nur mein Gefühl, oder ist die ganze Welt verrückt geworden!?
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |