Project JEDI - Issue Tracker
Mantis Bugtracker

Viewing Issue Simple Details Jump to Notes ] View Advanced ] Issue History ] Print ]
ID Category Severity Reproducibility Date Submitted Last Update
0004305 [JEDI VCL] 00 JVCL Components major always 2007-12-05 11:58 2007-12-16 06:47
Reporter Kiriakos View Status public  
Assigned To AHUser
Priority normal Resolution fixed  
Status resolved   Product Version 3.33
Summary 0004305: JvDocking JvDockVSnetStyle: Forms are autohidden while a context menu is displayed
Description To reproduce in the JvDocking Advanced demo:
 - add a context menu to the DockClient with one or two menu items
 - use the JvDockVSNetStyle
 - Run the form and add a Dock Client form
 - Dock and autohide the dock form
 - Point the mouse on the Channel tab to roll out the form
 - Right click on the form to show the context menu and wait a couple of seconds

Result: The form is auto-hidden but the context menu is still shown. A selection on the context menu may result in an Exception "Cannot focus a disabled or invisible window"

Expected Result: The form should not be hidden while the context menu is shown.


Solution: Modify TJvDockVSNetStyle.Timer as follows

procedure TJvDockVSNetStyle.Timer(Sender: TObject);
  function PointIsOnPopup(P : TPoint) : Boolean;
  Var
    Control: TWinControl;
    Handle : HWND;
    LStyle : Cardinal;
    OwningProcess: DWORD;
    Rect : TRect;
  begin
    Control := FindVCLWindow(P);
    Result := ControlIsOnPopup(Control);
    if not Result then begin
      // Check whether a popup window is currently displayed (hint, popup menu)
      Handle := WindowFromPoint(P);
      if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
         (OwningProcess = GetCurrentProcessId) then
      begin
        LStyle := GetWindowLong(Handle, GWL_STYLE);
        if WS_POPUP and LSTYLE <> 0 then begin
          GetWindowRect(Handle, Rect);
          // Search for a control one pixel to the left;
          Dec(Rect.Left);
          Result := PointIsOnPopup(Rect.TopLeft);
        end;
      end;
    end;
  end;

var
  P: TPoint;
  Control: TWinControl;
  I: Integer;
  ADockServer: TJvDockServer;
begin
  if not ChannelOption.MouseleaveHide then
    Exit;
  if csDesigning in ComponentState then
    Exit;

  if (GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0 then
    Exit;
  GetCursorPos(P);

  if PointIsOnPopup(P) then
  begin
    { Reset timer }
    FCurrentTimer := ChannelOption.HideHoldTime;
    Exit;
  end;

  Dec(FCurrentTimer, 100);
  if FCurrentTimer > 0 then
    Exit;
  DestroyTimer;

  for I := 0 to FDockServers.Count - 1 do
  begin
    ADockServer := TJvDockServer(FDockServers[I]);
    with TChannelEnumerator.Create(ADockServer) do
    try
      while MoveNext do
        Current.HidePopupPanelWithAnimate;
    finally
      Free;
    end;
  end;
end;


Remarks: It is very hard to find out whether a popup menu is shown, because in many cases (eg. menus, File Explorer controls) they are not VCL controls or they do not have Parent window set. The solution implemented checks for WS_POPUP style which also works for hints.
Additional Information
Tags No tags attached.
Attached Files

- Relationships
related to 0004846resolvedobones [Unit JvDockVSNetStyle] TJvDockVSNetStyle.Timer can cause stack overflow on Vista/Aero 

-  Notes
(0014041)
Kiriakos (reporter)
2007-12-05 12:18

A slightly improved version below:

Compared to the previous one a redundant declaration of Control is removed and PointIsOnPopup now checks both on the left and the right side of the popup window. This is because sometimes popup menus are displayed to the left of the mouse if they do not fit on the right.

procedure TJvDockVSNetStyle.Timer(Sender: TObject);
  function PointIsOnPopup(P : TPoint) : Boolean;
  Var
    Control: TWinControl;
    Handle : HWND;
    LStyle : Cardinal;
    OwningProcess: DWORD;
    Rect : TRect;
  begin
    Control := FindVCLWindow(P);
    Result := ControlIsOnPopup(Control);
    if not Result then begin
      // Check whether a popup window is currently displayed (hint, popup menu)
      Handle := WindowFromPoint(P);
      if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
         (OwningProcess = GetCurrentProcessId) then
      begin
        LStyle := GetWindowLong(Handle, GWL_STYLE);
        if WS_POPUP and LSTYLE <> 0 then begin
          GetWindowRect(Handle, Rect);
          // Search for a control one pixel to the left;
          Dec(Rect.Left);
          Result := PointIsOnPopup(Rect.TopLeft);
          if not Result then begin
            Inc(Rect.Right);
            Result := PointIsOnPopup(Point(Rect.Right, Rect.Top));
          end;
        end;
      end;
    end;
  end;

var
  P: TPoint;
  I: Integer;
  ADockServer: TJvDockServer;
begin
  if not ChannelOption.MouseleaveHide then
    Exit;
  if csDesigning in ComponentState then
    Exit;

  if (GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0 then
    Exit;
  GetCursorPos(P);

  if PointIsOnPopup(P) then
  begin
    { Reset timer }
    FCurrentTimer := ChannelOption.HideHoldTime;
    Exit;
  end;

  Dec(FCurrentTimer, 100);
  if FCurrentTimer > 0 then
    Exit;
  DestroyTimer;

  for I := 0 to FDockServers.Count - 1 do
  begin
    ADockServer := TJvDockServer(FDockServers[I]);
    with TChannelEnumerator.Create(ADockServer) do
    try
      while MoveNext do
        Current.HidePopupPanelWithAnimate;
    finally
      Free;
    end;
  end;
end;
(0014042)
Kiriakos (reporter)
2007-12-05 16:13

Here is a third version and hopefully the final! The problem with the previous versions was that they only worked as long as the mouse was inside the menu. If the mouse left the menu the Dock form would hide despite the fact that the context menu was active.

procedure TJvDockVSNetStyle.Timer(Sender: TObject);

  function IsPopupWindow(Handle : HWND) : Boolean;
  Var
    OwningProcess: DWORD;
    LStyle : Cardinal;
  begin
    Result := False;
    if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
       (OwningProcess = GetCurrentProcessId) then
    begin
      LStyle := GetWindowLong(Handle, GWL_STYLE);
      if WS_POPUP and LSTYLE <> 0 then
        Result := True;
    end;
  end;

  function PointIsOnPopup(P : TPoint; GlobalCheck : Boolean) : Boolean;
  Const
    GW_ENABLEDPOPUP = 6;
  Var
    Control: TWinControl;
    Handle : HWND;
    Rect : TRect;
    ActivePopupWindow : Boolean;
  begin
    Control := FindVCLWindow(P);
    Result := ControlIsOnPopup(Control);
    if not Result then begin
      // Check whether a popup window is currently displayed (hint, popup menu)
      Handle := WindowFromPoint(P);
      ActivePopupWindow := IsPopUpWindow(Handle);
      if not ActivePopupWindow and GlobalCheck then begin
        Handle := GetWindow(Application.Handle, GW_ENABLEDPOPUP);
        ActivePopupWindow := IsPopUpWindow(Handle);
        if not ActivePopupWindow then begin
          Handle := GetTopWindow(GetDesktopWindow);
          ActivePopupWindow := IsPopUpWindow(Handle);
        end;
      end;

      if ActivePopupWindow then begin
        GetWindowRect(Handle, Rect);
        // Search for a control one pixel to the left;
        Dec(Rect.Left);
        Result := PointIsOnPopup(Rect.TopLeft, False);
        if not Result then begin
          // Search for a control one pixel to the Right;
          Inc(Rect.Right);
          Result := PointIsOnPopup(Point(Rect.Right, Rect.Top), False);
        end;
      end;
    end;
  end;

var
  P: TPoint;
  I: Integer;
  ADockServer: TJvDockServer;
begin
  if not ChannelOption.MouseleaveHide then
    Exit;
  if csDesigning in ComponentState then
    Exit;

  if (GetAsyncKeyState(VK_LBUTTON) and $8000) <> 0 then
    Exit;
  GetCursorPos(P);

  if PointIsOnPopup(P, True) then
  begin
    { Reset timer }
    FCurrentTimer := ChannelOption.HideHoldTime;
    Exit;
  end;

  Dec(FCurrentTimer, 100);
  if FCurrentTimer > 0 then
    Exit;
  DestroyTimer;

  for I := 0 to FDockServers.Count - 1 do
  begin
    ADockServer := TJvDockServer(FDockServers[I]);
    with TChannelEnumerator.Create(ADockServer) do
    try
      while MoveNext do
        Current.HidePopupPanelWithAnimate;
    finally
      Free;
    end;
  end;
end;
(0014055)
AHUser (developer)
2007-12-16 06:47

Fixed in SVN

- Issue History
Date Modified Username Field Change
2007-12-05 11:58 Kiriakos New Issue
2007-12-05 12:18 Kiriakos Note Added: 0014041
2007-12-05 16:13 Kiriakos Note Added: 0014042
2007-12-16 06:47 AHUser Status new => resolved
2007-12-16 06:47 AHUser Fixed in Version => Daily / SVN
2007-12-16 06:47 AHUser Resolution open => fixed
2007-12-16 06:47 AHUser Assigned To => AHUser
2007-12-16 06:47 AHUser Note Added: 0014055
2009-07-06 14:03 obones Relationship added related to 0004846


Mantis 1.1.6[^]
Copyright © 2000 - 2008 Mantis Group
Powered by Mantis Bugtracker