Delphi实用代码自绘XP风格菜单

这是以前写的代码，自绘XP风格的菜单，硬盘坏了后以为没了，最后写的一个软件要自定义风格，“翻箱倒柜”的终于在我可爱的古董机^_^上找到了一个应用的例子。

把主菜单作以下调整：

　　OnMeasureItem指向MeasureMainItem、

　　OnAdvancedDrawItem指向DrawMainItem，

　　子菜单的OnMeasureItem指向MeasureSubItem、

　　OnAdvancedDrawItem指向DrawSubItem，

　　调整颜色或使用默认颜色即可达到效果

　　//调整主菜单项尺寸

　　procedure MeasureMainItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);

　　begin

　　Width := Width + 6;

　　Height := Height + 2;

　　end;

　　//调整子菜单项尺寸

　　procedure MeasureSubItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);

　　begin

　　Width := Width + 20;

　　Height := Height + 2;

　　end;

　　//绘制主菜单内容

　　procedure DrawMainItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);

　　const

　　MainMenuBackColor : TColor = $DEEDEF;

　　MainMenuBorderColor : TColor = $DEEDEF;

　　MainMenuSelectedBackColor : TColor = $DFA988;

　　MainMenuSelectedBorderColor: TColor = $C08000;

　　MainMenuHotLightBackColor : TColor = $DEEDEF;

　　MainMenuHotLightBorderColor: TColor = $800080;

　　MainMenuGrayedBackColor : TColor = $DEEDEF;

　　var

　　BrushColor, PenColor: TColor;

　　TextRect: TRECT;

　　begin

　　if odGrayed in State then

　　begin

　　BrushColor := MainMenuGrayedBackColor;

　　PenColor := MainMenuGrayedBackColor;

　　end

　　else

　　if odHotLight in State then

　　begin //鼠标划过

　　BrushColor := MainMenuHotLightBackColor;

　　PenColor := MainMenuHotLightBorderColor;

　　end

[NextPage]

else

　　if odSelected in State then

　　begin

　　BrushColor := MainMenuSelectedBackColor;

　　PenColor := MainMenuSelectedBorderColor;

　　end

　　else

　　begin

　　BrushColor := MainMenuBackColor;

　　PenColor := MainMenuBackColor;

　　if TMenuItem(Sender).Caption = '帮助(&H)' then ARect.Right := ARect.Right + 1600;

　　end;

　　ACanvas.Brush.Color := BrushColor;

　　ACanvas.Pen.Color := PenColor;

　　//ACanvas.FillRect(ARect);

　　ACAnvas.Rectangle(ARect);

　　ACanvas.Brush.Style := bsClear;

　　//绘出文字

　　if odGrayed in State then

　　ACanvas.Font.Color := clBtnShadow

　　else

　　ACanvas.Font.Color := clBlack;

　　SetRect(TextRect, ARect.left+10, ARect.top+3, ARect.right, ARect.bottom);

　　DrawText(ACanvas.Handle, PChar(TMenuItem(Sender).Caption), Length(TMenuItem(Sender).Caption),

　　TextRect, DT_LEFT);

　　end;

　　//绘制子菜单内容

　　procedure DrawSubItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);

　　const

　　SubMenuBackColor : TColor = $F7F8F9;

　　SubMenuBorderColor : TColor = $DEEDEF;

　　SubMenuSelectedBackColor : TColor = $EED2C1;

　　SubMenuSelectedBorderColor: TColor = $C08000;

　　SubMenuLineColor : TColor = $C8D0D4;

　　//SubMenuHotLightBorderColor: TColor = $C08000;

　　SubMenuGrayedBackColor : TColor = $F7F8F9;//$DEEDEF;

您正在看的Delphi教程是:Delphi实用代码自绘XP风格菜单。　　var

　　BrushColor, PenColor: TColor;

　　TextRect: TRECT;

　　str: String;

　　ImageList: TCustomImageList;

　　begin

　　if (odGrayed in State) and not(TMenuItem(Sender).IsLine) then

　　begin

　　BrushColor := SubMenuGrayedBackColor;

　　{if odSelected in State then

　　PenColor := SubMenuSelectedBorderColor

　　else}

[NextPage]

　PenColor := SubMenuGrayedBackColor;

　　end

　　else

　　if odSelected in State then

　　begin

　　BrushColor := SubMenuSelectedBackColor;

　　PenColor := SubMenuSelectedBorderColor;

　　end

　　else

　　begin

　　BrushColor := SubMenuBackColor;

　　PenColor := SubMenuBackColor;

　　end;

　　ACanvas.Brush.Color := BrushColor;

　　ACanvas.Pen.Color := PenColor;

　　ACAnvas.Rectangle(ARect);

　　if not(odSelected in State) or (odGrayed in State) then

　　begin

　　ACanvas.Brush.Color := SubMenuBorderColor;

　　ACanvas.FillRect(Rect(ARect.Left, ARect.Top, ARect.Left+20, ARect.Bottom));

　　end;

　　//绘文字和快捷键

　　if TMenuItem(Sender).IsLine then

　　begin

　　ACanvas.Brush.Color := SubMenuLineColor;

　　ACanvas.Pen.Color := SubMenuLineColor;

　　ACanvas.FillRect(Rect(ARect.Left+23, ARect.Top+(ARect.Bottom-ARect.Top) div 2-1,

　　ARect.Right-2, ARect.Top+(ARect.Bottom-ARect.Top) div 2));

　　end

　　else

　　begin

　　ACanvas.Brush.Style := bsClear;

　　if odGrayed in State then

　　ACanvas.Font.Color := clBtnShadow

　　else

　　ACanvas.Font.Color := clBlack;

　　str := TMenuItem(Sender).Caption;

[NextPage]

SetRect(TextRect, ARect.Left+24, ARect.Top+3, ARect.Right, ARect.Bottom);

　　DrawText(ACanvas.Handle, PChar(str), Length(str), TextRect, DT_LEFT);

　　str := ShortCutToText(TMenuItem(Sender).ShortCut);

　　SetRect(TextRect, ARect.Left+24, ARect.Top+3, ARect.Right-10, ARect.Bottom);

　　DrawText(ACanvas.Handle, PChar(str), Length(str), TextRect, DT_RIGHT);

　　//

　　if TMenuItem(Sender).Checked then

　　begin

　　ACanvas.Font.Charset := DEFAULT_CHARSET;

　　ACanvas.Font.Name := 'Webdings';

　　if TMenuItem(Sender).RadioItem then

　　ACanvas.TextOut(ARect.Left+4, ARect.Top, '=')

　　else

　　begin

　　ACanvas.Font.Height := -16;

　　ACanvas.TextOut(ARect.Left+2, ARect.Top, 'a');

　　end;

　　end;

　　end;

　　//绘制图片

　　ImageList := TMenuItem(Sender).GetImageList;

　　if ImageList<>nil then

　　if (odSelected in State) and not(odGrayed in State) then

　　ImageList.Draw(ACanvas, ARect.left+2, ARect.Top+2, TMenuItem(Sender).ImageIndex)

　　else

　　ImageList.Draw(ACanvas, ARect.left+3, ARect.Top+3,

　　TMenuItem(Sender).ImageIndex, TMenuItem(Sender).Enabled);

　　end;