Придайте вашему меню свой собственный стиль

Обратите внимание: Удостоверьтесь, что свойства OwnerRedraw и ParentBidiMode установлены в True.

unit fMenu; 

interface 

uses 
  Windows, SysUtils, Classes, Graphics, Controls, 
  Forms, Menus, ImgList; 

type 
  TForm1 = class(TForm) 
    ImageList1: TImageList; 
    MainMenu1: TMainMenu; 
    FileMenu: TMenuItem; 
    procedure DrawItem(Sender: TObject; 
        ACanvas: TCanvas; ARect: TRect; 
        Selected: Boolean); 
    procedure FormCreate(Sender: TObject); 
  private 
    procedure MenueDrawItemX(xMenu: TMenu); 
  public 
  end; 
procedure MenueDrawItem(Sender: TObject; 
      ACanvas: TCanvas; ARect: TRect; 
      Selected: Boolean); 

var 
  Form1: TForm1; 

implementation 

{$R *.DFM} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  MenueDrawItemX(Menu); 
end; 

procedure TForm1.DrawItem(Sender: TObject; 
    ACanvas: TCanvas; ARect: TRect; 
    Selected: Boolean); 
begin 
  MenueDrawItem(Sender, ACanvas, ARect, Selected); 
end; 

procedure TForm1.MenueDrawItemX(xMenu: TMenu); 
var 
  i: integer; 
  B: TBitmap; 
  FMenuItem: TMenuItem; 
begin 
  B := TBitmap.Create; 
  B.Width := 1; 
  B.Height := 1; 

  for i := 0 to ComponentCount - 1 do 
    if Components[i] is TMenuItem then 
      begin 
        FMenuItem := TMenuItem(Components[i]); 
        FMenuItem.OnDrawItem := DrawItem; 
        if (FMenuItem.ImageIndex = -1) and 
           (FMenuItem.Bitmap.width = 0) and (xMenu <> nil) then 
          if FMenuItem.GetParentComponent.Name <> xMenu.Name then 
            FMenuItem.Bitmap.Assign(b); 
      end; 

  B.Free; 
  DrawMenuBar(handle); 


end; 


procedure MenueDrawItem(Sender: TObject; 
    ACanvas: TCanvas; ARect: TRect; 
    Selected: Boolean); 
var 
  txt: string; 
  B: TBitmap; 

  IConRect, TextRect: TRect; 
  FBackColor, FIconBackColor, FSelectedBkColor, 
    FFontColor, FSelectedFontColor, 
    FDisabledFontColor, FSeparatorColor, FCheckedColor: TColor; 

  i, X1, X2: integer; 
  TextFormat: integer; 
  HasImgLstBitmap: boolean; 
  FMenuItem: TMenuItem; 
  FMenu: TMenu; 

begin 
  FMenuItem := TMenuItem(Sender); 
  FMenu := FMenuItem.Parent.GetParentMenu; 

  FBackColor := $00E1E1E1; 
  FIconBackColor := $00D1D1D1; 
  FSelectedBkColor := $00DCCFC7; 

  FFontColor := clBlack; 
  FSelectedFontColor := clNavy; 
  FDisabledFontColor := clGray; 
  FSeparatorColor := $00D1D1D1; 
  FCheckedColor := clGray; 

  if FMenu.IsRightToLeft then 
    begin 
      X1 := ARect.Right - 20; 
      X2 := ARect.Right; 
    end 
  else 
    begin 
      X1 := ARect.Left; 
      X2 := ARect.Left + 20; 
    end; 
  IConRect := Rect(X1, ARect.Top, X2, ARect.Bottom); 

  TextRect := ARect; 
  txt := ' ' + FMenuItem.Caption; 

  B := TBitmap.Create; 

  B.Transparent := True; 
  B.TransparentMode := tmAuto; 

  HasImgLstBitmap := false; 
  if (FMenuItem.Parent.GetParentMenu.Images <>  nil) or 
     (FMenuItem.Parent.SubMenuImages <> nil) then 
    begin 
      if FMenuItem.ImageIndex <> -1 then 
        HasImgLstBitmap := true 
      else 
        HasImgLstBitmap := false; 
    end; 

  if HasImgLstBitmap then 
    begin 
      if FMenuItem.Parent.SubMenuImages <> nil then 
        FMenuItem.Parent.SubMenuImages.GetBitmap(
          FMenuItem.ImageIndex, B) 
      else 
        FMenuItem.Parent.GetParentMenu.Images.GetBitmap(
          FMenuItem.ImageIndex, B) 
    end 
  else 
    if FMenuItem.Bitmap.Width > 0 then 
      B.Assign(TBitmap(FMenuItem.Bitmap)); 

  if FMenu.IsRightToLeft then 
    begin 
      X1 := ARect.Left; 
      X2 := ARect.Right - 20; 
    end 
  else 
    begin 
      X1 := ARect.Left + 20; 
      X2 := ARect.Right; 
    end; 
  TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom); 

  ACanvas.brush.color := FBackColor; 
  ACanvas.FillRect(TextRect); 

  if FMenu is TMainMenu then 
    for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do 
      if FMenuItem.GetParentMenu.Items[i] = FMenuItem then 
        begin 
          ACanvas.brush.color := FIConBackColor; 
          ACanvas.FillRect(ARect); 
          if (FMenuItem.ImageIndex = -1) and (
              FMenuItem.Bitmap.width = 0) then 
            begin 
              TextRect := ARect; 
              break; 
            end; 
        end; 

  ACanvas.brush.color := FIconBackColor; 
  ACanvas.FillRect(IconRect); 

  if FMenuItem.Enabled then 
    ACanvas.Font.Color := FFontColor 
  else 
    ACanvas.Font.Color := FDisabledFontColor; 

  if Selected then 
    begin 
      ACanvas.brush.Style := bsSolid; 
      ACanvas.brush.color := FSelectedBkColor; 
      ACanvas.FillRect(TextRect); 

      ACanvas.Pen.color := FSelectedFontColor; 

      ACanvas.Brush.Style := bsClear; 
      ACanvas.RoundRect(TextRect.Left, 
                        TextRect.top, TextRect.Right, 
                        TextRect.Bottom, 6, 6); 

      if FMenuItem.Enabled then 
        ACanvas.Font.Color := FSelectedFontColor; 
    end; 

  X1 := IConRect.Left + 2; 
  if B <> nil then 
    ACanvas.Draw(X1, IConRect.top + 1, B); 

  if FMenuItem.Checked then 
    begin 
      ACanvas.Pen.color := FCheckedColor; 
      ACanvas.Brush.Style := bsClear; 
      ACanvas.RoundRect(IconRect.Left, 
                        IconRect.top, IconRect.Right, 
                        IconRect.Bottom, 3, 3); 
    end; 

  if not FMenuItem.IsLine then 
    begin 
      SetBkMode(ACanvas.Handle, TRANSPARENT); 

      ACanvas.Font.Name := 'Tahoma'; 
      if FMenu.IsRightToLeft then 
        ACanvas.Font.Charset := ARABIC_CHARSET; 

      if FMenu.IsRightToLeft then 
        TextFormat := DT_RIGHT + DT_RTLREADING 
      else 
        TextFormat := 0; 


      if FMenuItem.Default then 
        begin 
          Inc(TextRect.Left, 1); 
          Inc(TextRect.Right, 1); 
          Inc(TextRect.Top, 1); 
          ACanvas.Font.color := clGray; 
          DrawtextEx(ACanvas.Handle, 
                     PChar(txt), 
                     Length(txt), 
                     TextRect, TextFormat, nil); 

          Dec(TextRect.Left, 1); 
          Dec(TextRect.Right, 1); 
          Dec(TextRect.Top, 1); 

          ACanvas.Font.color := FFontColor; 
        end; 

      DrawtextEx(ACanvas.Handle, 
                 PChar(txt), 
                 Length(txt), 
                 TextRect, TextFormat, nil); 

      txt := ShortCutToText(FMenuItem.ShortCut) +  ' '; 

      if FMenu.IsRightToLeft then 
        TextFormat := DT_LEFT 
      else 
        TextFormat := DT_RIGHT; 

      DrawtextEx(ACanvas.Handle, 
                 PChar(txt), 
                 Length(txt), 
                 TextRect, TextFormat, nil); 
    end 
  else 
    begin 
      ACanvas.Pen.Color := FSeparatorColor; 
      ACanvas.MoveTo(ARect.Left + 10, 
                     TextRect.Top + 
                     Round((TextRect.Bottom - TextRect.Top) / 2)); 
      ACanvas.LineTo(ARect.Right - 2, 
                     TextRect.Top + 
                     Round((TextRect.Bottom - TextRect.Top) / 2)) 
    end; 


  B.free; 


end; 

end.