У меня 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.p...0216320&n=8, все должно работать, однако, кнопка добавляется, а по нажатию ничего не происходит. Это сообщение отредактировал(а) cemick - 11.8.2009, 14:56
|