Graphic.SaveToStream - Takes morethan 600ms in Delphi

I did some testing and there's no difference if this code is run from within application or COM library. below my test code.

interface declaration in OCX:

  IArrayStream = interface(IUnknown)
    ['{D01A755C-A36D-44CC-810A-8ED7DEC11D84}']
    function SetJPEG(Stream: OleVariant): HResult; stdcall;
    function GetJPEG: OleVariant; stdcall;
  end;

implementation in COM DLL:

unit uArrayStream;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, OCXLib_TLB, StdVcl;

type
  TArrayStream = class(TTypedComObject, IArrayStream)
  protected
    function SetJPEG(Stream: OleVariant): HResult; stdcall;
    function GetJPEG: OleVariant; stdcall;
    {Declare IArrayStream methods here}
  end;

implementation

uses ComServ, Variants;

function TArrayStream.SetJPEG(Stream: OleVariant): HResult;
var ms: TMemoryStream;
    lck: Pointer;
begin
  Result := E_FAIL;
  ms := TMemoryStream.Create;
  try
    if VarIsArray(Stream) then begin
      lck := VarArrayLock(Stream);
      try
        ms.Write(lck^, VarArrayHighBound(Stream, 1));
      finally
        VarArrayUnlock(Stream);  
      end;
      ms.SaveToFile('D:\MyTestProjects\EE\bin\ocx_set.jpg');
      Result := S_OK;
    end;
  finally
    ms.Free;
  end;
end;

function TArrayStream.GetJPEG: OleVariant;
var ms: TMemoryStream;
    lck: Pointer;
begin
  Result := Unassigned;
  ms := TMemoryStream.Create;
  try
    ms.LoadFromFile('D:\MyTestProjects\EE\bin\screen.jpg');
    ms.Position := 0;
    Result := VarArrayCreate([0, ms.Size], varByte);  
    lck := VarArrayLock(Result);
    try
      ms.Read(lck^, ms.Size);  
    finally
      VarArrayUnlock(Result);
    end;
  finally
    ms.Free;
  end;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TArrayStream, Class_ArrayStream,
    ciMultiInstance, tmApartment);
end.


usage on EXE side:

procedure TForm1.Button4Click(Sender: TObject);
var arr: IArrayStream;
    ov: OleVariant;
    lck: Pointer;
    ms: TMemoryStream;
    tc: Cardinal;
begin
  tc := GetTickCount;
  arr := CoArrayStream.Create;
  ms := TMemoryStream.Create;  
  try
    ov := arr.GetJPEG;
    if VarIsArray(ov) then begin
      lck := VarArrayLock(ov);
      try
        ms.Write(lck^, VarArrayHighBound(ov, 1));  
      finally
        VarArrayUnlock(ov);
      end;
      ms.SaveToFile('D:\MyTestProjects\EE\bin\test.jpg');
    end;
  finally
    arr := nil;
    ms.Free;
  end;
  Memo1.Lines.Add(IntToStr(GetTickCount - tc));  
end;

procedure TForm1.Button6Click(Sender: TObject);
var ms: TMemoryStream;
    arr: IArrayStream;
    ov: OleVariant;
    lck: Pointer;
    tc: Cardinal;
begin
  tc := GetTickCount;
  arr := CoArrayStream.Create;  
  ms := TMemoryStream.Create;
  try
    Image1.Picture.Graphic.SaveToStream(ms);
    ms.Position := 0;
    ov := VarArrayCreate([0, ms.Size], varByte);
    lck := VarArrayLock(ov);
    try
      ms.Read(lck^, ms.Size);
    finally
      VarArrayUnlock(ov);
    end;
    arr.SetJPEG(ov);
  finally
    ms.Free;
    arr := nil;
  end;
  Memo1.Lines.Add(IntToStr(GetTickCount - tc));
end;


ziolko