7

有几个第三方控件（例如Raize Components）具有关闭的“十字”按钮“选项”（例如页面控件）。我的要求更简单，我想将右上方对齐的十字“按钮”放在 TPanel 上并访问其单击事件。是否有一种简单的方法可以在不创建 TPanel 后代的情况下执行此操作，或者是否有我可以使用的付费或免费库组件？

4

3 回答 3

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.

示例（启用和不启用主题）：

截屏 截屏

只需将其放在TPanel右上角并设置Anchors为顶部和右侧。

于 2011-07-01T16:21:11.970 回答
4

我相信您可以从Torry's或任何其他类似网站免费找到大量此类组件……但是，如果您只需要在单个面板上使用此类功能，则将按钮放到面板上，将其锚定到右上角，你就完成了。如果您还想在该面板上有“字幕区域”，那么可能需要更多的工作......

顺便说一句，如果您安装了JVCL，那么您已经安装了这样的组件 - 它称为 TjvCaptionPanel 或类似的。

于 2011-07-01T16:05:41.873 回答
4

如果您（或其他任何人）想要一个完成的 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.

您可以使用 TClosePanel.Position 属性设置关闭按钮的位置（我默认为 16x16 像素，而不是 Andreas 默认的 32x32）。如果您将此设置为 posCustom 以外的任何其他值，那么只要面板（或按钮）更改大小，它就会自动在面板周围移动。如果将其设置为 posCustom，则必须使用公开的 CloseBtn 属性自行控制放置。然后您可能需要更改 Andreas 的文件以公开 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;
于 2011-07-02T05:43:07.293 回答