向TRichEdit插入图片的单元

很简单, 就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插入图片的单元的更多相关文章

【VBA】单元格插入图片，单元格删除图片
封装函数: Sub 插入产品形象(strRange As String, datebaseTu As String) Dim strJpg As String strJpg = datebaseTu ...
如何在excel单元格中插入图片批注
在excel单元格中插入图片批注的方法: 1.选定要插入图片的单元格,然后右键选择插入批注. 2.然后会插入一个批注框,为了不影响图片效果,可以将批注文字都删除.然后鼠标移动到批注框边角再右键. 3. ...
自己写的POIUtil，主要解决从不同的HSSFWorkbook复制sheet以及根据单元格插入图片等
复制sheet的原始代码网上找的,但是小问题很多,然后自己动手改了一下: 根据单元格信息动态插入图片,如果单元格有文字,图片的位置会在文字之后,如果同样的位置已有图片则会往下插入. import or ...
c#在Excel指定单元格中插入图片
方法一: /// 将图片插入到指定的单元格位置,并设置图片的宽度和高度./// 注意:图片必须是绝对物理路径/// </summary>/// <param name="R ...
C#中如何创建PDF网格并插入图片
这篇文章我将向大家演示如何以编程的方式在PDF文档中创建一个网格,并将图片插入特定的网格中. 网上有一些类似的解决方法,在这里我选择了一个免费版的PDF组件.安装控件后,创建新项目,添加安装目录下的d ...
【VBA】批量插入图片
解决如下问题: 需要批量导入图片到Excel 图片放在一个文件夹中图片有严格的顺序关系,即按照:共通名_编号的方式命名. 图片格式统一,即均为同一格式. 有两种方式可以插入图片到Excel中,其一为 ...
【POI】使用POI处理xlsx的cell中的超链接和插入图片和设置打印区域
使用POI对xlsx中插入超链接和插入图片 package com.it.poiTest; import java.awt.image.BufferedImage; import java.io.B ...
C#调用NPOI组件读取excel表格数据转为datatable写入word表格中并向word中插入图片/文字/书签获得书签列表
调用word的com组件将400条数据导入word表格中耗时10分钟简直不能忍受,使用NPOI组件耗时4秒钟.但是NPOI中替换书签内容的功能不知道是不支持还是没找到. 辅助类 Excel表格数据与D ...
Java操作Excel(读、写、搜索关键字、插入图片)
import java.io.File; import java.io.IOException; import jxl.Cell; import jxl.Sheet; import jxl.Workb ...

随机推荐

Android 性能测试之方向与框架篇
假期结束,你的状态有没有回归?那么,放空脑袋后,先来学习学习,欢迎大家继续关注腾讯云技术社区. 作者:李帅导语借项目的开发周期,把思考了一段时间的场景化性能测试框架搭建起来,包括耗电性能测试.内 ...
WPF之DataGrid应用
前几天打算尝试下DataGrid的用法,起初以为应该很简单,可后来被各种使用方法和功能实现所折磨.网络上的解决方法太多,但也太杂.没法子,我只好硬着头皮阅览各种文献资料,然后不断的去尝试,总算小有成果 ...
（图文实例）用VB.net操作SQLite数据库
转载请注明出处:HateMath归来(http://www.cnblogs.com/hatemath/) 环境: Visual Studio 社区版 64位 Windows 7系统新建的解决方案基于 ...
jquery层次选择器：空格 > next + nextAll ~ siblings
全栈工程师开发手册 (作者:栾鹏) jquery系列教程1-选择器全解 jquery层次选择器 jquery层次选择器,包括空格.>.next.+.nextAll.~.siblings等函数或表 ...
SSM框架整合项目：租房管理系统
使用ssm框架整合,oracle数据库框架: Spring SpringMVC MyBatis 导包: 1, spring 2, MyBatis 3, mybatis-spring 4, fastj ...
【学习】js学习笔记：对象的一些基础知识
1.创建对象 //构造函数方法 function fun1(){} var obj=new fun1(); //Object方法,O要大写 var obj1=new Object(); //json方 ...
SpringMVC 实现文件的上传与下载
一配置SpringMVC ,并导入与文件上传下载有关的jar包(在此不再赘述) 二新建相应 jsp 和controller FileUpAndDown.jsp <%@ page lang ...
我的第一个python web开发框架（8）——项目结构与RESTful接口风格说明
PS:再次说明一下,原本不想写的太啰嗦的,可之前那个系列发布后发现,好多朋友都想马上拿到代码立即能上手开发自己的项目,对代码结构.基础常识.分类目录与文件功能结构.常用函数......等等什么都不懂, ...
即时通信系统Openfire分析之八：集群管理
前言在第六章<路由表>中,客户端进行会话时,首先要获取对方的Session实例.获取Session实例的方法,是先查找本地路由表,若找不到,则通过路由表中的缓存数据,由定位器获取. 路由 ...
斐讯 FIR151M 频繁掉线（OpenWRT解决方案）
0. 现象与前言在使用斐讯 FIR151M 路由器连接网络时,传输数据时频繁掉线. 官方固件刷了两个版本,问题未解决. 建议高级用户看本教程,要做好不能使用 Web 管理界面的心理准备. 1. 准备 ...

向TRichEdit插入图片的单元

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

随机推荐

热门专题