Reputation: 583

Delphi OwnerDraw TPopupMenu design modifications

Can we achieve the below look and feel with TPopupMenu VCL component

Can someone guide us in achieving the design?

I have tried setting OwnerDraw to True and wrote the OnDrawItem for menu items, But that is not successfull.

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;

after compiling this I got the look and feel like below.

I have to eliminate that black border and align the items vertically.

UPDATE

I have managed to write some code to get the UI as shown in the image but only the Vertical line separator in-between icons and text is missing. My code is as below:

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;

when i compile this code my output is as below :

Only thing left is I want to get a vertical line as shown in below image:

Upvotes: 3

Answers (3)

flydev

Reputation: 5674

I needed something similar, the technique used here is to draw a vertical line for each item, adjusting rect for separators.

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;

Upvotes: 0

Baxter

Reputation: 126

I have to eliminate that black border and align the items vertically.

This is written in C++. I've assumed that the MenuItem string is known. The DoGetMenuString function is not accessible.

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