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.