今天在找如何在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');
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
