Moving a caption-less window by using a "drag area"

Question

I would like to have my own caption bar and therefore I am using basically a panel (Name: pnCaption) and remove the original caption bar in CreateParams. But the ability to move the window by MouseDown-MouseMove in the new panel is a problem.

Normally you would use the NCHITTEST message. BUT this isn't signaled if the mouse is over the panel (my own caption). See code ...

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;  

I would appreciate any hints how to accomplish that task.

Christian

Answer 1

As I am looking into our old code for custom StatusBar component, which is descendant of TWinControl, to provide form resizing using StatusBar's grip we handle WM_NCHITTEST in the control, not in the form and return 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;

This means that you need to implement descendant of your panel component (or hook it's message handling) and handle WM_NCHITTEST there.

Also, I'd go the route of handling WM_NCCALCSIZE and WM_NCPAINT messages in the form in order to provide your own caption area and avoid using TPanel or other control. But this is only my preference.

Answer 2

The easiest way is probably to use a component that hasn't a HWND window handle and therefore can't receive messages. They will be passed to your form, where they can be handled the way you show in your question.

Simply replacing the TPanel with a top-aligned TPaintBox, TImage or similar TGraphicControl descendant would make your code work. You keep both the message handling of the form and the alignment support of the VCL.

Answer 3

Not exactly what you're looking for, but for others interested in a similar technique, here's code for a TLabel-descended component that can serve as a caption bar:

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

You can always drag a window by any control that has a mousedown event by using the "Magic" $F012 number with a WM_SYSCOMMAND message. It's something I picked up from Ray Kanopka (author of the excellent raize components), but I no longer remember how this was imparted to me.

It is also a neat and simple way of allowing users to move borderless forms by giving them a label of panel that looks like a caption. For example, I use it to allow users to move a borderless about dialog:

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;