Delphi实用代码:自绘XP风格菜单
把主菜单作以下调整:
OnMeasureItem指向MeasureMainItem、
OnAdvancedDrawItem指向DrawMainItem,
子菜单的OnMeasureItem指向MeasureSubItem、
OnAdvancedDrawItem指向DrawSubItem,
调整颜色或使用默认颜色即可达到效果
//调整主菜单项尺寸
procedure TForm1.MeasureMainItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
Width := Width + 6;
Height := Height + 2;
end;
//调整子菜单项尺寸
procedure TForm1.MeasureSubItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
Width := Width + 20;
Height := Height + 2;
end;
//绘制主菜单内容
procedure TForm1.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 TForm1.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;
【推荐】国内首个AI IDE,深度理解中文开发场景,立即下载体验Trae
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步
· Linux系列:如何用 C#调用 C方法造成内存泄露
· AI与.NET技术实操系列(二):开始使用ML.NET
· 记一次.NET内存居高不下排查解决与启示
· 探究高空视频全景AR技术的实现原理
· 理解Rust引用及其生命周期标识(上)
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布:重大改进与新特性概览!
· 单线程的Redis速度为什么快?
· 展开说说关于C#中ORM框架的用法!
· Pantheons:用 TypeScript 打造主流大模型对话的一站式集成库