如何将 RxRichEdit 中的图片取出来，生成文件

ezhuo 2012-01-19 09:40:34

我现在已经将图元数据放到 TSTGMEDIUM 结构里，就是使用 BuildHandleBMP 函数 ,不知道下一步该怎么做了。

代码如下





procedure TForm1.Button12Click(Sender: TObject);

var

  idx: integer;

  FRTF: IRichEditOle;

  ReObject: TReObject;

  hr: HRESULT;

  tmpDataOBject: IDataObject;





  procedure BuildHandleBMP(dataObj: IDataObject; fetc: TFormatEtc);

  var

    stgm: TSTGMEDIUM;

    tmpbitmap: TBitmap;

    mmoStream: TMemoryStream;

    cf: word;

    Buffer: PChar;

  begin



    tmpbitmap := TBitmap.Create;

    mmoStream := TMemoryStream.Create;



    if (dataObj.QueryGetData(fetc) = NOERROR) then

    begin

      stgm.hBitmap := 0;

      OleCheck(dataObj.GetData(fetc, stgm));

      ShowMessage(IntToStr(stgm.tymed));

      if stgm.hBitmap = null then ShowMessage('b');



      Buffer := GlobalLock(stgm.hglobal);



      Image1.Visible := true;

      Image1.Picture.bitmap.Handle := stgm.hglobal;

      Image1.Refresh;



      Image1.Picture.SaveToFile(apppath + '\aaaa.jpg');

      ReleaseStgMedium(stgm);



    end;



  end;



  procedure BuildPicture(var dataobj: IDataObject);

  var

    FmEtc: TFormatEtc;

    ef: IEnumFORMATETC;

    bNotFound: Boolean;

    sFormat: string;

    pic: TPicture;

  begin



    Memo1.Clear;



    FmEtc.cfFormat := CF_BITMAP; // Clipboard format = CF_BITMAP

    FmEtc.ptd := nil; // Target Device = Screen

    FmEtc.dwAspect := DVASPECT_CONTENT; // Level of detail = Full content

    FmEtc.lindex := -1; // Index = Not applicaple

    FmEtc.tymed := TYMED_GDI; // Storage medium = HBITMAP handle



    FillChar(FmEtc, SizeOf(FmEtc), 0);



    ef := nil;

    FillChar(ef, SizeOf(ef), 0);

    dataObj.EnumFormatEtc(DATADIR_GET, ef);



    FillChar(FmEtc, SizeOf(FmEtc), 0);



    while ef.Next(1, FmEtc, nil) <> S_FALSE do

    begin



      Memo1.Lines.Add(StringFromClipboardFormat(FmEtc.cfFormat, true));

      Memo1.Lines.Add((StringFromTymed(FmEtc.tymed)));

     // SubItems.Add(StringFromspect(fetc.dwAspect));

      Memo1.Lines.Add((IntToStr(FmEtc.lindex)));

      Memo1.Lines.Add((StringFromTD(FmEtc.ptd)));



      bNotFound := false;

      case FmEtc.cfFormat of

        CF_BITMAP: HandleBMP(dataObj, FmEtc);

        CF_DIB: BuildHandleBMP(dataObj, FmEtc);

        CF_METAFILEPICT: HandleBMP(dataObj, FmEtc);

      else

        bNotFound := true;

      end;



      if bNotFound then ShowMessage('对象不存在');

    end;



  end;



begin



  if Sendmessage(RxRichEdit1.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF)) = 0 then

  begin

    ShowMessage('error');

    exit;

  end;



  for idx := 0 to FRTF.GetObjectCount - 1 do

  begin



    FillChar(ReObject, SizeOf(ReObject), 0);

    ReObject.cbStruct := SizeOf(ReObject);



    hr := FRTF.GetObject(Longint(idx), ReObject, REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE);



    if Assigned(ReObject.poleobj) and (ReObject.dwFlags and REO_INPLACEACTIVE = 0) then

    begin



      tmpDataOBject := nil;

      hr := ReObject.poleobj.QueryInterface(IDataObject, tmpDataOBject);

      if Succeeded(hr) then

      begin

        if Assigned(tmpDataOBject) then

        begin

          BuildPicture(tmpDataOBject);

        end;

      end

      else

        ShowMessage('QueryInterface失败');



    end;



  end;



end;