有一些第三方控件(例如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,
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.
示例(启用和禁用主题):
将此放在一个 TPanel
中的右上角,并将 Anchors
设置为顶部和右侧即可。
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
实现 mouseleave 代码。然后它就可以工作了。 - The_Fox如果你(或其他人)需要一个已完成的 TClosePanel(具有向下传递包含控件的 Enabled 属性的可选功能),我为你编写了一个:
unit ClosePanel;
interface
USES Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, UxTheme, CloseButton;
TYPE
TPosition = (posCustom,posTopLeft,posTopCenter,posTopRight,posMiddleRight,posBottomRight,posbottomCenter,posBottomLeft,posMiddleLeft,posCenter);
TEnableState = RECORD
CTRL : TControl;
State : BOOLEAN
END;
TClosePanel = CLASS(TCustomPanel)
CONSTRUCTOR Create(AOwner : TComponent); OVERRIDE;
PRIVATE
FCloseBtn : TCloseButton;
FPosition : TPosition;
States : ARRAY OF TEnableState;
FAutoEnable : BOOLEAN;
PROTECTED
PROCEDURE SetEnabled(Value : BOOLEAN); OVERRIDE;
PROCEDURE SetParent(Parent : TWinControl); OVERRIDE;
PROCEDURE SetPosition(Value : TPosition); VIRTUAL;
PROCEDURE MoveCloseButton; VIRTUAL;
PROCEDURE WMWindowPosChanged(VAR Message : TWMWindowPosChanged); MESSAGE WM_WINDOWPOSCHANGED;
FUNCTION GetOnClose: TNotifyEvent; VIRTUAL;
PROCEDURE SetOnClose(Value : TNotifyEvent); VIRTUAL;
PUBLIC
PROPERTY DockManager;
PUBLISHED
PROPERTY Align;
PROPERTY Alignment;
PROPERTY Anchors;
PROPERTY AutoSize;
PROPERTY AutoEnable : BOOLEAN read FAutoEnable write FAutoEnable default TRUE;
PROPERTY BevelEdges;
PROPERTY BevelInner;
PROPERTY BevelKind;
PROPERTY BevelOuter;
PROPERTY BevelWidth;
PROPERTY BiDiMode;
PROPERTY BorderWidth;
PROPERTY BorderStyle;
PROPERTY Caption;
PROPERTY CloseBtn : TCloseButton read FCloseBtn write FCloseBtn;
PROPERTY Color;
PROPERTY Constraints;
PROPERTY Ctl3D;
PROPERTY UseDockManager default True;
PROPERTY DockSite;
PROPERTY DragCursor;
PROPERTY DragKind;
PROPERTY DragMode;
PROPERTY Enabled;
PROPERTY FullRepaint;
PROPERTY Font;
PROPERTY Locked;
PROPERTY Padding;
PROPERTY ParentBiDiMode;
PROPERTY ParentBackground;
PROPERTY ParentColor;
PROPERTY ParentCtl3D;
PROPERTY ParentFont;
PROPERTY ParentShowHint;
PROPERTY PopupMenu;
PROPERTY Position : TPosition read FPosition write SetPosition default posTopRight;
PROPERTY ShowHint;
PROPERTY TabOrder;
PROPERTY TabStop;
PROPERTY VerticalAlignment;
PROPERTY Visible;
PROPERTY OnAlignInsertBefore;
PROPERTY OnAlignPosition;
PROPERTY OnCanResize;
PROPERTY OnClick;
PROPERTY OnClose : TNotifyEvent read GetOnClose write SetOnClose;
PROPERTY OnConstrainedResize;
PROPERTY OnContextPopup;
PROPERTY OnDockDrop;
PROPERTY OnDockOver;
PROPERTY OnDblClick;
PROPERTY OnDragDrop;
PROPERTY OnDragOver;
PROPERTY OnEndDock;
PROPERTY OnEndDrag;
PROPERTY OnEnter;
PROPERTY OnExit;
PROPERTY OnGetSiteInfo;
PROPERTY OnMouseActivate;
PROPERTY OnMouseDown;
PROPERTY OnMouseEnter;
PROPERTY OnMouseLeave;
PROPERTY OnMouseMove;
PROPERTY OnMouseUp;
PROPERTY OnResize;
PROPERTY OnStartDock;
PROPERTY OnStartDrag;
PROPERTY OnUnDock;
END;
PROCEDURE Register;
IMPLEMENTATION
PROCEDURE Register;
BEGIN
RegisterComponents('HeartWare', [TClosePanel]);
END;
TYPE
TMyCloseBtn = CLASS(TCloseButton)
CONSTRUCTOR Create(AOwner : TComponent); OVERRIDE;
PROTECTED
PROCEDURE WMWindowPosChanged(VAR Message : TWMWindowPosChanged); MESSAGE WM_WINDOWPOSCHANGED;
PRIVATE
SaveW : INTEGER;
SaveH : INTEGER;
SaveX : INTEGER;
SaveY : INTEGER;
END;
{ TClosePanel }
CONSTRUCTOR TClosePanel.Create(AOwner : TComponent);
BEGIN
INHERITED Create(AOwner);
FAutoEnable:=TRUE;
FCloseBtn:=TMyCloseBtn.Create(Self);
FCloseBtn.Name:='CloseButton';
FCloseBtn.Tag:=1
END;
FUNCTION TClosePanel.GetOnClose : TNotifyEvent;
BEGIN
Result:=CloseBtn.OnClick
END;
PROCEDURE TClosePanel.MoveCloseButton;
PROCEDURE SetPos(ModeX,ModeY : INTEGER);
PROCEDURE SetLeft(Value : INTEGER);
BEGIN
IF FCloseBtn.Left<>Value THEN FCloseBtn.Left:=Value
END;
PROCEDURE SetTop(Value : INTEGER);
BEGIN
IF FCloseBtn.Top<>Value THEN FCloseBtn.Top:=Value
END;
BEGIN
CASE ModeX OF
-1 : SetLeft(0);
0 : SetLeft((ClientWidth-FCloseBtn.Width) DIV 2);
1 : SetLeft(ClientWidth-FCloseBtn.Width)
END;
CASE ModeY OF
-1 : SetTop(0);
0 : SetTop((ClientHeight-FCloseBtn.Height) DIV 2);
1 : SetTop(ClientHeight-FCloseBtn.Height)
END
END;
BEGIN
CASE FPosition OF
posTopLeft : SetPos(-1,-1);
posTopCenter : SetPos(0,-1);
posTopRight : SetPos(1,-1);
posMiddleRight : SetPos(1,0);
posBottomRight : SetPos(1,1);
posbottomCenter : SetPos(0,1);
posBottomLeft : SetPos(-1,1);
posMiddleLeft : SetPos(-1,0);
posCenter : SetPos(0,0)
END
END;
PROCEDURE TClosePanel.SetEnabled(Value : BOOLEAN);
PROCEDURE Enable;
VAR
REC : TEnableState;
BEGIN
FOR REC IN States DO REC.CTRL.Enabled:=REC.State;
SetLength(States,0)
END;
PROCEDURE Disable;
VAR
I : Cardinal;
CMP : TComponent;
REC : TEnableState;
BEGIN
SetLength(States,0);
FOR I:=1 TO ComponentCount DO BEGIN
CMP:=Components[PRED(I)];
IF CMP IS TControl THEN BEGIN
REC.CTRL:=CMP AS TControl;
REC.State:=REC.CTRL.Enabled;
REC.CTRL.Enabled:=FALSE;
SetLength(States,SUCC(LENGTH(States)));
States[HIGH(States)]:=REC
END
END
END;
BEGIN
IF AutoEnable THEN
IF Value THEN Enable ELSE Disable;
FCloseBtn.Enabled:=Value;
INHERITED SetEnabled(Value)
END;
PROCEDURE TClosePanel.SetOnClose(Value : TNotifyEvent);
BEGIN
FCloseBtn.OnClick:=Value
END;
PROCEDURE TClosePanel.SetParent(Parent : TWinControl);
BEGIN
INHERITED SetParent(Parent);
IF FCloseBtn.Tag=1 THEN BEGIN
Position:=posTopRight; FCloseBtn.Tag:=0; Caption:=''
END
END;
PROCEDURE TClosePanel.SetPosition(Value : TPosition);
BEGIN
FPosition:=Value;
MoveCloseButton
END;
PROCEDURE TClosePanel.WMWindowPosChanged(VAR MESSAGE : TWMWindowPosChanged);
BEGIN
INHERITED;
MoveCloseButton
END;
{ TMyCloseBtn }
CONSTRUCTOR TMyCloseBtn.Create(AOwner : TComponent);
BEGIN
INHERITED Create(AOwner);
Width:=16; Height:=16; Parent:=AOwner AS TWinControl
END;
PROCEDURE TMyCloseBtn.WMWindowPosChanged(VAR Message : TWMWindowPosChanged);
BEGIN
INHERITED;
IF (Parent IS TClosePanel) AND (TClosePanel(Parent).Position<>posCustom) THEN
WITH Message.WindowPos^ DO IF (cx<>SaveW) OR (cy<>SaveH) OR (x<>SaveX) OR (y<>SaveY) THEN BEGIN
SaveW:=cx; SaveH:=cy; SaveX:=x; SaveY:=y;
TClosePanel(Parent).MoveCloseButton
END;
WITH Message.WindowPos^ DO BEGIN
SaveW:=cx; SaveH:=cy; SaveX:=x; SaveY:=y
END
END;
END.
published
property Anchors;
property Enabled;
property Height;
property Left;
property Top;
property Visible;
property Width;
property OnClick;
property OnMouseUp;
property OnMouseDown;
end;