Существует несколько сторонних элементов управления (таких как компоненты Raize), которые тесно связаны между собой. ' кнопка 'опция' (например, управление страницей). Мое требование проще, я хотел бы поместить перекрестную кнопку, выровненную вверху справа, на TPanel и получить доступ к событию, на которое она нажала. Есть ли простой способ сделать это без создания потомка TPanel, или есть платный или бесплатный библиотечный компонент, который я могу использовать?
Как лучше всего создать TPanel с кнопкой закрытия «крест» в правом верхнем углу?
Ответы (3)
Я написал контроль для вас.
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;
. Тогда это работает.
- person The_Fox; 02.03.2012
Я уверен, что вы можете найти массу таких компонентов бесплатно на Torry's или любом другом подобном сайте... однако, если вам нужна такая функция только на одной панели, поместите кнопку на панель, привяжите ее к верхнему правому углу, и все готово. Если вы также хотите иметь «область заголовка» на этой панели, тогда это может быть немного сложнее...
Кстати, если у вас установлен JVCL, то у вас уже установлен такой компонент - он называется TjvCaptionPanel или аналогичный.
И если вам (или кому-то еще) нужна законченная панель 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.
Вы можете установить положение кнопки «Закрыть» (которое по умолчанию я установил на 16x16 пикселей вместо 32x32 пикселей по умолчанию, как у Андреаса), используя свойство TClosePanel.Position. Если вы установите для этого любое другое значение, кроме posCustom, то оно будет автоматически перемещаться по панели всякий раз, когда панель (или кнопка) меняет размер. Если вы установите для него значение posCustom, вам придется самостоятельно контролировать размещение с помощью открытого свойства CloseBtn. Затем вам может понадобиться изменить файл Андреаса, чтобы открыть свойства 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;