POPUP меню в SYSTRAY

← →
Zergling (2002-09-12 13:00) [0]

Подскажите plz, как в systray"е правильно обработать вызов popup меню, а то у меня после вызова меню форма становится неактивной (не могу кликать по элементам управления, например кнопкам).

вот вам код:

unit TVTrayIcon;

interface

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

type
TTVTrayIcon = class(TComponent)
private
{ Private declarations }
FNotificationHandle: HWnd;
FTrayIcon: TIcon;
FShowHint: Boolean;
FHint: string;
FActive: Boolean;
FCurrentlyActive: Boolean;
FPopupMenu: TPopupMenu;
FOnDblClick: TNotifyEvent;
procedure NotificationWndProc(var Message : TMessage);
procedure SetShowHint(const Value: Boolean);
procedure SetHint(const Value: string);
procedure SetTrayIcon(const Value: TIcon);
procedure SetActive(const Value: Boolean);
procedure SetPopupMenu(const Value: TPopupMenu);
protected
{ Protected declarations }
procedure DoDblClick;
procedure Loaded; override;
procedure OnAppMinimize(Sender: TObject);
function SendTrayMessage(AMessage: DWORD): Boolean;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure RemoveTrayIcon;
procedure RestoreApp;
procedure ShowTrayIcon;
procedure RemoveFromTaskbar;
procedure ShowInTaskbar;
published
{ Published declarations }
property Active: Boolean read FActive write SetActive;
property Hint: string read FHint write SetHint;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property ShowHint: Boolean read FShowHint write SetShowHint;
property TrayIcon: TIcon read FTrayIcon write SetTrayIcon;
end;

procedure Register;

implementation

const
ID_TRAYICON =1;
UWM_TRAYICON = WM_USER + 1;

procedure Register;
begin
RegisterComponents("TVSystem", [TTVTrayIcon]);
end;

{ TTVTrayIcon }

constructor TTVTrayIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNotificationHandle := AllocateHwnd(NotificationWndProc);
FTrayIcon := TIcon.Create;
Application.OnMinimize := OnAppMinimize;
end;

destructor TTVTrayIcon.Destroy;
begin
if FCurrentlyActive then RemoveTrayIcon;
FTrayIcon.Free;
if FNotificationHandle <> 0 then DeallocateHWnd(FNotificationHandle);
inherited Destroy;
end;

procedure TTVTrayIcon.NotificationWndProc(var Message: TMessage);
var Pt: TPoint;
begin
if Message.Msg = UWM_TRAYICON then
begin
case Message.lParam of
WM_LBUTTONDBLCLK: DoDblClick;
WM_RBUTTONDOWN: if Assigned(FPopupMenu) then
begin
SetForegroundWindow(FNotificationHandle);
GetCursorPos(Pt);
FPopupMenu.Popup(Pt.X, Pt.Y);
end;
end;
end;
end;

procedure TTVTrayIcon.SetPopupMenu(const Value: TPopupMenu);
begin
FPopupMenu := Value;
end;

end.

← →
Song (2002-09-12 13:32) [1]

Вы забываете передавать WM_NULL

POPUP меню в SYSTRAY Найти похожие ветки