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

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或其他控件.但这只是我的偏好.