Move borderless form with right mouse button in Delphi

357 views Asked by At

I have this code from the internet to drag a borderless form by holding the Left mouse button down:

procedure TForm6.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState;X,Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
  end;
end;

It works fine but I need to drag by Right mouse button. Which parameter must be changed for this?

2

There are 2 answers

2
AmigoJack On BEST ANSWER

How to move window by right mouse button using C++? has a solution which handles the dragging itself, instead of letting Windows do it. Projecting that work from MFC needs one to know what Delphi's Forms already handle, instead of overly calling WinApi functions.

One major issue is to incorporate a window's caption height, which can rely on multiple factors. In my example I used a normal one for a sizable window and it works as expected using Windows 7 without any theme (looks like Windows 95). Having no caption, or having a tool window, or having no border, or having a window which can't be sized needs the calls to GetSystemMetrics() adjusted.

I incorporated both: dragging by left mouse button and by right mouse button. Although I encourage still displaying a potential context menu at the end of the dragging (like the Explorer does so for dragging files), because it's still a right mouse button and every user expects a popup menu for that click.

My example also works for both: bound to either a TWinControl or to the TForm itself.

unit Unit1;

interface

uses
  Windows, Messages, Classes, Controls, Forms, ExtCtrls;

const
  SC_DRAGMOVE=         SC_MOVE or $0002;  // The four low-order bits of the wParam parameter are used internally by the system
  SM_CXPADDEDBORDER=   92;

type
  TForm1= class( TForm )
    Panel1: TPanel;
    procedure Panel1MouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
    procedure FormMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
    procedure FormMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
  private
    vStart: TPoint;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Mouse button is pressed down and held
procedure TForm1.Panel1MouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  case Button of
    mbLeft: begin  // Dragging through left mouse button
      ReleaseCapture();  // Restore normal mouse input processing; self.MouseCapture is already FALSE at this point
      self.Perform( WM_SYSCOMMAND, SC_DRAGMOVE, 0 );  // Handles all the rest of dragging the window
    end;

    mbRight: begin  // Through right mouse button
      GetCursorPos( self.vStart );  // Remember position on form, relative to screen
      self.vStart:= self.ScreenToClient( self.vStart );
      Inc( self.vStart.Y, GetSystemMetrics( SM_CYCAPTION )  // Window title height
                        + GetSystemMetrics( SM_CXPADDEDBORDER )  // Width of potential border padding
                        + GetSystemMetrics( SM_CYSIZEFRAME )  // Height of a potential window border when sizable; SM_CYEDGE is not enough
      );

      self.MouseCapture:= TRUE;  // WinApi: SetCapture( Handle )
    end;
  end;
end;

// Mouse is moved, unrelated to button status; must be handled by form, not panel
procedure TForm1.FormMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
var
  pt: TPoint;
begin
  if self.MouseCapture then begin  // WinApi: GetCapture()= Handle
    GetCursorPos( pt );  // Position on desktop

    Dec( pt.X, self.vStart.X );  // Subtract relative starting position
    Dec( pt.Y, self.vStart.Y );

    MoveWindow( self.Handle, pt.X, pt.Y, self.Width, self.Height, TRUE );  // Reposition window by horizontal and vertical deltas
  end;
end;

// Mouse button is released; must be handled by form, not panel
procedure TForm1.FormMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  if Button= mbRight then self.MouseCapture:= FALSE;  // End dragging
end;

Note that initiating the dragging is bound to the control's OnMouseDown event, but handling and ending the dragging must be bound to the form's events:

object Form1: TForm1
  OnMouseMove = FormMouseMove
  OnMouseUp = FormMouseUp
  object Panel1: TPanel
    OnMouseDown = Panel1MouseDown
  end
end
3
dwrbudr On

It could be done in another way.

In interface section:

  TMyForm = class(TForm)
  private
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  end;

In implementation section:

procedure TMyForm.WMNCHitTest(var Msg: TWMNCHitTest);
begin
    inherited;   
    Msg.Result := HTCAPTION;
end;