站内搜索

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

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


  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;

  • 上一篇:Delphi开发WEB应用程序打印组件
  • 下一篇:Delphi实现随时随刻知道自己的IP