SC_DRAGMOVE

← →
иванс (2008-04-09 18:22) [0]

Есть форма без заголовка, требуется при клике по ней сделать:
её перемещение или вызов PopupMenu.Popup(); в разных случаях - если пользователь кликнул и стал перемещать мышку - то перемещать форму; а если просто кликнул - то сделать PopupMenu.Popup().

Код перемещения такой:
procedure Form1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const SC_DRAGMOVE = $F012; begin if Button = mbLeft then begin ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0); end; end;

Как это сделать?

← →
Palladin © (2008-04-09 18:32) [1]

нужно реализовать на OnMouseUp проверку двигали форму или нет...

← →
иванс (2008-04-09 18:50) [2]

Странно получается. Сдалал проверку на перемещение. И в случае если положение не изменилось в OnMouseUp делаю PopupMenu.Popup.

НО!

OnMouseUp Срабатывает только для правой кнопки. Для левой не срабатывает. Виной тому видимо код в OnMouseDown.

Как исправить?

← →
{RASkov} © (2008-04-09 18:58) [3]

> [2] иванс (09.04.08 18:50)
> Как исправить?

переместить в маусап?

← →
{RASkov} © (2008-04-09 19:02) [4]

Не [3] не верно...

← →
{RASkov} © (2008-04-09 19:11) [5]

> [2] иванс (09.04.08 18:50)

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var P: TPoint;
begin
P:=ClientToScreen(Point(X,Y));
PopupMenu1.Popup(P.X, P.Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);
end;

Но лучше наверное чтонить так:
var DownPos: TPoint; function VerPoints(const P, P1: TPoint): Boolean; begin Result:=(ABS(P.X-P1.X)<10) and (ABS(P.Y-P1.Y)<10); end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin DownPos:=Point(X, Y); end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; begin P:=ClientToScreen(Point(X,Y)); PopupMenu1.Popup(P.X, P.Y); end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if not VerPoints(DownPos, Point(X, Y)) then ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, $F012, 0); end;
Есть возможность прощения нечаенного смещения мышки при нажатии аж на 10 пикселей)

или так, Релиз:
var DownPos: TPoint; ShiftPos: Boolean; function VerPoints(const P, P1: TPoint): Boolean; begin Result:=(ABS(P.X-P1.X)<10) and (ABS(P.Y-P1.Y)<10); end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button<>mbLeft then Exit; DownPos:=Point(X, Y); ShiftPos:=False; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if not (ssLeft in Shift) then Exit; if not ShiftPos then ShiftPos:=not VerPoints(DownPos, Point(X, Y)); if not ShiftPos then Exit; ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, $F012, 0); end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; begin P:=ClientToScreen(Point(X,Y)); PopupMenu1.Popup(P.X, P.Y); end;
За имена сорри..)

SC_DRAGMOVE Найти похожие ветки