У меня Add-ins к Outlook, добавляю на Ribbon кнопку и устанавливаю CallBack, при нажатии на кнопку процедура обратного вызова не срабатывает. В чем может быть проблема?
| Код |
IDTExtensibility2 = interface(IDispatch)
['{B65AD801-ABAF-11D0-BB8B-00A0C90F2744}']
procedure OnConnection(const Application: IDispatch; ConnectMode: ext_ConnectMode;
const AddInInst: IDispatch; var custom: PSafeArray); safecall;
procedure OnDisconnection(RemoveMode: ext_DisconnectMode; var custom: PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
procedure OnBeginShutdown(var custom: PSafeArray); safecall;
procedure DoAction(const Control: IRibbonControl); safecall;
end;
IRibbonControl = interface(IDispatch)
['{000C0395-0000-0000-C000-000000000046}']
function Get_Id: WideString; safecall;
function Get_Context: IDispatch; safecall;
function Get_Tag: WideString; safecall;
property Id: WideString read Get_Id;
property Context: IDispatch read Get_Context;
property Tag: WideString read Get_Tag;
end;
IRibbonExtensibility = interface(IDispatch)
['{000C0396-0000-0000-C000-000000000046}']
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
end;
TgsOfficeAddIn = class(TAutoObject, IgsOfficeAddIn, IDTExtensibility2,
IRibbonExtensibility)
private
procedure OnConnection(const Application: IDispatch; ConnectMode:
ext_ConnectMode; const AddInInst: IDispatch; var custom: PSafeArray);
safecall;
procedure OnDisconnection(RemoveMode: ext_DisconnectMode; var custom:
PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
procedure OnBeginShutdown(var custom: PSafeArray); safecall;
protected
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
public
procedure DoAction(const Control: IRibbonControl); safecall;
end;
function TgsOfficeAddIn.GetCustomUI(
const RibbonID: WideString): WideString;
begin
Result :=
'<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">'+
' <ribbon>' +
' <tabs> ' +
' <tab idMso="TabNewMailMessage"> ' +
' <group id="btkGlobal" label="Global">'+
' <button ' +
' id="btkChooseRecipient"'+
' label="Выбрать получателей" size="large"'+
' imageMso ="AccountMenu" onAction="DoAction" /> '+
' </group>'+
' </tab>'+
' </tabs>'+
' </ribbon>'+
'</customUI>';
end;
procedure TgsOfficeAddIn.DoAction(const Control: IRibbonControl);
begin
MessageBox(0, 'Hello, World', 'Information', MB_ICONINFORMATION);
end;
initialization
TAutoObjectFactory.Create(ComServer, TgsOfficeAddIn, CLASS_gsOfficeAddIn_,
ciMultiInstance, tmApartment);
end.
|
Судя вот из этого поста http://www.delphimaster.ru/cgi-bin/forum.pl?id=1190216320&n=8, все должно работать, однако, кнопка добавляется, а по нажатию ничего не происходит.
|