怎么样可以使菜单做成XP风格的

Question

我用的是DELPHI7 我想知道怎么样可以直接写代码把菜单做成XP风格的

Answer 1

用ActionBar,在Delphi7的Demos目录下的ActionBar有一个例子！！！

Answer 2

这里找不到你满意的答案吗？来这里试试！
这里有问必答
http://systemer.51.net/cgi-bin/leoboard.cgi
希望你能在这里找到你满意的答案！

Answer 3

unit XPMenu;interfaceuses
  Windows, Messages,SysUtils, Classes,Menus,Graphics;type
  TXPMenu = class(TComponent)
  private
    { Private declarations }
    FSelColor,FBdyColor,FIcnColor,FFntColor:TColor;
    procedure SetSelColor(SelColor:TColor);
    function  GetSelColor:TColor;
    procedure SetBdyColor(BdyColor:TColor);
    function  GetBdyColor:TColor;
    procedure SetFntColor(FntColor:TColor);
    function  GetFntColor:TColor;
    procedure SetIcnColor(IcnColor:TColor);
    function  GetIcnColor:TColor;
    procedure DrawItem(Sender: TObject; ACanvas: TCanvas;
              ARect: TRect; Selected: Boolean);
    procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
              var Width, Height: Integer);
  protected
    { Protected declarations }
  public
    { Public declarations }    constructor Create(AOwner:TComponent);override;
  published
    { Published declarations }
    property  BodyColor:TColor read GetBdyColor write SetBdyColor;
    property  SelectedColor:TColor read GetSelColor write SetSelColor;
    property  FontColor:TColor read GetFntColor write SetFntColor;
    property  GlyphColor:TColor read GetIcnColor write SetIcnColor;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Snake_Eye', [TXPMenu]);
end;{ TXPMenu }procedure TXPMenu.MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  Txt:String;
begin
  ACanvas.Font.Size:=8;
  Txt:=(Sender as TMenuItem).Caption;
  Width :=ACanvas.TextWidth(Txt)+20;
  Height:=ACanvas.TextHeight(Txt)+6;
  if Txt='-' then
     Height:=ACanvas.TextHeight(Txt) div 2;
end;constructor TXPMenu.Create(AOwner: TComponent);
var
  icount:integer;
begin
  inherited create(AOwner);
  FBdyColor:=$00E6E6E6;
  FIcnColor:=$0074F1B9;
  FFntColor:=clBlack;
  FSelColor:=$00FFD8CE;
  for icount:=0 to Owner.ComponentCount-1 do
  begin
    if Owner.Components[icount] Is TMenu then
      (Owner.Components[icount] as TMenu).OwnerDraw:=True;
    if Owner.Components[icount] Is TMenuItem then
    begin
      (Owner.Components[icount] as TMenuItem).OnDrawItem:=DrawItem;
      (Owner.Components[icount] as TMenuItem).OnMeasureItem:=MeasureItem;
    end;
  end;
end;procedure TXPMenu.DrawItem(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);
  TxtRect:=Rect(ARect.Left+22,ARect.Top,ARect.Right,ARect.Bottom);
  IsTopItem:=False;
  if MenuItem.GetParentMenu Is TMainMenu then
    for icount:=0 to MenuItem.GetParentMenu.Items.Count-1 do
      if MenuItem.GetParentMenu.Items[icount]=MenuItem then
      begin
        IsTopItem:=True;
        break;
      end;
  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(TxtRect.Left-2,TxtRect.Top,TxtRect.Right,TxtRect.Bottom);
  if Selected then
  begin
    ACanvas.Brush.Color:=FSelColor;
    ACanvas.Pen.Color  :=clBlack;
    ACanvas.Rectangle(ARect);
  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,Transparent);
    DrawText(ACanvas.Handle,
             Pchar(Txt),
             Length(Txt),
             TxtRect,
             DT_VCenter or DT_Left or DT_SingleLine );
  end;
  if MenuItem.Checked then
  begin
    ACanvas.Pen.Color  :=clGray;
    ACanvas.Pen.Width  :=1;
    ACanvas.Polyline([Point(IcnRect.Left+2 ,IcnRect.Bottom-2),
                      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);
    IcnRect:=Rect(IcnRect.Left+2,IcnRect.Top+2,IcnRect.Right-2,IcnRect.Bottom-2);
    ACanvas.StretchDraw(IcnRect,B);
    B.Free;
  end;
end;function TXPMenu.GetSelColor: TColor;
begin
  Result:=FSelColor;
end;procedure TXPMenu.SetSelColor(SelColor: TColor);
begin
  FSelColor:=SelColor;
end;function TXPMenu.GetBdyColor: TColor;
begin
  Result:=FBdyColor;
end;procedure TXPMenu.SetBdyColor(BdyColor: TColor);
begin
  FBdyColor:=BdyColor;
end;function TXPMenu.GetFntColor: TColor;
begin
  Result:=FFntColor;
end;procedure TXPMenu.SetFntColor(FntColor: TColor);
begin
  FFntColor:=FntColor;
end;function TXPMenu.GetIcnColor: TColor;
begin
  Result:=FIcnColor;
end;procedure TXPMenu.SetIcnColor(IcnColor: TColor);
begin
  FIcnColor:=IcnColor;
end;end.

Answer 4

用XPmenu控件，下载地址:http://www.shagrouni.com/english/software/xpmenu.html
使用方法非常简单，只要将Active属性设为True即可。

Answer 5

不用写代码吧，WIN32页有XPMANIFEST控件直接用就可以了，在XP下窗口中所有的东东都是XP风格。