Delphi OwnerDraw 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);
}

Answer 3

我需要类似的东西，这里使用的技术是为每个项目绘制一条垂直线，调整分隔符的矩形。

Pen.Width := 1; // set the width of the vertical line
if Caption = '-' then // for separator
begin
  // start at 25px (icon margin) + 3px for a small space between the lines, 
  // and 3 pixels down from the top
  MoveTo(ARect.left + 25 + 3, ARect.Top + 3); 
  // ... and stopping 3 pixels above the bottom
  LineTo(ARect.Left + 25 + 3, ARect.Bottom - 3);
end
else 
begin
  // for normals items, start 6 pixels above the top so it extends down to the bottom
  MoveTo(ARect.Left - 4, ARect.Top - 6);
  LineTo(ARect.Left - 4, ARect.Bottom);
end;

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;

      // => Draw the vertical Line
      Pen.Width := 1; // set the width of the vertical line
      if Caption = '-' then // for separator
      begin
        // start at 25px (icon margin) + 3px for a small space between the lines, 
        // and 3 pixels down from the top
        MoveTo(ARect.left + 25 + 3, ARect.Top + 3); 
        // ... and stopping 3 pixels above the bottom
        LineTo(ARect.Left + 25 + 3, ARect.Bottom - 3);
       end
      else 
      begin
        // for normals items, start 6 pixels above the top 
        // so it extends down to the bottom
        MoveTo(ARect.Left - 4, ARect.Top - 6);
        LineTo(ARect.Left - 4, ARect.Bottom);
      end;
    end;
  end;
end;