Delphi TPopupMenu 设计修改

Question

我们能否用 TPopupMenu VCl 组件实现以下外观

有人可以指导我们完成设计吗？

我尝试将 OwnerDraw 设置为 True 并为菜单项编写 OnDrawItem，但这并不成功。

procedure TForm.tCopyDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
  s: string;
begin
  // change font
  ACanvas.Font.Name := 'Noto Sans';
  ACanvas.Font.Size := 12;
  //ACanvas.Font.Style := [fsBold];
  ACanvas.Font.Color := $00757575;
  // change background
  ACanvas.Brush.Color := clWindow;
  ACanvas.Rectangle(ARect);
  // write caption/text
  s := (Sender as TMenuItem).Caption;
  //ACanvas.TextOut(ARect.Left + 2, ARect.Top + 2 , s);
  ACanvas.TextOut(-2, -2, s);
end;

编译后，我得到了如下外观。

我必须消除黑色边框并垂直对齐项目。

更新

我已经设法编写了一些代码来获得如图所示的 UI，但只有图标和文本之间的垂直线分隔符丢失。 我的代码如下：

procedure TForm1.pmiProjectCopyDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  bt: Tbitmap;
begin
  bt := Tbitmap.Create;
  with TMenuItem(Sender) do
  begin
    with ACanvas do
    begin
      Brush.Color := clWhite;
      FillRect(ARect);
      pen.Color := $00E5DFD7;
      if Selected then
      begin
        Font.Color := $006C4E1F;
      end
      else
      begin
         Font.Color := $00757575;
      end;
      Font.Size := 8;
      Font.Name := 'Noto Sans';
      if Caption = '-' then
      begin
        MoveTo(ARect.left + 25, ARect.Top + 3);
        LineTo(ARect.Width, ARect.Top + 3);
      end
      else
      begin
        ImageList1.GetBitmap(ImageIndex, bt);
        Draw(ARect.left + 3, ARect.Top + 3, bt);
        ARect.left := ARect.left + 25;
        DrawText(ACanvas.Handle, PChar(Caption), Length(Caption), ARect,
          DT_SINGLELINE or DT_VCENTER);
        DrawText(ACanvas.Handle, PChar(ShortCutToText(shortcut)),
          Length(ShortCutToText(shortcut)), ARect, DT_SINGLELINE or DT_RIGHT);
      end;
    end;

  end;
end;

当我编译这段代码时，我的输出如下：

剩下的就是我想得到一条垂直线，如下图所示：

Answer 1

我已经设法编写了一些代码来获得如图所示的 UI，但只有图标和文本之间的垂直线分隔符丢失。 我的代码如下：

procedure TForm1.pmiProjectCopyDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  bt: Tbitmap;
begin
  bt := Tbitmap.Create;
  with TMenuItem(Sender) do
  begin
    with ACanvas do
    begin
      Brush.Color := clWhite;
      FillRect(ARect);
      pen.Color := $00E5DFD7;
      if Selected then
      begin
        Font.Color := $006C4E1F;
      end
      else
      begin
         Font.Color := $00757575;
      end;
      Font.Size := 8;
      Font.Name := 'Noto Sans';
      if Caption = '-' then
      begin
        MoveTo(ARect.left + 25, ARect.Top + 3);
        LineTo(ARect.Width, ARect.Top + 3);
      end
      else
      begin
        ImageList1.GetBitmap(ImageIndex, bt);
        Draw(ARect.left + 3, ARect.Top + 3, bt);
        ARect.left := ARect.left + 25;
        DrawText(ACanvas.Handle, PChar(Caption), Length(Caption), ARect,
          DT_SINGLELINE or DT_VCENTER);
        DrawText(ACanvas.Handle, PChar(ShortCutToText(shortcut)),
          Length(ShortCutToText(shortcut)), ARect, DT_SINGLELINE or DT_RIGHT);
      end;
    end;

  end;
end;

当我编译这段代码时，我的输出如下：

剩下的就是我想得到一条垂直线，如下图所示：

Answer 2

我必须消除黑色边框并垂直对齐项目。

这是用 C++ 编写的。我假设MenuItem 字符串是已知的。 DoGetMenuString 函数不可访问。

void __fastcall TForm1::Undo1DrawItem(TObject *Sender, TCanvas *ACanvas,
      TRect &ARect, bool Selected)
{ 
  // The assumptions are that the Canvas colors etc and the Rect sizes 
  // are already set by the program 

  // The text has two spaces at the front and four spaces at the end 

  const AnsiString ItemStr("  Undo              Ctrl+Z    ");

  // calculate the position to draw the text

  static int textpos = (ARect.Height() - ACanvas->TextHeight(ItemStr)) / 2;


  // choose the color for the text

  if( Selected)
    ACanvas->Font->Color = clCream;
  else
    ACanvas->Font->Color = clAqua;


  // Fill the whole rectangle

  ACanvas->FillRect(ARect);


  // write text to Canvas

  ACanvas->TextOut(
    ARect.Left,
    textpos,
    ItemStr);
}