Неверное позиционирование DropdownMenu для кнопок TToolBar

Этот эффект был замечен при работе в WindowsXP SP3 приложения, скомпилированного Delphi 7. Возможно, что он проявляется и в других версиях ОС. Эффект заключается в неправильном вертикальном позиционировании DropdownMenu для TToolButton относительно ее границ, что наглядно демонстрирует прилагаемый пример.

Правильно	Неправильно

Причина этого в том, что при подсчете высоты меню в функции TToolBar.CheckMenuDropdown в расчет принимаются все пункты меню (FTempMenu.Items.Count), т.е. без учета уменьшения высоты меню за счет разбивки его на столбцы:

if (GetSystemMetrics(SM_CYMENU) * FTempMenu.Items.Count) + APoint.Y >
  Screen.MonitorFromPoint(APoint).Height then
Dec(APoint.Y, Button.Height);

Высота 12-ти пунктов меню кнопки pmOpen + координата нижней кромки кнопки (APoint.Y) меньше высоты экрана, поэтому ее меню позиционируется верно. Для меню кнопки pmSave суммарная высота превышает высоту экрана и позиционирование ее меню неверное. Если сместить окно приложения вверх, чтобы меню "хватало места" эффект исчезнет.

Для устранения эффекта необходимо, чтобы расчет высоты меню осуществлялся корректно, т.е. с учетом разбивки меню на столбцы. Это делает следующая функция:

function GetMenuHeight(AMenu: TMenu): Integer;
var
  I, H: Integer;
begin
  H:= 0;
  Result:= 0;
  for I:= 0 to AMenu.Items.Count - 1 do
  begin
    if AMenu.Items[I].Break <> mbNone then
    begin
      Result:= Max(Result, H);
      H:= 0;
    end;
    Inc(H);
  end;
  Result:= Result * GetSystemMetrics(SM_CYMENU);
end;

При использовании функции следует иметь ввиду, что, как видно из кода, высота пункта берется из настроек системы. Это значит, что если высота пункта была изменена в OnMeasureItem, то функция вернет неправильное значение!

Чтобы не создавать новый компонент пришлось скопировать все относящееся к TToolBar в новый модуль, который прилагается к примеру. Для использования модуля, необходимо просто добавить его в оператор uses интерфейсной секции.

Как оказалось в Delphi 2010 этот эффект так же присутствует. Для его исправления подходит описанный модуль, надо только в procedure TToolBarDockObject.AdjustDockRect(ARect: TRect); исправить строки:

Inc(Left, CX);
Inc(Top, CY);
Inc(Right, CX);
Inc(Bottom, CY);

на

DockRect := Rect(Left + CX, Top + CY, Right + CX, Bottom + CY);

К статье прилагаются файлы с исходным кодом на Delphi.

Внимание! Запрещается воспроизведение данной статьи или ее части без согласования с автором. Если вы желаете разместить эту статью на своем сайте или издать в печатном виде, свяжитесь с автором.
Автор статьи: Вершинин И.В.