让DELPHI自带的richedit控件显示图片

unit RichEx;

{

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 = $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 character 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;                     // object 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_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 believed 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 = $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, $00, $00, $00, $00, $00, $00, $46)

  );

  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 1;

    function TriggerFrameChange: WordBool; dispid 2;

    function GetFilePath: WideString; dispid 3;

    procedure ShowText(const Text: WideString); dispid 4;

  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(hRichEdit: THandle; const FileName: string): Boolean; overload;

function InsertBitmap(hRichEdit: THandle; Bitmap: TBitmap): 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;

  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, OldBitmap);

  finally

    DeleteDC(MemDC);

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

  medium.unkForRelease := 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

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

  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, 'LockBytes is null!');

  OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, Storage));

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

  OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName)), IID_IUnknown, 0, @FormatEtc, OleSite, 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.clsid));

  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; Bitmap: 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 := TBitmapOle.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, 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_SELECTION;

    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 := GetRichEditOle(hRichEdit);

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

  Assert(FileName <> '', 'FileName is null!');

  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, 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), 0);

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

  ReObj.poleobj := OleObject;

  ReObj.polesite := OleSite;

  ReObj.pstg := Storage;

  ReObj.sizel.cx := 0;

  ReObj.sizel.cy := 0;

  ReOle.InsertObject(ReObj);

  Result := True;

end;

end.

　　

让DELPHI自带的richedit控件显示图片的更多相关文章

  1. GridView控件显示图片

    与图片的二进制数据库存储和显示 1.将图片以二进制存入数据库 2.读取二进制图片在页面显示 3.设置Image控件显示从数据库中读出的二进制图片 4.GridView中ImageField以URL方式 ...

  2. VC2005中将Picture控件显示图片保存为BMP,JPG等格式

    1.在stdafx.h头文件中加入 #include <atlimage.h> 2.保存图片 方法一:   HBITMAP hBitmap = NULL; //创建位图段 BITMAPIN ...

  3. Android：ImageView控件显示图片

    1)android显示图片可以使用imageView来呈现,而且也可以通过ImageButton来实现给button添加图片. 2)在创建一个ImageView后,显示图片绑定元素是:android: ...

  4. winform下picturebox控件显示图片问题

    viewData_pictureBox.SizeMode=PictureBoxSizeMode.StretchImage;图片会自动按照比例缩放来完全显示在你的PictureBox中.

  5. Delphi中解析Xml的控件-SimDesign NativeXml

    Delphi中解析Xml的控件-SimDesign NativeXml 正在学习,感觉应用很方便.无源代码的版本还是免费的. SimDesign.NativeXml是一个delphi和bcb的XML控 ...

  6. 解决方案：带格式化文本控件（ RichText）的模板如果在InfoPath的浏览器中加载可能出现 COM 组件的80040154错误

      建议大家在微软的组件出现问题时,在GOOGLE上搜索解决方案,一般来说,总有结果:  带格式化文本控件( RichText)的模板如果在InfoPath的浏览器中加载,可能出现 COM 组件的80 ...

  7. Delphi下使用Oracle Access控件组下TOraSession控件链接

    Delphi下使用Oracle Access控件组下TOraSession控件链接数据库,使用  orsn1.Options.Direct:=true;  orsn1.Server:=IP:Port: ...

  8. 改进duilib的richedit控件的部分功能

    转载请说明原出处,谢谢~~:http://blog.csdn.net/zhuhongshu/article/details/41208207 如果要使用透明异形窗体功能,首先要改进duilib库让他本 ...

  9. 修改Delphi 10.1.2 edit控件在android的复制、剪切和粘贴样式

    Delphi 10.1.2 edit控件在android默认的复制.剪切和粘贴样式太丑,经悟能-DelphiTeacher的提示,用最简单的代码修改后稍有改观. 默认的样式: 修改后的样式: 修改FM ...

随机推荐

  1. vs 调试不进入断点

    背景 或许当时环境不知发了什么神经,就是不调试了.竟然还有这种简单错误. 解决方案---配置管理器---选择debug模式

  2. jTessBoxEditor工具进行Tesseract3.02.02样本训练

    1.背景 前文已经简要介绍tesseract ocr引擎的安装及基本使用,其中提到使用-l eng参数来限定语言库,可以提高识别准确率及识别效率. 本文将针对某个网站的验证码进行样本训练,形成自己的语 ...

  3. centos7 mysql5.7 rpm 安装

    卸载MariaDB CentOS7默认安装MariaDB而不是MySQL,而且yum服务器上也移除了MySQL相关的软件包.因为MariaDB和MySQL可能会冲突,故先卸载MariaDB. 查看已安 ...

  4. Github如何撤销提交并清除痕迹

    1.在命令行工具中进入项目目录 cd /Users/mac.manon/workspace/QuickCodes 2.sudo git reset --hard HEAD~4 根据提示输入本系统登录密 ...

  5. @ControllerAdvice + @ExceptionHandler 使用

    一.简介 @ControllerAdvice,是spring3.2提供的新注解,意思是控制器增强. 下面是它的解释. 大致意思是, 1.表示标有这个注解的类是一个Controller.它有一个默认行为 ...

  6. 001.RAID简介

    一 RAID介绍 独立磁盘冗余数组(RAID, Redundant Array of Independent Disks),旧称廉价磁盘冗余数组(RAID,Redundant Array of Ine ...

  7. 前端自动化grunt轻松入门

    如果你还不了解grunt,或者只是听过它的名字而没有去研究过它,那么这篇入门级的文章就是为你写的,相信看完你就会爱上grunt! grunt是什么? grunt是一个非常好的自动化工具,你只管code ...

  8. css实现自适应正方形

    这里介绍7种方法,仅供参考. 1.vm单位 <div class="square-shape">这是一个可以自适应的正方形,此法适用于移动端web页面.</div ...

  9. leetcode 岛屿的个数 python

      岛屿的个数     给定一个由 '1'(陆地)和 '0'(水)组成的的二维网格,计算岛屿的数量.一个岛被水包围,并且它是通过水平方向或垂直方向上相邻的陆地连接而成的.你可以假设网格的四个边均被水包 ...

  10. GRYZ 模 拟 赛 系 列 Xxy 的车厢调度

    Xxy 的车厢调度(train.cpp/c/pas)Description有 一 个 火 车 站 , 铁 路 如 图 所 示 ,每辆火车从 A 驶入,再从 B 方向驶出,同时它的车厢可以重新组合.假设 ...