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

Вниз

TPopupMenu   Найти похожие ветки 

← →
Azius   (2003-09-01 12:10) [0]

Как узнать, открыто ли TPopupMenu или нет?

---

← →
Skier   (2003-09-01 12:16) [1]

Вообще-то есть сообщения WM_ENTERMENULOOP и WM_EXITMENULOOP...
А зачем сие нужно ?

---

← →
mrcat   (2003-09-01 12:18) [2]

Azius © (01.09.03 12:10)

может обычного OnPopup хватит ?

---

← →
VMcL   (2003-09-01 14:13) [3]

>Skier © (01.09.03 12:16) [1]

Для Popup меню, думаю, не сработает.

---

← →
Song   (2003-09-01 15:21) [4]

2VMcL © (01.09.03 14:13) [3]
Это почему?

---

← →
VMcL   (2003-09-01 15:39) [5]

>Skier © (01.09.03 12:16) [1]
>Song © (01.09.03 15:21) [4]

Oops, отменяется. Я перехватывал WndProc для TPopupMenu.WindowHandle, а надо для PopupList.Window.

---

← →
VMcL   (2003-09-01 15:42) [6]

>VMcL © (01.09.03 15:39) [5]

Замечание: поскольку PopupList.Window один для всех TPopupMenu, пока остаётся открытым вопрос в случае с несколькими меню: "которое из них?"

---

← →
Skier   (2003-09-01 15:44) [7]

> "которое из них?"

А можно открыть сразу 2 Popup-меню ?

---

← →
VMcL   (2003-09-01 15:44) [8]

>"которое из них?"

М-да. Пора с ручника сняться. TPopupMenu.OnPopup никто не отменял :)

---

← →
VMcL   (2003-09-01 15:45) [9]

>Skier © (01.09.03 15:44) [7]
>А можно открыть сразу 2 Popup-меню ?

В теории нет, на практике да.

---

← →
Skier   (2003-09-01 15:49) [10]

>VMcL © (01.09.03 15:45)
Ужас ! :)

---

← →
VMcL   (2003-09-01 15:58) [11]

>Skier © (01.09.03 15:49) [10]

Серьёзно. Могу выложить в инете одну из (относительно:) старых версий моей программы (MacTray), в которой был (а может и сейчас есть, только затаился:) такой глюк.

---

← →
Azius   (2003-09-01 19:34) [12]

>Skier © (01.09.03 12:16) [1]
>Вообще-то есть сообщения WM_ENTERMENULOOP и WM_EXITMENULOOP...

Я пробовал так:
Tfrm = class(TForm)
...
procedure OnEnterML(m: TMessage); message WM_ENTERMENULOOP;
procedure OnExitML(m: TMessage); message WM_EXITMENULOOP;
Не работает... Ещё пытался IsWindowVisible(pm.WindowHandle) - результат тот же.

---

← →
Skier   (2003-09-01 19:37) [13]

( var m: TMessage); Это как минимум...
А сообщение вообще приходит ?

---

← →
Song   (2003-09-01 20:30) [14]

> procedure OnEnterML(m: TMessage); message WM_ENTERMENULOOP;
> procedure OnExitML(m: TMessage); message WM_EXITMENULOOP;


Дак ты их в классе формы что ли описал? :)

---

← →
VMcL   (2003-09-01 20:31) [15]

>Azius © (01.09.03 19:34) [12]

Сообщения для TPopupMenu приходят не форме, а окну PopupList.Window, поэтому нужно перехватывать WindowProc именно для него.

P.S.
См. MakeObjectInstance, FreeObjectInstance.

---

← →
Song   (2003-09-01 20:35) [16]

Гораздо быстрей этого можно добиться в TApplication.onMessage

---

← →
VMcL   (2003-09-01 20:56) [17]

>Song © (01.09.03 20:35) [16]

Так не выйдет.

---

← →
Song   (2003-09-01 21:02) [18]

Ты проверял?

---

← →
VMcL   (2003-09-01 21:06) [19]

Да.

unit Unit1;

interface

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

type
TWindowProc = function (Wnd: HWND; Msg: UInt;
wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

TForm1 = class(TForm)
Memo1: TMemo;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
PopupMenu1: TPopupMenu;
Copy1: TMenuItem;
Paste1: TMenuItem;
Undo1: TMenuItem;
N1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
protected
OldWndProc: TWindowProc;
NewWndProc: Pointer;

procedure WndProc_PM(var Msg: TMessage);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := Application.Title;
Application.OnMessage := ApplicationEvents1Message;

@OldWndProc := @TWindowProc(GetWindowLong(PopupMenu1.WindowHandle, GWL_WNDPROC));
NewWndProc := Classes.MakeObjectInstance(WndProc_PM);
if SetWindowLong(PopupList.Window, GWL_WNDPROC,
LongWord(NewWndProc)) = 0 then RaiseLastOSError;
end;

procedure TForm1.WndProc_PM(var Msg: TMessage);
begin
case Msg.Msg of
WM_ENTERMENULOOP: Memo1.Lines.Add("Enter menu/Pop");
WM_EXITMENULOOP: Memo1.Lines.Add("Exit menu/Pop");
end;

if Assigned(OldWndProc) then
with Msg do
Result := OldWndProc(PopupList.Window, Msg,
WParam, LParam);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(OldWndProc) then
SetWindowLong(PopupList.Window, GWL_WNDPROC,
LongWord(@OldWndProc));

Classes.FreeObjectInstance(NewWndProc);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
case Msg.message of
WM_ENTERMENULOOP: Memo1.Lines.Add("Enter menu/App");
WM_EXITMENULOOP: Memo1.Lines.Add("Exit menu/App");
end;
end;

end.

---

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

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

Наверх

Память: 0.48 MB
Время: 0.014 c