///////////////////////////////////////////////////////////////////////////////
// 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.