让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. JDK7的新玩具java.util.Objects

    空指针异常这个坑爹的异常是初学开发者最常见的坑,那么今天为大家分享一个jdk的新工具java.util.Objects包.里面有很多工具可以帮我们避免空指针异常让我我们的代码写起来更加优雅.下面我们来 ...

  2. POJ 3666 Making the Grade(二维DP)

    题目链接:http://poj.org/problem?id=3666 题目大意:给出长度为n的整数数列,每次可以将一个数加1或者减1,最少要多少次可以将其变成单调不降或者单调不增(题目BUG,只能求 ...

  3. （二）zookeeper安装

    再安装zookeeper之前,我们看下zookeeper简介 https://baike.baidu.com/item/zookeeper/4836397?fr=aladdin 再Dubbo中 官方推 ...

  4. 微信隐藏的webJS Api汇总

    1.右侧菜单增加"查看公众账号" API document.getElementById('post-user').addEventListener('click', functi ...

  5. P(查准率)，R(查全率)，F1 值

    起源: 我们平时用的精度 accuracy,也就是整体的正确率 acc=predict_right_num/predict_num 这个虽然常用,但不能满足所有任务的需求.比如,因为香蕉太多了,也不能 ...

  6. net mvc webapi 实用

    asp.net mvc webapi 实用的接口加密方法   在很多项目中,因为webapi是对外开放的,这个时候,我们就要得考虑接口交换数据的安全性. 安全机制也比较多,如andriod与webap ...

  7. 使用IDEA搭建spring

    从前使用eclipse开发,集成jar包,现在使用maven来管理 一: 1.框架 2.pom 需要spring core与spring context. <?xml version=" ...

  8. HashMap几个需要注意的知识点

    HashMap简介 HashMap 是java集合框架的一部分. key value都允许null值 (除了非同步和允许使用 null 之外,HashMap 类与 Hashtable 大致相同) 不保 ...

  9. .NET工作准备--01前言

    01应聘须知(已过时) -1.了解软件开发大环境.-2.准备简历:不宜超过一页,永远准备中文,模板. -3.渠道:3大网站,中华英才,前程无忧(51job最给力),智联招聘.现在还有猎聘网和100程序 ...

  10. mint-ui 关于有时候官网有时候打不开的问题

    难道就我只有这种情况,不知所措的,要不好看看是什么,看到别人说,是你路由的问题,换个路由的可以了,我觉得不是,那试试HTTP协议的问题 换个https试试就可以 这是什么原因呢? http是超文本传输 ...