| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

SC_DRAGMOVE [D7]

иванс ©   (2008-04-09 18:22:00) 

Есть форма без заголовка, требуется при клике по ней сделать:
её перемещение или вызов 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;

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

---

{RASkov}   (2008-04-09 19:28:00) [1]

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

---

{RASkov}   (2008-04-09 19:18:00) [2]

Но лучше наверное чтонить так:
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:11:00) [3]

> [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:02:00) [4]

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

---

{RASkov}   (2008-04-09 18:58:00) [5]

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

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

---

иванс   (2008-04-09 18:50:00) [6]

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

НО!

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

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

---

Palladin   (2008-04-09 18:32:00) [7]

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

---

Наверх