function TStreamAdapter.Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
var
  NumWritten: Longint;
begin
  try
    if pv = Nil then
    begin
      Result := STG_E_INVALIDPOINTER;
      Exit;
    end;
    NumWritten := FStream.Write(pv^, cb);
    if pcbWritten <> Nil then pcbWritten^ := NumWritten;
    Result := S_OK;
  except
    Result := STG_E_CANTSAVE;
  end;
end;

if (pv = Nil) and (cb > 0) then

procedure WriteBitmap(const AStrm: IStream);
var
  LBitmap: TBitmap;
  LOStrm: TStream;
begin
  LBitmap := TBitmap.Create;
  try
    // Draw bitmap
    LOStrm := TOleStream.Create(AStrm);
    try
      LBitmap.SaveToStream(LOStrm);
    finally
      LOStrm.Free;
    end;
  finally
    LBitmap.Free;
  end;
end;

var
  LFStrm: TStream;
  LIStrm: IStream;
begin
  LFStrm := TFileStream.Create('.....', fmCreate);
  LIStrm := TStreamAdapter.Create(LFStrm, soOwned);
  WriteBitmap(LIStrm);
end;

procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
begin
  ............
      Stream.WriteBuffer(Colors, ColorCount * PalSize[FOS2Format]);
  ............
end;

function TOleStream.Write(const Buffer; Count: Longint): Longint;
begin
  OleCheck(FStream.Write(@Buffer, Count, @Result));
end;

function TOleStream.Write(const Buffer; Count: Longint): Longint;
begin
  if Count > 0 then
    OleCheck(FStream.Write(@Buffer, Count, @Result))
  else
    Result := 0;
end;

 ss.WriteBuffer(Buf, 0);

var
  Buf: TBytes;
  ss: TStream;
  ist: IStream;
begin
  SetLength(Buf, 0);
  ss := TBytesStream.Create();
  ist := TStreamAdapter.Create(ss);
  OleCheck(ist.Write(Buf, 0, nil));
end;

procedure TBitmap.WriteStream(Stream: TStream; WriteSize: Boolean);
begin
  ............
      Stream.WriteBuffer(Colors, ColorCount * PalSize[FOS2Format]);
  ............
end;

procedure TStream.WriteBuffer(const Buffer; Count: Longint);
var
  Buf: TBytes;
  LTotalCount,
  LWrittenCount: Longint;
begin
  SetLength(Buf, Count);  // Count = 0 => Buf = nil
  Move(Buffer, Buf[0], Count);
  { Perform a write directly. Most of the time this will succeed
    without the need to go into the WHILE loop. }
  LTotalCount := Write(Buf, 0, Count);  // передали nil

  while (LTotalCount < Count) do
  begin
    { Try to read a contiguous block of <Count> size }
    LWrittenCount := Write(Buf, LTotalCount, (Count - LTotalCount));

    { Check if we written something and decrease the number of bytes left to read }
    if LWrittenCount <= 0 then
      raise EWriteError.CreateRes(@SReadError)
    else
      Inc(LTotalCount, LWrittenCount);
  end
end;