if Succeeded(DataObject.GetData(FormatEtc, Medium)) then

procedure TForm1.Button5Click(Sender: TObject);

var IREO:IRichEditOle;

ReObject:TReobject;

Count: Integer;

I:Integer;

DataObject:IDataObject;

FormatEtc:TFormatEtc;

Medium: TStgMedium;

MetafilePictPtr: PMetafilePict;

BitsLength: UINT;

Bits: Pointer;

 

MetaFile: TMetafile;

bmp: TBitmap;

Path:String;

Position:LongInt;

begin

Count := 0;

Path:='c:\temp2\richedit\';

SendMessage(RichEdit1.Handle, EM_GETOLEINTERFACE, 0, Longint(@IREO));

 

Count := IREO.GetObjectCount;

for I := 0 to Count-1 do

begin

   ZeroMemory(@ReObject, SizeOf(ReObject));

   ReObject.cbStruct:=SizeOf(ReObject);

   if Succeeded(IREO.GetObject(I,ReObject, {text}000001)) then

   if ReObject.poleobj.QueryInterface(IDataObject,DataObject)=S_OK then

   if Supports(ReObject.poleobj,IDataObject,DataObject) then

   begin

      Position:=ReObject.cp;

      FormatEtc.cfFormat:=CF_METAFILEPICT;

      FormatEtc.ptd:=nil;

      FormatEtc.dwAspect:=DVASPECT_CONTENT;

      FormatEtc.lindex:=-1;

      FormatEtc.tymed:=TYMED_MFPICT;

      OleCheck(DataObject.GetData(FormatEtc,Medium));

      if Succeeded(DataObject.GetData(FormatEtc,Medium)) then

      try

      

        MetafilePictPtr:=GlobalLock(Medium.hMetaFilePict);

        try

 

         BitsLength:= GetMetaFileBitsEx(MetafilePictPtr.hMF,0,nil);

         GetMem(Bits,BitsLength);

         try

          if GetMetaFileBitsEx(MetaFilePictPtr.hMF, BitsLength, Bits) < BitsLength then

          RaiseLastOSError;

 

          MetaFile:=TMetafile.Create;

          MetaFile.Handle:=SetWinMetaFileBits(BitsLength,Bits,0,MetafilePictPtr^);

          if (MetaFile.Width<=0)or(MetaFile.Height<=0)or(MetaFile.Handle<=0)then

          raise Exception.Create('Invalid Metafile-Picture');

          bmp:=TBitmap.Create;

          bmp.Width:=MetaFile.Width;

          bmp.Height:=MetaFile.Height;

          bmp.Canvas.StretchDraw(Rect(0,0,bmp.Width,bmp.Height),MetaFile);

          bmp.SaveToFile(Path+'img'+IntToStr(I+1)+'.bmp');

 

         finally

           bmp.Free;

           MetaFile.Free;

           FreeMem(Bits, BitsLength);

         end;

        finally

         GlobalUnlock(Medium.hMetaFilePict);

        end;

 

      finally

         ReleaseStgMedium(Medium);

      end;

    

   end;

end;