精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>OLE&Activex>>用Delphi制作Office的Com AddIn

主题:用Delphi制作Office的Com AddIn
发信人: simonwall(肥猫朱古力)
整理人: teleme(2003-07-04 13:21:01), 站内信件
1. 新建一个Active Library
2. 新建一个COM Object,在Class Name填一个名字,如Test。
 点一下Implemented Interface后面的List按钮。再点一下对话框中的Add Library按钮,
 选择“Program Files\Common Files\Designer”目录下的msaddndr.dll文件。
 然后在列表中找到msaddndr.dll里面的_IDTExtensibility2接口点击确定。
3. 现在Com AddIn部分已经完成,现在要在Word里面加一个CommandBar和一个按钮,并且让按钮响应事件。

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

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

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

constructor TCommandBarButton.Create(AOwner: TComponent);
begin
 inherited;

end;

destructor TCommandBarButton.Destroy;
begin

 inherited;
end;

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

function TCommandBarButton.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 TCommandBarButton.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 TCommandBarButton.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 TCommandBarButton.SetOnClick(
 const Value: TCommandBarButtonClick);
begin
 FOnClick := Value;
end;

5. 继续完成Ttest类
在类定义里面增加两项
 private
   FCommandBarButton : TCommandBarButton;
   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;
 aCommandBar : CommandBar;
 aButton : _CommandBarButton;
begin
 App := WordApplication(Application);
 aCommandBar := App.CommandBars.Add('Test', msoBarTop, False, True);
 aButton := aCommandBar.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');
 FCommandBarButton := TCommandBarButton.Create(nil);
 FCommandBarButton.ConnectTo(aButton);
 FCommandBarButton.OnClick := FClick;
 aCommandBar.Set_Visible(True);
end;

在OnDisconnection写下面代码
procedure TTest.OnDisconnection(RemoveMode: ext_DisconnectMode;
 var custom: PSafeArray);
begin
 FCommandBarButton.Disconnect;
 FCommandBarButton.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_USER\Software\Microsoft\Office\Word\Addins\AddInTest.Test”
在这个项下面增加一个字符串值“FriendlyName”随便给一个值,如“Test”
再增加一个双字节值“LoadBehavior”把值设为3

完成!现在打开Word你就可以看到增加了一个工具栏点一下上面的按钮就会在当前文档输出一个当前时间。

                                       Tassadar([email protected])
                                                  2003.6.11  

[关闭][返回]