很简单, 就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.

向TRichEdit插入图片的单元的更多相关文章

  1. 【VBA】单元格插入图片，单元格删除图片

    封装函数: Sub 插入产品形象(strRange As String, datebaseTu As String) Dim strJpg As String strJpg = datebaseTu ...

  2. 如何在excel单元格中插入图片批注

    在excel单元格中插入图片批注的方法: 1.选定要插入图片的单元格,然后右键选择插入批注. 2.然后会插入一个批注框,为了不影响图片效果,可以将批注文字都删除.然后鼠标移动到批注框边角再右键. 3. ...

  3. 自己写的POIUtil，主要解决从不同的HSSFWorkbook复制sheet以及根据单元格插入图片等

    复制sheet的原始代码网上找的,但是小问题很多,然后自己动手改了一下: 根据单元格信息动态插入图片,如果单元格有文字,图片的位置会在文字之后,如果同样的位置已有图片则会往下插入. import or ...

  4. c#在Excel指定单元格中插入图片

    方法一: /// 将图片插入到指定的单元格位置,并设置图片的宽度和高度./// 注意:图片必须是绝对物理路径/// </summary>/// <param name="R ...

  5. C#中如何创建PDF网格并插入图片

    这篇文章我将向大家演示如何以编程的方式在PDF文档中创建一个网格,并将图片插入特定的网格中. 网上有一些类似的解决方法,在这里我选择了一个免费版的PDF组件.安装控件后,创建新项目,添加安装目录下的d ...

  6. 【VBA】批量插入图片

    解决如下问题: 需要批量导入图片到Excel 图片放在一个文件夹中 图片有严格的顺序关系,即按照:共通名_编号的方式命名. 图片格式统一,即均为同一格式. 有两种方式可以插入图片到Excel中,其一为 ...

  7. 【POI】使用POI处理xlsx的cell中的超链接 和 插入图片 和 设置打印区域

    使用POI对xlsx中插入超链接和 插入图片 package com.it.poiTest; import java.awt.image.BufferedImage; import java.io.B ...

  8. C#调用NPOI组件读取excel表格数据转为datatable写入word表格中并向word中插入图片/文字/书签 获得书签列表

    调用word的com组件将400条数据导入word表格中耗时10分钟简直不能忍受,使用NPOI组件耗时4秒钟.但是NPOI中替换书签内容的功能不知道是不支持还是没找到. 辅助类 Excel表格数据与D ...

  9. Java操作Excel(读、写、搜索关键字、插入图片)

    import java.io.File; import java.io.IOException; import jxl.Cell; import jxl.Sheet; import jxl.Workb ...

随机推荐

  1. Linux视频主要概述

    Linux当中称之为视频的主要为俩个方面(主要以kernel为主): 1.源代码video目录指的是主显示输出,也就是帧缓冲(Frame Buffer)驱动部分,表示对基本图形层的显示支持; 2.源代 ...

  2. ch1-vuejs基础入门（hw v-bind v-if v-for v-on v-model 应用组件简介 小案例）

    1 hello world 引入vue.min.js 代码: ----2.0+版本 <div id="test"> {{str}} </div> <s ...

  3. java web 项目 图书管理系统的设计与实现

     java web 项目 图书管理系统的设计与实现

  4. IDL 创建数组

    1.赋值创建 通过方括号[]赋值创建数组,示例代码如下 IDL> arr=[1,2,3] IDL> help,arr ARR INT = Array[3] IDL> arr=[[1, ...

  5. zookeeper curator使用caches实现各种监听

    1.篇首语 curator是zookeeper的一个高级api开发包.封装了zookeeper众多的recipes,并且实现了一些新的recipes原语,最重要的是基于zookeeper提供的各种机制 ...

  6. 从开发到部署会用到的 Docker 命令

    本文的目的是理解容器开发在目标环境中部署的端到端流程,并列出这些操作所需的 Docker 命令.如果有任何Docker问题,请移步到最新最热的技术社区 IT帮 itbang.me 提问,短信通知专家来 ...

  7. mac idea sbt工程打jar包

    1.首先保证sbt已下载,否则下载homebrew:在命令行输入/usr/bin/ruby XXX ->下载完成后在终端输入brew install sbt ->安装完毕后可以打jar包 ...

  8. JavaEE 对象的串行化（Serialization）

    什么情况下需要序列化 a)当你想把的内存中的对象写入到硬盘的时候:b)当你想用套接字在网络上传送对象的时候:c)当你想通过RMI传输对象的时候:再稍微解释一下:a)比如说你的内存不够用了,那计算机就要 ...

  9. Python 第十三节 文件操作

    A 1.首先文件读写操作有以下几种模式:   a\a+  w\w+ r\r+   a模式:追加_写入模式,写入指针默认在开头,如果文件存在将在开头追加写入,如果文件不存在将创建文件再写入. a+模式: ...

  10. LeetCode 695. Max Area of Island （岛的最大区域）

    Given a non-empty 2D array grid of 0's and 1's, an island is a group of 1's (representing land) conn ...