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

Delphi
Delphi编程中Http协议应用(一)
Delphi存取图像完整解决方案
简析Delphi中的XML编程
用Delphi实现IP地址的隐藏
Delphi面向对象编程的20条规则
Delphi中的Wrapper设计模式
用Delphi实现软件的在线升级
Delphi7.0实现添加记录的“携带”实现
Delphi编程访问注册表
让Delphi的DBGrid支持鼠标轮
怎样在DELPHI中实现文件切割/组合
Delphi设计可中/英文切换的界面技巧
用Delphi制作以浏览器为界面的应用程序
Delphi 中压缩流和解压流的应用
Delphi控制并行端口位操作
Delphi编写后台监控软件
用Delphi编写VxD设备驱动程序
用Delphi进行OpenGL编程学习心得
DELPHI编程实现3DS的动画播放
用Delphi制作动态菜单

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-10-30   浏览: 207 ::
收藏到网摘: 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

登陆 还没注册?