The second project should offer some more interaction to the user. Delphi provides an ExcelXP
and OfficeXP
unit but a TCommandBarButton
cannot be found. We will add this as a TOleServer
descendant. The sample COM Add-In creates a custom command bar and some buttons. It handles the Click
event of the buttons.
A TOleServer
descendant is an easy way with the TServerEventDispatch
behind which works as an event sink and invokes its server’s InvokeEvent
method. So, we don’t need to deal with the named arguments of Invoke
.
TCommandBarButton
is defined the same way as other wrappers. We add a ConnectTo
method to connect to a button and a DefaultInterface
property to access this button.
type CommandBarButton_Click = procedure(const Ctrl: CommandBarButton; var CancelDefault: WordBool) of object; type TCommandBarButton = class(TOleServer) private FIntf: _CommandBarButton; FOnClick: CommandBarButton_Click; function GetDefaultInterface: _CommandBarButton; protected procedure InitServerData; override; procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override; public procedure Connect; override; procedure ConnectTo(svrIntf: _CommandBarButton); procedure Disconnect; override; property DefaultInterface: _CommandBarButton read GetDefaultInterface; published property OnClick: CommandBarButton_Click read FOnClick write FOnClick; end;
The TServerData
record contains a field named EventIID
. Don’t put in the IID
of the event interface. The Disp Infterface ID (DIID
) is expected.
procedure TCommandBarButton.InitServerData; const CServerData: TServerData = ( ClassID: '{55F88891-7708-11D1-ACEB-006008961DA5}'; // CLASS_CommandBarButton; IntfIID: '{000C030E-0000-0000-C000-000000000046}'; // IID__CommandBarButton; EventIID: '{000C0351-0000-0000-C000-000000000046}'; // DIID__CommandBarButtonEvents; LicenseKey: nil; Version: 500); begin ServerData:= @CServerData; end;
You can take the other methods from any wrapper e.g. TExcelApplication
and change the used type to _CommandBarButton
. The InvokeEvent
method is implemented as follows.
procedure TCommandBarButton.InvokeEvent(DispID: TDispID; var Params: TVariantArray); begin case DispID of 1 : if Assigned(FOnClick) then FOnClick(IUnknown(TVarData(Params[0]).VPointer) as _CommandBarButton {const CommandBarButton}, WordBool((TVarData(Params[1]).VPointer)^) {var WordBool}); end; end;
Now we can start with the new COM Add-In. We define a FApp
field as an internal reference to the host application and a TObjectList
field which will hold the TCommandBarButtons
.
type TDelphiAddin2 = class(TAutoObject, IDelphiAddin2, IDTExtensibility2) private FApp: IDispatch; FBList: TObjectList; procedure BtnClick(const Ctrl: CommandBarButton; var CancelDefault: WordBool); procedure InitButtons; procedure DestroyButtons; { IDTExtensibility2 } { ... } public procedure Initialize; override; Destructor Destroy; override; end;
Initialize
and Destroy
do nothing but create and free the TObjectList
. The BtnClick
method handles the events fired by the buttons which are commonly identified by the Tag
property.
procedure TDelphiAddin2.BtnClick(const Ctrl: CommandBarButton; var CancelDefault: WordBool); var s: WideString; begin s:='Hello World! ' + Ctrl.Tag + ' clicked'; MessageBoxW(0, PWideChar(s), '', MB_OK); end;
The internal reference to the host application (FApp
) is set in the OnConnection
method and is released in the OnDisconnection
method. InitButtons
method is called by to create a CommandBar
. This is done in the OnStartupComplete
method for an Add-In that is already installed and in the OnConnection
method for ConnectMode = ext_cm_AfterStartup
for an Add-In that is loaded by the Add-In Manager. DeleteButtons
method is called OnDisconnection
to delete the CommandBar
.
procedure TDelphiAddin2.OnConnection(const Application: IDispatch; ConnectMode: ext_ConnectMode; const AddInInst: IDispatch; var custom: PSafeArray); begin FApp:= Application; if ConnectMode = ext_cm_AfterStartup then InitButtons; end; procedure TDelphiAddin2.OnDisconnection(RemoveMode: ext_DisconnectMode; var custom: PSafeArray); begin DestroyButtons; FApp:=nil; end; procedure TDelphiAddin2.OnStartupComplete(var custom: PSafeArray); begin InitButtons; end;
The InitButtons
method creates a new temporary command bar and adds some buttons but exits if a bar with the same name already exists. TCommandBarButtons
are created and linked to the BtnClick
handler. They are stored in the TObjectList
and connected to the result of the CommandBar
’s Add
method. The Set
-methods of the CommandBarButton
are used because the Delphi 7 version of it defines all properties as readonly
.
procedure TDelphiAddin2.InitButtons; const FIDs: array[1..5] of integer = (92, 104, 86, 91, 80); var Excel: ExcelApplication; MBar: CommandBar; Button: TCommandBarButton; Popup: CommandBarPopup; i: integer; begin if Assigned(FApp) and Supports(FApp, ExcelApplication, Excel) then begin try MBar:=Excel.CommandBars.Item['MyglaBar']; // assume that already initialized Excel:=nil; Exit; // alternative solution: // FBList.Clear; // MBar.Delete; except end; // create a Bar MBar:=Excel.CommandBars.Add('MyglaBar', msoBarTop, emptyParam, true); MBar.Set_Visible(true); // add Buttons to the Bar For i:=1 to 5 do begin Button:=TCommandBarButton.Create(nil); Button.OnClick:= Self.BtnClick; FBList.Add(Button); Button.ConnectTo(MBar.Controls.Add(msoControlButton, emptyParam, emptyParam, emptyParam, True) as CommandBarButton); Button.DefaultInterface.Set_Style(msoButtonIcon); Button.DefaultInterface.Set_FaceId(FIDs[i]); Button.DefaultInterface.Set_Tag('Mygla_Button' + IntToStr(i)); // Tag for BtnClick { ... } end; { ... } MBar:=nil; Excel:=nil; end; end;
The DestroyButtons
method frees the TCommandBarButtons
and deletes the CommandBar
.
procedure TDelphiAddin2.DestroyButtons; var Excel: ExcelApplication; MBar: CommandBar; begin // disconnect button handlers FBList.Clear; // search the bar and delete it if Assigned(FApp) and Supports(FApp, ExcelApplication, Excel) then begin try MBar:=Excel.CommandBars.Item['MyglaBar']; MBar.Delete; except end; Excel:=nil; end; end;
It looks good in Excel 11 and before but appears in the Add-Ins Tab of Excel 12 and later.