Problem mit Hook einer Komponente (Anzeigen eines Menüs)

[franz]

Hi,
ich habe eine Komponente geschrieben, die die jeweilige Anwendung in den System Tray „befördern“ soll.
Da das Programm dann nur noch als Symbol im Tray angezeigt wird, ist ein Menü notwendig, um es zu beenden.

Mit einem Hook habe ich versucht dieses anzuzeigen, wenn der Benutzer die rechte Maustaste drückt.

Der Hook funktioniert auch soweit, solange das Menü innerhalb einer Form angezeigt wird. Wenn aber auf das Symbol im Tray geklickt wird, passiert gar nichts.

Ich habe mal den gesamten Quelltext der Unit aufgelistet:

Delphi-Quellcode:

unit FJFShellTrayIcon;

interface

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

const
  WM_ICONTRAY = WM_USER + 1;

type
  TFJFShellTrayIcon = class(TComponent)
  private
    { Private-Deklarationen }
    FPopupMenu: TPopupMenu;
    FEnabled:   Boolean;
    FIcon:      TIcon;
    FTipText:   String;
    procedure SetIcon(NewIcon: TIcon);
    procedure SetTipText(NewText: String);
    procedure SetPopupMenu(NewPopupMenu: TPopupMenu);
  protected
    NotifyIconData: TNotifyIconData;
    procedure HookCreate(Sender: TObject);
    procedure HookDestroy(Sender: TObject);
  public
    { Public-Deklarationen }
    procedure Enable;
    procedure Execute;
    procedure UpdateTrayIcon;
    procedure Disable;
    procedure Show;
    procedure Hide;
    procedure Icontray(var Msg: TMessage); message WM_ICONTRAY;
  published
    { Published-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property Icon: TIcon
        read FIcon write SetIcon;
    property TipText: String
        read FTipText write SetTipText;
    property PopupMenu: TPopupMenu
        read FPopupMenu write SetPopupMenu;
  end;

procedure Register;
function  MouseHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): Integer; stdcall;

implementation
//{$R *.dcr}

var
  hMouseHook: HHOOK;
  mHookMenu:  TPopupMenu;

procedure Register;
begin
  RegisterComponents('FJF', [TFJFShellTrayIcon]);
end;

function MouseHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): Integer; stdcall;
begin
  if (wParam = WM_RBUTTONDOWN) then
     if Assigned(mHookMenu) then
        mHookMenu.Popup(Mouse.CursorPos.x,Mouse.CursorPos.y);
  Result := CallNextHookEx(hMouseHook,nCode,wParam,lParam);
end;

procedure TFJFShellTrayIcon.HookCreate(Sender: TObject);
begin
  hMouseHook := SetWindowsHookEx(WH_MOUSE,MouseHookProc,0,0);
  inherited;
end;

procedure TFJFShellTrayIcon.HookDestroy(Sender: TObject);
begin
  UnhookWindowsHookEx(hMouseHook);
  // inherited;
end;

constructor TFJFShellTrayIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := false;
  FIcon := TIcon.Create;
  FIcon.Assign(Application.Icon);
  FTipText  := Application.Title;
  (Owner as TForm).OnShow    := HookCreate;
  (Owner as TForm).OnDestroy := HookDestroy;
end;

destructor TFJFShellTrayIcon.Destroy;
begin
  if FEnabled then
     Disable;
  Application.ProcessMessages;

  FIcon.Free;
  Application.ProcessMessages;

  inherited Destroy;
end;

procedure TFJFShellTrayIcon.SetIcon(NewIcon: TIcon);
begin
  FIcon.Assign(NewIcon);
end;

procedure TFJFShellTrayIcon.SetTipText(NewText: String);
begin
  FTipText := NewText;
end;

procedure TFJFShellTrayIcon.SetPopupMenu(NewPopupMenu: TPopupMenu);
begin
  mHookMenu  := NewPopupMenu;
  FPopupMenu := NewPopupMenu;
end;

procedure TFJFShellTrayIcon.Enable;
const
  cErrNoPopup = 'No PopupMenu available!';
begin
  if (FEnabled) then
     Exit;
  if not Assigned(FPopupMenu) then
     raise Exception.Create(cErrNoPopup);

  with NotifyIconData do
    begin
      hIcon := FIcon.Handle;
      StrPCopy(szTip, FTipText);
      Wnd := (Owner as TForm).Handle;
      uCallbackMessage := WM_ICONTRAY;
      uID := 1;
      uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
      cbSize := sizeof(TNotifyIconData);
    end;
  Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
  FEnabled := true;
end;

procedure TFJFShellTrayIcon.Execute;
begin
  Enable;
end;

procedure TFJFShellTrayIcon.Hide;
begin
  Application.MainForm.Hide;
  Enable;
end;

procedure TFJFShellTrayIcon.UpdateTrayIcon;
begin
  if not FEnabled then
     Exit;

  with NotifyIconData do
    begin
      hIcon := FIcon.Handle;
      StrPCopy(szTip, FTipText);
      Wnd := (Owner as TForm).Handle;
      uCallbackMessage := WM_ICONTRAY;
      uID := 1;
      uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
      cbSize := sizeof(TNotifyIconData);
    end;
  Shell_NotifyIcon(NIM_MODIFY, @NotifyIconData);
end;

procedure TFJFShellTrayIcon.Disable;
begin
  if not FEnabled then
     Exit;
  Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
  FEnabled := false;
end;

procedure TFJFShellTrayIcon.Icontray(var Msg: TMessage);
var
  CursorPos : TPoint;
begin
  if Msg.lParam = WM_RBUTTONDOWN then
     begin
       GetCursorPos(CursorPos);
       FPopupMenu.Popup(CursorPos.x, CursorPos.y);
     end
  else
    inherited;
end;

procedure TFJFShellTrayIcon.Show;
begin
  Application.MainForm.Show;
  Disable;
end;

end.