让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控件显示图片的更多相关文章

GridView控件显示图片
与图片的二进制数据库存储和显示 1.将图片以二进制存入数据库 2.读取二进制图片在页面显示 3.设置Image控件显示从数据库中读出的二进制图片 4.GridView中ImageField以URL方式 ...
VC2005中将Picture控件显示图片保存为BMP,JPG等格式
1.在stdafx.h头文件中加入 #include <atlimage.h> 2.保存图片方法一: HBITMAP hBitmap = NULL; //创建位图段 BITMAPIN ...
Android：ImageView控件显示图片
1)android显示图片可以使用imageView来呈现,而且也可以通过ImageButton来实现给button添加图片. 2)在创建一个ImageView后,显示图片绑定元素是:android: ...
winform下picturebox控件显示图片问题
viewData_pictureBox.SizeMode=PictureBoxSizeMode.StretchImage;图片会自动按照比例缩放来完全显示在你的PictureBox中.
Delphi中解析Xml的控件-SimDesign NativeXml
Delphi中解析Xml的控件-SimDesign NativeXml 正在学习,感觉应用很方便.无源代码的版本还是免费的. SimDesign.NativeXml是一个delphi和bcb的XML控 ...
解决方案：带格式化文本控件（ RichText）的模板如果在InfoPath的浏览器中加载可能出现 COM 组件的80040154错误
建议大家在微软的组件出现问题时,在GOOGLE上搜索解决方案,一般来说,总有结果: 带格式化文本控件( RichText)的模板如果在InfoPath的浏览器中加载,可能出现 COM 组件的80 ...
Delphi下使用Oracle Access控件组下TOraSession控件链接
Delphi下使用Oracle Access控件组下TOraSession控件链接数据库,使用 orsn1.Options.Direct:=true; orsn1.Server:=IP:Port: ...
改进duilib的richedit控件的部分功能
转载请说明原出处,谢谢~~:http://blog.csdn.net/zhuhongshu/article/details/41208207 如果要使用透明异形窗体功能,首先要改进duilib库让他本 ...
修改Delphi 10.1.2 edit控件在android的复制、剪切和粘贴样式
Delphi 10.1.2 edit控件在android默认的复制.剪切和粘贴样式太丑,经悟能-DelphiTeacher的提示,用最简单的代码修改后稍有改观. 默认的样式: 修改后的样式: 修改FM ...

随机推荐

VS2017创建类库项目后添加不了WPF资源字典
第一步: 先找到你需要添加的库类工程文件,位置如下: 第二步: 使用记事本文件打开,找到图片的位置,把三行代码粘贴进去,保存文件.重新打开项目: 三行代码如下: <ProjectTypeGuid ...
.gitkeep
看一个开源项目中有个.gitkeep文件,不知道是干嘛用的查询知道 git是不允许提交一个空的目录到版本库上的,可以在空的文件夹里面建立一个.gitkeep文件,然后提交去即可. 其实在git中 .g ...
【前端开发】关于闭包最通俗易懂的解释 for循环，定时器，闭包混合一块的那点事。
for循环,定时器,闭包混合一块的那点事. 1,对于一个基本的for循环,顺序输出变量值. for(var i = 1; i < 4; i++){ console.log(i);//结果不多说了 ...
2018ACM/ICPC 青岛现场赛 E题 Plants vs. Zombies
题意: 你的房子在0点,1,2,3,...,n(n<=1e5)点每个点都有一颗高度为0的花,浇一次水花会长a[i]. 你有一个机器人刚开始在你家,最多走m步,每一步只能往前走或者往后走,每走到一 ...
APP性能测试开始之旅
你是不是也跟我一样在工作中存在着同样的问题,APP版本在上线后不断的会有市场人员或者用户反馈页面加载慢,进入页面loading很久(实际我们设置的加载超时是15秒,15秒内加载出内容则显示,15秒外未 ...
android 跳转到应用通知设置界面的示例
4.4以下并没有提过从app跳转到应用通知设置页面的Action,可考虑跳转到应用详情页面,下面是直接跳转到应用通知设置的代码: if (android.os.Build.VERSION.SDK_IN ...
nginx log 错误502 upstream sent too big header while reading response header from upstream
cookies的值超出了范围我是说看看了一下日志错误502 upstream sent too big header while reading response header from upst ...
Git（三）Git的远程仓库
一. 添加远程库现在我们已经在本地创建了一个Git仓库,又想让其他人来协作开发,此时就可以把本地仓库同步到远程仓库,同时还增加了本地仓库的一个备份.常用的远程仓库就是github:https://g ...
linux环境vnc安装
环境:centos6.9 背景:有时安装软件图形化方便操作 1.安装vnc服务端 yum install tigervnc-server -y 2.修改vncserver的配置文件.命令:vim /e ...
【LOJ】#2108. 「JLOI2015」装备购买
题解换成long double才过--出题人丧心病狂卡精度只要按照费用排序从小到大排序,一个个插入线性基,插入的时候加上费用即可代码 #include <bits/stdc++.h> ...

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

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

随机推荐

热门专题