让DELPHI自带的richedit控件显示图片
让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 ...
随机推荐
- 升级Chrome后无法打开网页
最近升级了网站,发现很多普通网站Chrome 都打不开了.... IE 可以正常打开,很是郁闷,重启电脑都不行. chrome://net-internals/#dns 点击如下按钮 清楚DNS缓 ...
- poj2049
优先队列广搜,有人说用SPFA,不知道怎么做的 #include <cstdio> #include <queue> #include <cmath> #inclu ...
- 错误/异常：java.net.SocketException: Unrecognized Windows Sockets error: 0: JVM_Bind；的解决方法
1.异常视图 2.解决方法 SocketException(JVM_Bind):套接口异常 说明:服务器端口号被占用 了 解决方法:点击 Window-->Preferences- ...
- java 异常的限制
一. 1.) 在覆盖方法的时候,只能抛出在基类方法的异常说明里列出的那些异常 2.) 在基类构造器声明的异常,在子类必须抛出,子类的构造器可以抛出任何异常,但是必须抛出基类构造器的异常 3.) 在基类 ...
- Java编程的逻辑 (26) - 剖析包装类 (上)
本系列文章经补充和完善,已修订整理成书<Java编程的逻辑>,由机械工业出版社华章分社出版,于2018年1月上市热销,读者好评如潮!各大网店和书店有售,欢迎购买,京东自营链接:http:/ ...
- 生成和打上patch的方法(转载)
原文链接:http://my.oschina.net/fgq611/blog/180750 在团队开发的过程中,经常需要生成patch,或者打上别人提供的patch,那么一般情况是如何操作的呢. 首先 ...
- 在idea中关闭vim模式
每次在idea的文件中插入新的内容时,都需要先点击键盘上的i 进入插入模式,感觉这是vim编辑器的模式,很不习惯. 你可能是按照了vim emulation 插件, 在setting-----plug ...
- 如何简单区分Web前后端与MVC
MVC是开发所有软件所必须涉及的基本几个划分 M主要负责数据与模型,V主要负责显示C主要负责交互与业务所以不管是前端还是后端,都是有MVC的.MVC是一个对于软件简单的抽象,不管是M还是V,还是C都是 ...
- 【AtCoder】CODE FESTIVAL 2017 Final
A - AKIBA 模拟即可 代码 #include <bits/stdc++.h> #define fi first #define se second #define pii pair ...
- 【洛谷】P4198 楼房重建
题解 我们转而维护每个点的斜率,显然一个楼房能被看见它就是一个前缀最大值,斜率比较为了节约精度可以用向量替代 我们每个区间维护被看到的楼房的个数,和楼房的最大值,叶子节点在有楼房时,值为1 那么考虑合 ...