Mega Code Archive
Flattening down the interface II
<![CDATA[
Title: Flattening down the interface II
Question: I like the flat style buttons in the Delphi3000 web pages. How do I get that style?
Part II
Answer:
I would like to thank's Gian Luca Pepe for the big part of the code.
I just add the MouseOver feature to his component.
unit FlatButton;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TFlatButton = class(TButton)
private
{ Private declarations }
FMouseOver3D : Boolean;
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
public
{ Public declarations }
published
{ Published declarations }
property MouseOver3D : Boolean read FMouseOver3D write MouseOver3D
default False;
property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Bigpepe', [TFlatButton]);
end;
{ TFlatButton }
procedure TFlatButton.CMMouseEnter(var Msg: TMessage);
var
dwStyle: LongInt;
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
if FMouseOver3D then
begin
dwStyle := GetWindowLong(Handle,GWL_STYLE) and not BS_FLAT;
SetWindowLong(Handle,GWL_STYLE,dwStyle);
Invalidate;
end;
end;
procedure TFlatButton.CMMouseLeave(var Msg: TMessage);
var
dwStyle: LongInt;
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
if FMouseOver3D then
begin
dwStyle := GetWindowLong(Handle,GWL_STYLE) or BS_FLAT;
SetWindowLong(Handle,GWL_STYLE,dwStyle);
Invalidate;
end;
end;
procedure TFlatButton.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or BS_FLAT;
end;
end.
]]>