procedure TForm1.menuFileNewAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var MenuHeight,BmpPos:Integer;//菜单项的高度;菜单中所画图标的边距 TempMenuItem:TMenuItem; file://调用此过程的菜单项 DrawIco:TIcon; file://图标对象,用以画出菜单项的图标 TempRect:TRect; file://临时的矩形区域,程序中多次使用 ShowCaption:String; file://菜单项的标题 ImageList:TCustomImageList; file://菜单项所使用的图标列表控件 begin TempMenuItem:=(Sender as TMenuItem);//获取调用此过程的菜单项 ShowCaption:=TempMenuItem.Caption; file://获取菜单标题 DrawIco:=TIcon.Create; file://创建图标对象with ACanvas,ARect do begin MenuHeight:=25; file://此数值与在 OnMeasureItem 事件中设置的Height属性值相同 BmpPos:=(MenuHeight-16) div 2;{ 计算所画的图标边距,所显示的图标尺寸一般为16,所以此处取值也为16, 可根据实际更改此数值。} Brush.Color :=RGB(255,251,247);//设置菜单的背景色,此处设为奶白色,可根据需要更改 FillRect(Arect); file://填充背景 Brush.Color:=RGB(223,215,207);//设置菜单项图标区域的背景色,可根据需要更改 TempRect:=Rect(Left,Top,MenuHeight,Bottom);//设置图标背景的矩形区域 FillRect(TempRect);//填充图标背景 if TempMenuItem.Caption='-' then begin Pen.Color:=RGB(175,183,207); MoveTo(Left+MenuHeight+5,Top+((Bottom-Top) div 2)-1); LineTo(Right,Top+((Bottom-Top) div 2)-1); Pen.Color:=clWhite;//RGB(175,183,207); MoveTo(Left+MenuHeight+5,Top+((Bottom-Top) div 2)); LineTo(Right,Top+((Bottom-Top) div 2)); Exit; end;{以上程序判断该菜单项是否为分隔线, 如果是,则画出分隔线样式后退出此过程。可根据需要更改其效果} ImageList:=TempMenuItem.GetImageList;//获取所使用的图标列表控件 if ImageList<>nil then file://如果主菜单关联了图标列表控件 if (TempMenuItem.Imageindex<>-1) then file://如果该菜单项指定了图标 begin ImageList.GetIcon(TempMenuItem.ImageIndex,DrawIco);//从图标列表控件中获取图标 if TempMenuItem.Checked then file://如果该菜单项有复选标记则画出一个蓝色框 begin brush.Color:=RGB(175,183,207); Pen.Color :=clBlack; RoundRect(Left+1,Top+2,MenuHeight-2,Bottom-2,0,0); end; end else file://如果该菜单项没有指定图标 if TempMenuItem.Checked then Imagelist.GetIcon(11,DrawIco); {如果菜单项有复选标记,则从图标列表控件中获取一个表示复选的图标 数字11是该图标的索引号,可根据实际更改;如没有该图标,可将这两句删除} if (odSelected in State) {and (Not (odDisabled in State))} then {如果该菜单项处于被选择状态,则画出以下选择样式 注释的一句加上的话表示如果菜单项处于无效状态则光标指向时无任何效果} begin file://以下程序画出一个蓝色框以表示该菜单项处于被选择状态 Inc(Left,2);Inc(Top,2); Brush.Style:=bsSolid; brush.Color:=clGray;//RGB(110,120,180); Pen.Color:=clMenu; RoundRect(Left,Top,Right,Bottom,5,5); {以上四句画出蓝色框的阴影} brush.Color:=RGB(175,183,207); Dec(Left,2);Dec(Top,2); Dec(Right,2);Dec(Bottom,2); Pen.Color :=clBlack; RoundRect(Left,Top,Right,Bottom,3,3); {以上四句画出蓝色框} Draw(BmpPos,Top+BmpPos,DrawIco); file://画出图标阴影(我不知道怎样把图标颜色变成灰度,只好原样画上) Dec(BmpPos,1); end; Draw (BmpPos,Top+BmpPos,DrawIco);//画出图标 DrawIco.Free; file://图标已画出,可以释放图标对象 TempRect:=Rect(Left+MenuHeight+10,Top,Right,Bottom);//设置菜单标题的矩形区域 Brush.Style:=bsClear;//设置画刷的填充样式为透明,这样画出的菜单标题就为透明底色 with Font do file://根据菜单项的状态设置字体样式 begin if (odDisabled in State) then Color :=clgray else Color :=clblack; {设置菜单项在有效或无效状态时的字体颜色,具体的颜色可根据实际更改} if TempMenuItem.Default then Style:= Style+[fsBold]; {如果菜单项为默认,则设置字体为粗体} end; DrawText(Handle,PChar(ShowCaption),-1,TempRect,DT_LEFT or DT_SINGLELINE or DT_VCENTER); {最后画出菜单项的标题} end; end; file://此过程为菜单项的尺寸设置列表事件 procedure TForm1.menuFileNewMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin if TMenuItem(Sender).Caption<>'-' then Height:=25; file://如果菜单项不是分隔线则设置其高度,可根据需要更改,更改后注意将高级自画事件中的 MenuHeight 变量设置为相同数值 end; file://此过程为主菜单项的高级自画事件,主要是画出一个带阴影的矩形框 procedure TForm1.menuFileAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var TempMenuItem:TMenuItem; TempRect:TRect; ShowCaption:String; begin TempMenuItem:=(Sender as TMenuItem); ShowCaption:=TempMenuItem.Caption; with acanvas,arect do begin FillRect(ARect); Inc(Left,1);
if (odSelected in State) then file://如果该菜单项处于被选择状态 begin Brush.Color:=RGB(189,190,189); TempRect:=Rect(Left,Top+3,Right,Bottom); FillRect(TempRect); Brush.Color:=RGB(181,182,181); TempRect:=Rect(Left,Top+2,Right-1,Bottom); FillRect(TempRect); Brush.Color:=RGB(165,162,165); TempRect:=Rect(Left,Top+1,Right-2,Bottom); FillRect(TempRect); file://以上三段分别画出阴影 Inc(Bottom,5); Pen.Color:=RGB(99,97,99); Brush.Color:=clMenu; RoundRect(Left,Top,Right-3,Bottom,5,5); Dec(Bottom,5); TempRect:=Rect(Left,Bottom,Right,Bottom+5); FillRect(TempRect); file://画出边框颜色为灰色的矩形框 end; DrawText(Handle,pchar(ShowCaption),-1,ARect,DT_CENTER or DT_SINGLELINE or DT_VCENTER); file://最后画出菜单标题 end; end;
{$R WindowsXP.RES}
就可以将.EXE文件编译成XP风格
但.CPL文件为什么不行!?关注中....
var
MenuHeight,BmpPos:Integer;//菜单项的高度;菜单中所画图标的边距
TempMenuItem:TMenuItem; file://调用此过程的菜单项
DrawIco:TIcon; file://图标对象,用以画出菜单项的图标
TempRect:TRect; file://临时的矩形区域,程序中多次使用
ShowCaption:String; file://菜单项的标题
ImageList:TCustomImageList; file://菜单项所使用的图标列表控件
begin
TempMenuItem:=(Sender as TMenuItem);//获取调用此过程的菜单项
ShowCaption:=TempMenuItem.Caption; file://获取菜单标题
DrawIco:=TIcon.Create; file://创建图标对象with ACanvas,ARect do
begin
MenuHeight:=25; file://此数值与在 OnMeasureItem 事件中设置的Height属性值相同
BmpPos:=(MenuHeight-16) div 2;{
计算所画的图标边距,所显示的图标尺寸一般为16,所以此处取值也为16,
可根据实际更改此数值。} Brush.Color :=RGB(255,251,247);//设置菜单的背景色,此处设为奶白色,可根据需要更改
FillRect(Arect); file://填充背景
Brush.Color:=RGB(223,215,207);//设置菜单项图标区域的背景色,可根据需要更改
TempRect:=Rect(Left,Top,MenuHeight,Bottom);//设置图标背景的矩形区域
FillRect(TempRect);//填充图标背景 if TempMenuItem.Caption='-' then
begin
Pen.Color:=RGB(175,183,207);
MoveTo(Left+MenuHeight+5,Top+((Bottom-Top) div 2)-1);
LineTo(Right,Top+((Bottom-Top) div 2)-1);
Pen.Color:=clWhite;//RGB(175,183,207);
MoveTo(Left+MenuHeight+5,Top+((Bottom-Top) div 2));
LineTo(Right,Top+((Bottom-Top) div 2));
Exit;
end;{以上程序判断该菜单项是否为分隔线,
如果是,则画出分隔线样式后退出此过程。可根据需要更改其效果} ImageList:=TempMenuItem.GetImageList;//获取所使用的图标列表控件
if ImageList<>nil then file://如果主菜单关联了图标列表控件
if (TempMenuItem.Imageindex<>-1) then file://如果该菜单项指定了图标
begin
ImageList.GetIcon(TempMenuItem.ImageIndex,DrawIco);//从图标列表控件中获取图标
if TempMenuItem.Checked then file://如果该菜单项有复选标记则画出一个蓝色框
begin
brush.Color:=RGB(175,183,207);
Pen.Color :=clBlack;
RoundRect(Left+1,Top+2,MenuHeight-2,Bottom-2,0,0);
end;
end
else file://如果该菜单项没有指定图标
if TempMenuItem.Checked then Imagelist.GetIcon(11,DrawIco);
{如果菜单项有复选标记,则从图标列表控件中获取一个表示复选的图标
数字11是该图标的索引号,可根据实际更改;如没有该图标,可将这两句删除} if (odSelected in State) {and (Not (odDisabled in State))} then
{如果该菜单项处于被选择状态,则画出以下选择样式
注释的一句加上的话表示如果菜单项处于无效状态则光标指向时无任何效果} begin file://以下程序画出一个蓝色框以表示该菜单项处于被选择状态
Inc(Left,2);Inc(Top,2);
Brush.Style:=bsSolid;
brush.Color:=clGray;//RGB(110,120,180);
Pen.Color:=clMenu;
RoundRect(Left,Top,Right,Bottom,5,5);
{以上四句画出蓝色框的阴影} brush.Color:=RGB(175,183,207);
Dec(Left,2);Dec(Top,2);
Dec(Right,2);Dec(Bottom,2);
Pen.Color :=clBlack;
RoundRect(Left,Top,Right,Bottom,3,3);
{以上四句画出蓝色框} Draw(BmpPos,Top+BmpPos,DrawIco);
file://画出图标阴影(我不知道怎样把图标颜色变成灰度,只好原样画上)
Dec(BmpPos,1);
end; Draw (BmpPos,Top+BmpPos,DrawIco);//画出图标
DrawIco.Free; file://图标已画出,可以释放图标对象
TempRect:=Rect(Left+MenuHeight+10,Top,Right,Bottom);//设置菜单标题的矩形区域
Brush.Style:=bsClear;//设置画刷的填充样式为透明,这样画出的菜单标题就为透明底色
with Font do file://根据菜单项的状态设置字体样式
begin
if (odDisabled in State) then Color :=clgray else Color :=clblack;
{设置菜单项在有效或无效状态时的字体颜色,具体的颜色可根据实际更改} if TempMenuItem.Default then Style:= Style+[fsBold];
{如果菜单项为默认,则设置字体为粗体}
end;
DrawText(Handle,PChar(ShowCaption),-1,TempRect,DT_LEFT or DT_SINGLELINE or DT_VCENTER);
{最后画出菜单项的标题}
end;
end;
file://此过程为菜单项的尺寸设置列表事件
procedure TForm1.menuFileNewMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
if TMenuItem(Sender).Caption<>'-' then Height:=25;
file://如果菜单项不是分隔线则设置其高度,可根据需要更改,更改后注意将高级自画事件中的 MenuHeight 变量设置为相同数值
end;
file://此过程为主菜单项的高级自画事件,主要是画出一个带阴影的矩形框
procedure TForm1.menuFileAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
TempMenuItem:TMenuItem;
TempRect:TRect;
ShowCaption:String;
begin
TempMenuItem:=(Sender as TMenuItem);
ShowCaption:=TempMenuItem.Caption;
with acanvas,arect do
begin
FillRect(ARect);
Inc(Left,1);
if (odSelected in State) then file://如果该菜单项处于被选择状态
begin
Brush.Color:=RGB(189,190,189);
TempRect:=Rect(Left,Top+3,Right,Bottom);
FillRect(TempRect); Brush.Color:=RGB(181,182,181);
TempRect:=Rect(Left,Top+2,Right-1,Bottom);
FillRect(TempRect); Brush.Color:=RGB(165,162,165);
TempRect:=Rect(Left,Top+1,Right-2,Bottom);
FillRect(TempRect);
file://以上三段分别画出阴影 Inc(Bottom,5);
Pen.Color:=RGB(99,97,99);
Brush.Color:=clMenu;
RoundRect(Left,Top,Right-3,Bottom,5,5);
Dec(Bottom,5);
TempRect:=Rect(Left,Bottom,Right,Bottom+5);
FillRect(TempRect);
file://画出边框颜色为灰色的矩形框
end;
DrawText(Handle,pchar(ShowCaption),-1,ARect,DT_CENTER or DT_SINGLELINE or DT_VCENTER);
file://最后画出菜单标题
end;
end;