| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как программно закрыть PopupMenu и отлавливать указатель мыши [D7, WinXP]
Max_005 © (2005-04-19 16:22:00)Как программно закрыть TPopupMenu на одном компоненте(на котором оно было открыто) и расскрыть его на другом компаненте при наведении указателя мыши на него(на другой такой же компонент? Может действительно мышиный хук организовать? как это сделать в таком случае?
Димастый (2005-05-29 12:41:00) [1]Удалено модератором
Примечание: В своей ветке свои вопросы.
Димастый (2005-05-29 03:12:00) [2]Cobalt ошибка какая-то в том, что этот код с кнопкой работает, а с моим компонентом нет...
Cobalt (2005-05-29 01:59:00) [3]Да, кстати, совсем упустил - в чём ошибка-то?
Из поста Димастый (28.05.05 22:27) [32]
совершенно непонятно - в чём проблема?
Димастый (2005-05-28 23:02:00) [4]Да немного да понимаю что делает код... Подскажите где хоть ошибка?
Cobalt (2005-05-28 22:55:00) [5]2 Димастый (28.05.05 22:27) [32]
А у меня этот код делает вот что:
раскрывает меню по правой кнопке, и при перемещении мышки от одной кнопки к другой раскрывает меню у новой кнопки.
Процитирую Piter © (23.04.05 23:56) [30] :)
ок, начнем заново, будем учить рекурсию.
Итак, смотри пост [24]
Димастый (2005-05-28 22:27:00) [6]Вот код который 100% работает у меня с Button:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
PopupMenu2: TPopupMenu;
PopupMenu3: TPopupMenu;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure PopupMenu2Popup(Sender: TObject);
procedure PopupMenu3Popup(Sender: TObject);
private
procedure OnHookEvent(MouseEvent: WPARAM; Struct: PMouseHookStruct);
end;
var
Form1: TForm1;
HookHandle: THandle;
CurrentPopupComponent: TComponent;
implementation
{$R *.dfm}
const Magic = $6534; // Random number
function MouseProc(Code: Integer; WParam: WPARAM; Struct: PMouseHookStruct): integer; stdcall;
begin
if Code >= 0 then Form1.OnHookEvent(WParam, Struct);
Result := CallNextHookEx(HookHandle, Code, WParam, LPARAM(Struct));
end;
procedure TForm1.OnHookEvent(MouseEvent: WPARAM; Struct: PMouseHookStruct);
var i: integer;
MouseWinHandle: THandle;
begin
if (MouseEvent <> WM_MOUSEMOVE) and (Struct <> nil) and (Struct.dwExtraInfo <> Magic) then
CurrentPopupComponent := nil;
//if (MouseEvent = WM_MOUSEMOVE) then
// begin
// if
// end;
if CurrentPopupComponent = nil then exit;
MouseWinHandle := WindowFromPoint(Struct.pt);
for i := 0 to ComponentCount - 1 do
if (CurrentPopupComponent <> Components[i]) and (Components[i] is TButton)
and (TButton(Components[i]).Handle = MouseWinHandle) then
with TButton(Components[i]), Struct.pt do begin
CurrentPopupComponent := nil;
PostMessage (MouseWinHandle, WM_RBUTTONDOWN, MK_RBUTTON, Struct.pt.X + Struct.pt.Y shl 16);
PostMessage (MouseWinHandle, WM_RBUTTONUP, MK_RBUTTON, Struct.pt.X + Struct.pt.Y shl 16);
PostMessage (MouseWinHandle, WM_CONTEXTMENU, MouseWinHandle, Struct.pt.X + Struct.pt.Y shl 16);
//mouse_event(MOUSEEVENTF_RIGHTDOWN, X, Y, 0, Magic);
//mouse_event(MOUSEEVENTF_RIGHTUP, X, Y, 0, Magic);
break;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
HookHandle := SetWindowsHookEx(WH_MOUSE, @Mouseproc, 0, GetCurrentThreadId);
for i := 0 to ComponentCount - 1 do
if Components[i] is TButton then
TButton(Components[i]).PopupMenu := PopupMenu1;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx(HookHandle);
end;
procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
CurrentPopupComponent := TPopupMenu(Sender).PopupComponent;
if TPopupMenu(Sender).PopupComponent is TWinControl then
TWinControl(TPopupMenu(Sender).PopupComponent).SetFocus;
end;
procedure TForm1.PopupMenu2Popup(Sender: TObject);
begin
CurrentPopupComponent := TPopupMenu(Sender).PopupComponent;
if TPopupMenu(Sender).PopupComponent is TWinControl then
TWinControl(TPopupMenu(Sender).PopupComponent).SetFocus;
end;
procedure TForm1.PopupMenu3Popup(Sender: TObject);
begin
CurrentPopupComponent := TPopupMenu(Sender).PopupComponent;
if TPopupMenu(Sender).PopupComponent is TWinControl then
TWinControl(TPopupMenu(Sender).PopupComponent).SetFocus;
end;
end.
Создал тут компонент свой, наследник TCustomControl. При нажатии левой кнопки мыши расскрывается PopupMenu внизу компонента. Вот попробовал применить этот на тот компонент хук(чтобы так же расскрывалось меню на другом таком же компоненте), не работает почему-то...:( В PostMessage поменял WM_RBUTTONDOWN, MK_RBUTTON на WM_LBUTTONDOWN, MK_LBUTTON. Т.е. по идее должно работать... ПРобовал и mouse_event(MOUSEEVENTF_LEFTDOWN, X, Y, 0, Magic); mouse_event(MOUSEEVENTF_LEFTUP, X, Y, 0, Magic); тоже не работает...:( Начал как бы тестировать код, т.е. чтобы в какой-то момент чтонибудь произошло... Вот я заметил что после строк
if (MouseEvent <> WM_MOUSEMOVE) and (Struct <> nil) and (Struct.dwExtraInfo <> Magic) then
CurrentPopupComponent := nil;
if CurrentPopupComponent = nil then exit;
Ничего не происходит... Помогите ктонибудь!
Max_005 (2005-04-24 16:57:00) [7]Понятно...
Piter (2005-04-23 23:56:00) [8]Max_005 (23.04.05 22:56) [29]
Так почему же всетаки не переключается меню?
ок, начнем заново, будем учить рекурсию.
Итак, смотри пост [24]
Max_005 (2005-04-23 22:56:00) [9]Так почему же всетаки не переключается меню? см. Max_005 (22.04.05 21:49) [20]
Piter (2005-04-23 20:25:00) [10]Max_005 (23.04.05 19:14) [27]
Да не, не обижайся!
ты мне? Да я не обижаюсь вовсе, мне то что...
Я просто не понимаю эти хуки
ну так разберись
Вот я и думал что ктонибудь поможет
помочь разобраться и написать за тебя исходный код - разные вещи
Max_005 (2005-04-23 19:14:00) [11]Да не, не обижайся! Я просто не понимаю эти хуки, а в книге нету их... Вот я и думал что ктонибудь поможет
Piter (2005-04-23 17:56:00) [12]Max_005 (23.04.05 17:39) [25]
неа...
а тебе не приходило в голову разобраться?
Или ты всерьез решил, что так люди и программируют, используя код других людей?
Max_005 (2005-04-23 17:39:00) [13]неа...
Piter (2005-04-23 13:49:00) [14]Max_005 (23.04.05 0:17) [22]
а ты понимаешь, что делает твой код построчно?
Max_005 (2005-04-23 11:28:00) [15]???
Max_005 (2005-04-23 00:17:00) [16]ну... не работает... не переключается popup
Piter (2005-04-22 23:41:00) [17]Max_005 (22.04.05 21:49) [20]
Что-то не работает...:(
что значит что-то не работает?
Max_005 (2005-04-22 21:49:00) [18]Что-то не работает...:( Приведу весь код программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
PopupMenu2: TPopupMenu;
PopupMenu3: TPopupMenu;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure OnHookEvent;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hhk: THandle;
popHandle: THandle;
implementation
{$R *.dfm}
function MouseProc (code: Integer;wParam: WPARAM; lParam: LPARAM): Integer; stdcall;
begin
// all operations
Form1.OnHookEvent;
Result := CallNextHookEx (hhk, Code, wParam, lParam);
end;
procedure TForm1.OnHookEvent; // создать процедуру вручную
var h: THandle;
p: TPoint;
btns: array [1..3] of TButton;
n: Integer;
begin
btns [1] := Button1;
btns [2] := Button2;
btns [3] := Button3;
p := mouse.CursorPos; // screen coord of mouse cursor
h := WindowFromPoint (p); // контрол под курсором мыша
for n := 1 to 3 do
if (h = btns [n].handle) and (popHandle <> h) and
(popHandle <> 0) then
begin
PostMessage (h, WM_RBUTTONDOWN, MK_RBUTTON, p.X + p.Y shl 16);
PostMessage (h, WM_RBUTTONUP, MK_RBUTTON, p.X + p.Y shl 16);
popHandle := h;
btns [n].SetFocus;
PostMessage (h, WM_CONTEXTMENU, h, p.x + p.y shl 16);
break;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
hhk := SetWindowsHookEx (WH_MOUSE, @Mouseproc, 0, GetCurrentThreadId);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx (hhk);
end;
end.
alpet (2005-04-20 13:52:00) [19]После вызова TrackPopupMenuEx (а оно вызывается) основной поток будет ждать пока меню не закроется. Так что цикла организовать не удастся (если только не создавать отдельный поток, что уже черезмерно). Так же и сообщения WM_MouseMove не доходят до формы, пока открыто это меню, но они прекрасно ловятся поставленной ловушкой.
Что касается вопроса "Как?"
Вот ориентировочный код, как сделать чтобы меню выскакивало не всегда думай сам.
var hhk: THandle;
function MouseProc (code: Integer;wParam: WPARAM; lParam: LPARAM): Integer; stdcall;
begin
// all operations
form1.OnHookEvent;
result := CallNextHookEx (hhk, Code, wParam, lParam);
end;
var popHandle: THandle; // лучше поместить в TForm1
procedure TForm1.OnHookEvent; // создать процедуру вручную
var h: THandle;
p: TPoint;
btns: array [1..3] of TButton;
n: Integer;
begin
btns [1] := button1;
btns [2] := button2;
btns [3] := button3;
p := mouse.CursorPos; // screen coord of mouse cursor
h := WindowFromPoint (p); // контрол под курсором мыша
for n := 1 to 3 do
if (h = btns [n].handle) and (popHandle <> h) and
(popHandle <> 0) then
begin
PostMessage (h, WM_RBUTTONDOWN, MK_RBUTTON, p.X + p.Y shl 16);
PostMessage (h, WM_RBUTTONUP, MK_RBUTTON, p.X + p.Y shl 16);
popHandle := h;
btns [n].SetFocus;
PostMessage (h, WM_CONTEXTMENU, h, p.x + p.y shl 16);
break;
end;
end;
Max_005 (2005-04-20 13:18:00) [20]Ой извените за много сообщений... у меня все время ошибка выдавалась... а потом сразу СТОЛЬКО сообщений
| |
Страницы: 