Главная страница
    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.006 c
2-1207638630
MKS_
2008-04-08 11:10
2008.05.04
сбросить modal


2-1207485828
TRSteep
2008-04-06 16:43
2008.05.04
Выравнивание


15-1205919660
Empleado
2008-03-19 12:41
2008.05.04
Три закона А. Кларка


15-1205948943
Express
2008-03-19 20:49
2008.05.04
Компонент для Клавиатурного тренажерa


2-1207568244
azamatufa
2008-04-07 15:37
2008.05.04
Редактирование даты в БД





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский