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

Delphi
利用Delphi编写Socket通信程序
用Delphi设计“抢三十”游戏
对《QQ列表精灵》源代码分析和仿制
Delphi接口编程的两大陷阱
基于Delphi的组件设计之简单实例
基于Delphi的组件设计之概念
浅述Delphi下的OpenGL图形开发
深入理解Delphi的消息机制
Delphi处理SQL Server多媒体数据
Delphi中为RichEdit加入链接
用Delphi7设计FTP上传软件
利用Delphi编程控制摄像头
用Delphi实现快闪窗体信息提示
Delphi制作图形化的ComboBox
用Delphi设计能携带附件的EMail
Delphi中利用网页打造程序界面
Delphi控件的“拿来主义”
Delphi设计PhotoShop型弹出菜单
用Delphi获取Windows及系统路径
Delphi控制Excel自动生成报表

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


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

登陆 还没注册?