Popup/Contextmenü bleibt leer

[Orakel-von-Delphi]

Teilweise wird OwnerDrawn verwendet, aber in der Regel nicht.

Ich habe schon überlegt, ob ein Handling wie dieses etwas bringen könnte:

Code:

unit Dialog;

interface

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

type
  TEnterExitDia = class(TForm)
    mmInfo: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    popDia: TPopupMenu;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    PopupMenu3: TPopupMenu;
    Neu1: TMenuItem;
    Oeffnen1: TMenuItem;
    Neu2: TMenuItem;
    Neu3: TMenuItem;
    Oeffnen2: TMenuItem;
    Info1: TMenuItem;
    btnAll: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnAllClick(Sender: TObject);
  private
    { Private-Deklarationen }
    evPopAvail : TEvent;
    OldPopupListWndProc: TFNWndProc;
    NewPopupListWndProc: TFNWndProc;
    fPopupOpen : Boolean;
    procedure PopupListWndProc(var Message: TMessage);
  public
    { Public-Deklarationen }
  end;

implementation

{$R *.DFM}

procedure TEnterExitDia.PopupListWndProc(var Message: TMessage);
begin
  with Message do
  begin
    case Msg of
      WM_ENTERMENULOOP:
        if evPopAvail.WaitFor(0) = wrSignaled then
          begin
           evPopAvail.ResetEvent();
          end
        else
          begin
           mmInfo.Lines.Add('Attention: NOT signaled !');
           Exit;
          end;
      WM_EXITMENULOOP:
        evPopAvail.SetEvent();
    end;
   Result := CallWindowProc(OldPopupListWndProc, PopupList.Window, Msg, WParam, LParam);
  end;
end;

procedure TEnterExitDia.FormCreate(Sender: TObject);
begin
  evPopAvail := TEvent.Create(nil, True, True, Format('%s-%d', [self.Classname, self.Handle]));
  mmInfo.Lines.Add(Format('Event ''%s-%d'' created.', [self.Classname, self.Handle]));
  NewPopupListWndProc := MakeObjectInstance(PopupListWndProc);
  OldPopupListWndProc := TFNWndProc(GetWindowLong(PopupList.Window, GWL_WNDPROC));
  SetWindowLong(PopupList.Window, GWL_WNDPROC, Longint(NewPopupListWndProc));
end;

procedure TEnterExitDia.FormDestroy(Sender: TObject);
begin
  SetWindowLong(PopupList.Window, GWL_WNDPROC, Longint(OldPopupListWndProc));
  evPopAvail.Free();
end;

procedure TEnterExitDia.btnAllClick(Sender: TObject);
begin
  // Try to open more than one Popup at once ...
  PostMessage(self.Handle, WM_RBUTTONDOWN, MK_RBUTTON, 0);
  PostMessage(self.Handle, WM_RBUTTONUP, MK_RBUTTON, 0);

  PostMessage(Panel1.Handle, WM_RBUTTONDOWN, MK_RBUTTON, 0);
  PostMessage(Panel1.Handle, WM_RBUTTONUP, MK_RBUTTON, 0);

  PostMessage(Panel2.Handle, WM_RBUTTONDOWN, MK_RBUTTON, 0);
  PostMessage(Panel2.Handle, WM_RBUTTONUP, MK_RBUTTON, 0);

  PostMessage(Panel2.Handle, WM_RBUTTONDOWN, MK_RBUTTON, 0);
  PostMessage(Panel2.Handle, WM_RBUTTONUP, MK_RBUTTON, 0);
end;

end.

Das Example funktioniert natürlich einwandfrei. Ob es sich lohnt, dieses Handling in das große Projekt einzubauen ???