用Delphi制作Office的Com AddIn

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

最近想做一个像金山词霸那样在Word上面增加一个按钮的东西
在网上找了一会儿，竟然没有 Com" target=_blank>Delphi的例子，没办法只好自己搞定，

1. 新建一个Active Library
2. 新建一个 Com Object，在Class Name填一个名字，如Test。
点一下Implemented Interface后面的List按钮。再点一下对话框中的Add Library按钮，
选择“Program Files Common FilesDesigner”目录下的msaddndr.dll文件。
然后在列表中找到msaddndr.dll里面的_IDTExtensibility2接口点击确定。
3. 现在 Com AddIn部分已经完成，现在要在Word里面加一个 CommandBar和一个按钮，并且让按钮响应事件。

4. 创建一个T CommandBarButton的OleServer类以连接到 CommandButton并响应事件。代码：如下
定义部分
T CommandBarButtonClick = procedure(const Ctrl: OleVariant; var CancelDefault: OleVariant) of Object;
T CommandBarButton = class(TOleServer)
private
 FIntf:         CommandBarButton;
 FOnClick: T CommandBarButtonClick;
 function GetDefaultInterface: CommandBarButton;
 procedure SetOnClick(const Value: T CommandBarButtonClick);
protected
 procedure InitServerData; override;
 procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
public
 constructor Create(AOwner: T Component); override;
 destructor  Destroy; override;
 procedure Connect; override;
 procedure ConnectTo(svrIntf: CommandBarButton);
 procedure Disconnect; override;
 property DefaultInterface: CommandBarButton read GetDefaultInterface;
published
 property OnClick : T CommandBarButtonClick read FOnClick write SetOnClick;
end;
实施部分
{ T CommandBarButton }

procedure T CommandBarButton.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
 punk := GetServer;
 ConnectEvents(punk);
 Fintf:= punk as CommandBarButton;
end;
end;

procedure T CommandBarButton.ConnectTo(svrIntf: CommandBarButton);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;

constructor T CommandBarButton.Create(AOwner: T Component);
begin
inherited;

end;

destructor T CommandBarButton.Destroy;
begin

inherited;
end;

procedure T CommandBarButton.Disconnect;
begin
if Fintf <> nil then
begin
 DisconnectEvents(FIntf);
 FIntf := nil;
end;
end;

function T CommandBarButton.GetDefaultInterface: CommandBarButton;
begin
if FIntf = nil then
 Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;

procedure T CommandBarButton.InitServerData;
const
CServerData: TServerData = (
 ClassID:   '{55F88891-7708-11D1-ACEB-006008961DA5}';
 IntfIID:   '{000C030E-0000-0000-C000-000000000046}';
 EventIID:  '{000C0351-0000-0000-C000-000000000046}';
 LicenseKey: nil;
 Version: 500);
begin
ServerData := @CServerData;
end;

procedure T CommandBarButton.InvokeEvent(DispID: TDispID;
var Params: TVariantArray);
begin
case DispID of
 -1: Exit;  // DISPID_UNKNOWN
1: if Assigned(FOnClick) then
   FOnClick(Params[0], Params[1]);
end; {case DispID}
end;

procedure T CommandBarButton.SetOnClick(
const Value: T CommandBarButtonClick);
begin
FOnClick := Value;
end;

5. 继续完成Ttest类
在类定义里面增加两项
private
 F CommandBarButton : T CommandBarButton;
 procedure FClick(const Ctrl: OleVariant; var CancelDefault: OleVariant);

在OnConnection写下面代码
procedure TTest.OnConnection(const Application: IDispatch;
ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;
var custom: PSafeArray);
//这是从资源中读取一个Bitmap并复制到粘贴板
procedure CopyBitMapToClipBoard;
var
 aStream : TStream;
 aBitMap : Graphics.TBitmap;
begin
 with TClipboard.Create do
 begin
   try
     aStream := TResourceStream.CreateFromID(HInstance, 1, RT_RCDATA);
     aBitMap := Graphics.TBitmap.Create;
     aBitMap.LoadFromStream(aStream);
     Assign(aBitMap);
   finally
     aStream.Free;
     aBitMap.Free;
     Free;
   end;
 end;
end;
var
App : WordApplication;
a CommandBar : CommandBar;
aButton : _ CommandBarButton;
begin
App := WordApplication(Application);
a CommandBar := App. CommandBars.Add('Test', msoBarTop, False, True);
aButton := a CommandBar.Controls.Add(msoControlButton, EmptyParam, EmptyParam, EmptyParam, True) as _ CommandBarButton;
aButton.Set_Style(msoButtonIconAndCaption);
aButton.Set_Caption('Test');
//CopyBitMapToClipBoard; //这两句话是给按钮设定一个外部图标，
//aButton.PasteFace; //你要增加一个rcdata的bitmap资源bitmap大小为16*16,具体怎么做请参考其他文档
aButton.Set_Tag('test111');
F CommandBarButton := T CommandBarButton.Create(nil);
F CommandBarButton.ConnectTo(aButton);
F CommandBarButton.OnClick := FClick;
a CommandBar.Set_Visible(True);
end;

在OnDisconnection写下面代码
procedure TTest.OnDisconnection(RemoveMode: ext_DisconnectMode;
var custom: PSafeArray);
begin
F CommandBarButton.Disconnect;
F CommandBarButton.Free;
end;

写Click事件（在Word文档中插入当前时间）
procedure TTest.FClick(const Ctrl: OleVariant;
var CancelDefault: OleVariant);
begin
Ctrl.Application.Selection.TypeText(DateTimeToStr(Now) + #13#10);
end;

6. 最后用菜单->Run->Register Active Server注册 Com对象
7. 给Word增加 Com AddIn打开RegEdit,增加一个项“HKEY_CURRENT_USERSoftwareMicrosoft Com" target=_blank>OfficeWord AddIns AddInTest.Test”
在这个项下面增加一个字符串值“FriendlyName”随便给一个值，如“Test”
再增加一个双字节值“LoadBehavior”把值设为3

完成！现在打开Word你就可以看到增加了一个工具栏点一下上面的按钮就会在当前文档输出一个当前时间。 <script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>