Delphi运行时MainMenu字符重叠显示异常求助

问题场景 #

使用Delphi 10.4.2在Windows 10/11开发时，主菜单出现显示异常：

• 设计阶段MainMenu显示完全正常
• 在主窗体FormCreate中执行以下代码后，运行时菜单字符出现重叠：

MainMenu1.OwnerDraw:= True;
Screen.MenuFont.Name:= 'Tahoma';                                   
Screen.MenuFont.Size:=12;

• 主窗体字体为Tahoma 12号，不添加上述代码时菜单字符显示正常但尺寸过小
• 仅在Object Inspector中设置MainMenu1.OwnerDraw=True，菜单字符变大但重叠
• 仅运行时修改Screen.MenuFont，字符显示正常但尺寸偏小
• 新建MainMenu组件或新项目测试，问题依旧

解决方案 #

启用OwnerDraw后，VCL不会自动适配自定义字体的菜单项尺寸，需要通过手动处理尺寸测量和绘制逻辑来修复：

步骤1：添加菜单项尺寸测量事件 #

给MainMenu1绑定OnMeasureItem事件，根据自定义字体计算菜单项的正确宽高：

procedure TForm1.MainMenu1MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  TextSize: TSize;
  MenuItem: TMenuItem;
begin
  MenuItem := Sender as TMenuItem;
  ACanvas.Font.Assign(Screen.MenuFont);
  // 获取文本实际尺寸
  TextSize := ACanvas.TextExtent(MenuItem.Caption);
  // 增加边距避免文本拥挤或截断
  Width := TextSize.cx + 16;
  Height := TextSize.cy + 8;
end;

步骤2：添加菜单项绘制事件 #

绑定OnDrawItem事件，手动绘制菜单项的背景和文本：

procedure TForm1.MainMenu1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  MenuItem: TMenuItem;
begin
  MenuItem := Sender as TMenuItem;
  ACanvas.Font.Assign(Screen.MenuFont);

  // 处理选中状态的样式
  if Selected then
  begin
    ACanvas.Brush.Color := clHighlight;
    ACanvas.Font.Color := clHighlightText;
  end
  else
  begin
    ACanvas.Brush.Color := clMenu;
    ACanvas.Font.Color := clMenuText;
  end;

  // 填充背景
  ACanvas.FillRect(ARect);
  // 绘制文本，预留左右上下边距
  ACanvas.TextOut(ARect.Left + 8, ARect.Top + 4, MenuItem.Caption);
end;

步骤3：调整FormCreate中的代码顺序 #

先设置菜单字体，再启用OwnerDraw，确保菜单初始化时能获取到正确的字体参数：

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 先自定义菜单字体
  Screen.MenuFont.Name := 'Tahoma';
  Screen.MenuFont.Size := 12;
  // 再开启OwnerDraw模式
  MainMenu1.OwnerDraw := True;
end;

问题原因 #

当启用OwnerDraw=True时，VCL会将菜单项的绘制权完全交给开发者，不再自动计算适配自定义字体的菜单项尺寸，默认的固定尺寸无法容纳更大的字体，最终导致文本重叠。通过手动测量文本尺寸并绘制，就能让菜单项适配自定义字体的大小。

内容的提问来源于stack exchange，提问作者basti