邪恶八进制信息安全团队技术讨论组's Archiver

Etern4lCn 2005-4-10 11:13

[转载]Delphi实用代码:自绘XP风格菜单

  信息来源：CSDN


　　这是以前写的代码，自绘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






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

　　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;

　　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;

haicao 2005-5-17 11:03

这个是不错。
用delpi里有自带控件可以做成和delphi系统本身一样的菜单。
可单是菜单似乎有点不够还要程序界面也变xp风格。
网上有一种方法。用xml编译成res包含进来，我试过但好像没什么变化。。。。

evilow 2005-6-12 13:34

问个很菜的问题  OnMeasureItem指向MeasureMainItem  是什么意思~~~  我刚刚学Delphi

haicao 2005-6-14 10:41

OnMeasureItem是一个事件,把这个事件指向这个事件处理程序MeasureItem
默认的一些事件都是onXXX在属性面板直接双击时就自动产生名为xxxx的过程与它关联.

softbug 2005-7-10 19:48

一步一步的画，好辛苦啊 ，谢谢楼上的同志

haicao 2005-8-26 11:10

如果要作程序界面用vclskin蛮不错的，默认已经有好多种界面包了。
从菜单到对话框再到最简单的程序界面，它都会帮你作得很不错！

haokale 2005-9-2 21:04

上面有点代码不明白什么意思
能不能说清楚些

页: [1]
© 1999-2008 EvilOctal Security Team