How to export OLE objects from TRichViewEdit to a .rtf file.

[anup sarda]

Hi,

In my application user is allowed to embed OLE objects in the TDBRichViewEdit. When the contents of the RichViewEdit are saved using SaveRTF function to a file the embeded OLE object is lost.

What should be done to save the embed OLE object in RTF file?

Thanks,
Anup

[DavidRM]

I had posted a long-ish answer to this question some time back. Unfortunately, that was on the newsgroup.

Before I dig it up, one question: Are you handling the OLE objects in TOleContainers embedded in the TRVE? That's how I do it, and my code is based on that assumption.

-David

[DavidRM]

Here is my code for exporting OLE objects in TOleContainers from TRVE to RTF. Most of the code is an event handler for OnSaveComponentToFile. Following that are some support routines for TOleContainer that are called in the handler.

There are some "magic numbers" in the output, but I've run into no issues when testing MS Word, Excel, and Visio on XP SP2 with Office 2002. If anyone has further information about the RTF format details, I'd be happy to hear them.

This code is used in my The Journal product.

Enjoy.

-David
http://www.davidrm.com/

Code: Select all

procedure TJ4RVEStandardEventHandler.StandardSaveComponentToFile(Sender:TCustomRichView; 
Path:String; SaveMe:TPersistent; SaveFormat:TRVSaveFormat; var 
OutStr:String);


   function GetTwipsPerPixel:double;
      var
         DC: HDC;
      begin
      DC:=CreateCompatibleDC(0);
      try
         if RichViewPixelsPerInch>0 then
            Result:=(72*20)/RichViewPixelsPerInch
         else
            Result:=(72*20)/GetDeviceCaps(DC,LOGPIXELSY);
      finally
         DeleteDC(DC);
      end; // try
      end;

   function GetLEIntHexStr(int:integer):string;
      var
         ii: integer;
         bb: byte;
      begin
      // create "little endian" hexadecimal format
      Result:='';
      for ii:=1 to 4 do
         begin
         bb:=int and $FF;
         Result:=Result+IntToHex(bb,2);
         int:=int shr 8;
         end;
      end;

   function GetASCIIHexStr(const str:string):string;
      var
         ss: integer;
      begin
      // creates hexadecimal list from string's characters
      Result:='';
      for ss:=1 to Length(str) do
         begin
         Result:=Result+IntToHex(Ord(str[ss]),2);
         end;
      Result:=Result+'00';
      end;

   function GetStreamHexStr(stream:TStream):string;
      var
         ss, ssStop, cc: integer;
         bb: byte;
      begin
      // broken into 78-char lines, like TRichEdit's RTF embedded object output
      Result:='';
      ssStop:=(stream.Size-stream.Position) div 39;
      for ss:=1 to ssStop do
         begin
         for cc:=1 to 39 do
            begin
            stream.Read(bb,1);
            Result:=Result+IntToHex(bb,2);
            end;
         Result:=Result+#13#10;
         end;
      ssStop:=(stream.Size-stream.Position) mod 39;
      for ss:=1 to ssStop do
         begin
         stream.Read(bb,1);
         Result:=Result+IntToHex(bb,2);
         end;
      if Result<>'' then
         Result:=Result+#13#10;
      end;

   const
      MetaPictName: string = 'METAFILEPICT';

   var
      gif: TGifImage;
      imageFileName, className: string;
      sStream: TStringStream;
      mStream: TMemoryStream;
      ii: integer;
      metaFile: TMetafile;
   begin
   case SaveFormat of
      rvsfHTML:
         begin
         if SaveMe is TImage then
            begin
            gif:=TGifImage.Create;
            try
               gif.Assign(TImage(SaveMe).Picture.Graphic);
               imageFileName:=Sender.SavePicture(SaveFormat,Path,gif);
               OutStr:='<IMG SRC="'+imageFileName+'">';
            finally
               gif.Free;
            end; // try
            end;
         end;
      rvsfRTF:
         begin
         if SaveMe is TImage then
            begin
            sStream:=TStringStream.Create('');
            try
               RVSaveImageToRTF(sStream,GetTwipsPerPixel,TImage(SaveMe).Picture.Graphic,
                                TImage(SaveMe).Width,TImage(SaveMe).Height,Sender.RTFOptions);
               OutStr:=sStream.DataString;
            finally
               sStream.Free;
            end; // try
            end
         else if (SaveMe is TOleContainer) and 
(TOleContainer(SaveMe).OleObjectInterface<>nil) then
            begin
            className:=TOleContainer(SaveME).OleClassName;
            sStream:=TStringStream.Create('');
            try
               // write data
               sStream.WriteString('{\object\objemb');
               sStream.WriteString('{\*\objclass '+className+'}');
               ii:=Round(TOleContainer(SaveME).Width*GetTwipsPerPixel);
               sStream.WriteString('\objw'+inttostr(ii));
               ii:=Round(TOleContainer(SaveME).Height*GetTwipsPerPixel);
               sStream.WriteString('\objh'+inttostr(ii));
               sStream.WriteString('{\*\objdata'+#13#10);
               sStream.WriteString('01050000'#13#10);
               sStream.WriteString('02000000'#13#10);
               sStream.WriteString(GetLEIntHexStr(Length(className)+1)+#13#10);
               sStream.WriteString(GetASCIIHexStr(className)+#13#10);
               sStream.WriteString('00000000'#13#10);
               sStream.WriteString('00000000'#13#10);
               mStream:=TMemoryStream.Create;
               try
                  SaveOleObjectAsDocumentToStream(TOleContainer(SaveMe),mStream);
                  mStream.Seek(0,0);
                  sStream.WriteString(GetLEIntHexStr(mStream.Size)+#13#10);
                  sStream.WriteString(GetStreamHexStr(mStream));
               finally
                  mStream.Free;
               end; // try
               // write metapict
               sStream.WriteString('01050000'#13#10);
               sStream.WriteString('05000000'#13#10);
               sStream.WriteString(GetLEIntHexStr(Length(MetaPictName)+1)+#13#10);
               sStream.WriteString(GetASCIIHexStr(MetaPictName)+#13#10);
               metaFile:=TMetafile.Create;
               try
                  metaFile.Handle:=GetOleObjectMetaPict(TOleContainer(SaveMe));
                  ii:=Round(metaFile.Width*GetTwipsPerPixel);
                  sStream.WriteString(GetLEIntHexStr(ii)+#13#10);
                  ii:=-Round(metaFile.Height*GetTwipsPerPixel);
                  sStream.WriteString(GetLEIntHexStr(ii)+#13#10);
                  mStream:=TMemoryStream.Create;
                  try
                     metaFile.Enhanced:=false;
                     metaFile.SaveToStream(mStream);
                     mStream.Seek(22,0); // sizeof(TMetafileHeader)=22
                     sStream.WriteString(GetLEIntHexStr((mStream.Size-22)+8)+#13#10); 
// sizeof(TMetafileHeader)=22
                     ii:=Round(metaFile.Width*GetTwipsPerPixel);
                     ii:=(ii shl 16) or $0008;
                     sStream.WriteString(GetLEIntHexStr(ii));
                     ii:=Round(metaFile.Height*GetTwipsPerPixel);
                     sStream.WriteString(GetLEIntHexStr(ii)+#13#10);
                     sStream.WriteString(GetStreamHexStr(mStream));
                     sStream.WriteString('}');
                     // write "result" (metapict again)
                     sStream.WriteString('{\result');
                     sStream.WriteString('{\pict\wmetafile8');
                     ii:=Round(metaFile.Width*GetTwipsPerPixel);
                     sStream.WriteString('\picw'+inttostr(ii));
                     ii:=Round(metaFile.Height*GetTwipsPerPixel);
                     sStream.WriteString('\pich'+inttostr(ii));
                     ii:=Round(TOleContainer(SaveME).Width*GetTwipsPerPixel);
                     sStream.WriteString('\picwgoal'+inttostr(ii));
                     ii:=Round(TOleContainer(SaveME).Height*GetTwipsPerPixel);
                     sStream.WriteString('\pichgoal'+inttostr(ii)+#13#10);
                     mStream.Seek(22,0); // sizeof(TMetafileHeader)=22
                     sStream.WriteString(GetStreamHexStr(mStream));
                     sStream.WriteString('}}');
                  finally
                     mStream.Free;
                  end; // try
               finally
                  metaFile.Free;
               end; // try
               sStream.WriteString('}');
               OutStr:=sStream.DataString;
            finally
               sStream.Free;
            end; // try
            end;
         end;
      end; // case
   end;

procedure SaveOleObjectAsDocumentToStream(OleContainer:TOleContainer; 
Stream:TStream);
   var
      PersistStorage: IPersistStorage;
      TempLockBytes: ILockBytes;
      TempStorage: IStorage;
      DataHandle: HGlobal;
      BufferSize: integer;
      Buffer: Pointer;
   begin
   if OleContainer.OleObjectInterface<>nil then
      begin
      OleContainer.OleObjectInterface.QueryInterface(IPersistStorage,PersistStorage);
      if PersistStorage<>nil then
         begin
         OleCheck(CreateILockBytesOnHGlobal(0,True,TempLockBytes));
         OleCheck(StgCreateDocfileOnILockBytes(TempLockBytes,STGM_READWRITE
               or STGM_SHARE_EXCLUSIVE or STGM_CREATE,0,TempStorage));
         OleCheck(OleSave(PersistStorage,TempStorage,False));
         PersistStorage.SaveCompleted(nil);
         OleCheck(GetHGlobalFromILockBytes(TempLockBytes,DataHandle));
         BufferSize:=GlobalSize(DataHandle);
         Buffer:=GlobalLock(DataHandle);
         try
            Stream.WriteBuffer(Buffer^,BufferSize);
         finally
            GlobalUnlock(DataHandle);
         end; // try
         end;
      end;
   end;

function GetOleObjectMetaPict(OleContainer:TOleContainer):HGlobal;
   var
      DataObject: IDataObject;
      FormatEtc: TFormatEtc;
      Medium: TStgMedium;
      ClassID: TCLSID;
   begin
   Result:=0;
   if OleContainer.OleObjectInterface<>nil then
      begin
      // metapict won't draw unless the object's server is running
      if OleContainer.State=osLoaded then
         OleContainer.Run;
      OleContainer.OleObjectInterface.QueryInterface(IDataObject, 
DataObject);
      if DataObject<>nil then
         begin
         if OleContainer.Iconic then
            begin
            FormatEtc.cfFormat:=CF_ENHMETAFILE;
            FormatEtc.ptd:=nil;
            FormatEtc.dwAspect:=DVASPECT_ICON;
            FormatEtc.lIndex:=-1;
            FormatEtc.tymed:=TYMED_ENHMF;
            if Succeeded(DataObject.GetData(FormatEtc,Medium)) then
               Result:=Medium.hEnhMetaFile;
            end
         else
            begin
            OleContainer.OleObjectInterface.QueryInterface(IDataObject,DataObject);
            if DataObject <> nil then
               begin
               FormatEtc.cfFormat:=CF_ENHMETAFILE;
               FormatEtc.ptd:=nil;
               FormatEtc.dwAspect:=DVASPECT_CONTENT;
               FormatEtc.lIndex:=-1;
               FormatEtc.tymed:=TYMED_ENHMF;
               FillChar(Medium,SizeOf(Medium),0);
               if Succeeded(DataObject.GetData(FormatEtc, Medium)) then
                  Result:=Medium.hEnhMetaFile;
               end;
            end;
         end;
      end;
   end;

[Sergey Tkachenko]

Thank you, David.
I added a link to this topic in the Examples&Demos forum

[Guest]

Thanks David,

I tried using the code. It complied but the result is not as expected. I could see one image (rectangle with diagonal lines) instead of OLE object. It behaves as an image and not OLE.

While debugging I found that the following statment from GetOleObjectMetaPict is failing
Succeeded(DataObject.GetData(FormatEtc, Medium))

I don't know what is the reason for the failure of this statement. Can you please help.

One more question...
How canl I import this OLE back to TDBRichViewEdit from the .rtf file?

Thanks,
Anup

[DavidRM]

I tried using the code. It complied but the result is not as expected. I could see one image (rectangle with diagonal lines) instead of OLE object. It behaves as an image and not OLE.

While debugging I found that the following statment from GetOleObjectMetaPict is failing
Succeeded(DataObject.GetData(FormatEtc, Medium))

Without more information about the OLE object in question, it's hard to say. Are you certain that the OLE server supprts creating the metapict?

My testing was done with standard OLE servers like MS Word, Excel, Visio, etc.

One more question...
How canl I import this OLE back to TDBRichViewEdit from the .rtf file?

That's a bit harder to share. It boils down to this:

1. You need a TRichEdit component (like TRxRichEdit) that supports embedded objects.

2. You then load the RTF file into this component, and use the IRichEditOle interface to cycle through all of the objects (if any).

3. As you cycle through the objects, you can load the RTF *between* the objects into the TRVE. When you find an object, you load it into a TOleContainer, and insert that component into the TRVE.


Hope that helps.

-David

[MLefebvre]

Hi, David

I have tried your code to save a RV-embedded object (via TOleContainer) to RTF, and this works fine. (note that one must "use" ActiveX, ComObj and RVFuncs to compile ok).

Yet there is a problem with the visual size of the result in RTF : when opened with MS-Word (2000), it seems about 60% of the size of the original object in RV. In addition, does not seem to take into account any resizing done from within RV.

Would you have any idea about this ?

Thanks in advance
ML

[DavidRM]

ML,

It could be that the calculation of the metafile's width and height should ignore the RichViewPixelsPerInch and just use the device context PPI. You could experiment with that and see if it makes any difference.

I'm not sure I'll have a chance to experiment with it soon, but I'll try to work it in.

-David

[MLefebvre]

Well, actually I work with the default value for RichViewPixelsPerInch (=0), so it should make no difference.

It might be depending on the way the resizing is handled within RV. In my case I just let RV do the job, by allowing the RV item to be resized and setting the sizemode of the TOleContainer to smScale (to keep proportions in all circumstances). But to be honnest I did not understand all of it.

I am neither a specialist of RTF nor of Metafiles. I can see in your code that there are many places where "width" and "height" are specified, but I do not know their roles and priorities. I am afraid I could spend years trying all possible combinations ...

To summarize, as soon as you have a brilliant idea on this, I'll be happy if you can let me know. Thanks in advance.

Michel

[Sergey Tkachenko]

I created a unit based on your code:
http://www.trichview.com/forums/viewtop ... 3569#13569
I made some optimization, checked Delphi 2009-2010 compatibility, and changed a way for getting a metafile.
Unfortunately, requesting a metafile from OleContainer is not reliable, it fails, for example, for Paint pictures or embedded files (displayed as an icon). And an invalid metafile makes Word to ignore the whole object. So I just used OleContainer.PaintTo procedure. Alternatively, a metafile can be specified as a parameter.

[DavidRM]

Very cool. I'll check it out.

-David