unit Unit1;
interface
uses
Classes, Controls, Graphics, Forms, SysUtils, Dialogs, StdCtrls;
type
{ TCustomButton }
TCustomButton = class(TCustomControl)
private
FMouseOver: Boolean;
FPressed: Boolean;
FCaption: string;
FTextColor: TColor; // New property for text color
procedure SetMouseOver(Value: Boolean);
procedure SetPressed(Value: Boolean);
procedure SetTextColor(Value: TColor); // Setter for the text color
protected
procedure Paint; override;
procedure MouseEnter; override;
procedure MouseLeave; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
property Caption: string read FCaption write FCaption;
property TextColor: TColor read FTextColor write SetTextColor; // Exposing TextColor property
end;
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FButton: TCustomButton;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TCustomButton }
constructor TCustomButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMouseOver := False;
FPressed := False;
FTextColor := clBlack; // Default text color is black
ControlStyle := ControlStyle + [csCaptureMouse];
Visible := True;
Parent := TForm(AOwner); // Ensure the button is added to the form's control list
Width := 120; // Initial width
Height := 40; // Initial height
FCaption := 'Click Me!'; // Default caption
end;
procedure TCustomButton.SetMouseOver(Value: Boolean);
begin
if FMouseOver <> Value then
begin
FMouseOver := Value;
Invalidate; // Redraw the button on hover state change
end;
end;
procedure TCustomButton.SetPressed(Value: Boolean);
begin
if FPressed <> Value then
begin
FPressed := Value;
Invalidate; // Redraw the button on press state change
end;
end;
procedure TCustomButton.SetTextColor(Value: TColor);
begin
if FTextColor <> Value then
begin
FTextColor := Value;
Invalidate; // Redraw the button on text color change
end;
end;
procedure TCustomButton.Paint;
var
R: TRect;
BtnColorStart, BtnColorEnd: TColor;
BorderColor: TColor;
BorderThickness: Integer;
begin
Width:= canvas.TextWidth(Fcaption)+30;
R := ClientRect;
BorderThickness := 1; // Border thickness
// Determine button color based on state
if FPressed then
begin
form1.FButton.TextColor:=clGreen ; // Green;
BorderThickness := 3; // Border thickness
BtnColorStart := clGreen; // Green
BtnColorEnd := clLime; // Lime Green
BorderColor := clBlack; // Black Border Color for pressed state
// You can trap mouse clicks here.. or not!
writeln('mouse click detected');
end
else if FMouseOver then
begin
form1.FButton.TextColor:=clBlack ;// Black;
BtnColorStart := clGreen; // Green
BtnColorEnd := clLime; // Lime Green
BorderColor := clBlack; // Border Color for hover state
end
else
begin
form1.FButton.TextColor:=clBlack ;// Black;
BtnColorStart := clLime; // Lime Green
BtnColorEnd := clGreen; // Green
BorderColor := clBlack; // Black Border Color for normal state
end;
// Manually adjust the rectangle to fit inside the border
Canvas.GradientFill(R, BtnColorStart, BtnColorEnd, gdVertical); // Gradient fill
// Draw the border (border should be on top of the gradient)
Canvas.Pen.Color := BorderColor;
Canvas.Pen.Width := BorderThickness; // Border thickness
Canvas.Pen.Color := clLime;
// Uses WIDTH property to auto adjust caption size
//draws a rectangle with the top-left corner at (0, 0) and the bottom-right corner at (Width, Height).
Canvas.Rectangle(R.Left+1, R.Top+1, Width-1, R.Bottom-1);
Canvas.Brush.Style := bsClear; // No fill for the caption COMMENT THIS AND TEST :)
// Draw the button text with customizable color
Canvas.Font.Color := FTextColor; // Use the TextColor property
Canvas.TextOut((Width - Canvas.TextWidth(FCaption)) div 2,
(Height - Canvas.TextHeight(FCaption)) div 2,
FCaption);
end;
procedure TCustomButton.MouseEnter;
begin
SetMouseOver(True); // Trigger hover effect
end;
procedure TCustomButton.MouseLeave;
begin
SetMouseOver(False); // Remove hover effect
end;
procedure TCustomButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
SetPressed(True); // Trigger pressed effect when mouse button is down
end;
procedure TCustomButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
SetPressed(False); // Remove pressed effect when mouse button is up
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FButton := TCustomButton.Create(Self);
FButton.Parent := Self;
FButton.Left := 20;
FButton.Top := 20;
FButton.Caption := ' Custom Button Demo! '; // Set initial caption
end;
end.
WIKI Timeout issues
