1、RichEdit中插入位圖(從文件或TBitmap對象或Gif動畫(從文件 關(guān)鍵字: 分類: 個人專區(qū) 密級: 公開 (評分: , 回復(fù): 0, 閱讀: 252 ? KeyLife富翁筆記 作者: lichengbin 標題: RichEdit中插入位圖(從文件或TBitmap對象或Gif動畫(從文件 關(guān)鍵字: 分類: 個人專區(qū) 密級: 公開 (評分: , 回復(fù): 0, 閱讀: 561 »» unit RichEx; 2005-03-04 LiChengbin Added: Insert bitmap or gif into RichEdit controls from s

2、ource 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 wh

3、ich 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 characte

4、r 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; / Objec

5、t 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_

6、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 be

7、lieved 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 = $

8、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,$

9、00,$00,$00,$00,$00,$00,$46; IID_IGifAnimator: TGUID = '0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16' CLASS_GifAnimator: TGUID = '06ADA938-0FB0-4BC0-B19B-0A38 AB17F182' type _ReObject = record cbStruct: DWORD; Size of structure cp: ULONG; Character position of object clsid: TCLSID; Class ID o

10、f 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 us

11、er'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' functi

12、on 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; s

13、tdcall; 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: L

14、ongint; 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; functio

15、n 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: IGifAnimat

16、or / 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; safe

17、call; function GetFilePath: WideString; safecall; procedure ShowText(const Text: WideString; sa fecall; end; / */ / DispIntf: IGifAnimatorDisp / Flags: (4544 Dual NonExtensible OleAutomation Dispatchable / GUID: 0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16 / */ IGifAnimatorDisp = dispinterface '0C1CF2DF

18、-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 priv

19、ate 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: HRes

20、ult; 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(

21、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:

22、 HResult; stdcall; function DUnadvise(dwConnection: Longint: HResult; stdcall; function EnumDAdvise(out enumAdvise: IEnumStatData: HResult; stdcall; = end; function InsertBitmap(hRichEdit: THandle; const FileName: string: Boolean; overload; function InsertBitmap(hRichEdit: THandle; Bitmap: TBitmap:

23、Boolean; overload; function InsertGif(hRichEdit: 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;

24、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

25、, OldBitmap; finally DeleteDC(MemDC; ReleaseDC(0, DC; end; Result := Dest; end; function TBitmapOle.GetData(c onst formatetcIn: TFormatEtc; out medium: TStgMedium: HResult; stdcall; begin medium.tymed := TYMED_GDI; medium.hBitmap := OleDuplicateData(FStgm.hBitmap, CF_BITMAP, 0; medium.unkForRelease

26、:= 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

27、 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 F

28、Stgm := 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; o

29、ut 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; procedur

30、e 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: TFor

31、matEtc; 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 FmE

32、tc.lindex := -1; / Index = Not applicaple FmEtc.tymed := TYMED_GDI; / Storage medium = HBITMAP handle SetData(FmEtc, Stgm, True; end; function InsertBitmap(hRichEdit: THandle; const FileName: string: Boolean; var ReOle: IRichEditOle; OleSite: IOleClientSite; Storage: IStorage; LockBytes: ILockBytes;

33、 OleObject: IOleObject; ReObj: TReObject; TempOle: IUnknown; FormatEtc: TFormatEtc; begin ReOle := GetRichEditOle(hRichEdit; Assert(ReOle <> nil, 'RichEditOle is null!' ReOle.GetClientSite(OleSite; OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes; Assert(LockBytes <> nil, &#

34、39;LockBytes is null!' OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STG M_READWRITE, 0, Storage; Assert(Storage <> nil, 'Storage is null!' OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName, IID_IUnknown, 0, FormatEtc, Ole

35、Site, 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.clsi

36、d; 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(hRichEdit: THandle; Bit

37、map: TBitmap: Boolean; var ReOle: IRichEditOle; BitmapOle: TBitmapOle; OleSite: IOleClientSite; Storage: IStorage; LockBytes: ILockBytes; OleObject: IOleObject; ReObj: TReObject; begin ReOle := GetRichEditOle(hRichEdit; Assert(ReOle <> nil, 'RichEditOle is null!' BitmapOle := TBitmapOl

38、e.Create; try BitmapOle.SetBitmap(GetImage(Bitmap; 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

39、, Storage; Assert(Storage <> nil, 'Storage is null!' BitmapOle.GetOleObject(OleSite, Storage, OleObject; OleCheck(OleSetContainedObject(OleObject, True; FillChar(ReObj, Sizeof(ReObj, 0; ReObj.cbStruct := Sizeof(ReObj; OleCheck(OleObject.GetUserClassID(ReObj.clsid; ReObj.cp := REO_CP_SE

40、LECTION; ReObj.dvaspect := DVASPECT_CONTENT; ReObj.poleobj := OleObject; ReObj.polesite := OleSite; ReObj.pstg := Storage; ReOle.InsertObject(ReObj; Result := True; finally BitmapOle.Free; end; end; function InsertGif(hRichEdit: THandle; const FileName: string: Boolean; var ReOle: IRichEditOle; OleSite: IOleClientSite; Storage: IStorage; LockBytes: ILockBytes; OleObject: IOleObject; ReObj: TReObject; Animator: IGifAnimator; begin ReOle :