很简单, 就3个函数, 直接看代码吧
unit RichEditBmp; { 2005-03-04 LiChengbin Added: Insert bitmap or gif into RichEdit controls from source file. 2005-01-31 LiChengbin Usage: Insert bitmap into RichEdit controls by IRichEditOle interface and implementation of IDataObject interface. Example: InsertBitmap(RichEdit1.Handle, Image1.Picture.Bitmap); } interface uses Windows, Messages, Graphics, ActiveX, ComObj; const // Flags to specify which interfaces should be returned in the structure above REO_GETOBJ_NO_INTERFACES = $00000000; REO_GETOBJ_POLEOBJ = $00000001; REO_GETOBJ_PSTG = $00000002; REO_GETOBJ_POLESITE = $00000004; REO_GETOBJ_ALL_INTERFACES = $00000007; // Place object at selection REO_CP_SELECTION = $FFFFFFFF; // Use character position to specify object instead of index REO_IOB_SELECTION = $FFFFFFFF; REO_IOB_USE_CP = $FFFFFFFF; // Object flags REO_NULL = $00000000; // No flags REO_READWRITEMASK = $0000003F; // Mask out RO bits REO_DONTNEEDPALETTE = $00000020; // Object doesn't need palette REO_BLANK = $00000010; // Object is blank REO_DYNAMICSIZE = $00000008; // Object defines size always REO_INVERTEDSELECT = $00000004; // Object drawn all inverted if sel REO_BELOWBASELINE = $00000002; // Object sits below the baseline REO_RESIZABLE = $00000001; // Object may be resized REO_LINK = $80000000; // Object is a link (RO) REO_STATIC = $40000000; // Object is static (RO) REO_SELECTED = $08000000; // Object selected (RO) REO_OPEN = $04000000; // Object open in its server (RO) REO_INPLACEACTIVE = $02000000; // Object in place active (RO) REO_HILITED = $01000000; // Object is to be hilited (RO) REO_LINKAVAILABLE = $00800000; // Link believed available (RO) REO_GETMETAFILE = $00400000; // Object requires metafile (RO) // flags for IRichEditOle::GetClipboardData(), // IRichEditOleCallback::GetClipboardData() and // IRichEditOleCallback::QueryAcceptData() RECO_PASTE = $00000000; // paste from clipboard RECO_DROP = $00000001; // drop RECO_COPY = $00000002; // copy to the clipboard RECO_CUT = $00000003; // cut to the clipboard RECO_DRAG = $00000004; // drag 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)); IID_IGifAnimator: TGUID = '{0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16}'; CLASS_GifAnimator: TGUID = '{06ADA938-0FB0-4BC0-B19B-0A38AB17F182}'; 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 cpMin: Integer; cpMax: Integer; end; TFormatRange = record hdc: Integer; hdcTarget: Integer; rectRegion: TRect; rectPage: TRect; chrg: TCharRange; end; 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; // *********************************************************************// // Interface: IGifAnimator // Flags: (4544) Dual NonExtensible OleAutomation Dispatchable // GUID: {0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16} // *********************************************************************// IGifAnimator = interface(IDispatch) ['{0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16}'] procedure LoadFromFile(const FileName: WideString); safecall; function TriggerFrameChange: WordBool; safecall; function GetFilePath: WideString; safecall; procedure ShowText(const Text: WideString); safecall; end; // *********************************************************************// // DispIntf: IGifAnimatorDisp // Flags: (4544) Dual NonExtensible OleAutomation Dispatchable // GUID: {0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16} // *********************************************************************// IGifAnimatorDisp = dispinterface ['{0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16}'] procedure LoadFromFile(const FileName: WideString); dispid 1; function TriggerFrameChange: WordBool; dispid 2; function GetFilePath: WideString; dispid 3; procedure ShowText(const Text: WideString); dispid 4; end; TBitmapOle = class(TInterfacedObject, IDataObject) private FStgm: TStgMedium; FFmEtc: TFormatEtc; procedure SetBitmap(hBitmap: HBITMAP); procedure GetOleObject(OleSite: IOleClientSite; Storage: IStorage; var OleObject: IOleObject); public { ======================================================================= } { Implementation of IDataObject interface } function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall; function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall; function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall; function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall; function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall; function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall; function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall; function DUnadvise(dwConnection: Longint): HResult; stdcall; function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall; { ======================================================================= } end; function InsertBitmap(AREHandle: THandle; const FileName: string): Boolean; overload; function InsertBitmap(AREHandle: THandle; Bitmap: TBitmap): Boolean; overload; function InsertGif(AREHandle: THandle; const FileName: string): Boolean; implementation function GetRichEditOle(hRichEdit: THandle): IRichEditOle; begin SendMessage(hRichEdit, EM_GETOLEINTERFACE, 0, Longint(@Result)); end; function GetImage(Bitmap: TBitmap): HBITMAP; var Dest: HBitmap; DC, MemDC: HDC; OldBitmap: HBITMAP; begin DC := GetDC(0); MemDC := CreateCompatibleDC(DC); try Dest := CreateCompatibleBitmap(DC, Bitmap.Width, Bitmap.Height); OldBitmap := SelectObject(MemDC, Dest); BitBlt(MemDC, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY); SelectObject(MemDC, OldBitmap); finally DeleteDC(MemDC); ReleaseDC(0, DC); end; Result := Dest; end; function TBitmapOle.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall; begin medium.tymed := TYMED_GDI; medium.hBitmap := OleDuplicateData(FStgm.hBitmap, CF_BITMAP, 0); medium.unkForRelease := nil; if medium.hBitmap = 0 then Result := E_HANDLE else Result := S_OK; end; function TBitmapOle.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall; begin Result := E_NOTIMPL; end; function TBitmapOle.QueryGetData(const formatetc: TFormatEtc): HResult; stdcall; begin Result := E_NOTIMPL; end; function TBitmapOle.GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall; begin Result := E_NOTIMPL; end; function TBitmapOle.SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall; begin FStgm := medium; FFmEtc := formatetc; Result := S_OK; end; function TBitmapOle.EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall; begin Result := E_NOTIMPL; end; function TBitmapOle.DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall; begin Result := E_NOTIMPL; end; function TBitmapOle.DUnadvise(dwConnection: Longint): HResult; stdcall; begin Result := E_NOTIMPL; end; function TBitmapOle.EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall; begin Result := E_NOTIMPL; end; procedure TBitmapOle.GetOleObject(OleSite: IOleClientSite; Storage: IStorage; var OleObject: IOleObject); begin OleCheck(OleCreateStaticFromData(Self, IID_IOleObject, OLERENDER_FORMAT, @FFmEtc, OleSite, Storage, OleObject)); end; procedure TBitmapOle.SetBitmap(hBitmap: HBITMAP); var Stgm: TStgMedium; FmEtc: TFormatEtc; begin Stgm.tymed := TYMED_GDI; // Storage medium = HBITMAP handle Stgm.hBitmap := hBitmap; Stgm.unkForRelease := nil; FmEtc.cfFormat := CF_BITMAP; // Clipboard format = CF_BITMAP FmEtc.ptd := nil; // Target Device = Screen FmEtc.dwAspect := DVASPECT_CONTENT; // Level of detail = Full content FmEtc.lindex := -1; // Index = Not applicaple FmEtc.tymed := TYMED_GDI; // Storage medium = HBITMAP handle SetData(FmEtc, Stgm, True); end; function InsertBitmap(AREHandle: THandle; const FileName: string): Boolean; var ReOle: IRichEditOle; OleSite: IOleClientSite; Storage: IStorage; LockBytes: ILockBytes; OleObject: IOleObject; ReObj: TReObject; TempOle: IUnknown; FormatEtc: TFormatEtc; begin ReOle := GetRichEditOle(AREHandle); Assert(ReOle <> nil, 'RichEditOle is null!'); ReOle.GetClientSite(OleSite); OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes)); Assert(LockBytes <> nil, 'LockBytes is null!'); OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage)); Assert(Storage <> nil, 'Storage is null!'); OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName)), IID_IUnknown, 0, @FormatEtc, OleSite, Storage, TempOle)); OleCheck(TempOle.QueryInterface(IID_IOleObject, OleObject)); OleCheck(OleSetContainedObject(OleObject, True)); Assert(OleObject <> nil, 'OleObject is null!'); FillChar(ReObj, Sizeof(ReObj), 0); ReObj.cbStruct := Sizeof(ReObj); OleCheck(OleObject.GetUserClassID(ReObj.clsid)); ReObj.cp := REO_CP_SELECTION; ReObj.dvaspect := DVASPECT_CONTENT; ReObj.poleobj := OleObject; ReObj.polesite := OleSite; ReObj.pstg := Storage; ReObj.dwUser := 0; ReObj.sizel.cx := 0; ReObj.sizel.cy := 0; ReOle.InsertObject(ReObj); Result := True; end; function InsertBitmap(AREHandle: THandle; Bitmap: TBitmap): Boolean; var nIRE: IRichEditOle; nBMP: TBitmapOle; nIOleSite: IOleClientSite; nIStorage: IStorage; nILockBytes: ILockBytes; nIOleObject: IOleObject; nREObj: TReObject; begin nIRE := GetRichEditOle(AREHandle); Assert(nIRE <> nil, 'RichEditOle is null'); nBMP := TBitmapOle.Create; try nBMP.SetBitmap(GetImage(Bitmap)); nIRE.GetClientSite(nIOleSite); OleCheck(CreateILockBytesOnHGlobal(0, True, nILockBytes)); Assert(nILockBytes <> nil, 'LockBytes is null'); OleCheck(StgCreateDocfileOnILockBytes(nILockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, nIStorage)); Assert(nIStorage <> nil, 'Storage is null'); nBMP.GetOleObject(nIOleSite, nIStorage, nIOleObject); OleCheck(OleSetContainedObject(nIOleObject, True)); FillChar(nREObj, Sizeof(nREObj), 0); nREObj.cbStruct := Sizeof(nREObj); OleCheck(nIOleObject.GetUserClassID(nREObj.clsid)); nREObj.cp := REO_CP_SELECTION; nREObj.dvaspect := DVASPECT_CONTENT; nREObj.poleobj := nIOleObject; nREObj.polesite := nIOleSite; nREObj.pstg := nIStorage; nIRE.InsertObject(nREObj); Result := True; finally nBMP.Free; end; end; function InsertGif(AREHandle: THandle; const FileName: string): Boolean; var ReOle: IRichEditOle; OleSite: IOleClientSite; Storage: IStorage; LockBytes: ILockBytes; OleObject: IOleObject; ReObj: TReObject; Animator: IGifAnimator; begin ReOle := GetRichEditOle(AREHandle); Assert(ReOle <> nil, 'RichEditOle is null!'); Assert(FileName <> '', 'FileName is null!'); ReOle.GetClientSite(OleSite); OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes)); Assert(LockBytes <> nil, 'LockBytes is null!'); OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage)); Assert(Storage <> nil, 'Storage is null!'); Animator := IUnknown(CreateComObject(CLASS_GifAnimator)) as IGifAnimator; Animator.LoadFromFile(PWideChar(WideString(FileName))); OleCheck(Animator.QueryInterface(IID_IOleObject, OleObject)); OleCheck(OleSetContainedObject(OleObject, True)); FillChar(ReObj, Sizeof(ReObj), 0); ReObj.cbStruct := Sizeof(ReObj); OleCheck(OleObject.GetUserClassID(ReObj.clsid)); ReObj.cp := REO_CP_SELECTION; ReObj.dvaspect := DVASPECT_CONTENT; ReObj.dwFlags := REO_STATIC or REO_BELOWBASELINE; ReObj.dwUser := 0; ReObj.poleobj := OleObject; ReObj.polesite := OleSite; ReObj.pstg := Storage; ReObj.sizel.cx := 0; ReObj.sizel.cy := 0; ReOle.InsertObject(ReObj); Result := True; end; end.