There are several third-pary controls (such as the Raize Components) which have a close 'cross' button 'option' (eg the page control). My requirement is simpler, I'd like to plonk a cross 'button' aligned top right on to a TPanel and access its clicked event. Is there either a simple way of doint this without creating a TPanel descendent, or is there a paid or free library component that I can use?
I wrote a control for you.
unit CloseButton;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, UxTheme;
type
TCloseButton = class(TCustomControl)
private
FMouseInside: boolean;
function MouseButtonDown: boolean;
protected
procedure Paint; override;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
procedure WndProc(var Message: TMessage); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
property Enabled;
property OnClick;
property OnMouseUp;
property OnMouseDown;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rejbrand 2009', [TCloseButton]);
end;
{ TCloseButton }
constructor TCloseButton.Create(AOwner: TComponent);
begin
inherited;
Width := 32;
Height := 32;
end;
function TCloseButton.MouseButtonDown: boolean;
begin
MouseButtonDown := GetKeyState(VK_LBUTTON) and $8000 <> 0;
end;
procedure TCloseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
Invalidate;
end;
procedure TCloseButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if not FMouseInside then
begin
FMouseInside := true;
Invalidate;
end;
end;
procedure TCloseButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
Invalidate;
end;
procedure TCloseButton.Paint;
function GetAeroState: cardinal;
begin
result := CBS_NORMAL;
if not Enabled then
result := CBS_DISABLED
else
if FMouseInside then
if MouseButtonDown then
result := CBS_PUSHED
else
result := CBS_HOT;
end;
function GetClassicState: cardinal;
begin
result := 0;
if not Enabled then
result := DFCS_INACTIVE
else
if FMouseInside then
if MouseButtonDown then
result := DFCS_PUSHED
else
result := DFCS_HOT;
end;
var
h: HTHEME;
begin
inherited;
if UseThemes then
begin
h := OpenThemeData(Handle, 'WINDOW');
if h <> 0 then
try
DrawThemeBackground(h,
Canvas.Handle,
WP_CLOSEBUTTON,
GetAeroState,
ClientRect,
nil);
finally
CloseThemeData(h);
end;
end
else
DrawFrameControl(Canvas.Handle,
ClientRect,
DFC_CAPTION,
DFCS_CAPTIONCLOSE or GetClassicState)
end;
procedure TCloseButton.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_MOUSELEAVE:
begin
FMouseInside := false;
Invalidate;
end;
CM_ENABLEDCHANGED:
Invalidate;
end;
end;
end.
Sample (with and without themes enabled):
Just put this in a TPanel
at the top-right corner and set Anchors
to top and right.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With