有几个第三方控件(例如
Raize Components)有一个紧密的“交叉”按钮“选项”(例如页面控件).我的要求更简单,我想将一个十字’按钮’右上方对齐到TPanel并访问其点击的事件.是否有一种简单的方法可以在不创建TPanel后代的情况下执行此操作,或者是否可以使用付费或免费的库组件？
解决方法
我为你写了一个控件.
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,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.
示例(启用和不启用主题)：
Screenshot http://privat.rejbrand.se/closebuttonaero.png
Screenshot http://privat.rejbrand.se/closebuttonclassic.png
只需将其放在右上角的TPanel中,然后将Anchors设置为顶部和右侧.