您现在的位置:首页 >> VCL >> VCL >> 内容

Delphi中给Raize的菜单加上Flat效果

时间:2011/9/3 16:24:45 点击:

  核心提示:直接拖个RzMenuController1放到窗体上,放上菜单,设置OwnerDraw:=True效果图: 600) this.width = 600;'>每个Item中关联procedure TFo...

直接拖个RzMenuController1放到窗体上,放上菜单,设置OwnerDraw:=True
效果图: 600) this.width = 600;">

每个Item中关联

procedure TForm1.N1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
  DrawMenuItem(Sender as TMenuItem,ACanvas,ARect,Selected);
end;

 

procedure TForm1.DrawMenuItem(Item: TMenuItem; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  hMenu     : HWND;
  TmpCanvas : TCanvas;
  TmpRect:TRect;
begin
  hMenu := WindowFromDC(ACanvas.Handle);
  if ( hMenu <> Handle ) and ( hMenu <> 0 ) then
  begin
    TmpCanvas := TCanvas.Create;
    try
      TmpCanvas.Handle := GetDC(0);
      TmpCanvas.Pen.Color  := $AE7323;//CF9365;
      TmpCanvas.Brush.Color:= $AE7323;//CF9365;
      GetWindowRect(hMenu, TmpRect);
      TmpCanvas.FrameRect(TmpRect);
      InflateRect(TmpRect, -1, -1);
      TmpCanvas.Brush.Color := $FFFFFF;//DFDBDF;
      TmpCanvas.FrameRect(TmpRect);
      InflateRect(TmpRect, -1, -1);
      TmpCanvas.FrameRect(TmpRect);
    finally
      ReleaseDC(0, TmpCanvas.Handle);
      if Assigned(TmpCanvas) then FreeAndNil(TmpCanvas);
    end;
  end;
end;

作者:站长 来源:原创
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2020 版权所有 All Rights Reserved.
  • 沪ICP备05001939号