PHP DM Gate v0.9 » RibbonX <span class="vd">[Delphi, Windows]</span>

Magedon © (19.09.07 19:38) [0]

Доброе время суток, уважаемые.

Подскажите или лучше покажите как использовать эту новую веху в истории человечества, это технологию которая позволит всем людям идти семимильными шагами к светлому будущему, это творение гения всех времен и народов... дальше можете сами добавить по настроению

Если покороче дайте, пожалуйста, пример использования этой вражеской технологии на делфе.
Мне нужно всего то чтобы мой старый комовский плагин в 2007 офисе находился на своем месте по адресу Файл/Отправить, а не на задворках вселенной, на закладке под названием Надстройки (если по русски).

Буду премного благодарен.
Даже скажу как в народных украинских сказках: Я вам у пригодi стану

<Цитата>
Lacmus © (19.09.07 21:43) [1]

Здесь были ? - http://msdn2.microsoft.com/library/aa338202.aspx

<Цитата>
Lacmus © (21.09.07 21:46) [2]

unit Unit2;

interface

uses
Windows, ActiveX, ComObj, Variants;

const
CLASS_DTExtensibility2: TGUID = '{AD1C5BA3-0140-4E45-8C92-2550B1271BC0}';

type
IDTExtensibility2 = interface(IDispatch)
['{B65AD801-ABAF-11D0-BB8B-00A0C90F2744}']
procedure OnConnection(const HostApp: IDispatch; ext_ConnectMode: Integer;
const AddInInst: IDispatch; var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer; var custom: PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
procedure BeginShutdown(var custom: PSafeArray); safecall;
procedure DoAction(const Control: IUnknown); safecall;
end;

IRibbonExtensibility = interface(IDispatch)
['{000C0396-0000-0000-C000-000000000046}']
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
end;

TOfficeAddInsTest = class(TAutoObject, IDTExtensibility2, IRibbonExtensibility)
private

protected
procedure BeginShutdown(var custom: PSafeArray); safecall;
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;

procedure DoAction(const Button: IUnknown); safecall;
end;

implementation

uses
ComServ;

procedure TOfficeAddInsTest.OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.BeginShutdown(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnAddInsUpdate(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnStartupComplete(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.DoAction(const Button: IUnknown);
begin
MessageBox(0, 'Hello, World', 'Information', MB_ICONINFORMATION)
end;

function TOfficeAddInsTest.GetCustomUI(const RibbonID: WideString): WideString; safecall;
begin
Result :=
'<customUI xmlns=\"http://schemas.microsoft.com/office/2006/01/customui\">'#13#10+
' <ribbon>'#13#10+
' <officeMenu>'#13#10+
' <menu idMso=\"FileSendMenu\">'#13#10+
' <button id=\"TestButtonID\" insertAfterMso=\"FileSendAsAttachment\" label=\"Hello, World!\" imageMso =\"HappyFace\" onAction=\"DoAction\"/>'#13#10+
' </menu>'#13#10+
' </officeMenu>'#13#10+
' </ribbon>'#13#10+
'</customUI>'
end;

initialization
TAutoObjectFactory.Create(ComServer, TOfficeAddInsTest, CLASS_DTExtensibility2, ciSingleInstance);
end.

<Цитата>
Magedon © (24.09.07 19:25) [3]

Спасибо. Заработало.

Только у меня уже есть обработчик, который работает для офисов 2000-2003. В принципе он и для 2007 тоже работает, только кнопочка на закладке Надстройки.
procedure ButtonClick(Button: CommandBarButton; var CancelDefault: WordBool);

В этом ButtonClickе я не обрабатываю ни Button, ни var CancelDefault. Поэтому я просто пытаюсь вызвать его из DoAction таким образом
procedure TtmMSOfficeSendTo.DoAction(const Button: IUnknown);
begin
// MessageBox(0, 'Hello, World', 'Information', MB_ICONINFORMATION)
ButtonClick(button as _CommandBarButton, false);
end;

А оно мне выдает ошибку:
[Error] tmMSOfficeSendTo.pas(172): Types of actual and formal var parameters must be identical

Что то я не совсем пойму что ему там надо. Поэкспериментировав и не получив желаемого результата решил задать этот детский вопрос.
Что ему надо скормить? Или не заморачиваться и просто сделать отдельную процедуру обработки и потом ее вызывать и в ButtonClickе и в DoActionе

Спасибо

<Цитата>
Lacmus © (24.09.07 21:19) [4]

Честно говоря не совсем понимаю зачем вызывать ButtonClick, если можно вызвать действия по ButtonClick напрямую.

В DoAction(const Button: IUnknown); Button это IRibbonControl

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;

<Цитата>
Magedon © (25.09.07 14:38) [5]

Наверное я неправильно выразился. Прошу прощения - это самая большая проблема на форумах. Когдато с тут была ссылочка на Шекли"Ответчик". Вроде бы так назывался рассказ.

Попробую рассказать все с начала.
Дали мне задание написать плагин к Оффису. Он должен находится в Файл/Отправить. И должен коечто отправлять в наше главное приложение из текущего документа. Поискав в инете коечто по этому поводу нашел статью А.Тенцера http://podgoretsky.com/ftp/Docs/Delphi/Tenser/1/ComAddIn.doc.
Взял этот пример за основу. В нем то и используется procedure ButtonClick(Button: CommandBarButton; var CancelDefault: WordBool);

Все это чудесно работает. Вот только повесили баг, что в 2007 офисе плагин не работает. Поставил оффис оказалось все работает, просто юзеры не нашли кнопочку. Нашел свою кнопку на здворках вселенной :)
Спросил людей почему. Сказали ибо РиббонХ.
Почитал про эту РыбуХ. Но т.к. с COM только-только начинаю дружить, то сам не разобрался как все то что они написали для ВБ,СШ и СПП изобразить на Великом И Могучем языке Делфи :)

Вот вы мне это и показали. За что вам ОГРОМНОЕ СПАСИБО. Кроме того что оно огромное оно еще и чистосердечное :)

Посмотрев ваш пример, добавил себе в модуль

IRibbonExtensibility = interface(IDispatch)
['{000C0396-0000-0000-C000-000000000046}']
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
end;
....
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
и
procedure DoAction(const Button: IUnknown); safecall;

xml подправил, сначала вместо onAction="DoAction"/> вписал onAction="ButtonClick"/>. Оно естественно не заработало.

Т.к. при нажатии на эту самую кнопку я не использую никаких входящих параметров, мне интересен только текущий документ, то я сделал отдельную процедуру перенес туда весь код из ButtonClickа и вызаваю эту процедуру и в ButtonClickе и в DoActione.
Хотя это работает, но думаю это не очень красивое решение. Поэтому и решил задать вопрос.

И еще вопросик, я пока еще не нашел как в РыбеХ на кнопку повесить мою иконку,из ДЛЛки, а не из ихнего набора.
Подскажите, если не очень отвлекаю.

Спасибо

<Цитата>
Lacmus © (25.09.07 15:58) [6]

unit Unit2;

interface

uses
Windows, ActiveX, ComObj, Variants;

const
CLASS_DTExtensibility2: TGUID = '{AD1C5BA3-0140-4E45-8C92-2550B1271BC0}';

type
IDTExtensibility2 = interface(IDispatch)
['{B65AD801-ABAF-11D0-BB8B-00A0C90F2744}']
procedure OnConnection(const HostApp: IDispatch; ext_ConnectMode: Integer;
const AddInInst: IDispatch; var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer; var custom: PSafeArray); safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;
procedure BeginShutdown(var custom: PSafeArray); safecall;
procedure DoAction(const Control: IUnknown); safecall;

function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
end;

IRibbonExtensibility = interface(IDispatch)
['{000C0396-0000-0000-C000-000000000046}']
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
end;

TOfficeAddInsTest = class(TAutoObject, IDTExtensibility2, IRibbonExtensibility)
private

protected
procedure BeginShutdown(var custom: PSafeArray); safecall;
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
procedure OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray); safecall;
procedure OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray); safecall;
procedure OnStartupComplete(var custom: PSafeArray); safecall;

procedure DoAction(const Button: IUnknown); safecall;
function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
end;

implementation

uses
AxCtrls, Graphics, ComServ;

procedure TOfficeAddInsTest.OnConnection(const HostApp: IDispatch;
ext_ConnectMode: Integer; const AddInInst: IDispatch;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnDisconnection(ext_DisconnectMode: Integer;
var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.BeginShutdown(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnAddInsUpdate(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.OnStartupComplete(var custom: PSafeArray);
begin

end;

procedure TOfficeAddInsTest.DoAction(const Button: IUnknown);
begin
MessageBox(0, 'Hello, World', 'Information', MB_ICONINFORMATION)
end;

function TOfficeAddInsTest.DoLoadImage(const aImageName: WideString): IPictureDisp;
var
PictureDesc: TPictDesc;
begin
if aImageName = 'mainicon.ico' then begin
with PictureDesc do begin
cbSizeOfStruct := SizeOf(PictureDesc);
picType := PICTYPE_ICON;
hIcon := LoadIcon(HInstance, 'MAINICON')
end;
OleCheck(OleCreatePictureIndirect(PictureDesc, IPicture, True, Result))
end else
Result := nil
end;

function TOfficeAddInsTest.GetCustomUI(const RibbonID: WideString): WideString; safecall;
begin
Result :=
'<customUI xmlns=\"http://schemas.microsoft.com/office/2006/01/customui\" loadImage=\"DoLoadImage\">'#13#10+
' <ribbon>'#13#10+
' <officeMenu>'#13#10+
' <menu idMso=\"FileSendMenu\">'#13#10+
// ' <button id=\"TestButtonID\" insertAfterMso=\"FileSendAsAttachment\" label=\"Hello, World!\" imageMso =\"HappyFace\" onAction=\"DoAction\"/>'#13#10+
' <button id=\"TestButtonID\" insertAfterMso=\"FileSendAsAttachment\" label=\"Hello, World!\" image=\"mainicon.ico\" onAction=\"DoAction\"/>'#13#10+
' </menu>'#13#10+
' </officeMenu>'#13#10+
' </ribbon>'#13#10+
'</customUI>'
end;

initialization
TAutoObjectFactory.Create(ComServer, TOfficeAddInsTest, CLASS_DTExtensibility2, ciSingleInstance);
end.

<Цитата>
Lacmus © (25.09.07 16:03) [7]

На всякий случай

HRESULT _stdcall DoLoadImage([in] BSTR aImageName, [out, retval] IPictureDisp ** aImage);

<Цитата>
Magedon © (25.09.07 18:06) [8]

Что то не работает. Не вешает иконку.
Стаблю бряк на вход DoLoadImage. Даже не заходит. :(

Вот что я тут на... накуралесил

const
tmBUTTON_TAG2007 = 'MainProg.SendTo';
cButtonCaption = 'MainProg';
cButtonTooltip = 'Send current document to MainProg as attachment';
cTMIconName = 'TMMAINICON';

...

type
TtmMSOfficeSendTo = class(TAutoObject, IDTExtensibility2,IRibbonExtensibility)
...
protected
...
procedure DoAction(const Button: IUnknown); safecall;
function GetCustomUI(const RibbonID: WideString): WideString; safecall;
function DoLoadImage(const aImageName: WideString): IPictureDisp; safecall;
...

function TtmMSOfficeSendTo.GetCustomUI(const RibbonID: WideString): WideString;
begin
Result :=
'<customUI xmlns=\"http://schemas.microsoft.com/office/2006/01/customui\">'#13#10+
' <ribbon>'#13#10+
' <officeMenu>'#13#10+
' <menu idMso=\"FileSendMenu\">'#13#10+
' <button id=\"'+WideString(tmBUTTON_TAG2007)+'\" insertAfterMso=\"FileSendAsAttachment\" label=\"'+WideString(cButtonCaption)+'\" screentip=\"'+WideString(cButtonTooltip)+'\" image=\"'+cTMIconName+'\" onAction=\"DoAction\"/>'#13#10+
' </menu>'#13#10+
' </officeMenu>'#13#10+
' </ribbon>'#13#10+
'</customUI>'
;
{$IFOPT D+}
SendDebug('Result: '+Result);
{$ENDIF}
end;

...

function TtmMSOfficeSendTo.DoLoadImage(const aImageName: WideString): IPictureDisp;
var
PictureDesc: TPictDesc;
begin
if aImageName = cTMIconName then //ТУТ БРЯК. НЕ ЗАХОДИТ ДАЖЕ
begin
with PictureDesc do begin
cbSizeOfStruct := SizeOf(PictureDesc);
picType := PICTYPE_BITMAP;//PICTYPE_ICON;
hIcon := LoadIcon(HInstance, PChar(cTMIconName));
end;
OleCheck(OleCreatePictureIndirect(PictureDesc, IPicture, True, Result))
end else
Result := nil
end;

...

Также прописал в Type Library

HRESULT _stdcall DoLoadImage([in] BSTR aImageName, [out, retval] IPictureDisp ** aImage);

Да кстати, где можно посмотреть какие еще есть примочки для <button ... />?

Спасибо

<Цитата>
Lacmus © (25.09.07 18:23) [9]

Пропустили

'<customUI xmlns=\"http://schemas.microsoft.com/office/2006/01/customui\" loadImage=\"DoLoadImage\">'#13#10+

>Да кстати, где можно посмотреть какие еще есть примочки для <button ... />?
http://msdn2.microsoft.com/library/aa338202.aspx

<Цитата>
Magedon © (25.09.07 18:45) [10]

Спасибо! Все заработало как надо.
А мне, я вижу, пора выспатся.
Еще раз спасибо :)

<Цитата>
cemick (11.08.09 19:05) [11]

У меня 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.

<Цитата>