很简单, 就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 = $;

 REO_GETOBJ_POLEOBJ = $;

 REO_GETOBJ_PSTG = $;

 REO_GETOBJ_POLESITE = $;

 REO_GETOBJ_ALL_INTERFACES = $;

// 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 = $; // No flags

 REO_READWRITEMASK = $0000003F; // Mask out RO bits

 REO_DONTNEEDPALETTE = $; // Object doesn't need palette

 REO_BLANK = $; // Object is blank

 REO_DYNAMICSIZE = $; // Object defines size always

 REO_INVERTEDSELECT = $; // Object drawn all inverted if sel

 REO_BELOWBASELINE = $; // Object sits below the baseline

 REO_RESIZABLE = $; // Object may be resized

 REO_LINK = $; // Object is a link (RO)

 REO_STATIC = $; // Object is static (RO)

 REO_SELECTED = $; // Object selected (RO)

 REO_OPEN = $; // Object open in its server (RO)

 REO_INPLACEACTIVE = $; // Object in place active (RO)

 REO_HILITED = $; // Object is to be hilited (RO)

 REO_LINKAVAILABLE = $; // Link believed available (RO)

 REO_GETMETAFILE = $; // Object requires metafile (RO)

// flags for IRichEditOle::GetClipboardData(),

// IRichEditOleCallback::GetClipboardData() and

// IRichEditOleCallback::QueryAcceptData()

 RECO_PASTE = $; // paste from clipboard

 RECO_DROP = $; // drop

 RECO_COPY = $; // copy to the clipboard

 RECO_CUT = $; // cut to the clipboard

 RECO_DRAG = $; // drag

 EM_GETOLEINTERFACE  = WM_USER + ;

 IID_IUnknown: TGUID =

   (D1:$;D2:$;D3:$;D4:($C0,$,$,$,$,$,$,$));

 IID_IOleObject: TGUID =

   (D1:$;D2:$;D3:$;D4:($C0,$,$,$,$,$,$,$));

 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 ;

   function  TriggerFrameChange: WordBool; dispid ;

   function  GetFilePath: WideString; dispid ;

   procedure ShowText(const Text: WideString); dispid ;

 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, , Longint(@Result));

end;

function GetImage(Bitmap: TBitmap): HBITMAP;

var

Dest: HBitmap;

DC, MemDC: HDC;

 OldBitmap: HBITMAP;

begin

 DC := GetDC();

 MemDC := CreateCompatibleDC(DC);

 try

   Dest := CreateCompatibleBitmap(DC, Bitmap.Width, Bitmap.Height);

   OldBitmap := SelectObject(MemDC, Dest);

   BitBlt(MemDC, , , Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, , , SRCCOPY);

   SelectObject(MemDC, OldBitmap);

 finally

   DeleteDC(MemDC);

   ReleaseDC(, 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, );

 medium.unkForRelease := nil;

 if medium.hBitmap =  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 := -;                 // 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(, True, LockBytes));

 Assert(LockBytes <> nil, 'LockBytes is null!');

 OleCheck(StgCreateDocfileOnILockBytes(LockBytes,

   STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, , Storage));

 Assert(Storage <> nil, 'Storage is null!');

 OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName)),

   IID_IUnknown, , @FormatEtc, OleSite, Storage, TempOle));

 OleCheck(TempOle.QueryInterface(IID_IOleObject, OleObject));

 OleCheck(OleSetContainedObject(OleObject, True));

 Assert(OleObject <> nil, 'OleObject is null!');

 FillChar(ReObj, Sizeof(ReObj), );

 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 := ;

 ReObj.sizel.cx := ;

 ReObj.sizel.cy := ;

 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(, True, nILockBytes));

    Assert(nILockBytes <> nil, 'LockBytes is null');

    OleCheck(StgCreateDocfileOnILockBytes(nILockBytes,

    STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, , nIStorage));

    Assert(nIStorage <> nil, 'Storage is null');

    nBMP.GetOleObject(nIOleSite, nIStorage, nIOleObject);

    OleCheck(OleSetContainedObject(nIOleObject, True));

    FillChar(nREObj, Sizeof(nREObj), );

    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(, True, LockBytes));

 Assert(LockBytes <> nil, 'LockBytes is null!');

 OleCheck(StgCreateDocfileOnILockBytes(LockBytes,

   STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, , 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), );

 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 := ;

 ReObj.poleobj := OleObject;

 ReObj.polesite := OleSite;

 ReObj.pstg := Storage;

 ReObj.sizel.cx := ;

 ReObj.sizel.cy := ;

 ReOle.InsertObject(ReObj);

 Result := True;

end;

end.

最新文章

  1. 从零自学Hadoop(17)：Hive数据导入导出，集群数据迁移下
  2. VMware workstation CentOs 7 虚拟机网卡设置为NAT模式并设置固定IP
  3. swift 批量 取出中间文本
  4. 翻译 - NodeJS错误处理最佳实践
  5. iOS开发——UI篇Swift篇&amp;UIWebView
  6. Android 文件读写的例子
  7. 获取本地IP和端口号的指令
  8. WCF入门及在WinForm中动态调用
  9. 分布式文件系统 Mogilefs 安装步骤
  10. Boost的VS开发环境搭建
  11. Binary Watch
  12. eclipse-ee修改字体大小和配置Tomcat服务器
  13. Java-线程池专题 (美团面试题)
  14. 11/5/2018模拟 Problem C
  15. Unable to construct api.Node object for kubelet: can&#39;t get ip address of node master.example.com: lookup master.example.com on : no such host
  16. Erlang中一些错误或者异常的标识
  17. Ionic学习资源
  18. DevOps之零停机部署
  19. div中内容超出自动换行
  20. javascript实现俄罗斯方块游戏

热门文章

  1. html5获取用户当前的地理位置，即经纬度。
  2. Crossin-8-1;8-2课程记录
  3. webpack2使用ch5-多页面设置 内部js和引入js
  4. python2.7 使用super关键词 报错 TypeError: must be type, not&amp;n
  5. 有趣的flash例子
  6. python concurrent.futures
  7. windows下Maven的安装与配置
  8. Js全选 添加和单独删除
  9. DevOps之归纳总结
  10. 通过VBA，当在EXCEL单元格中输入任意的日期格式时，都能自动转换为指定的标准格式的日期值