Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.05.04;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.005 c
15-1206283466
Илья
2008-03-23 17:44
2008.05.04
Подскажите, как можно перехватить все запускающиеся приложения?


4-1188562548
Krants
2007-08-31 16:15
2008.05.04
GetTextExtentPoint32 при


2-1207655460
molodoi
2008-04-08 15:51
2008.05.04
Проблема с динамическим добавлением полей


2-1207419208
AndrewG
2008-04-05 22:13
2008.05.04
Копирование


15-1206100087
Пробегал2...
2008-03-21 14:48
2008.05.04
COM-порты





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский