お言葉ですが、田舎のじじぃです。

Delphiを使ってVBA Collection(IEnumVariant)の実装例です。 インターネットを探しても良い例がなかったので作ってみました。

ポイントは、コレクションのアイテムをTStringListで保持し IEnumVariantインターフェイスを使って操作することです。

以下に例です。

先ずは、コレクションのアイテムの実装から ソース中のTEST_TLBは、Delphiのタイプライブラリエディタが 生成したソースです。 個々のアイテムを操作するインターフェイスの実装です。 DelphiのCom関係のClassから派生したClassを定義します。

unit PVData;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

 ComObj, ActiveX, TEST_TLB, StdVcl;

type

 TPVData = class(TAutoObject, IPVData)

private

   FTagName : WideString;
   FValue   : Single;
   FStatus  : Integer;
   FEnabled : WordBool;
   FService : Integer;
 protected
   function Get_Enabled: WordBool; safecall;
   function Get_Service: Integer; safecall;
   function Get_Status: Integer; safecall;
   function Get_TagName: WideString; safecall;
   function Get_Value: Single; safecall;
   procedure Set_Enabled(Value: WordBool); safecall;
   procedure Set_Service(Value: Integer); safecall;
   procedure Set_Status(Value: Integer); safecall;
   procedure Set_TagName(const Value: WideString); safecall;
   procedure Set_Value(Value: Single); safecall;

 end;

implementation

uses ComServ;

function TPVData.Get_Enabled: WordBool; begin Result := FEnabled; end;

function TPVData.Get_Service: Integer; begin Result := FService; end;

function TPVData.Get_Status: Integer; begin Result := FStatus; end;

function TPVData.Get_TagName: WideString; begin Result := FTagName; end;

function TPVData.Get_Value: Single; begin Result := FValue; end;

procedure TPVData.Set_Enabled(Value: WordBool); begin FEnabled := Value; end;

procedure TPVData.Set_Service(Value: Integer); begin FService := Value; end;

procedure TPVData.Set_Status(Value: Integer); begin FStatus := Value; end;

procedure TPVData.Set_TagName(const Value: WideString); begin FTagName := Value; end;

procedure TPVData.Set_Value(Value: Single); begin FValue := Value; end;

initialization

 TAutoObjectFactory.Create(ComServer, TPVData, Class_PVData,
   ciMultiInstance, tmApartment);

end.

次にコレクションの実装です。 アイテムがDelphiのクラスであれば、TObjectにキャスト することでTStringListに登録が可能です。 アイテムの操作時はTObjectから所定のインターフェイス （この場合はIPVData)にキャストします。

unit PVList;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

 //ShareMem,
 ComObj, ActiveX, TEST_TLB, StdVcl,Classes;

type

 TPVList = class(TAutoObject, IPVList, IEnumVARIANT)
 private
 	FPVList : TStringList;
   FIndex  : Integer;
   procedure InitList;
 protected

   {IEnumVARIANT インターフェイス}
   function Clone(out ppenum: IEnumVARIANT): HResult; stdcall;
   function Next(celt: LongWord; var rgvar: OleVariant;
     out pceltFetched: LongWord): HResult; stdcall;
   function Reset: HResult; stdcall;
   function Skip(celt: LongWord): HResult; stdcall;

   {IPVLIST インターフェイス}
   function _NewEnum: IUnknown; safecall;
   function Item(Index: OleVariant): IPVData; safecall;
   function Count: Integer; safecall;
   function Add(const KeyStr: WideString): IPVData; safecall;
   procedure Remove(Index: OleVariant); safecall;
   procedure RemoveAll; safecall;
 public
 	//constructor Create;
   procedure AfterConstruction; override;
   procedure BeforeDestruction; override;
   //destructor Destroy; override;

 end;

　function GetListIndex(SL : TStrings; Index : OleVariant) : Integer;

implementation

uses ComServ, Variants,

 IniFiles,
 SysUtils,
 PVData, TL2WUTIL,Forms;
 //Forms, TL2WUTIL;

const PVMAX = 64;

 SECTIONNAME = 'PVTAG';

function GetListIndex(SL : TStrings; Index : OleVariant) : Integer; var CheckIdx : Integer; begin Result := -1;

if Assigned(SL) then begin

   CheckIdx := -1;

if VarIsNumeric(Index) then begin

   	CheckIdx := Integer(Index);

end else begin if VarIsStr(Index) then begin CheckIdx := SL.IndexOf(VarToStr(Index)); end; end;

   If (CheckIdx < SL.Count) then begin
   	Result := CheckIdx;
   end;

end; end;

function TPVList.Clone(out ppenum: IEnumVARIANT): HResult; var PVList : TPVList; begin

PVList := TPVList.Create; try

 	ppenum := PVList As IEnumVARIANT;
   Result := S_OK;
 except

Result := S_FALSE;

 end;

end;

function TPVList.Next(celt: LongWord; var rgvar: OleVariant;

 out pceltFetched: LongWord): HResult;

type TVariantList = array[0..0] of Olevariant; var I : LongWord; begin I := 0;

 while (I < celt) and (FIndex < FPVLIST.Count) do begin

   TVariantList(rgvar)[i] := Self.Item(Integer(I) + FIndex);

   Inc(I);
   Inc(FIndex);
 end;

if (@pceltFetched <> nil) then begin

 	pceltFetched := I;

end;

if (I = celt) then begin Result := S_OK; end else begin Result := S_FALSE; end;

end;

function TPVList.Reset: HResult; begin FIndex := 0;

 Result := S_OK

end;

function TPVList.Skip(celt: LongWord): HResult; begin

if FIndex + Integer(celt = FPVLIST.Count) then begin

 	Inc(FIndex,celt);

Result := S_OK; end else begin FIndex := FPVLIST.Count; Result := S_FALSE;

 end;

end;

function TPVList._NewEnum: IUnknown; begin Result := Self As IEnumVariant; end;

function TPVList.Item(Index: OleVariant): IPVData; var ListIndex : Integer; begin

Result := nil; ListIndex := GetListIndex(FPVLIST,Index);

 If ListIndex <> -1 then begin
 	Result := TPVData(FPVLIST.Objects[ListIndex]) As IPVData;
 end;

end;

function TPVList.Count: Integer; begin Result := 0;

 //Result := 4;

if Assigned(FPVLIST) then begin

 	Result := FPVLIST.Count;
 end;

end;

{ constructor TPVList.Create; begin //inherited Create(Comserver.TypeLib,IPVList);

 //inherited Create;

FPVLIST := TStringList.Create; end; }

function TPVList.Add(const KeyStr: WideString): IPVData; var PVData : TPVData;

 Index : Integer;

begin

 //Application.MessageBox(PChar(AnsiString(KeyStr)),'PVAdd',0);

Result := Nil; try

 	PVData := TPVData.Create;

Index := FPVLIST.AddObject(AnsiString(KeyStr),TObject(PVData));

 	//FPVLIST.Objects[Index] := TObject(PVData);
 	Result := PVData As IPVData;
   //AddRefしておくのを忘れずに実施する
   Result._AddRef;
 except
 	;
 end;

end;

procedure TPVList.Remove(Index: OleVariant); var ListIndex : Integer; RmPV : IPVData; begin

ListIndex := TL2WUTIL.GetListIndex(FPVLIST, Index); If ListIndex <> -1 then begin

 	RmPV := TPVData(FPVLIST.Objects[Index]) As IPVData;
   RmPV._Release;
   FPVLIST.Delete(Index);
 end;

end;

procedure TPVList.RemoveAll; var RmPV : IPVData;

 i : Integer;

begin

with FPVLIST do begin

 	For i := 0 to Count -1 do begin
     RmPV := TPVData(Objects[i]) As IPVData;
     RmPV._Release;
     Objects[i] := nil;
   end;
   Clear;

end;

 FPVLIST.Clear;
 

end;

procedure TPVList.InitList; begin

FPVLIST := TStringList.Create;

 //重複を不可（大文字・小文字の区別なしにします。
 FPVLIST.Sorted := true;
 FPVLIST.CaseSensitive := false;
 //重複時は、最初に書いたものを優先とします。
 FPVLIST.Duplicates := dupError;

end;

{destructor TPVList.Destroy; begin

if Assigned(FPVLIST) then begin

 	RemoveAll;
 	FPVLIST.Free;
 end;

 inherited;

end; }

procedure TPVList.AfterConstruction; begin

 inherited;
 FIndex := 0;

InitList; end;

procedure TPVList.BeforeDestruction; begin

 if Assigned(FPVLIST) then begin
 	RemoveAll;
 	FPVLIST.Free;
 end;
 inherited;

end;

initialization

 TAutoObjectFactory.Create(ComServer, TPVList, Class_PVList,
   ciMultiInstance, tmApartment);

end.

[参考文献] Delphi 5 Developer’s Guide Chapter 23 -- COM-Based Technologies

本国のボーランドサイトにNew Versionのアナウンスが あった。しかし、この時期にアップするのに、dotNet 2.0対応ではない。genericsなどの2.0の機能は 次のバージョンまでおあずけ。

確かに、MSちゃんのフレームワークリリースと 同時に対応は、MSちゃん以外のベンダーには 難しいことだと思う。

でも、もう少しボーランドさんにがんばってもらいたい のですよ。無理やりスケジュールに合わせるのでは なく、たとえば新バージョンの出荷を３ヶ月 遅らせれば新しいフレームワークに対応できる のであればそれでも良いと思うのですが・・・

と云いつつバージョンアップしちゃうのだろうな。