Delphi TPopupMenu дизайн модификации

Question

Можем ли мы добиться описанного ниже внешнего вида с помощью компонента TPopupMenu VCl

Может ли кто-нибудь помочь нам в разработке дизайна?

Я пытался настроить OwnerDrawTrue и написал 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;

после компиляции я получил вид и ощущение, как показано ниже.

Я должен устранить эту черную границу и выровнять элементы по вертикали.

ОБНОВЛЕНИЕ

Мне удалось написать некоторый код, чтобы получитьПользовательский интерфейс, как показано на рисунке, но отсутствует только вертикальный разделитель между значками и текстом.Мой код такой, как показано ниже:

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

Мне удалось написать некоторый код для получения пользовательского интерфейса, как показано на рисунке, но отсутствует только вертикальный разделитель между значками и текстом. Мой код, как показано ниже:

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