Pourquoi la fameuse solution de contournement pour fermer un menu contextuel avec Echap ne fonctionne pas avec un descripteur privé?

Question

J'ai créé un composant pour utiliser des icônes de bac dans mon application et lorsque l'icône affiche le menu contextuel, il ne peut pas être fermé avec la touche Échap. Puis j'ai trouvé une solution de contournement here, par David Heffernan. J'intègre le code dans mon composant et maintenant le menu peut être fermé avec Esc mais après que j'ouvre le menu mon application soit complètement morte, je ne peux rien accéder sur le formulaire principal, même les boutons du système ne fonctionnent plus.

Voici le code pour reproduire le problème:

unit Unit1; 

interface 

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

const WM_ICONTRAY = WM_USER+1; 

type 
    TForm1 = class(TForm) 
    PopupMenu1: TPopupMenu; 
    Test1: TMenuItem; 
    Test2: TMenuItem; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    private 
    IconData: TNotifyIconData; 
    protected 
    procedure PrivateWndProc(var Msg: TMessage); virtual; 
    public 
    PrivateHandle:HWND; 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
PrivateHandle:=AllocateHWnd(PrivateWndProc); 

// add an icon to tray 
IconData.cbSize:=SizeOf(IconData); 
IconData.Wnd:=PrivateHandle; 
IconData.uID:=1; 
IconData.uFlags:=NIF_MESSAGE + NIF_ICON; 
IconData.uCallbackMessage:=WM_ICONTRAY; 
IconData.hIcon:=Application.Icon.Handle; 
Shell_NotifyIcon(NIM_ADD, @IconData); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
IconData.uFlags:=0; 
Shell_NotifyIcon(NIM_DELETE, @IconData); 
DeallocateHWnd(PrivateHandle); 
end; 

procedure TForm1.PrivateWndProc(var Msg: TMessage); 
var p:TPoint; 
begin 
if (Msg.Msg = WM_ICONTRAY) and (Msg.LParam=WM_RBUTTONUP) then 
    begin 
    GetCursorPos(p); 
    SetForegroundWindow(PrivateHandle); 
    PopupMenu1.Popup(p.x,p.y); 
    PostMessage(PrivateHandle, WM_NULL, 0, 0); 
    end; 
end; 

end. 

Answer 1

Je suppose que vous venez de manquer d'appeler DefWindowProc. Essayez ceci:

procedure TForm1.PrivateWndProc(var Msg: TMessage); 
begin 
    if (Msg.Msg = WM_ICONTRAY) and (Msg.lParam = WM_RBUTTONUP) then 
    begin 
    ... 
    end 
    else 
    Msg.Result := DefWindowProc(PrivateHandle, Msg.Msg, Msg.wParam, Msg.lParam); 
end;