How best to create a TPanel with a close 'cross' button in the top right?

Asked 1/7, 2011 at 15:53 Answered 2/7, 2011 at 5:43

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?

Falsity answered 1/7, 2011 at 15:53 Comment(3)

What's wrong with dropping a TImage on the TPanel, anchor it right and top, and put a bitmap in it, and double click it and write your handler? No subclassing. Almost no code. 100% designtime. – Mathian 1/7, 2011 at 17:13

@Warren P: That bitmap will not reflect the current theme, and it will always look the same, no matter if the control is disabled, hot, or depressed. And my control is also 100 % design-time. Just drop it on the panel and anchor it. – Florance 1/7, 2011 at 17:19

I love your component. But I'm asking why a plain image isn't okay by Brian's standards, since he's the OP. – Mathian 1/7, 2011 at 19:50

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):

Screenshot

Just put this in a TPanel at the top-right corner and set Anchors to top and right.

Florance answered 1/7, 2011 at 16:21 Comment(2)

You are so sweet :-) Thank you +1 and accepted purely for the effort! Brian. – Falsity 1/7, 2011 at 20:26

Maybe it's a Delphi 7 thing, but the WM_MOUSELEAVE in WdnProc is never handled. You have to implement the mouseleave code using procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;. Then it works. – Ambary 2/3, 2012 at 14:10

I'm sure you can find a ton of such a components available for free from Torry's or any other similar site... however, if you only need such a feature on a single panel, then drop an button onto panel, anchor it to top-right corner and youre done. If you also want to have "caption area" on that panel, then it might be bit more work...

BTW if you have JVCL installed then you already have such a component installed - it is called TjvCaptionPanel or similar.

Crystallo answered 1/7, 2011 at 16:5 Comment(0)

And if you (or anyone else) want a finished TClosePanel (with the added optional functionality to propagate the Enabled property down through the contained controls), I have written one for you:

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.

You can set the position of the Close Button (which I have defaulted to 16x16 pixels instead of the 32x32 of Andreas' default) using the TClosePanel.Position property. If you set this to any other value than posCustom, then it'll auto-move around the panel whenever the panel (or the button) changes size. If you set it to posCustom, you'll have to control the placement yourself with the exposed CloseBtn property. You may then need to alter Andreas' file to expose the Anchors, Visible, Top, Left, Width and Height properties. Alter the PUBLISHED section in his code to the following:

  published
    property Anchors;
    property Enabled;
    property Height;
    property Left;
    property Top;
    property Visible;
    property Width;
    property OnClick;
    property OnMouseUp;
    property OnMouseDown;
  end;

Cavie answered 2/7, 2011 at 5:43 Comment(0)

Recommended topics

Hot tags