Richedit 插入对象并以图标 显示

function TfrmBillattachment.cxRicheditInsertFile(FilePath:string): Boolean;
const
  REO_CP_SELECTION = $FFFFFFFF;
  REO_IOB_SELECTION = $FFFFFFFF;
  IID_IUnknown: TGUID = (
    D1: $00000000;
    D2: $0000;
    D3: $0000;
    D4: ($C0, $00, $00, $00, $00, $00, $00, $46)
  );
  IID_IOleObject: TGUID = (
    D1: $00000112;
    D2: $0000;
    D3: $0000;
    D4: ($C0, $00, $00, $00, $00, $00, $00, $46)
  );
 REO_RESIZABLE       = $00000001;	// Object may be resized

 procedure ReleaseObject(var AObj);
 begin
   if IUnknown(AObj) <> nil then
     IUnknown(AObj)._Release;
   IUnknown(AObj) := nil;
 end;
 function GetOleMetaPict(AOleObject:IOleObject; ALable:string):HGlobal;
 var
   AClassID: TCLSID;
 begin
  Result := 0;
  OleCheck(AOleObject.GetUserClassID(AClassID));
  Result := OleGetIconOfClass(AClassID, PWideChar(WideString(ALable)), False);
 end;
var
  ReOle: IcxRichEditOle;
  OleSite: IOleClientSite;
  Storage: IStorage;
  SubSTG: IStorage;
  LockBytes: ILockBytes;
  OleObject: IOleObject;
  ReObj: TReObject;
  TempOle: IUnknown;
  FormatEtc: TFormatEtc;
  ASelection: TCharRange;
  IST :IStream;
  OST :TOLESTream;
  FileName :Pchar;
  FileName2 :array[1..1024] of char;
  FileM: TmemoryStream;
  IconMetaPict: HGlobal;
begin
 Result := False;
 
 if not FileExists(FilePath) then
  Exit;
 if not cxRichEditGetOleInterface(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle,ReOle) then
    Exit;
  Assert(ReOle <> nil, 'RichEditOle is null!');

  try
   ReOle.GetClientSite(OleSite);
   OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
   Assert(LockBytes <> nil, 'LockBytes is null!');

   OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage));
   Assert(Storage <> nil, 'Storage is null!');

   FormatEtc.dwAspect := DVASPECT_ICON;

   OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FilePath)), IID_IUnknown, 0, @FormatEtc, OleSite, Storage, TempOle));
   OleCheck(TempOle.QueryInterface(IID_IOleObject, OleObject));
   OleCheck(OleSetContainedObject(OleObject, True));
   Assert(OleObject <> nil, 'OleObject is null!');

   FillChar(ReObj, Sizeof(ReObj), 0);
   FileName := PansiCHar(ExtractFileName(FilePath));

   olecheck(
   Storage.CreateStorage('substorage',
   stgm_create or stgm_write or stgm_share_exclusive,
   0,0,subSTG));
   //创建IStream
   //文件名
   olecheck(substg.createstream('filename',
   stgm_create or stgm_write or stgm_share_exclusive,
   0,0,IST));
   //创建OLEStream

   OST:=TOLEStream.create(IST);
   OST.write(FileName^,length(string(FileName))); //写入数据
   OST.Free;
   //文件内容
   olecheck(substg.createstream('filecontent',
   stgm_create or stgm_write or stgm_share_exclusive,
   0,0,IST));

   //创建OLEStream
   FileM := TmemoryStream.Create;
   FileM.LoadFromFile(FilePath);
   FileM.Position := 0;
   OST:=TOLEStream.create(IST);
   OST.CopyFrom(FileM, FileM.size);
   OST.Free;
   FileM.Free;

   ReObj.cbStruct := Sizeof(ReObj);
   OleCheck(OleObject.GetUserClassID(ReObj.clsid));
   ReObj.cp := REO_CP_SELECTION;
   ReObj.dvaspect := DVASPECT_CONTENT;
   ReObj.oleobj := OleObject;
   ReObj.olesite := OleSite;
   ReObj.stg := Storage;
   ReObj.dwUser := 0;
   ReObj.dwFlags := REO_RESIZABLE;//ULong(REO_STATIC) or ULong(REO_BELOWBASELINE);
   ReObj.sizel.cx := 0;
   ReObj.sizel.cy := 0;
//   if cxDBRichEdit1.Lines.Count =0 then
//   begin
////    cxDBRichEdit1.Text := ExtractFileName(FilePath)+'： ';
////    cxDBRichEdit1.SelStart := Length(cxDBRichEdit1.Text);
//   end
//   else
//   begin
//    try
//     cxDBRichEdit1.Lines.Add('');
//    except
//    end;
//   end;
   if TcxRichInnerEdit(cxDBRichEdit1.InnerControl).HandleAllocated then
   begin
     SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_SCROLLCARET, 0, 0);
   end;
   if TcxRichInnerEdit(cxDBRichEdit1.InnerControl).HandleAllocated then
   begin
     SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_EXGETSEL, 0, LPARAM(@ASelection));
     ASelection.cpMax := ASelection.cpMin + 1;
   end;
   //获取该对象的图标 图片也是一样。不显示图片内容
   IconMetaPict := GetOleMetaPict(OleObject, FileName);
   OleCheck(cxSetDrawAspect(OleObject, True,  IconMetaPict, ReObj.dvaspect));
   if Succeeded(ReOle.InsertObject(ReObj))then
   begin
//    if TcxRichInnerEdit(cxDBRichEdit1.InnerControl).HandleAllocated then
//    begin
//      SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_EXSETSEL, 0, LPARAM(@ASelection));
//      SendMessage(TcxRichInnerEdit(cxDBRichEdit1.InnerControl).Handle, EM_SCROLLCARET, 0, 0);
//    end;
//    ReOle.SetDvaspect(Longint(REO_IOB_SELECTION), ReObj.dvaspect);
    Result := True;
   end;
//   if Pos(ExtractFileExt(FilePath),'.doc,.docx,.xls,.xlsx') >0 then
//   begin
//    try
//     cxDBRichEdit1.Lines.Add(ExtractFileName(FilePath));
//    except
//    end;
//   end;    
  finally
   ReleaseObject(OleObject);
   ZeroMemory(@ReObj,SizeOf(ReObj));
//   FileInfo.Free;
   qry_Data.Tag := 1;
  end;
end;

　以下是摘抄dev的处理方式。

function cxSetDrawAspect(AOleObject: IOleObject; AIconic: Boolean;
  AIconMetaPict: HGlobal; var ADrawAspect: Cardinal): HResult;
var
  AOleCache: IOleCache;
  AEnumStatData: IEnumStatData;
  AOldAspect: Cardinal;
  AAdviseFlags, AConnection: Longint;
  ATempMetaPict: HGlobal;
  AFormatEtc: TFormatEtc;
  AMedium: TStgMedium;
  AClassID: TCLSID;
  AStatData: TStatData;
  AViewObject: IViewObject;
begin
  AOldAspect := ADrawAspect;
  if AIconic then
  begin
    ADrawAspect := DVASPECT_ICON;
    AAdviseFlags := ADVF_NODATA;
  end else
  begin
    ADrawAspect := DVASPECT_CONTENT;
    AAdviseFlags := ADVF_PRIMEFIRST;
  end;
  if (ADrawAspect <> AOldAspect) or (ADrawAspect = DVASPECT_ICON) then
  begin
    AOleCache := AOleObject as IOleCache;
    if ADrawAspect <> AOldAspect then
    begin
      OleCheck(AOleCache.EnumCache(AEnumStatData));
      if AEnumStatData <> nil then
        while AEnumStatData.Next(1, AStatData, nil) = 0 do
          if AStatData.formatetc.dwAspect = Integer(AOldAspect) then
            AOleCache.Uncache(AStatData.dwConnection);
      FillChar(AFormatEtc, SizeOf(FormatEtc), 0);
      AFormatEtc.dwAspect := ADrawAspect;
      AFormatEtc.lIndex := -1;
      OleCheck(AOleCache.Cache(AFormatEtc, AAdviseFlags, AConnection));
      if AOleObject.QueryInterface(IViewObject, AViewObject) = 0 then
        AViewObject.SetAdvise(ADrawAspect, 0, nil);
    end;
    if ADrawAspect = DVASPECT_ICON then
    begin
      ATempMetaPict := 0;
      if AIconMetaPict = 0 then
      begin
        OleCheck(AOleObject.GetUserClassID(AClassID));
        ATempMetaPict := OleGetIconOfClass(AClassID, nil, True);
        AIconMetaPict := ATempMetaPict;
      end;
      try
        with AFormatEtc do
        begin
          cfFormat := CF_METAFILEPICT;
          ptd := nil;
          dwAspect := DVASPECT_ICON;
          lindex := -1;
          tymed := TYMED_MFPICT;
        end;

        with AMedium do
        begin
          tymed := TYMED_MFPICT;
          hMetaFilePict :=  AIconMetaPict;
          unkForRelease := nil;                         
        end;

        OleCheck(AOleCache.SetData(AFormatEtc, AMedium, False));
      finally
        DestroyMetaPict(ATempMetaPict);
      end;
    end;
    if ADrawAspect <> DVASPECT_ICON then
      AOleObject.Update;
  end;
  Result := S_OK;
end;

function cxRichEditGetOleInterface(AH: HWnd; out AOleInterface: IcxRichEditOle): Boolean;
 begin
   Result := SendMessage(AH, EM_GETOLEINTERFACE, 0, LPARAM(@AOleInterface)) <> 0;
 end;

function cxRichEditSelectedIsPic(cxRichEdit: TcxRichEdit; out Pic: TPicture; IsOutPic: Boolean=False): Boolean;
var
  FRichEditOle: IUnknown;
  i: Integer;
  AReObject: TReObject;
  pDataObject: IDataObject;
  fm: TFormatEtc;
  em: IEnumFormatEtc;
  stg: TStgMedium;
  TmpPic1, TmpPic2: TPicture;
  g: TGPGraphics;
  img: TGPImage;
  MemStream: TMemoryStream;
  MyIStream: TStreamAdapter;
  RootSTG,SubSTG :IStorage;
begin
 Result := False;
 try
  FRichEditOle := nil;
  if not cxRichEditGetOleInterface(TcxRichInnerEdit(cxRichEdit.InnerControl).Handle,IcxRichEditOle(FRichEditOle)) then
    Exit;
  with IcxRichEditOle(FRichEditOle) do
  begin
   for i := 0 to GetObjectCount -1 do
   begin
     FillChar(AReObject, SizeOf(AReObject), 0);
     AReObject.cbStruct := SizeOf(AReObject);
     OleCheck(GetObject(LongInt(i), AReObject, REO_GETOBJ_ALL_INTERFACES));
     //不是选中状态跳过
     if (AReObject.dwFlags and REO_SELECTED) <> REO_SELECTED then
        Continue;
     pDataObject := nil;
     OleCheck(AReObject.oleobj.QueryInterface(IDataObject, pDataObject));
     if pDataObject <> nil then
     begin
       em := nil;
       pDataObject.EnumFormatEtc(DATADIR_GET, em);
       if em <> nil then
       begin
        FillChar(fm, SizeOf(fm), 0);
        while em.Next(1, fm, nil) <> S_FALSE do
        begin
          Result :=  fm.cfFormat in [CF_BITMAP, CF_DIB, CF_METAFILEPICT];
         if not Result then
          Break;
        end;
       end;
     end;
   end;
  end;
  if Result and IsOutPic then
  begin
   TmpPic1 := TPicture.Create;
   TmpPic2 := TPicture.Create;
   MemStream := TMemoryStream.Create;
   if fm.cfFormat in [CF_BITMAP,CF_DIB] then
   begin
    fm.cfFormat := CF_BITMAP;
    fm.ptd := nil;
    fm.dwAspect := DVASPECT_CONTENT;
    fm.lindex := -1;
    fm.tymed := TYMED_GDI;
    if Succeeded(pDataObject.GetData(fm, stg)) then
    begin
     TmpPic1.Bitmap.Handle := stg.hBitmap;
     TmpPic2.Bitmap.Width := TmpPic1.Bitmap.Width;
     TmpPic2.Bitmap.Height := TmpPic1.Bitmap.Height;
     TmpPic2.Bitmap.Canvas.CopyRect(TmpPic1.Bitmap.Canvas.ClipRect, TmpPic1.Bitmap.Canvas, TmpPic1.Bitmap.Canvas.ClipRect);
     TmpPic2.Bitmap.SaveToStream(MemStream);
     ReleaseStgMedium(stg);
    end;
   end //图元文件 以emf文件格式存在
   else if fm.cfFormat = CF_METAFILEPICT then
   begin
    SendMessage(TcxRichInnerEdit(cxRichEdit.InnerControl).Handle, WM_COPY, 0, 0);
    try
     if OpenClipboard(0) then
     begin
      TmpPic2.Metafile.LoadFromClipboardFormat(0,0,0);
      TmpPic2.Metafile.SaveToStream(MemStream);
      MemStream.Position := 0;
     end;
    finally
     CloseClipboard;
    end;
   end;
   MyIStream := TStreamAdapter.Create(MemStream);
   img := TGPImage.Create(MyIStream);
   pic := TPicture.Create;
   pic.Bitmap.Width := img.GetWidth;
   pic.Bitmap.Height :=img.GetHeight;
   g := TGPGraphics.Create(pic.Bitmap.Canvas.Handle);
    { 缩放时的算法模式 }
   g.SetInterpolationMode(TInterpolationMode(InterpolationModeHighQualityBicubic));
   g.DrawImage(img, MakeRect(0, 0, img.GetWidth, img.GetHeight), 0, 0, img.GetWidth, img.GetHeight, UnitPixel);
   g.Free;
   img.Free;
   FreeAndNil(MemStream);
   TmpPic1.Free;
   TmpPic2.Free;
  end;
 finally
  em := nil;
  pDataObject := nil;
  FRichEditOle := nil;
 end;
end;

 还有一种是自带的插入对话框

function cxRicheditInsertFile2(cxRichEdit: TcxCustomRichEdit; FilePath:string): Boolean;

 procedure ReleaseObject(var AObj);
 begin
   if IUnknown(AObj) <> nil then
     IUnknown(AObj)._Release;
   IUnknown(AObj) := nil;
 end;

 procedure cxCreateStorage(var AStorage: IStorage);
 var
  ALockBytes: ILockBytes;
 begin
  OleCheck(CreateILockBytesOnHGlobal(0, True, ALockBytes));
  OleCheck(StgCreateDocfileOnILockBytes(ALockBytes, STGM_READWRITE
    or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, AStorage));
  ReleaseObject(ALockBytes);
 end;

var
  AData: TOleUIInsertObject;
  ANameBuffer: array[0..255] of AnsiChar;
  RichEditOle: IcxRichEditOle;
  AOleClientSite: IOleClientSite;
  AStorage: IStorage;
  AReObject: TReObject;
  AOleObject: IOleObject;
  ASelection: TCharRange;
  AIsNewObject: Boolean;
  FormatEtc: TFormatEtc;
  TempOle: IOleObject;
begin
  Result := False;
//
  if not cxRichEditGetOleInterface(TcxRichInnerEdit(cxRichEdit.InnerControl).Handle,RichEditOle) then
    Exit;
  Assert(RichEditOle <> nil, 'RichEditOle is null!');
//
  FillChar(AData, SizeOf(AData), 0);
  FillChar(ANameBuffer, SizeOf(ANameBuffer), 0);
  AStorage := nil;
  try
    cxCreateStorage(AStorage);
    RichEditOle.GetClientSite(AOleClientSite);
    with AData do
    begin
      cbStruct := SizeOf(AData);
      dwFlags := IOF_SELECTCREATEFROMFILE or IOF_VERIFYSERVERSEXIST or
        IOF_CREATENEWOBJECT or IOF_CREATEFILEOBJECT or IOF_CREATELINKOBJECT or IOF_CHECKLINK or IOF_CHECKDISPLAYASICON;
      hWndOwner := cxRichEdit.InnerControl.Handle;
      lpfnHook := cxOleDialogHook;
      ANameBuffer := 'J:\源码\test\Richedit测试\1.docx';
      lpszFile := ANameBuffer;
//      lpszFile := PAnsiChar('J:\源码\test\Richedit测试\1.docx');
      cchFile := SizeOf(ANameBuffer);
      oleRender := OLERENDER_DRAW;
      iid := IOleObject;
      lpIOleClientSite := AOleClientSite;
      lpIStorage := AStorage;
      lpszCaption := PChar('选择文件');
//      lpszTemplate := pchar('test');
      ppvObj := @AOleObject;
//      lpszFile := PAnsiChar('J:\源码\test\Richedit测试\1.docx');
    end;
    if {$IFDEF DELPHI12}OleUIInsertObjectA{$ELSE}OleUIInsertObject{$ENDIF}(AData) = OLEUI_OK then
      try

//        AData.lpszFile := PAnsiChar(FilePath);
//        FillChar(AReObject, SizeOf(AReObject), 0);
//
//        FormatEtc.dwAspect := DVASPECT_ICON;
//        OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FilePath)),
//        IID_IUnknown, 0, @FormatEtc, AOleClientSite, AStorage, TempOle));
//
//        OleCheck(TempOle.QueryInterface(IID_IOleObject, AOleObject));
//        OleCheck(OleSetContainedObject(AOleObject, True));
//        AOleObject.SetClientSite(AOleClientSite);
//        OleCheck(AOleObject.GetUserClassID(AReObject.clsid));

        with AReObject do
        begin
          cbStruct := SizeOf(AReObject);
          cp := REO_CP_SELECTION;
          oleobj := AOleObject;
          stg := AStorage;
          olesite := AOleClientSite;
          dvaspect := DVASPECT_CONTENT;
          dwFlags := REO_RESIZABLE;
          AReObject.sizel.cx := 0;
          AReObject.sizel.cy := 0;
        end;

        OleCheck(SetDrawAspect(AOleObject, True, 0, AReObject.dvaspect));

//        if HandleAllocated then
//        begin
//          SendMessage(Handle, EM_EXGETSEL, 0, LPARAM(@ASelection));
//          ASelection.cpMax := ASelection.cpMin + 1;
//        end;
        if Succeeded(RichEditOle.InsertObject(AReObject)) then
        begin
//          if HandleAllocated then
//          begin
//            SendMessage(Handle, EM_EXSETSEL, 0, LPARAM(@ASelection));
//            SendMessage(Handle, EM_SCROLLCARET, 0, 0);
//          end;
          RichEditOle.SetDvaspect(Longint(REO_IOB_SELECTION), AReObject.dvaspect);
//          if AIsNewObject then OleCheck(AReObject.oleobj.DoVerb(OLEIVERB_SHOW, nil,
//            AOleClientSite, 0, Handle, ClientRect));
          Result := True;
        end;
      finally
        DestroyMetaPict(AData.hMetaPict);
        ReleaseObject(AOleObject);
        ZeroMemory(@AReObject,SizeOf(AReObject));
      end;
  finally
    ZeroMemory(@AData,SizeOf(AData));
  end;

end;