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?
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