Fix ElPack-Menu an possition of menu on bottom-screen-border

Quanos Service Solutions GmbH

The possition of the menu is wrong if the window is moved to the bottom and/or right of the screen.

We have made a fix in TElPopupTracker.InternalTrack.
The new implemenation is following:

procedure TElPopupTracker.InternalTrack(Menu : TElPopupMenu; MenuItem :
    TElMenuItem; X, Y1, Y2: integer; Flags: integer; ExcludeRect: TRect;
    SelectFirstItem: boolean);
var
  Window: TElPopupWindow;
  WR: TRect;
  NX,
  NY : integer;
  MenuItemHeight : Integer;

  // Returns the menu item height of the first menu item which's height is greater than zero.
  function GetMenuItemHeight : Integer;
  var
    i : Integer;
  begin
    Result := 0;
    for i := Low(Window.FItemHeights) to High(Window.FItemHeights) do
    begin
      if( Window.FItemHeights[i] > 0) then
      begin
        Result := Window.FItemHeights[i];
        Break;
      end;
    end;
  end;

begin
  // create popup window
  Window := TElPopupWindow.Create(Self, MenuItem, FDrawStyle, FFont, FRightToLeft,
    FImages, FAlphaImages, SelectFirstItem);
  FWindows.Add(Window);

  if Menu.FForm <> nil then
    SendMessage(Menu.FForm.Handle, WM_INITMENUPOPUP, MenuItem.Handle, MenuItem.MenuIndex);

  Window.MeasureBounds;

  // -------------------------------------------- //
  // Basics: X = left to right, Y = top to bottom //
  // -------------------------------------------- //

  // adjust window position vertically
  if Menu.FMustBeInScreen then
    WR := Rect(0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN))
  else
    WR := LMDGetWorkSpaceRect;

  NX := X;
  NY := Y1;

  if FRightToLeft then
    NX := NX - Window.Width;

  MenuItemHeight := GetMenuItemHeight;
  // If the windows' lower end would be out of the visible screen area the menu needs to be unfolded vertically up.
  // It's neccessary to not appear on position of the "Parent"-menu item and so to overlay it.
  // In this case the mouse click always was forwarded to the appearing menu item (unfortunally).
  if NY + Window.Height > WR.Bottom then
  begin
    if( ( Y2 - (Window.Height + MenuItemHeight) ) > WR.Top ) then
      NY := Y2 - (Window.Height + MenuItemHeight)
    else
      NY := WR.Bottom - (Window.Height + MenuItemHeight);
  end;

  if NY < WR.Top then
    NY := WR.Top;

  if FRightToLeft then
  begin
    if NX < WR.Left then
    begin
      if IsRectEmpty(ExcludeRect) then
      begin
        if NX + Window.Width > WR.Right then
          NX := WR.Left + Window.Width
        else
          NX := NX + Window.Width
      end
      else
      begin
        if ExcludeRect.Left - Window.Width > WR.Left then
          NX := WR.Left + Window.Width
        else
          NX := ExcludeRect.Left + Window.Width;
      end;
    end;

  end
  else
  begin
    if NX + Window.Width > WR.Right then
    begin
      if IsRectEmpty(ExcludeRect) then
      begin
        NX := WR.Right - Window.Width;
      end
      else
      begin
        if ExcludeRect.Left - Window.Width < WR.Left then
          NX := WR.Right - Window.Width
        else
          NX := ExcludeRect.Left - Window.Width;
      end;
    end;
  end;

  if (NX = x) and (NY = y1) and (Menu <> nil) and (Menu.Items = MenuItem) then
    Window.ExcludeRect := Menu.ExcludeRect;

  SetWindowPos(Window.Handle, HWND_TOPMOST, NX, NY, 0, 0,
    SWP_NOACTIVATE or SWP_NOSIZE {or SWP_NOMOVE} or SWP_SHOWWINDOW or SWP_NOREPOSITION);

  // track mouse messages
  SetCapture(FTrackerWnd);

  Window.Left := NX;
  Window.Top := NY;

  if Assigned(FShadows) and (not FSystemShadows) then
  begin
    FShadows.Add(TElShadow.Create(Menu.FForm));
    TElShadow(FShadows.Last).Control := Window;
    TElShadow(FShadows.Last).Show;
  end;
end;

Eugene Balabuev (LMD)

Hi,

Thanks, for report. Your fix has been incorporated.

Eugene.