Перемещение окна без заголовков с помощью «области перетаскивания»

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

Вы всегда можете перетащить окно любым элементом управления, у которого есть событие mousedown, используя номер "Magic" $ F012 с сообщением WM_SYSCOMMAND. Это то, что я подобрал у Рэя Канопки (автора отличных компонентов 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, мы обрабатываем 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

Не совсем то, что вы ищете, но для тех, кто интересуется подобной техникой, вот код для компонента 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.

Answer 4

Самый простой способ - это использовать компонент, который не имеет дескриптора окна HWND и поэтому не может получать сообщения. Они будут переданы в вашу форму, где они могут быть обработаны так, как вы указали в своем вопросе.

Простая замена TPanel на потомок TPaintBox, TImage или аналогичный TGraphicControl с выравниванием сверху сделает ваш код работоспособным. Вы сохраняете как обработку сообщений формы, так и поддержку выравнивания VCL.