名称: RICHEDIT中插入图象 -- 作者:
开发语言: Delphi &
Kylix
上传者: 脑膜炎
上传日期: 2003-06-27 08:56:48
访问次数: 213
适合系统:
简介: unit InsRich;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ActiveX,ComCtrls;
const
REO_CP_SELECTION = ULONG(-1);
REO_BELOWBASELINE = $00000002;
REO_RESIZABLE = $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
{ 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;
TCharRange = record {Copy From RichEdit.pas}
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;
implementation
function 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.