Как лучше всего создать TPanel с кнопкой "крестик" в правом верхнем углу?

Question

Как лучше всего создать TPanel с кнопкой "крестик" в правом верхнем углу?

Существует несколько элементов управления третьего уровня (таких как Raize Components), которые имеют опцию "крестик" кнопки "Закрыть" (например, элемент управления страницы). Мое требование более простое, я хотел бы вставить перекрестную "кнопку", выровненную в верхнем правом углу, на TPanel и получить доступ к событию clicked. Есть ли простой способ сделать это без создания потомка TPanel, или есть платный или бесплатный библиотечный компонент, который я могу использовать?

7

delphi button tpanel

Источник

user47012 01 июл '11 в 15:53

3 ответа

Решение

И если вы (или кто-либо еще) хотите, чтобы готовый 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 по умолчанию для Andreas), используя свойство TClosePanel.Position. Если вы установите для него любое другое значение, кроме posCustom, то оно будет автоматически перемещаться по панели всякий раз, когда панель (или кнопка) изменяет размер. Если вы установите его в posCustom, вам придется самостоятельно управлять размещением с помощью открытого свойства CloseBtn. Затем вам может понадобиться изменить файл Андреаса, чтобы выставить свойства Anchors, Visible, Top, Left, Width и Height. Измените ОПУБЛИКОВАННЫЙ раздел в его коде следующим образом:

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

4

Источник

user96201 02 июл '11 в 05:43

Я уверен, что вы можете найти тонну таких компонентов, доступных бесплатно на Torry или любом другом подобном сайте... однако, если вам нужна такая функция только на одной панели, тогда перетащите кнопку на панель, закрепите ее на верхний правый угол и все готово. Если вы также хотите иметь "область заголовка" на этой панели, то это может быть немного больше работы...

Кстати, если у вас установлен JVCL, значит, у вас уже установлен такой компонент - он называется TjvCaptionPanel или аналогичным.

4

Источник

user723693 01 июл '11 в 16:05

Другие вопросы по тегам delphi button tpanel

user282848 01 июл '11 в 16:21 2011-07-01 16:21 · Accepted Answer · 2011-07-01 16:21

Я написал контроль для вас.

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.

Пример (с включенными и не включенными темами):

http://privat.rejbrand.se/closebuttonaero.png http://privat.rejbrand.se/closebuttonclassic.png

Просто поместите это в TPanel в правом верхнем углу и установить Anchors сверху и справа.