Mega Code Archive
A Nice Flat Coloured button used as a TButton replacement
<![CDATA[
Title: A Nice Flat Coloured button used as a TButton replacement
Question: Nice Flat Button made from a TPanel with Colour Highlights and Click event (Can customize all the colours)
Answer:
{-----------------------------------------------------------------------------
Unit Name: unitSMOSSFlatButton
COMPONENT
---------
Documentation Date: 20/02/02 00:05:24
Version: 1.1
Compiler directives:
Purpose:
Is a nice Flat Coloured button used as a TButton replacement.
Description:
Nice Flat Button made of a TPanel with Colour Highlights and Click features
(Can customize all the colours)
Dependancies:
None
Copyright 2001 by Stewart Moss
All rights reserved.
-----------------------------------------------------------------------------}
unit unitSMOSSFlatButton;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;
type
TSMOSSFlatButton = class(TPanel)
private
{ Private declarations }
FHilite : Boolean;
FHiLiteColor,
SaveColor : TColor;
FOnClick: TNotifyEvent;
procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure ButtonDown(var message : TMessage); message WM_LBUTTONDOWN;
procedure ButtonUp(var message : TMessage); message WM_LBUTTONUP;
property OnClick : TNotifyEvent read FonClick write FOnclick;
protected
{ Protected declarations }
public
{ Public declarations }
constructor create(aowner : TComponent); override;
published
{ Published declarations }
property hiLite : boolean read FHilite write FHilite default true;
property HiliteColor : TColor read FHiliteColor write FHiliteColor default clred;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Stewart Moss', [TSMOSSFlatButton]);
end;
{ TSMOSSFlatButton }
procedure TSMOSSFlatButton.ButtonDown(var message: TMessage);
begin
inherited;
BevelInner := bvLowered;
end;
procedure TSMOSSFlatButton.ButtonUp(var message: TMessage);
begin
inherited;
BevelInner := bvNone;
end;
procedure TSMOSSFlatButton.MouseEnter(var Message: TMessage);
begin
inherited;
if FHilite then
begin
SaveColor := Font.Color;
Font.Color := FHiliteColor;
end;
end;
procedure TSMOSSFlatButton.MouseLeave(var Message: TMessage);
begin
inherited;
if FHilite then
begin
Font.Color := SaveColor;
end;
end;
constructor TSMOSSFlatButton.create(aowner: TComponent);
begin
inherited;
FHilite := true;
FHiliteColor := clred;
Height := 25;
width := 75;
end;
end.
]]>