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

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

Проблемы с отловом события WM_MBUTTONUP

demon ©   (2008-11-06 15:26:00) 

После добавления обработчика событий 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.


---

demon   (2008-11-07 13:06:00) [1]

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

---

Vlad Oshin   (2008-11-07 11:33:00) [2]

> WM_NCMBUTTONUP

блинн...
:)

---

Vlad Oshin   (2008-11-07 11:25:00) [3]

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

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.

---

Leonid Troyanovsky   (2008-11-07 11:13:00) [4]

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

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

--
Regards, LVT.

---

demon   (2008-11-06 23:42:00) [5]

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

---

Vlad Oshin   (2008-11-06 17:04:00) [6]

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

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

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

---

demon   (2008-11-06 16:55:00) [7]

Наверное 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 16:27:00) [8]

WM_MOUSEMOVE

---

demon   (2008-11-06 16:20:00) [9]

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

---

Vlad Oshin   (2008-11-06 16:01:00) [10]

а зачем так?

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

---

Наверх