让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. 初始ADO.NET数据操作

    以下介绍直接来源与百度百科,介绍十分全面和详细,作为小菜的我们没有理由不看完这些枯燥的介绍原有: ADO.NET的名称起源于ADO(ActiveX Data Objects),是一个COM组件库,用于 ...

  2. SqlServer行转列（PIVOT），列转行（UNPIVOT）总结

    PIVOT用于将列值旋转为列名(即行转列) 语法: table_source PIVOT( 聚合函数(value_column) FOR pivot_column IN(<column_list ...

  3. winform解析json

    在使用C#开发爬虫程序时,会遇到需要解析json字符串的情况.对于json字符串可以使用正则表达式的形式进行解析,更为方便的方法是使用Newtonsoft.Json来实现. Nuget添加应用包 在工 ...

  4. 【Java】 大话数据结构(15) 排序算法(2) （快速排序及其优化）

    本文根据<大话数据结构>一书,实现了Java版的快速排序. 更多:数据结构与算法合集 基本概念 基本思想:在每轮排序中,选取一个基准元素,其他元素中比基准元素小的排到数列的一边,大的排到数 ...

  5. 《编写可维护的javascript》读书笔记（上）

    最近在读<编写可维护的javascript>这本书,为了加深记忆,简单做个笔记,同时也让没有读过的同学有一个大概的了解. 一.编程风格 程序是写给人读的,所以一个团队的编程风格要保持一致. ...

  6. url后面添加参数,注意&?的添加方式

    // 添加参数&key=value 直接输出url function insertParam(key, value) { key = encodeURI(key); value = encod ...

  7. 新手通过SVN向eclipse中导入项目注意事项

    该文章进行的前提是,jdk.eclipse.tomcat.maven已安装完成 要从svn上获取项目数据,首先要安装svn 1)通过help->installsoft->svn->a ...

  8. 获取当前页面url中的参数 coffeescript+node.js+angular

    获取当前url:@$window.alert @$location.url()获取参数(json格式)@$window.alert @$location.search().channel

  9. Codeforces.1041F.Ray in the tube(思路)

    题目链接 \(Description\) 有两条平行于\(x\)轴的直线\(A,B\),每条直线上的某些位置有传感器.你需要确定\(A,B\)轴上任意两个整点位置\(x_A,x_B\),使得一条光线沿 ...

  10. Codechef September Challenge 2018 游记

    Codechef September Challenge 2018 游记 Magician versus Chef 题目大意: 有一排\(n(n\le10^5)\)个格子,一开始硬币在第\(x\)个格 ...