向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 ...

随机推荐

Windows下如何创建低权限进程
1. 前言在使用 Sysinternals 出品的 Process Explorer 过程中,对 “Run as Limited User” 功能的实现方式颇感兴趣,一番搜寻之下发现Mark ...
STM8学习无法仿真原因Starting debug session... -> Emulator reset (usb://usb)... ** Connection error (usb://usb): swim error [30200]: st-link connection error
刚调试程序时,STlink总是连不上,一直提示: Starting debug session...-> Emulator reset (usb://usb)...** Connection e ...
webpack2使用ch4-向根目录index.html文件传参并使用参数使用线上资源压缩html
1 webpack.config.js const webpack = require('webpack'), htmlWebpackPlugin = require('html-webpack-pl ...
vim环境设置(应用于python编程)
1. 安装完整的vim # apt-get install vim-gnome 2. 安装ctags,ctags用于支持taglist,必需! # apt-get install ctags 3. 安 ...
学习札记 ----wind7下如何安装SqlServer数据库
1.控制面板 ---找到程序和功能选项如下图所示: 2.打开程序和功能后进入如下图所示的界面,点击打开或关闭window功能. 3.启动window7自带的IIS功能.如下图所示: 4.如上动作准备 ...
Android 性能测试之方向与框架篇
假期结束,你的状态有没有回归?那么,放空脑袋后,先来学习学习,欢迎大家继续关注腾讯云技术社区. 作者:李帅导语借项目的开发周期,把思考了一段时间的场景化性能测试框架搭建起来,包括耗电性能测试.内 ...
Spring MVC Ajax 嵌套表单数据的提交
概述在一些场景里,某个大表单里常常嵌套着一个或若干个小逻辑块,比如以下表单里"设计预审"中包括了一个子模块表单"拟定款项". 在这种情况下该怎么去设计实体类以 ...
python虚拟环境的安装配置
安装使用pip安装 pip install virtualenv 因为已经安装过了,所以显示这样在这里我想在这里推荐大家以后再安装类库时可以用豆瓣源来安装,速度很快,因为在国内访问官方p ...
Ubuntu 中登录相关的日志
登录相关的日志涉及到系统的安全,所以是系统管理中非常重要的一部分内容.本文试图对登录相关的日志做一个整理. /var/log/auth.log 这是一个文本文件,记录了所有和用户认证相关的日志.无论是 ...
wpf GifBitmapDecoder 解析 gif 格式
在网上有很多图片都是gif,那么如何在 wpf 解析 gif? 本文告诉大家如何使用 GifBitmapDecoder 把gif分开为一张一张,获得他的信息. 如果需要把一个 gif 分开,使用的代码 ...

向TRichEdit插入图片的单元

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

随机推荐

热门专题