View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0004305JEDI VCL00 JVCL Componentspublic2007-12-05 11:582007-12-16 06:47
ReporterKiriakosAssigned ToAHUser 
PrioritynormalSeveritymajorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.33 
Target VersionFixed in Version3.34 
Summary0004305: JvDocking JvDockVSnetStyle: Forms are autohidden while a context menu is displayed
DescriptionTo 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.
TagsNo tags attached.

Relationships

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

Activities

Kiriakos

2007-12-05 12:18

reporter   ~0014041

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;

Kiriakos

2007-12-05 16:13

reporter   ~0014042

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;

AHUser

2007-12-16 06:47

developer   ~0014055

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