中国开发网: 论坛: 程序员情感CBD: 贴子 119579
有狐: 不知道还有人写COM吗,也许这个有点用
unit DispatchClasses;

interface

uses
ActiveX, ComObj;

type
{ TDispatchObject }

TDispatchObject = class(TAutoIntfObject)
public
constructor Create(const TypeLib: ITypeLib; const DispIntf: TGUID);
procedure Initialize; virtual;
end;

{ TDispatchList }

TItemHolder = record
FInterface: IUnknown;
FObject: TDispatchObject;
end;

TDispatchList = class(TDispatchObject)
private
FItems: array of TItemHolder;
function GetCount: Integer;
protected
function GetAsObject(Index: Integer): TDispatchObject;
function GetAsInterface(Index: Integer): IUnknown;
public
function Add(AObject: TDispatchObject): Integer;
property Count: Integer read GetCount;
property Objects[Index: Integer]: TDispatchObject read GetAsObject;
property Interfaces[Index: Integer]: IUnknown read GetAsInterface;
end;

implementation

{ TDispatchObject }

constructor TDispatchObject.Create(const TypeLib: ITypeLib; const DispIntf: TGUID);
begin
inherited Create(TypeLib, DispIntf);
Initialize;
end;

procedure TDispatchObject.Initialize;
begin
{ do nothing }
end;

{ TDispatchList }

function TDispatchList.Add(AObject: TDispatchObject): Integer;
begin
Result := Length(FItems);
SetLength(FItems, Result + 1);
FItems[Result].FObject := AObject;
FItems[Result].FInterface := AObject;
end;

function TDispatchList.GetCount: Integer;
begin
Result := Length(FItems);
end;

function TDispatchList.GetAsInterface(Index: Integer): IUnknown;
begin
Result := FItems[Index].FInterface;
end;

function TDispatchList.GetAsObject(Index: Integer): TDispatchObject;
begin
Result := FItems[Index].FObject;
end;

end.

相关信息:


欢迎光临本社区,您还没有登录,不能发贴子。请在 这里登录