Ownerdrawn menus
Change the ownerdraw property of the TMainMenu to True, then for each
TMenuItem you want to custom draw mess with OnDrawItem and
OnMeasureItem. Following an example freely converted from a MSDN
sample :
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem; // File
N2: TMenuItem; // File -> Regular
N3: TMenuItem; // File -> Bold
N4: TMenuItem; // File -> Italic
N5: TMenuItem; // File -> Underline
procedure N1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure N1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
...
procedure TForm1.N1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
clrPrevText: TColor;
clrPrevBkgnd: TColor;
begin
case (Sender as TMenuItem).MenuIndex of
1: ACanvas.Font.Style := [fsBold];
2: ACanvas.Font.Style := [fsItalic];
3: ACanvas.Font.Style := [fsUnderline];
end;
// Saving foreground and background colors.
clrPrevText := ACanvas.Font.Color;
clrPrevBkgnd := ACanvas.Brush.Color;
// Set the appropriate foreground and background colors.
if Selected then
begin
ACanvas.Font.Color := clHighlightText;
ACanvas.Brush.Color := clHighlight;
end
else
begin
ACanvas.Font.Color := clMenuText;
ACanvas.Brush.Color := clMenu;
end;
// Determine where to draw and leave space for a check mark.
ExtTextOut(ACanvas.Handle, ARect.Left +
GetSystemMetrics(SM_CXMENUCHECK), ARect.Top + 1,
ETO_OPAQUE, @ARect, PChar((Sender as TMenuItem).Caption),
Length((Sender as TMenuItem).Caption), nil);
// Restore the original font and colors.
ACanvas.Font.Color := clrPrevText;
ACanvas.Brush.Color := clrPrevBkgnd;
ACanvas.Font.Style := [];
end;
procedure TForm1.N1MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
Size: TSize;
begin
GetTextExtentPoint32(ACanvas.Handle,
PChar((Sender as TMenuItem).Caption),
Length((Sender as TMenuItem).Caption), Size);
Width := size.cx + 2 * GetSystemMetrics(SM_CXMENUCHECK);
Height := size.cy + 5;
end;