Delphi2010中向TRxRichEdit控件中插入OLE对象。-阿里云开发者社区

Delphi2010中向TRxRichEdit控件中插入OLE对象。

2017-11-13 1326

版权

本文内容由阿里云实名注册用户自发贡献，版权归原作者所有，阿里云开发者社区不拥有其著作权，亦不承担相应法律责任。具体规则请查看《阿里云开发者社区用户服务协议》和《阿里云开发者社区知识产权保护指引》。如果您发现本社区中有涉嫌抄袭的内容，填写侵权投诉表单进行举报，一经查实，本社区将立刻删除涉嫌侵权内容。

简介：

今天在找如何在Delphi2010下向TRxRichEdit空间中插入PNG图的时候，找到了一段关于想TRxRichEdit空间中插入OLE对象的代码。自己测试了一下，使用正常。现在贴出来与大家分享。

Uses
activex, richedit, comobj

type
  IRichEditOle = interface(IUnknown)    ['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out reobject: TReObject;       dwFlags: DWORD): HResult; stdcall;
function InsertObject(var reobject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID;       lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR;       lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD;       out dataobj: IDataObject): HResult; stdcall;
function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;       hMetaPict: HGLOBAL): HResult; stdcall;
  end;
const
  REO_CP_SELECTION = ULONG(-1);
  REO_RESIZABLE    = $00000001;
  IID_IOleObject: TGUID = (    D1: $00000112;D2: $0000;D3: $0000;D4: ($C0,$00,$00,$00,$00,$00,$00,$46));

procedure InsertOleObjectFromFile(RichEdit: TRxRichEdit; FileName: string);
var
RichEditOle: IRichEditOle;
LockBytes: ILockBytes;
Storage: IStorage;
FormatEtc: TFormatEtc;
ClientSite: IOleClientSite;
OleObject: IOleObject;
ClassID: TCLSID;
ReObject: TReObject;
begin
SendMessage(RichEdit.Handle, EM_GETOLEINTERFACE, 0, Longint(@RichEditOle));
if not Assigned(RichEditOle) then
  raise EOleError.Create('Failed to retrieve IRichEditOle');
OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
OleCheck(StgCreateDocfileOnILockBytes(LockBytes,    STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage));
LockBytes := nil;
OleCheck(RichEditOle.GetClientSite(ClientSite));
FillChar(FormatEtc, SizeOf(FormatEtc), 0);
FormatEtc.dwAspect := DVASPECT_CONTENT;
FormatEtc.lIndex := -1;
OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName)),    IID_IOleObject, OLERENDER_DRAW, @FormatEtc, ClientSite, Storage,    OleObject));
OleCheck(OleSetContainedObject(OleObject, True));
OleCheck(OleObject.GetUserClassID(ClassID));
FillChar(ReObject, SizeOf(TReObject), 0);
ReObject.cbStruct := SizeOf(TReObject);
ReObject.cp := REO_CP_SELECTION;
ReObject.clsid := ClassID;
ReObject.poleobj := OleObject;
ReObject.pstg := Storage;
ReObject.polesite := ClientSite;
ReObject.dvAspect := DVASPECT_CONTENT;
ReObject.dwFlags := REO_RESIZABLE;
OleCheck(RichEditOle.InsertObject(ReObject));
end;

调用方式
procedure TMainFrm.Button1Click(Sender: TObject);
begin
  InsertOleObjectFromFile(ActionRich, 'C:\1111.xls');

end;

本文转自狗窝博客51CTO博客，原文链接http://blog.51cto.com/fxh7622/556199如需转载请自行联系原作者

fxh7622

Delphi2010中向TRxRichEdit控件中插入OLE对象。

热门文章

最新文章

相关电子书