TRichView.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;