lvitems.pas

《Delphi开发人员指南》配书原码

unit LVItems;

interface

uses
  ComObj, Windows, ActiveX, ComCtrls, LVCtrl_TLB, StdVcl;

type
  TListItems = class(TAutoIntfObject, IListItems, IEnumVARIANT)
  private
    FListItems: ComCtrls.TListItems;
    FEnumPos: Integer;
  protected
    { IListItems methods }
    function Add: IListItem; safecall;
    function Get_Count: Integer; safecall;
    function Get_Item(Index: Integer): IListItem; safecall;
    procedure Remove(Index: Integer); safecall;
    function Get__NewEnum: IUnknown; safecall;
    { IEnumVariant methods }
    function Next(celt: LongWord; var rgvar : OleVariant;
      out pceltFetched: LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;
  public
    constructor Create(AOwner: ComCtrls.TListItems);
  end;

implementation

uses ComServ, LVItem;

{ TListItems }

constructor TListItems.Create(AOwner: ComCtrls.TListItems);
begin
  inherited Create(ComServer.TypeLib, IListItems);
  FListItems := AOwner;
end;

{ TListItems.IListItems }

function TListItems.Add: IListItem;
begin
  Result := LVItem.TListItem.Create(FListItems.Add);
end;

function TListItems.Get__NewEnum: IUnknown;
begin
  Result := Self;
end;

function TListItems.Get_Count: Integer;
begin
  Result := FListItems.Count;
end;

function TListItems.Get_Item(Index: Integer): IListItem;
begin
  Result := LVItem.TListItem.Create(FListItems[Index]);
end;

procedure TListItems.Remove(Index: Integer);
begin
  FListItems.Delete(Index);
end;

{ TListItems.IEnumVariant }

function TListItems.Clone(out Enum: IEnumVariant): HResult;
begin
  Enum := nil;
  Result := S_OK;
  try
    Enum := TListItems.Create(FListItems);
  except
    Result := E_OUTOFMEMORY;
  end;
end;

function TListItems.Next(celt: LongWord; var rgvar : OleVariant;
  out pceltFetched: LongWord): HResult; stdcall;
var
  V: OleVariant;
  PV: PVariantArg;
  I: Integer;
begin
  Result := S_FALSE;
  try
    if @pceltFetched <> nil then pceltFetched := 0;
    PV := @rgvar;
    for I := 0 to celt - 1 do
    begin
      if FEnumPos >= FListItems.Count then Exit;
      V := Get_Item(FEnumPos);
      PV^ := TVariantArg(V);
      // trick to prevent variant from being garbage collected, since it needs
      // to stay alive because it is party of the elt array
      TVarData(V).VType := varEmpty;
      TVarData(V).VInteger := 0;
      Inc(PV);
      Inc(FEnumPos);
      if @pceltFetched <> nil then Inc(pceltFetched);
    end;
  except
  end;
  if (@pceltFetched = nil) or ((@pceltFetched <> nil) and
    (pceltFetched = celt)) then Result := S_OK;
end;

function TListItems.Reset: HResult;
begin
  FEnumPos := 0;
  Result := S_OK;
end;

function TListItems.Skip(celt: LongWord): HResult;
begin
  Inc(FEnumPos, celt);
  Result := S_OK;
end;

end.