unit MenuButton;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Messages, Graphics, Types;
type
TBevel = (bNone, bRaised, bLowered, bInside);
TMenuButton =
class(TCustomPanel)
private
FHover: Boolean;
FColor,
FHighlight,
FShadow: TColor;
FGlyph: TPicture;
FBevel,
FHoverBevel: TBevel;
FBevelWidth: Integer;
procedure CMMouseEnter(
var Msg: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(
var Msg: TMessage);
message CM_MOUSELEAVE;
procedure MouseEnter;
procedure MouseLeave;
procedure SetColor(Value: TColor);
procedure SetHighlight(Value: TColor);
procedure SetShadow(Value: TColor);
procedure SetGlyph(Value: TPicture);
procedure SetBevel(Value: TBevel);
procedure SetHoverBevel(Value: TBevel);
procedure SetBevelWidth(Value: Integer);
protected
public
constructor Create(AOwner: TComponent);
override;
procedure Paint;
override;
property Hover: Boolean
read FHover
write FHover;
published
property Color: TColor
read FColor
write SetColor;
property Highlight: TColor
read FHighlight
write SetHighlight;
property Shadow: TColor
read FShadow
write SetShadow;
property Glyph: TPicture
read FGlyph
write SetGlyph;
property Bevel: TBevel
read FBevel
write SetBevel;
property HoverBevel: TBevel
read FHoverBevel
write SetHoverBevel;
property BevelWidth: Integer
read FBevelWidth
write FBevelWidth;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Eigene', [TMenuButton]);
end;
constructor TMenuButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Hover := False;
Color := clBtnFace;;
Highlight := clBtnHighlight;
Shadow := clBtnShadow;
FGlyph := TPicture.Create;
Bevel := bRaised;
HoverBevel := bLowered;
BevelWidth := 1;
end;
procedure TMenuButton.Paint;
var
ARect: TRect;
begin
ARect := Rect(0, 0, Width, Height);
Canvas.Pen.Style := psClear;
Canvas.Brush.Color := Color;
Canvas.Rectangle(ARect);
if Hover = False
then
begin
case Bevel
of
bRaised: Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
bLowered: Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
bInside:
begin
Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
end;
end;
end
else
begin
case HoverBevel
of
bRaised: Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
bLowered: Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
bInside:
begin
Frame3D(Canvas, ARect, Highlight, Shadow, BevelWidth);
Frame3D(Canvas, ARect, Shadow, Highlight, BevelWidth);
end;
end;
end;
end;
procedure TMenuButton.CMMouseEnter(
var Msg: TMessage);
begin
MouseEnter;
end;
procedure TMenuButton.CMMouseLeave(
var Msg: TMessage);
begin
MouseLeave;
end;
procedure TMenuButton.MouseEnter;
begin
Hover := True;
Repaint;
end;
procedure TMenuButton.MouseLeave;
begin
Hover := False;
Repaint;
end;
procedure TMenuButton.SetColor(Value: TColor);
begin
FColor := Value;
Repaint;
end;
procedure TMenuButton.SetHighlight(Value: TColor);
begin
FHighlight := Value;
Repaint;
end;
procedure TMenuButton.SetShadow(Value: TColor);
begin
FShadow := Value;
Repaint;
end;
procedure TMenuButton.SetGlyph(Value: TPicture);
begin
FGlyph.Assign(Value);
Repaint;
end;
procedure TMenuButton.SetBevel(Value: TBevel);
begin
FBevel := Value;
Repaint;
end;
procedure TMenuButton.SetHoverBevel(Value: TBevel);
begin
FHoverBevel := Value;
Repaint;
end;
procedure TMenuButton.SetBevelWidth(Value: Integer);
begin
FBevelWidth := Value;
Repaint;
end;
end.