Code:
type
TForm1 = class(TForm)
...
published
procedure AdvancedDrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
procedure MeasureMenuItem(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);
end;
const
GlyphBarWidth = 20;
TextMargin = 5;
procedure TForm1.MeasureMenuItem(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);
begin
if not TMenuItem(Sender).IsLine then Inc(Height, 3);
if not (TMenuItem(Sender).GetParentComponent is TMainMenu) then
Inc(Width, GlyphBarWidth + TextMargin + 10);
end;
function LightenColor(Color: TColor; Value: integer): TColor;
var
R, G, B: Integer;
begin
if Value > 100 then Value := 100;
Color := ColorToRGB(Color);
R := Color and $000000FF;
G := (Color and $0000FF00) shr 8;
B := (Color and $00FF0000) shr 16;
R := R + Round((255 - R) * (Value / 100));
G := G + Round((255 - G) * (Value / 100));
B := B + Round((255 - B) * (Value / 100));
Result := RGB(R, G, B);
end;
procedure TForm1.AdvancedDrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
Item: TMenuItem;
TopLevel: Boolean;
GlyphRect, TextRect: TRect;
Txt: String;
Glyph: TBitmap;
begin
Item := TMenuItem(Sender);
TopLevel := Item.GetParentComponent is TMainMenu;
GlyphRect := ARect;
GlyphRect.Right := GlyphRect.Left + GlyphBarWidth;
TextRect := ARect;
if TopLevel then
OffsetRect(TextRect, TextMargin, -1)
else begin
Inc(TextRect.Left, GlyphBarWidth);
InflateRect(TextRect, -TextMargin, 0);
end;
Inc(TextRect.Top, 4);
with ACanvas, Item do begin
if TopLevel then Brush.Color := clBtnFace else Brush.Color := clMenu;
FillRect(ARect);
if Enabled then Font.Color := clMenuText else Font.Color := clGrayText;
if Default then Font.Style := [fsBold];
if not TopLevel then begin
Brush.Color := clBtnFace;
FillRect(GlyphRect);
end;
if Enabled then begin
if (odHotLight in State) and TopLevel then begin
Pen.Color := clHighLight;
Brush.Color := LightenColor(clHighlight, 68);
Rectangle(Rect(ARect.Left + 1, ARect.Top + 1,
ARect.Right - 1, ARect.Bottom - 1));
end;
if odSelected in State then begin
if TopLevel then begin
Pen.Color := clBtnShadow;
MoveTo(ARect.Left, ARect.Bottom - 1);
LineTo(ARect.Left, ARect.Top + 1);
LineTo(ARect.Right - 2, ARect.Top + 1);
LineTo(ARect.Right - 2, ARect.Bottom);
end else begin
Pen.Color := clHighLight;
Brush.Color := LightenColor(clHighlight, 68);
Rectangle(ARect);
end;
end;
if Checked then begin
Pen.Color := clHighLight;
if odSelected in State then
Brush.Color := LightenColor(clHighlight, 56)
else begin
Brush.Bitmap := AllocPatternBitmap(clBtnFace,
LightenColor(clHighlight, 84));
end;
InflateRect(GlyphRect, -1, -1);
Rectangle(GlyphRect);
Glyph := TBitmap.Create;
try
Glyph.Transparent := True;
Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
Draw(GlyphRect.Left + (GlyphRect.Right - GlyphRect.Left -
Glyph.Width) div 2 + 2, GlyphRect.Top + (GlyphRect.Bottom -
GlyphRect.Top - Glyph.Height) div 2, Glyph);
finally
Glyph.Free;
end;
end;
end;
end;
if Item.IsLine then begin
ACanvas.Pen.Color := LightenColor(clGrayText, 40);
ACanvas.MoveTo(TextRect.Left, Round((ARect.Top + ARect.Bottom) / 2));
ACanvas.LineTo(ARect.Right, Round((ARect.Top + ARect.Bottom) / 2));
end else begin
ACanvas.Brush.Style := bsClear;
Txt := Item.Caption;
DrawText(ACanvas.Handle, PChar(Txt), Length(Txt), TextRect, 0);
if Item.ShortCut <> scNone then begin
Txt := ShortCutToText(Item.ShortCut) + ' ';
DrawText(ACanvas.Handle, PChar(Txt), Length(Txt), TextRect, DT_RIGHT);
end;
end;
end;
Bookmarks