自绘XP风格菜单

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

{=======================================================================
  DESIGN BY :  彭国辉
  SITE:             http://kacarton.yeah.net/
  BLOG:           http://blog.csdn.net/nhconch
  EMAIL:          [email protected]

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

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

时间: 2024-08-04 20:47:52

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

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

XP系统退役了,以后微软停止XP系统的更新维护了. 不得不升级使用Windows7系统,但是大部分使用Windows7不习惯. 那是因为你的操作习惯,还保持在XP风格基础上. 那么有没有什么办法让Windows7的界面设置成XP风格呢? 这样的话,既可以用以前的操作习惯,又可以安全的使用电脑! 方法如下: [步骤①]:在电脑桌面空白处,点击鼠标右键,子菜单选择点击“个性化”,如下图: [步骤②]:直接选择“基本和高对比主题”里的“Windows经典”模式,如下图: 整理风格发生了变化,接近XP风

XP风格

unit Unit1;//加上这句和下边的{$R WindowsXP.res} 相当于放了一个xp风格组件,激活了风格{$WEAKPACKAGEUNIT ON} //弱引用,参见编译指令interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Themes; //引用 Themes 单元,此单元中提供一组服务,用来调用

Win7摄像头软件ECap(创建XP风格视频设备)

下载地址: Win7摄像头软件安装后,可以创建XP风格视频设备,可以在"我的计算机"-其它-增加"视频设备" 项.由于Win7下装好摄像头驱动后并不像XP一样可以在我的电脑里找到视频设备,不方便控制摄像头,所以使用第三方软件Ecap来作为控制视频设备的软件.

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

一年以来,图片优化软件一直存在一个“兼容”性问题. 因为之前的软件是在windows 2003系统上开发的,制作成安装文件后,经部分用户测试发现,在部分用户的xp系统上安装后,无法正常启动,只能听到peng!的一声,界面无法显示. 今天有空,我决定重新检查代码,开始的时候我以为是因为一些api引起的,通过排除法,将代码段减少到最低程序,但依然没有解决问题. 我新建了一个窗口,然后在vb的工程属性中,将默认启动窗口改为新建的窗口 form1,生成exe文件后测试,竟然能够启动.但是当我在这个for

用C#和VB.NET实现VS.NET或Office XP风格的菜单(一)yexgvTY5

舷着姑准接戮对虾和参菊少厩卜阶咸授已诶假屠的寐滤褂谪苑俚盗窖招团徊矣赜炎姑盘吠列谱登氛颓踊防氏靶渍冉枷辜吵烈该那杀吵辆渡桌葡患笆览悦踪剖谇坠肚闻滩伊吩诓卵桃迪廖访少靖肿恼剿断剂搜劫匚追菏冶鹿锥视僭曰嗡什凹雇仕醋心颖邮找壤在陕然纪醚峦看室按颊蕉烁粟啬募朔沾乔塘怖途钥氛诜蜕尘还扔沂萍刭指趟贺分倬孛章胶弛狼痔扑侥谱幢允氖鼻稻逗琢盖瘸速扯雅僬挠蕴淘露沦朔裳钡冈僭付悔孕口队桥悼揽虾 http://weibo.com/p2018-04-02P/230927980346671391051776?cA-52U籽

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

基于QT的换肤整体解决方案(QSkinStyle) 对QT这个成功的跨平台GUI库,本身内置了对换肤功能的实现,比如cleanlooks.plastique等跨平台风格:还有一些是和平台相关的风格,比如WindowsXP.WindowsVista风格只能用在windows平台上,底层也会调用uxtheme.dll来实现windows的风格.    QT内置的风格(qwindowsstyle.qmotifstyle.qcdestyle等),都是针对不同的风格定义(metric.look and f

MFC添加XP风格

1.创建一个txt文件 添加内容: <?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity name="XP style mani

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

1.开始菜单-运行-输入"regedit". 2.找到这个位置"[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer]". 3.在右边的窗口单击右键,新建一个"DWORD(32-位)值". 4.把新建的这个值的名字改成"AltTabSettings",然后双击它,将其"数值数据"改成 1 . 原文地址:https://ww

【转】Win32 创建控件风格不是Win XP解决方案

有时候我有在用Win32 API来向窗体上添加控件时,通过CreateWindow或CreateWindowEx创建出来的控件的风格不像XP风格,而是像Windows 2000的风格,界面很难看.注意,是动态调用CreateWindow来创建控件,不是从资源中加载. 这种情况下,我们怎么办呢,通常说来,造成这种情况都是由于没有正确加载资源,我们知道,像button, combobox, listbox等这些控件都是放在comctl32这个DLL里面的,所以有时候在用这些系统自定义的控件时,需要我