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

Вниз

Проблемы с отловом события WM_MBUTTONUP   Найти похожие ветки 

 
demon ©   (2008-11-06 15:26) [0]

После добавления обработчика событий WM_NCHITTEST перестают отлавливаться события с обработчитка WM_MBUTTONUP.
Как востановить реакцию формы на события средней клавиши мыши?

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
 private
   procedure MidleClick(var Msg: TMessage); message  WM_MBUTTONUP ;
   procedure WMNCHITTEST(var WMNChitTest: TWMNCHITTEST); message WM_NCHITTEST;
 public
 protected
   procedure CreateParams(var Params: TCreateParams); override;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MidleClick ;
begin
if  Form1.WindowState <> wsMaximized
 then Form1.WindowState := wsMaximized
 else Form1.WindowState := wsNormal;
end;

procedure TForm1.WMNCHITTEST(var WMNChitTest: TWMNCHITTEST);
begin
 inherited;
 if WMNChitTest.Result = HTClient then
   WMNChitTest.Result := hTCaption;
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 with Params do
   Style := (Style OR WS_POPUP) AND NOT WS_DLGFRAME;
end;

end.


 
Vlad Oshin ©   (2008-11-06 16:01) [1]

а зачем так?

можно
обрабатывать нажатие левой, взвести флаг
обрабатывать отпускание левой, сбросить флаг
если флаг и перемещение мыши, то можно таскать окно


 
demon ©   (2008-11-06 16:20) [2]

Это в обработчике WM_NCHITTEST"a выполнять нужно?
Про флаг при нажатии и отпускании ясно.
Как определить перемещение мыши?


 
Vlad Oshin ©   (2008-11-06 16:27) [3]

WM_MOUSEMOVE


 
demon ©   (2008-11-06 16:55) [4]

Наверное WMNCHITTEST обрабатываеться раньше чем TForm1.FormMouseDown...
Следующий код не работает, хотя все как вы советовали (только без WM_MOUSEMOVE )

var mousedownflag: bool;

procedure TForm1.MidleClick ;
begin
if  Form1.WindowState <> wsMaximized
 then Form1.WindowState := wsMaximized
 else Form1.WindowState := wsNormal;
end;

procedure TForm1.WMNCHITTEST(var WMNChitTest: TWMNCHITTEST);
begin
 inherited;

if mousedownflag and (WMNChitTest.Result = HTClient)  then
   WMNChitTest.Result := hTCaption;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if  Button=mbLeft then
 mousedownflag:=true;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if  Button=mbLeft then
 mousedownflag:=false;
end;


 
Vlad Oshin ©   (2008-11-06 17:04) [5]

да, скорее всего раньше

обрабатывать нажатие левой, взвести флаг
обрабатывать отпускание левой, сбросить флаг


Предлагаю ставить на
 WM_LBUTTONDOWN      = $0201;
 {$EXTERNALSYM WM_LBUTTONUP}
 WM_LBUTTONUP        = $0202;


 
demon ©   (2008-11-06 23:42) [6]

Тоже ничего не получаеться, вернее сказать получаеться совсем не то что надо...
Может у кого-небудь есть еще идеи?


 
Leonid Troyanovsky ©   (2008-11-07 11:13) [7]


> demon ©   (06.11.08 23:42) [6]

procedure MidleClick(var Msg: TMessage); message  WM_NCMBUTTONUP;

--
Regards, LVT.


 
Vlad Oshin ©   (2008-11-07 11:25) [8]

Навскидку
может это доработать получится?

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
private
  fl:byte;
  procedure MidleClick(var Msg: TMessage); message  WM_MBUTTONUP;
  procedure LBUTTONDOWNClick(var Msg: TMessage); message  WM_LBUTTONDOWN;
  procedure LBUTTONUPClick(var Msg: TMessage); message  WM_LBUTTONUP;
  procedure WM_MOUSEMOVEClick(var Msg: TMessage); message  WM_MOUSEMOVE;
public
protected
  procedure CreateParams(var Params: TCreateParams); override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.LBUTTONDOWNClick(var Msg: TMessage);
begin
 fl:=1;
end;

procedure TForm1.LBUTTONUPClick(var Msg: TMessage);
begin
 fl:=0;
end;

procedure TForm1.MidleClick ;
begin
if  Form1.WindowState <> wsMaximized
then Form1.WindowState := wsMaximized
else Form1.WindowState := wsNormal;
end;

procedure TForm1.WM_MOUSEMOVEClick(var Msg: TMessage);
begin
  if fl=1 then
  begin
     fl:=0;
     form1.top:=msg.LParamHi;
     form1.left:=msg.LParamLo;
     fl:=1;
  end;
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := (Style OR WS_POPUP) AND NOT WS_DLGFRAME;
fl:=0;
end;

end.


 
Vlad Oshin ©   (2008-11-07 11:33) [9]


> WM_NCMBUTTONUP

блинн...
:)


 
demon ©   (2008-11-07 13:06) [10]

О как все просто! :))
Спасибо!



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

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

Наверх





Память: 0.47 MB
Время: 0.006 c
3-1211360976
MegaVolt
2008-05-21 13:09
2008.12.14
Посоветуйте базу данных


15-1223364033
Vlad Oshin
2008-10-07 11:20
2008.12.14
Предложение по оформлению.


2-1225707879
FatBoySlim
2008-11-03 13:24
2008.12.14
Как передать в MySQL в качестве параметра текст SQL запроса?


4-1202232215
Dmitry S
2008-02-05 20:23
2008.12.14
"Прибить" повторный запуск моей проги.


2-1225802468
D7
2008-11-04 15:41
2008.12.14
StringList





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