这是以前写的代码,自绘XP风格的菜单,硬盘坏了后以为没了,最后写的一个软件要自定义风格,“翻箱倒柜”的终于在我可爱的古董机^_^上找到了一个应用的例子。还是把它放到Blog上来,即可共享又可作为备用 :)
  把主菜单的OnMeasureItem指向MeasureMainItem、OnAdvancedDrawItem指向DrawMainItem,子菜单的OnMeasureItem指向MeasureSubItem、OnAdvancedDrawItem指向DrawSubItem,调整颜色或使用默认颜色即可达到效果

{=======================================================================
  DESIGN BY :  彭国辉
  SITE:             http://kacarton.yeah.net/
  BLOG:           http://blog.csdn.net/nhconch
  EMAIL:          kacarton@sohu.com

文章为作者原创,转载前请先与本人联系,转载请注明文章出处、保留作者信息,谢谢支持!
========================================================================}

//调整主菜单项尺寸
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;

http://blog.csdn.net/nhconch/article/details/83723

自绘XP风格菜单的更多相关文章

  1. XP退役了,如何把Win7变成XP风格?| 怎么样去掉Win7的所有华丽效果? | 怎么样让Win7达到电脑最佳性能?

    XP系统退役了,以后微软停止XP系统的更新维护了. 不得不升级使用Windows7系统,但是大部分使用Windows7不习惯. 那是因为你的操作习惯,还保持在XP风格基础上. 那么有没有什么办法让Wi ...

  2. 让VC6.0编译出来的程序支持XP样式或XP风格

    (1)VC6.0编译出来的win32程序不支持winxp样式的原因:微软WINXP系统更新了Comctl32.dll(ver 6.0)这个“XP风格”的控件.为了保留传统的Windows界面风格,特地 ...

  3. VB|xp风格:终于解决了“图片优化软件”在部分xp系统上无法启动的问题。

    一年以来,图片优化软件一直存在一个“兼容”性问题. 因为之前的软件是在windows 2003系统上开发的,制作成安装文件后,经部分用户测试发现,在部分用户的xp系统上安装后,无法正常启动,只能听到p ...

  4. 在VC6/VC2005下使程序直接具有XP风格(XP Style):

    原文 首先将以下文本保存为XpStyle.mainfest(后经实践,文件名和后缀是什么都无所谓) <?xml version="1.0" encoding="UT ...

  5. vs 2005/2008/2010 ATL ActiveX控件显示XP风格

    vs 2005/2008/2010 ATL ActiveX控件在IE浏览器中控件显示的是原始的风格,要显示XP风格只要进行以下操作 一.在Stdafx.h中增加下以内容 #if defined _M_ ...

  6. 基于QT的换肤整体解决方案(QSkinStyle)(提供Linux的XP风格)

    基于QT的换肤整体解决方案(QSkinStyle) 对QT这个成功的跨平台GUI库,本身内置了对换肤功能的实现,比如cleanlooks.plastique等跨平台风格:还有一些是和平台相关的风格,比 ...

  7. windows 7 Alt+Tab 的风格改成 XP 风格

    1.开始菜单-运行-输入“regedit”. 2.找到这个位置“[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explore ...

  8. 支持xp风格的manifest

    MSDN 和一些网站上的manifest 有问题 ,  自己修改了一下加上Microsoft.VC80.DebugCRT 和 Microsoft.VC80.DebugMFC 就可以了.如果是relea ...

  9. XP右键菜单添加“打开所在文件夹”功能

    把以下文字保存为add.reg文件,双击后确定就可以了. REGEDIT4 [HKEY_CLASSES_ROOT\*\Shell\打开所在文件夹(&O)] [HKEY_CLASSES_ROOT ...

随机推荐

  1. poj 1363 Rails in PopPush City &&【求堆栈中合法出栈顺序次数】

    问题如下: 问题 B: Rails 时间限制: Sec 内存限制: MB 提交: 解决: [提交][状态][讨论版] 题目描述 There is a famous railway station in ...

  2. .NET Core & ASP.NET Core 1.0

    .NET Core & ASP.NET Core 1.0在Redhat峰会上正式发布 众所周知,Red Hat和微软正在努力使.NET Core成为Red Hat企业版Linux (RHEL) ...

  3. docker学习笔记12:Dockerfile 指令 ENTRYPOINT介绍

    本文介绍Dockerfile的 ENTRYPOINT指令的含义. 先回顾下CMD指令的含义,CMD指令可以指定容器启动时要执行的命令,但它可以被docker run命令的参数覆盖掉. ENTRYPOI ...

  4. 基于visual Studio2013解决C语言竞赛题之0513字符拷贝

     题目 解决代码及点评 /************************************************************************/ /* 13. 将字符数 ...

  5. CMAKE的使用

    CMAKE的使用 Version 1.0 2009-3-18 一.      基本使用 安装:下载二进制包后可直接解压使用 从源码安装则执行命令:./bootstrap; make; make ins ...

  6. JAVAC 命令使用方法

    结构 javac [ options ] [ sourcefiles ] [ @files ] 參数可按随意次序排列. options 命令行选项. sourcefiles 一个或多个要编译的源文件( ...

  7. Linux高性能server编程——Linux网络基础API及应用

     Linux网络编程基础API 具体介绍了socket地址意义极其API,在介绍数据读写API部分引入一个有关带外数据发送和接收的程序,最后还介绍了其它一些辅助API. socket地址API 主 ...

  8. [leetcode] Reverse Linked List 分类: leetcode 算法 2015-07-09 18:44 2人阅读 评论(0) 收藏

    反转链表:比较简单的问题,可以遍历也可以递归. # Definition for singly-linked list. class ListNode: def __init__(self, x): ...

  9. BZOJ 3039: 玉蟾宫( 悬线法 )

    最大子矩阵...悬线法..时间复杂度O(nm) 悬线法就是记录一个H向上延伸的最大长度(悬线), L, R向左向右延伸的最大长度, 然后通过递推来得到. ----------------------- ...

  10. SqlServer和Oracle中一些常用的sql语句6 存储过程

    --不带参数的存储过程 CREATE procedure proc_sql1 as begin declare @i int set @i=0 while @i<26 begin print c ...