有几个第三方控件(例如Raize Components)具有关闭的“交叉”按钮“选项”(例如页面控件)。我的要求更简单,我想将一个十字'按钮'对齐到TPanel右上方并访问其点击的事件。是否有一种简单的方法可以在不创建TPanel后代的情况下执行此操作,或者是否可以使用付费或免费的库组件?
答案 0 :(得分:19)
我为你写了一个控件。
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.
示例(启用和不启用主题):
Screenshot http://privat.rejbrand.se/closebuttonaero.png Screenshot http://privat.rejbrand.se/closebuttonclassic.png
只需将其放在右上角的TPanel
,然后将Anchors
设置为顶部和右侧。
答案 1 :(得分:4)
我确信您可以在Torry's或任何其他类似网站上免费找到大量此类组件...但是,如果您只在一个面板上需要这样的功能,那么请放弃按钮进入面板,将其固定在右上角,然后就完成了。如果你还希望在该面板上有“标题区域”,那么可能会有更多的工作......
顺便说一句,如果您安装了JVCL,那么您已经安装了这样的组件 - 它被称为TjvCaptionPanel或类似组件。
答案 2 :(得分:4)
如果您(或其他任何人)想要一个已完成的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.
您可以使用TClosePanel.Position属性设置关闭按钮(我默认为16x16像素而不是Andreas默认的32x32)的位置。如果将此值设置为posCustom以外的任何其他值,则只要面板(或按钮)改变大小,它就会在面板周围自动移动。如果将其设置为posCustom,则必须使用公开的CloseBtn属性自行控制放置。然后,您可能需要更改Andreas的文件以显示Anchors,Visible,Top,Left,Width和Height属性。将代码中的PUBLISHED部分改为:
published
property Anchors;
property Enabled;
property Height;
property Left;
property Top;
property Visible;
property Width;
property OnClick;
property OnMouseUp;
property OnMouseDown;
end;