user30478
user30478

Reputation: 401

Close TPopupMenu when moving out of it - removing its floating behavior when clicked outside of an (always on top) application

my application is showontop type window with a popupmenu(mastermenu) popping up at cursor location meant to be outside of the main form(demoForm), triggered by an external winapi message (clipboard change).

the annoying problem is that the menu won't disappear when clicked outside of the application instead of clicking on any menu items or the main form as when normally done to dismiss a menu. The focus goes out, my application stays on top, and the menu remains floating.

Tried to follow many articles and even changed from D7 to XE5 without success. Checked this too : Automatically Hide or Close PopUp Menu when Mouse Pointer is outside it - Delphi Mine is not complicated by delay timers or tray control.

Specifically, borrowing from a solution I did this:

procedure TDemoForm.tmrMenumouseOutMonitorTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  PT: TPoint;
begin
   hPopupWnd :=  FindWindow('#32768', mastermenu);
  if hPopupWnd = 0 then Exit;
  GetWindowRect(hPopupWnd, R);
  GetCursorPos(Pt);
  if PtInRect(R, Pt) then begin
  //do something
  end else begin
  //do something
  end;
end;

Where I am trying to poll the cursor position with a timer (MenumouseOutMonitorTimer) to detect if the cursor moved out of the menu (mastermenu). In case it moves out i will issue a .closeMenu()

But, this code throws - string, pAnsiChar/pwidestring mismatch in D7/XE5 at the FindWindow() last argument. maybe i should use FindWindowEx? XE5 directly returns some handles from a TPopupMenu but I don't know how to use them to solve my problem.

(on Win7, also targeting XP)

I am a total beginner, any help will be appreciated.

Full code here:

unit FmDemo;

interface

uses
  System.Classes,
  Vcl.Controls,
  Vcl.StdCtrls,
  Vcl.Forms, Menus, Dialogs, FileCtrl, ExtCtrls,PJCBView;// ....;

type
  TDemoForm = class(TForm)
    //......
    PJCBViewer1: TPJCBViewer; //custom control
    masterMenu: TPopupMenu;
    tmrMenumouseOutMonitor: TTimer;
    procedure tmrMenumouseOutMonitorTimer(Sender: TObject);

  private
    //........
    procedure menuItemClickHandler(Sender: TObject);
  end;

var
  DemoForm: TDemoForm;

implementation

uses
      Jpeg, Shellapi, Graphics, SysUtils, RichEdit, Messages;//GifImage

{$R *.dfm}

procedure tdemoform.menuItemClickHandler(Sender: TObject);
begin
  //.......
end;

procedure TDemoForm.PJCBViewer1ClipboardChanged(Sender: TObject);
var
   pnt: TPoint;
begin
  demoform.BringToFront; //formStyle -> fsStayOnTop already
  ///////////////////////////////////
  ///menu under cursor display code//
  ///////////////////////////////////

  if GetCursorPos(pnt) then
   begin
      masterMenu.Popup(pnt.X, pnt.Y);
   end;
  //remember to return focus to source window after each menu action (not implemented)
end;

procedure TDemoForm.tmrMenumouseOutMonitorTimer(Sender: TObject);
var
  hPopupWnd: HWND;
  R: TRect;
  PT: TPoint;
begin
  hPopupWnd :=  FindWindow('#32768', masterMenu);
  if hPopupWnd = 0 then Exit;
  GetWindowRect(hPopupWnd, R);
  GetCursorPos(Pt);
  if PtInRect(R, Pt) then begin
  //do something
  end else begin
  //do something
  end;
end;

//... other business logic

initialization
  CF_RTF := RegisterClipboardFormat( richedit.CF_RTF );
end.

Upvotes: 0

Views: 404

Answers (1)

Sertac Akyuz
Sertac Akyuz

Reputation: 54832

Here is a MCVE that doesn't require a third party control.

...

implementation

uses
  menus;

{$R *.dfm}

var
  Pop: TPopupMenu;
  Wnd: HWND;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Left := 200;
  Top := 100;
  Pop := TPopupMenu.Create(nil);
  Pop.Items.Add(TMenuItem.Create(Pop));
  Pop.Items[0].Caption := 'test';
  Wnd := GetForegroundWindow;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetForegroundWindow(Wnd); // comment this for the popup to be released when clicked outside
  Pop.Popup(100, 50);
end;

Click outside the form and the popup will not be released.

As you can see I had to artificially impose the condition that reproduces the problem, which is that your window is not in the foreground when you popup the menu.

As mentioned at several places at the page you linked, for the popup to be released normally, your window has to be in the foreground when you pop the menu, then you won't need to poll and find it and then manually release it. SetForegroundWindow does not guarantee that your window will come to the front. For more information about this issue and for several solutions, see this question.

Upvotes: 2

Related Questions