Как лучше всего создать TPanel с кнопкой «крестик» в правом верхнем углу? - PullRequest
7 голосов
/ 01 июля 2011

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

Ответы [ 3 ]

19 голосов
/ 01 июля 2011

Я написал для вас элемент управления.

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

4 голосов
/ 02 июля 2011

И если вы (или кто-либо еще) хотите получить готовую TClosePanel (с дополнительными дополнительными функциями для распространения свойства Enabled через содержащиеся в нем элементы управления), я написал для вас один:можно установить положение кнопки «Закрыть» (по умолчанию я выбрал 16x16 пикселей вместо 32x32 по умолчанию для Andreas), используя свойство TClosePanel.Position.Если вы установите для него любое другое значение, кроме posCustom, то оно будет автоматически перемещаться по панели всякий раз, когда панель (или кнопка) изменяет размер.Если вы установите его в posCustom, вам придется самостоятельно управлять размещением с помощью открытого свойства CloseBtn.Затем вам может понадобиться изменить файл Андреаса, чтобы открыть свойства «Якоря», «Видимый», «Вверх», «Влево», «Ширина» и «Высота».Измените ОПУБЛИКОВАННУЮ секцию в его коде следующим образом:

  published
    property Anchors;
    property Enabled;
    property Height;
    property Left;
    property Top;
    property Visible;
    property Width;
    property OnClick;
    property OnMouseUp;
    property OnMouseDown;
  end;
4 голосов
/ 01 июля 2011

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

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

...