急，如何在RichEdit中通过Ole的方式插入图片啊，就像写字版

[borland]

急，如何在RichEdit中通过Ole的方式插入图片啊，就像写字版

[dreamfan]

踢

[TechnoFantasy]

上面的代码是一个在RTF控件当前位置插入图像并打印的，你运行上面的代码需要首先引用
ActiveX, ComObj, RichEdit, Jpeg
并且将PrintRichEdit(strCaption,rtf);去掉

[TechnoFantasy]

以下的结构是需要手工加入的：

type
_ReObject = record
cbStruct: DWORD; { Size of structure }
cp: ULONG; { Character position of object }
clsid: TCLSID; { Class ID of object }
poleobj: IOleObject; { OLE object interface }
pstg: IStorage; { Associated storage interface }
polesite: IOleClientSite; { Associated client site interface }
sizel: TSize; { Size of object (may be 0,0) }
dvAspect: Longint; { Display aspect to use }
dwFlags: DWORD; { Object status flags }
dwUser: DWORD; { Dword for user's use }
end;
TReObject = _ReObject;

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;

Type TCharRange=record
cpMin:integer;
cpMax:integer;
End;

Type TFormatRange=record
hdc : Integer;
hdcTarget:integer;
rectRegion:trect;
rectPage:trect;
chrg : TCharRange;
End;

[TechnoFantasy]

procedure proPrintRTFWithBMP(strCaption,strPic,strTitle:string;rtf:TRichEdit);
{strText为要打印的文本 strCaption为打印标题 strPic为图像文件目录
strTitle为要显示在图像右侧的图像标题}
var
FRTF:IRichEditOle;
FOLE:IOLEObject;
formatEtc:tagFORMATETC;
FStorage :ISTORAGE;
FClientSite:IOLECLIENTSITE;
FLockBytes:ILockBytes;
ReObject:TReObject;
xt:TGuid;
FTemp:IUnknown;
strTemp:string;
bCreateNew:boolean;
ABMP:TBitmap;
Ajpeg:TJpegImage;
i:Longint;
begin
// rtfTemp:=TRichEdit.Create(frmPrintFrame);
try
{ with rtfTemp do
begin
Parent := frmPrintFrame;
width:=200;
height:=200;
visible:=false;
Text := strText;
end; }

//图片文件不存在，直接打印文本并退出
if not fileexists(strPic)then
begin
PrintRichEdit(strCaption,rtf);
exit;
end;

abmp:=TBitmap.Create;
ajpeg:= TJpegImage.Create;
try
if ExtractFileExt(strPic)='.jpg' then
begin
bCreateNew:=true;
ajpeg.LoadFromFile(strPic);
abmp.Assign(ajpeg);
strTemp:=ExtractFilePath(strPic)+'0099www.bmp';
abmp.SaveToFile(strTemp);
for i:=1 to 30000 do
application.ProcessMessages;
end
else
strTemp:= strPic;
finally
abmp.Free;
ajpeg.free;
abmp:=nil;
ajpeg:=nil;
end;

sendmessage(rtf.handle,EM_GETOLEINTERFACE,0,LongInt(@FRTF));
if not assigned(FRTF)then
begin
showmessage('Error to get Richedit OLE interface');
exit;
end;

//建立一个可以访问全局内存的Byte数组 FLockBytes
//返回ILockBytes接口
if CreateILockBytesOnHGlobal(0,true,FLockBytes)<>S_OK then
begin
showmessage('Error to create Global Heap');
exit;
end;

//建立一个混合文档存取对象
if StgCreateDocfileOnILockBytes(FLockBytes,STGM_SHARE_EXCLUSIVE or
STGM_CREATE or STGM_READWRITE,0,FStorage)<>S_OK then
begin
showmessage('Error to create storage');
exit;
end;

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(strTemp)),IID_IUnknown,0,@formatEtc,
FClientSite,FStorage,FOLE)<>S_OK then
begin
showmessage('Error');
exit;
end;

//现在的FOLE还是一个IUnKnown接口，将其转换为一个 IOleObject接口
FTemp:=FOLE;
FTemp.QueryInterface(IID_IOleObject, FOle);
OleSetContainedObject(FOle, TRUE);


//step 2
reobject.cbStruct := sizeof(TReObject);
FOLE.GetUserClassID(xt);
ReObject.clsid := xt;
reobject.cp := ULong(REO_CP_SELECTION);
reobject.dvaspect := DVASPECT_CONTENT;
reobject.dwFlags := ULong(REO_RESIZABLE) 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);

PrintRichEdit(strCaption,rtf);
finally
if bCreateNew then
Deletefile(strTemp);
FRTF:=nil;
FOLE:=nil;
end;
end;

[武稀松]

顶