谁知道怎样在delphi标准组件richedit中插入图像 谁知道怎样在delphi标准组件richedit中插入图像,不是用OLE方式 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 unit InsRich; interfaceuses SysUtils, Windows, Messages, Variants, Classes, Graphics, Controls, Forms, Dialogs, ActiveX, ComCtrls;const REO_CP_SELECTION = ULONG(-1); REO_BELOWBASELINE = $00000002; REO_RESIZEABLE = $00000001; REO_STATIC = $40000000; EM_GETOLEINTERFACE = WM_USER + 60; 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));type _ReObject = record cbStruct: DWORD; cp: ULONG; clsid: TCLSID; pOleObj: IOleObject; pstg: IStorage; sizel: TSize; dvAspect: Longint; dwFlags: DWORD; dwUser: DWORD; end; TReObject = _ReObject; TCharRange = record cpMin: Integer; cpMax: Integer; end; TFormatRange = record hdc: Integer; hdcTarget: Integer; rectRegion: TRect; rectPage: TRect; chrg: TCharRange; end; IRichEditOle = interface(System.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;function InsertBitmap(Editor: TRichEdit; BmpFile: string): Boolean;implementationfunction InsertBitmap(Editor: TRichEdit; BmpFile: string): Boolean;var FRTF: IRichEditOle; FOle: IOleObject; FormatEtc: tagFormatETC; FStorage: ISTORAGE; FClientSite: IOleClientSite; FLockBytes: ILockBytes; ReObject: TReObject; xt: TGUID; FTemp: IUnknown;begin Result := False; if not FileExists(BmpFile) then Exit; try SendMessage(Editor.Handle, em_GetOleInterFace, 0, Longint(@FRTF)); if not Assigned(FRTF) then Exit; if CreateILockBytesOnHGlobal(0, true, FLockBytes) <> S_OK then Exit; if StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, FStorage) <> S_OK then Exit; FormatEtc.cfFormat := 0; FormatEtc.ptd := nil; FormatEtc.dwAspect := DVASPECT_CONTENT; FormatEtc.lindex := -1; FormatEtc.tymed := TYMED_NULL; FRTF.GetClientSite(FClientSite); //从文件中创建一个Ole对象 if OleCreateFromFile(GUID_NULL, PWideChar(WideString(BmpFile)), IID_IUnknown, 0,@FormatEtc, FClientSite, FStorage,FOle) <> S_OK then Exit; FTemp := FOle; FTemp.QueryInterface(IID_IOleObject, FOle); OleSetContainedObject(FOle, true); ReObject.cbStruct:=SizeOf(TReObject); FOle.GetUserClassID(xt); ReObject.clsid := xt; ReObject.cp := ULONG(REO_CP_SELECTION); ReObject.dvaspect := DVASPECT_CONTENT; ReObject.dwFlags := ULONG(REO_STATIC) or ULONG(REO_BELOWBASELINE); ReObject.dwUser := 0; ReObject.pOleObj := FOle; ReObject.pOleSite := FClientSite; ReObject.pstg := FStorage; ReObject.sizel.cx := 0; ReObject.sizel.cy := 0; FRTF.InsertObject(ReObject); finally FRTF := nil; FOle := nil; end; Result := True;end;end. 谢谢,我特别指明不用OLE方式的 将图片转成rtf格式,就是不知道richedit行不行,可以试试看只在RxRichedit中试过是可以的 对线程方面搞的好的朋友请进。。 IdHttp控件怎么用,在哪里可以找到 在Delphi 7中如何使用TidHttp来达到Cached的目的 report machine控件问题! 关于SQL的问题 等待执行winexec至结束,怎么控制? 用 ServerSocket 作中转服务器 TCP 数据掉包了 注销当前用户,用另一用户名登录windows,这程序怎么编? 高分求购圣诞贺卡! VC++中的类型定义DELPHI中如何写? 关于Memo1与CheckBox1组件的应用问题 LoadMovieFromStream加载的flash显示不正常
interfaceuses
SysUtils, Windows, Messages, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, ComCtrls;const
REO_CP_SELECTION = ULONG(-1);
REO_BELOWBASELINE = $00000002;
REO_RESIZEABLE = $00000001;
REO_STATIC = $40000000;
EM_GETOLEINTERFACE = WM_USER + 60; 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));type
_ReObject = record
cbStruct: DWORD;
cp: ULONG;
clsid: TCLSID;
pOleObj: IOleObject;
pstg: IStorage;
sizel: TSize;
dvAspect: Longint;
dwFlags: DWORD;
dwUser: DWORD;
end;
TReObject = _ReObject; TCharRange = record
cpMin: Integer;
cpMax: Integer;
end; TFormatRange = record
hdc: Integer;
hdcTarget: Integer;
rectRegion: TRect;
rectPage: TRect;
chrg: TCharRange;
end; IRichEditOle = interface(System.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;function InsertBitmap(Editor: TRichEdit; BmpFile: string): Boolean;implementationfunction InsertBitmap(Editor: TRichEdit; BmpFile: string): Boolean;
var
FRTF: IRichEditOle;
FOle: IOleObject;
FormatEtc: tagFormatETC;
FStorage: ISTORAGE;
FClientSite: IOleClientSite;
FLockBytes: ILockBytes;
ReObject: TReObject;
xt: TGUID;
FTemp: IUnknown;
begin
Result := False;
if not FileExists(BmpFile) then
Exit; try
SendMessage(Editor.Handle, em_GetOleInterFace, 0, Longint(@FRTF));
if not Assigned(FRTF) then
Exit;
if CreateILockBytesOnHGlobal(0, true, FLockBytes) <> S_OK then
Exit;
if StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, FStorage) <> S_OK then
Exit;
FormatEtc.cfFormat := 0;
FormatEtc.ptd := nil;
FormatEtc.dwAspect := DVASPECT_CONTENT;
FormatEtc.lindex := -1;
FormatEtc.tymed := TYMED_NULL;
FRTF.GetClientSite(FClientSite);
//从文件中创建一个Ole对象
if OleCreateFromFile(GUID_NULL, PWideChar(WideString(BmpFile)), IID_IUnknown, 0,@FormatEtc, FClientSite, FStorage,FOle) <> S_OK then
Exit;
FTemp := FOle;
FTemp.QueryInterface(IID_IOleObject, FOle);
OleSetContainedObject(FOle, true);
ReObject.cbStruct:=SizeOf(TReObject);
FOle.GetUserClassID(xt);
ReObject.clsid := xt;
ReObject.cp := ULONG(REO_CP_SELECTION);
ReObject.dvaspect := DVASPECT_CONTENT;
ReObject.dwFlags := ULONG(REO_STATIC) or ULONG(REO_BELOWBASELINE);
ReObject.dwUser := 0;
ReObject.pOleObj := FOle;
ReObject.pOleSite := FClientSite;
ReObject.pstg := FStorage;
ReObject.sizel.cx := 0;
ReObject.sizel.cy := 0;
FRTF.InsertObject(ReObject);
finally
FRTF := nil;
FOle := nil;
end; Result := True;
end;end.
只在RxRichedit中试过是可以的