求XP菜单原码

Question

不用VCL，完全用API实现的那种。

Answer 1

我有一个，不过delphi7不是有吗？

Answer 2

看看这个是不是你需要的：
http://www.shagrouni.com/english/software/xpmenu.html

Answer 3

XPmenu这个控件适合你的要求吗？

Answer 4

http://www.shagrouni.com/english/software/xpmenu.html这个我有了。

Answer 5

Delphi 6 XP-Style ActionBands
要不？

Answer 6

Delphi 7 的ActionBar可以直接设成XPStyle 

Answer 7

只要完全用API实现的哦！别用DELPHI自带的东东。其实是想要XP实现的原理。给我DELPHI的例子，也没有用1

Answer 8

http://www.vcfan.com/delphi/kongjian.asp?subject_name=kongjian

Answer 9

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdCtrls;type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    ImageList1: TImageList;
    AAA1: TMenuItem;
    BBB1: TMenuItem;
    N1: TMenuItem;
    CCC1: TMenuItem;
    DDDD1: TMenuItem;
    SSSS1: TMenuItem;
    DSAA1: TMenuItem;
    PopupMenu1: TPopupMenu;
    ZZZZ1: TMenuItem;
    XXXX1: TMenuItem;
    CCCCC1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure CCC1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure CCC1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
      Height: Integer);
    procedure Button1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure BBB1Click(Sender: TObject);
  private
    FSelColor,FBdyColor,FIcnColor,FFntColor:TColor;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  FBdyColor:=$00F0E1E1;//整体的颜色，没有选择时的颜色
  FIcnColor:=$00BBD7FF;//图表背景的颜色
  FFntColor:=$00000024;//字体的颜色
  FSelColor:=$00FFD8CE;//选择时的颜色
end;procedure TForm1.CCC1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  MenuItem:TMenuItem;
  IcnRect,TxtRect:TRect;
  Txt:String;
  B:TBitmap;
  Icount:integer;
  IsTopItem:Boolean;
begin  MenuItem:=Sender as TMenuItem;
  Txt:=MenuItem.Caption;
  IcnRect:=Rect(ARect.Left,ARect.Top, ARect.Left+20,ARect.Bottom);//goto:
  TxtRect:=Rect(ARect.Left+22,ARect.Top,ARect.Right,ARect.Bottom);
  IsTopItem:=False;
   if IsTopItem then
  begin
    ACanvas.Brush.Color:=clBtnFace;
    ACanvas.Pen.Color:=clBtnFace;
    ACanvas.Rectangle(IcnRect);
  end
  else
  begin
    ACanvas.Brush.Color:=FIcnColor;
    ACanvas.Pen.Color:=FIcnColor;
    ACanvas.Rectangle(IcnRect);
    ACanvas.Brush.Color:=FBdyColor;
    ACanvas.Pen.Color:=FBdyColor;
  end;
  //ACanvas.Rectangle(Arect);
  //ACanvas.Brush.Color:=FBdyColor;
  //ACanvas.Pen.Color:=FBdyColor;
  ACanvas.Rectangle(TxtRect.Left-2,TxtRect.Top,TxtRect.Right,TxtRect.Bottom);
  if Selected then  //判断是否选中.选种画椭圆。
  begin
    ACanvas.Brush.Color:=FSelColor;
    ACanvas.Pen.Color  :=clBlack;
    ACanvas.RoundRect(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,7,7);
  end;
  if Txt='-' then  //对文字的处理
  begin
    ACanvas.Pen.Width  :=1;
    ACanvas.Pen.Color:=clGray;
    ACanvas.MoveTo(TxtRect.Left -1 ,TxtRect.Top+(TxtRect.Bottom-TxtRect.Top) div 2);
    ACanvas.LineTo(TxtRect.Right-2 ,TxtRect.Top+(TxtRect.Bottom-TxtRect.Top) div 2);
  end
  else
  begin                    //文字被覆盖时：
    ACanvas.Font.Size:=8;
    if MenuItem.Enabled then
      ACanvas.Font.Color:=FFntColor
    else
      ACanvas.Font.Color:=clGray;
    SetBkMode(ACanvas.Handle,OPAQUE); //GOTO:    //重新填充文字，也就是在MenuItem里
    DrawText(ACanvas.Handle,                        //的文字区域写文字。
             Pchar(Txt),
             Length(Txt),
             TxtRect,
             DT_VCenter or DT_SingleLine or DT_LEFT);  end;
  if MenuItem.Checked then //菜单被选择的时候
  begin
    ACanvas.Pen.Color  :=clGray;  //画个边框而已
    ACanvas.Pen.Width  :=1;                                 //上半部分
    ACanvas.Polyline([Point(IcnRect.Left+2 ,IcnRect.Bottom-2),  //GOTO:
                      Point(IcnRect.Left+2 ,IcnRect.Top+2   ),
                      Point(IcnRect.Right-2,IcnRect.Top+2   )]); //此函数是依据点来连线，有多少连多少
    ACanvas.Pen.Color  :=clWhite;
    ACanvas.Pen.Width  :=1;
    ACanvas.Polyline([Point(IcnRect.Right-2,IcnRect.Top+2   ),
                      Point(IcnRect.Right-2,IcnRect.Bottom-2), //下半部分
                      Point(IcnRect.Left+2 ,IcnRect.Bottom-2)]);
    ACanvas.Pen.Color  :=clRed  ;                           //产生影印的效果
    ACanvas.Pen.Width  :=2;
    ACanvas.Polyline([Point(IcnRect.Left+4 ,IcnRect.Top+10  ),
                      Point(IcnRect.Left+8 ,IcnRect.Top+14  ),
                      Point(IcnRect.Right-5,IcnRect.Top+5   )]);
  end else if (MenuItem.GetParentMenu.Images<>nil)and(Txt<>'-') then  //图标被覆盖时：
  begin
    B:=TBitmap.Create;
    B.Transparent:=True;//透明而已
    MenuItem.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex,B);  //goto:
    IcnRect:=Rect(IcnRect.Left+2,IcnRect.Top+2,IcnRect.Right-2,IcnRect.Bottom-2);//缩小图标的面积
    ACanvas.StretchDraw(IcnRect,B); //在长方型的框内，画图
    B.Free;
  end;
end;procedure TForm1.CCC1MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  Txt:String;
begin                                          // 在Application.Run 之前运行
  ACanvas.Font.Size:=8;
  Txt:=(Sender as TMenuItem).Caption;  //得到tet,等数据循环进行。
  Width :=ACanvas.TextWidth(Txt)+20;
  Height:=ACanvas.TextHeight(Txt)+6;
  if Txt='-' then
     Height:=ACanvas.TextHeight(Txt) div 2;end;procedure TForm1.Button1Click(Sender: TObject);
begin
   BBB1.Checked:=False;
end;procedure TForm1.N4Click(Sender: TObject);
begin
  N4.Enabled:=False;
end;procedure TForm1.BBB1Click(Sender: TObject);
begin
  BBB1.Checked:=not BBB1.Checked;
end;end.