Текущий архив: 2008.05.04;
Скачать: CL | DM;

Вниз

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;

---

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

Но лучше наверное чтонить так:
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 пикселей)

---

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

или так, Релиз:
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;
За имена сорри..)

---

Страницы: 1 вся ветка

Текущий архив: 2008.05.04;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.011 c