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

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


person Brian Frost    schedule 01.07.2011    source источник
comment
Что плохого в том, чтобы перетащить TImage на TPanel, привязать его справа и сверху, поместить в него растровое изображение, дважды щелкнуть по нему и написать свой обработчик? Без подклассов. Почти без кода. 100% время разработки.   -  person Warren P    schedule 01.07.2011
comment
@Warren P: Это растровое изображение не будет отражать текущую тему и всегда будет выглядеть одинаково, независимо от того, отключен ли элемент управления, активен или нажат. И мой контроль также 100% времени разработки. Просто поместите его на панель и закрепите.   -  person Andreas Rejbrand    schedule 01.07.2011
comment
Мне нравится твой компонент. Но я спрашиваю, почему простое изображение не подходит по стандартам Брайана, ведь он ОП.   -  person Warren P    schedule 01.07.2011


Ответы (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 вверху и справа.

person Andreas Rejbrand    schedule 01.07.2011
comment
Вы такие милые :-) Спасибо +1 и принято исключительно за усилия! Брайан. - person Brian Frost; 02.07.2011
comment
Возможно, дело в Delphi 7, но WM_MOUSELEAVE в WdnProc никогда не обрабатывается. Вы должны реализовать код mouseleave, используя procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;. Тогда это работает. - person The_Fox; 02.03.2012

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

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

person ain    schedule 01.07.2011

И если вам (или кому-то еще) нужна законченная панель 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;
person HeartWare    schedule 02.07.2011