当前位置: 首页 > 图文教程 > 开发语言 > Delphi > Delphi实用代码:自绘XP风格菜单

Delphi
Delphi设计简易对象垃圾回收框架
Delphi开发Web应用程序打印组件
Delphi客户服务器应用开发(四)
Delphi自定义部件开发(一)
Delphi自定义部件开发(二)
Delphi自定义部件开发(三)
Delphi自定义部件开发(四)
开发Delphi对象式数据管理功能(一)
开发Delphi对象式数据管理功能(二)
开发Delphi对象式数据管理功能(三)
开发Delphi对象式数据管理功能(四)
开发Delphi对象式数据管理功能(五)
用Delphi语言来学设计模式之简单工厂篇
Delphi2005和DUnit搭建敏捷开发平台记录
你想成Delphi高手吗?快来学Delphi快捷键
Borland最新版开发工具Delphi2005抢先预览
用Delphi实现JPEG格式图像的显示
用DELPHI编程访问SQL SERVER数据库
用Delphi编制趣味动画鼠标
用Delphi实现选单的自动隐藏功能

Delphi实用代码:自绘XP风格菜单


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-10-30   浏览: 205 ::
收藏到网摘: n/a

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

评论 (0) All

登陆 还没注册?