Question

我想拥有自己的标题栏，因此我基本上使用了一个面板（名称：pnCaption）并删除了CreateParams中的原始标题栏。但是在新面板中通过MouseDown-MouseMove移动窗口的能力是个问题。

通常你会使用NCHITTEST消息。但如果鼠标位于面板上（我自己的标题），则不会发出此信号。见代码......

procedure TForm1.CreateParams(var params: TCreateParams);  
begin  
  inherited Createparams(Params);  
  with Params do  
    Style := (Style or WS_POPUP) and (not WS_DLGFRAME);  
end;  

procedure TForm1.WM_NCHitTest(var Msg: TWMNcHitTest);  
begin  
  inherited;  
  if PtInRect(pnCaption.BoundsRect, ScreenToClient(Point(Msg.XPos, Msg.YPos)))  
      then Msg.Result := HTCAPTION;  
end;

我很感激任何提示如何完成这项任务。

基督教

Answer 1

通过使用带有WM_SYSCOMMAND消息的“Magic”$ F012数字，您可以随时通过任何具有mousedown事件的控件拖动窗口。这是我从Ray Kanopka（优秀的raize组件的作者）中汲取的东西，但我不再记得这是如何传授给我的。

这也是一种简洁明了的方法，允许用户通过给他们一个看起来像标题的面板标签来移动无边框表单。例如，我使用它来允许用户移动无边框的对话框：

procedure TAbout_Dlg.LblTitleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  sc_DragMove = $F012;
begin
  ReleaseCapture;
  Perform( wm_SysCommand, sc_DragMove, 0 );
end;

Answer 2

当我查看自定义StatusBar组件的旧代码（它是TWinControl的后代）时，为了使用StatusBar的handle提供表单大小调整，我们在控件中处理WM_NCHITTEST，而不是在表单中并返回HTBOTTOMRIGHT：

procedure TElStatusBar.WMNCHitTest;
var
  P : TPoint;

  function InGrip(Point : TPoint) : boolean;
  var
    r : TRect;
  begin
    R := ClientRect;
    R.Left := R.Right - R.Bottom + hMargin;
    result := PtInRect(R, Point);
  end;

begin
  if not FSizeGrip then
  begin
    inherited;
    exit;
  end;
  P := ScreenToClient(Point(Message.XPos, Message.YPos));
  if InGrip(P) and (TForm(Parent).WindowState = wsNormal)
    and (TForm(Parent).BorderStyle in [bsSizeable, bsSizeToolWin]) then
    Message.Result := HTBOTTOMRIGHT
  else
    inherited;
end;

这意味着您需要实现面板组件的后代（或挂钩它的消息处理）并在那里处理WM_NCHITTEST。

另外，我将在表单中处理WM_NCCALCSIZE和WM_NCPAINT消息的路由，以便提供您自己的标题区域并避免使用TPanel或其他控件。但这只是我的偏好。

Answer 3

最简单的方法可能是使用一个没有HWND窗口句柄的组件，因此无法接收消息。它们将被传递到您的表单，您可以按照您在问题中显示的方式处理它们。

只需将TPanel替换为顶部对齐的TPaintBox，TImage或类似的TGraphicControl后代，即可使代码正常运行。您保留表单的消息处理和VCL的对齐支持。

Answer 4

不完全是您正在寻找的，但对于对类似技术感兴趣的其他人，这里是TLabel后代组件的代码，可以作为标题栏：

unit Draglbl;

interface

uses
  WinTypes, WinProcs, Classes, Graphics, Controls, Forms, StdCtrls;

type
  TDragWindowTitle = class(TCustomLabel)
  private
    { Private declarations }
    _lastx,
    _lasty  : integer ;
  protected
    { Protected declarations }
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override ;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override ;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property Alignment;
    property Caption;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation
constructor TDragWindowTitle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner) ;
  color := clActiveCaption ;
  font := TForm(AOwner).Font ;
  font.color := clCaptionText ;
  Align := alTop ;
  AutoSize := false ;
  ShowAccelChar := false ;
  Transparent := false ;
end ;

procedure TDragWindowTitle.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then begin
    TForm(owner).left := TForm(owner).left+(x-_lastx) ;
    TForm(owner).top := TForm(owner).top+(y-_lasty) ;
  end ;

  inherited MouseMove(shift,x,y) ;
end ;

procedure TDragWindowTitle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then begin
    _lastx := x;
    _lasty := y ;
  end ;
end ;

procedure Register;
begin
  RegisterComponents('MYCOMPONENTS', [TDragWindowTitle]);
end;

end.

使用“拖动区域”移动无标题窗口

4 个答案: