[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 464
  • Last Modified:

Popup menu for system tray icon

The problem is that the popup menu dont desappear
after left mouse button clicked on the another app.

I use following code for showing the popup menu:

procedure TMainForm.WMAPPIcon(var Message: TMessage);
var
  pt: TPoint;
begin
  case Message.LParam of
    WM_RBUTTONUP:
      begin
        GetCursorPos(pt);
        PopupMenuIcon.Popup(pt.x, pt.y);
      end;
    WM_LBUTTONDBLCLK:
      begin
        Application.Restore;
        SetForegroundWindow(Handle);
      end;
  end;
end;

0
alx512
Asked:
alx512
  • 2
  • 2
1 Solution
 
smurffCommented:
I think the answer is callbacks. try this it works for me.
regards
Smurff


unit Unit1;

interface

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


const
 WM_MYTRAYICONCALLBACK = WM_USER + 1000;

type
 TForm1 = class(TForm)
   PopupMenu1 : TPopupMenu;
   Close1     : TMenuItem;
   Restore1   : TMenuItem;
   procedure Close1Click(Sender: TObject);
   procedure Restore1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
   MyTrayIcon: TNotifyIconData;
   procedure AppMinimize(Sender:TObject);
   procedure WMMyTrayIconCallback(var Msg:TMessage);
                      message WM_MYTRAYICONCALLBACK;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnMinimize := AppMinimize;
 ShowWindow(Application.Handle, SW_HIDE);
 MyTrayIcon.cbSize := SizeOf(TNotifyIconData);
 MyTrayIcon.Wnd    := Handle;
 MyTrayIcon.uId    := 1;
 MyTrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
 MyTrayIcon.uCallBackMessage := WM_MYTRAYICONCALLBACK;
 MyTrayIcon.hIcon  := Application.Icon.Handle;
 MyTrayIcon.szTip  := 'Click on Icon to see the options';
 Shell_NotifyIcon(NIM_ADD, @MyTrayIcon);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 Shell_NotifyIcon(NIM_DELETE, @MyTrayIcon);
 Application.Terminate;
end;

procedure TForm1.AppMinimize(Sender:TObject);
begin
 Application.Minimize;
 ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.WMMyTrayIconCallback(var Msg:TMessage);
var
 CursorPos : TPoint;
begin
 case Msg.lParam of
   WM_LBUTTONDOWN :
     begin
       GetCursorPos(CursorPos);
       PopupMenu1.Popup(CursorPos.X,CursorPos.Y);
     end;
 end;
end;

procedure TForm1.Close1Click(Sender: TObject);
begin
 Shell_NotifyIcon(NIM_DELETE, @MyTrayIcon);
 Application.Terminate;
end;

procedure TForm1.Restore1Click(Sender: TObject);
begin
 Application.Restore;
 ShowWindow(Application.Handle, SW_Show);
end;

end.
0
 
alx512Author Commented:
This answer is not what I nead.

I ask  how i can cancel popup menu whithowt
selecting any menu item.
0
 
MannSoftCommented:
Here is the code I use, and I think it should do what you want (it seems to work here anyway).

WM_RBUTTONDOWN:
begin
  if Assigned(FOnRightClick) then
    FOnRightClick(Self)
  else
    if Assigned(FPopupMenu) then
    begin
      SetForegroundWindow(FForm.Handle);
      GetCursorPos(Mouse);
      FPopupMenu.PopUp(Mouse.X, Mouse.Y);
      PostMessage(FForm.Handle, WM_NULL, 0, 0);
    end;
end;

FForm is type TForm and is assigned a value in the components create method like: FForm := (AOwner as TForm);
0
 
MannSoftCommented:
Of course that was a portion of my CASE statement in the components custom WindowProc.  Sorry, I have a habit of not making everything clear and causing confusion sometimes :)
0
 
alx512Author Commented:
You are right MannSoft. I read this code in MSDN yet.
the remark for TrackPopupMenu function discribe this problem.  All work good.

Thanks for your help.
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now