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

Вниз

popup menu при перетаскивании за клиент. область   Найти похожие ветки 

 
click   (2006-10-23 18:18) [0]

Для перетаскивания формы за клиентскую область использую следующий код:

procedure TForm1.WMNCHitTest(var m:TWMNCHitTest);
begin
inherited;
if m.Result=htclient then          
m.Result:=htcaption;
   end;


теперь возникла необходимость установить поп"ап меню на этой же форме... только вот есть проблема: не "поп"апится" :) оно, да и событие onclick с условием на правую кнопку не наступает никогда (чтоб вручную заставить его "выпасть")...
Подскажите плиз как изменить приведенный код так чтоб он позволял обрабатывать и другие события на форме, либо как с этим кодом заставить меню "выпадать"


 
Джо ©   (2006-10-23 18:26) [1]

Приведенный код обманным путем создает видимость того, что щелкнули не на клиенской области, а на заголовке окна. Как его можно исправить? Да никак не нужно. Его нужно переписать. Например, так:

 TForm1 = class(TForm)
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   LastPt: TPoint;
   Moving: Boolean;
 end;
...
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Button = mbLeft then
 begin
   LastPt.X := X;
   LastPt.Y := Y;
   Moving := True;
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 Moving := False
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if Moving then
 begin
   Left := Left + X - LastPt.X;
   Top := Top + Y - LastPt.Y;
 end;
end;


:)


 
click   (2006-10-23 18:38) [2]


> Джо ©   (23.10.06 18:26) [1]
>
> Приведенный код обманным путем создает видимость того, что
> щелкнули не на клиенской области, а на заголовке окна.


ну это та я понимаю ... ;)


>Его нужно переписать. Например, так:


спасибо Джо ! Но так хотелось что-нибудь коротенькое...
об этом варианте (неповериш естественно :) ) я думал... но корявенький он какой то... но как бы там ни было, спасибо!!!


 
Ketmar ©   (2006-10-23 18:38) [3]

>[1] Джо(c) 23-Oct-2006, 18:26
садюга.

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y:Integer);
const
 SC_DRAGMOVE = $F012;
begin
 // Если нужно вывести меню - выходим, а по левой кнопке просто перетаскиваем.
 if Button=mbRight then exit;
 ReleaseCapture();
 Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;


 
click   (2006-10-23 18:47) [4]


> Ketmar ©   (23.10.06 18:38) [3]


ты лучший!


 
Palladin ©   (2006-10-23 18:51) [5]


> click

гыгы... а много "чудовищ", не вызваших Кэтмара на бой или хотя бы не тех кто не развел его на код, сомневаются...
однако, не умеют разводить :)


 
Ketmar ©   (2006-10-23 18:51) [6]

>[4] click 23-Oct-2006, 18:47
>ты лучший!
это не я. это поисковики. %-) я только процитировал. %-)



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

Форум: "Основная";
Текущий архив: 2006.12.03;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.46 MB
Время: 0.048 c
15-1163270446
Cyrax spectre
2006-11-11 21:40
2006.12.03
Имею ли я право на реабилитацию или УДО ?


15-1163324692
Kerk
2006-11-12 12:44
2006.12.03
Фонарь


15-1163750633
Anatoly Podgoretsky
2006-11-17 11:03
2006.12.03
Новости APC


2-1163598133
КлЯкСа
2006-11-15 16:42
2006.12.03
Где можно счачать из из инета Русский help для Delphi?


15-1163092237
*Стажер*
2006-11-09 20:10
2006.12.03
Хочю делать как Ketmar. :)





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