office2003 的界面（特别是菜单）很好看，请问是怎样做出来。

[djchao]

如题

[jishiping]

自画式的菜单。主菜单条不能自画，所以主菜单条用Toolbar来做。在BCB6中，先放一个TMainMenu在Form上，设计好TMainMenu，然后将Form的属性Menu设为空。再放一个TToolbar
在Form上，指定Toolbar的属性Menu，Flat为true，AutoSize为true，这样就完成了TToolbar
替代主菜单了。对于TMainMenu空间，指定它的Images属性，指定OwnerDraw为true，设定所
有菜单项的事件OnMeasureItem和OnDrawItem，在OnMeasureItem里指定菜单项的宽度和高度，
在OnMeasureItem里自己写代码画菜单项。

[oishi]

unit XpSkin;

interface

uses
Windows, SysUtils, Classes, Controls, Menus, Graphics, Types, Forms,
ImgList;

type
TXpSkin = class(TComponent)
private { Private declarations }
FActive: Boolean;
FForm: TForm;
procedure SetActive(const Value: Boolean);
procedure AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
function IsTopMenu(AMenuItem: TObject): Boolean;
protected { Protected declarations }
procedure InitItems(AForm: TWinControl; AEnable, AUpdate: boolean);
procedure InitItem(AComp: TComponent; AEnable, AUpdate: boolean);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public { Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published { Published declarations }
property Active: Boolean read FActive write SetActive;
end;

procedure Register;

implementation

uses Math;

const
I_Indent = 5;
I_ImageWidth = 24;
I_ImageHeight = 24;
I_SplitHeight = 6;

procedure Register;
begin
RegisterComponents('Standard', [TXpSkin]);
end;

{ TXpSkin }

procedure TXpSkin.InitItem(AComp: TComponent; AEnable, AUpdate: boolean);
var
i: Integer;

procedure ActiveMenu(AMenuItem: TMenuItem);
var
j: Integer;
begin
for j := 0 to AMenuItem.Count - 1 do
ActiveMenu(AMenuItem.Items[j]);

if AEnable then
begin
AMenuItem.OnAdvancedDrawItem := AdvancedDrawItem;
AMenuItem.OnMeasureItem := MeasureItem;
end
else
begin
AMenuItem.OnAdvancedDrawItem := nil;
AMenuItem.OnMeasureItem := nil;
end;
end;
begin
if AComp.InheritsFrom(TMenu) then
begin
TMenu(AComp).OwnerDraw := AEnable;
for i := 0 to TMenu(AComp).Items.Count - 1 do
ActiveMenu(TMenu(AComp).Items[i]);
end;
if AComp.InheritsFrom(TMenuItem) then
ActiveMenu(TMenuItem(AComp));
end;

procedure TXpSkin.InitItems(AForm: TWinControl; AEnable, AUpdate: boolean);
var
i: integer;
Comp: TComponent;
begin
for i := 0 to AForm.ComponentCount - 1 do
begin
Comp := AForm.Components[i];
InitItem(Comp, AEnable, AUpdate);
end;
end;

procedure TXpSkin.SetActive(const Value: Boolean);
begin
FActive := Value;
InitItems(FForm, Value, False);
end;

procedure TXpSkin.MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
MenuItem: TMenuItem;
ImageList: TCustomImageList;
begin
Inc(Width, I_Indent);
{ MenuItem := TMenuItem(Sender);
ImageList := MenuItem.GetImageList;}
if not IsTopMenu(Sender) then
Inc(Width, I_ImageWidth + I_Indent);
if TMenuItem(Sender).IsLine then
begin
Height := I_SplitHeight;
end
else
Height := IfThen(ACanvas.TextHeight('WWW') > I_ImageHeight,
ACanvas.TextHeight('WWW'), I_ImageHeight);
end;

procedure TXpSkin.AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
DrawImage,
TopMenu,
Selected: Boolean;
MenuItem: TMenuItem;
FRect: TRect;
sText: String;
ImageList: TCustomImageList;
Glyph: TBitmap;
OldBrushColor: TColor;

procedure DrawMenuBackGround;
begin
TopMenu := IsTopMenu(MenuItem);
Selected := odSelected in State;
if Selected or (odHotLight in State) then
begin
ACanvas.Brush.Color := $00EFD3C6;
ACanvas.Pen.Color := clBlue;
ACanvas.Rectangle(ARect);
end
else
begin
ACanvas.Brush.Color := clMenu;
ACanvas.FillRect(ARect);
if not TopMenu then
begin
ACanvas.Brush.Color := clWindow;
FRect := ARect;
Inc(FRect.Left, I_ImageWidth);
ACanvas.FillRect(FRect);
end;
end;
end;

procedure DrawMenuSplitLine;
begin
ACanvas.Brush.Color := clMenu;
Dec(FRect.Right, I_Indent - 2);
Dec(FRect.Left, 2);
Inc(FRect.Top, I_SplitHeight div 2);
FRect.Bottom := FRect.Top + 1;
ACanvas.FillRect(FRect);
end;

procedure DrawMenuText;
begin
FRect := ARect;
Inc(FRect.Left, I_Indent);
if not TopMenu then
Inc(FRect.Left, I_ImageWidth);
sText := MenuItem.Caption;
if MenuItem.IsLine then
begin
DrawMenuSplitLine;
Exit;
end;
if not MenuItem.Enabled then
ACanvas.Font.Color := clGray
else
ACanvas.Font.Color := clMenuText;
DrawText(ACanvas.Handle, PChar(sText), Length(sText),
FRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
if MenuItem.ShortCut <> 0 then
begin
Dec(FRect.Right, I_Indent * 3);
sText := ShortCutToText(MenuItem.ShortCut);
DrawText(ACanvas.Handle, PChar(sText),
Length(sText), FRect, DT_RIGHT or DT_SINGLELINE or DT_VCENTER);
end;
end;

procedure DrawImageIcon;
begin
if DrawImage then
begin
FRect := ARect;
if Assigned(ImageList) and (MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < ImageList.Count) and not MenuItem.Checked then
begin
Inc(FRect.Left, (I_ImageWidth - ImageList.Width) div 2);
Inc(FRect.Top, (I_ImageHeight - ImageList.Height) div 2);
FRect.Right := FRect.Left + I_ImageWidth;
ImageList.Draw(ACanvas, FRect.Left, FRect.Top, MenuItem.ImageIndex,
MenuItem.Enabled);
end
else
begin
{ Draw a menu check }
FRect.Right := FRect.Left + I_ImageWidth;
Glyph := TBitmap.Create;
try
Glyph.Transparent := True;
Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
OldBrushColor := ACanvas.Font.Color;
ACanvas.Font.Color := clBtnText;
ACanvas.Draw(FRect.Left + (FRect.Right - FRect.Left - Glyph.Width) div 2 + 1,
FRect.Top + (FRect.Bottom - FRect.Top - Glyph.Height) div 2 + 1, Glyph);
ACanvas.Font.Color := OldBrushColor;
finally
Glyph.Free;
end;
end;
end;
end;
begin
MenuItem := TMenuItem(Sender);
ImageList := MenuItem.GetImageList;
DrawImage := (ImageList <> nil) and (MenuItem.ImageIndex in [0..ImageList.Count - 1])
or MenuItem.Checked;
DrawMenuBackGround;
DrawMenuText;
DrawImageIcon;
end;

destructor TXpSkin.Destroy;
begin
InitItems(FForm, False, False);
inherited;
end;

constructor TXpSkin.Create(AOwner: TComponent);
begin
inherited;
SetDesigning(True);
FForm := AOwner as TForm;
end;

procedure TXpSkin.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
InitItem(AComponent, Operation = opInsert, False);
end;

function TXpSkin.IsTopMenu(AMenuItem: TObject): Boolean;
begin
Result := TMenuItem(AMenuItem).GetParentComponent is TMainMenu;
end;

end.

[oishi]

這個控件已經可以實現自繪菜單了!不過還有點缺點!
你自己看著改吧!

[oishi]

只要把這個控件放在表單上就可以了!

[weill]

最最简单的就是使用suiPack控件。
www.ccrun.com有下(较早期版本，新版本的破解下载因为程序主人在这个论坛，偶就不说了）。

[hitripley]

主人在这？suiPack不是外国软件吗？

[cczlp]

XPMenu控件最简单, 网上很多.

[zly1980]

有控件的!XPMENU@!拖上去就可以了!

[zly1980]

你去www.chinabcb.com找一下下载地址!