如何最好地创建右上角密切的“十字”按钮TPanel？ [英] How best to create a TPanel with a close 'cross' button in the top right?

问题描述

有几个第三pary控件（如 Raize组件的），其中有一关闭交叉按钮选项（例如网页控制）。我的要求是简单，我想plonk的上一个TPanel十字按钮排列右上角并访问其点击事件。是否有任何doint这一个简单的方法，而无需创建一个TPanel后代，或者是有一个免费或付费的库组件，我可以使用？

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?

推荐答案

我写了一个控制你。

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

只是把这个在 TPanel 在右上角，并设置锚顶部和右侧。

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

这篇关于如何最好地创建右上角密切的“十字”按钮TPanel？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！