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){0C1CF2DF-05A3-4FEF-8CD4-F5CFC4355A16}';
CLASS_GifAnimator: TGUID = '{06ADA938-0FB0-4BC0-B19B-0A38AB17F182}';
end;
TReObject = _ReObject;
// 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 = '
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
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.
//测试:
RichEx.InsertBitmap(RichEdit1.Handle, ExtractFilePath(ParamStr(0)) + 'e.bmp');
RichEx.InsertBitmap(RichEdit1.Handle, Image1.Picture.Bitmap);
RichEx.InsertGif(RichEdit1.Handle, ExtractFilePath(ParamStr(0)) + 'c.gif'
分享到:
相关推荐
RichEdit显示文字,图片,动态图(gif)。 在网上找的RichEdit显示gif的资料很多不能用,有的就是用的是QQ的dll,没有一个完整可用的代码。这个是我发了不少心思在国外网站上找到的源码,能很好的显示gif。大家不要...
Richedit中显示GIF动画,以及bmp、jpg、png等图片格式,目前暂不支持swf格式
2、支持插入BMP、JPG、PNG、GIF等格式的图片文件。 3、支持图片和文字的复制剪切粘贴拖放,并与QQ、IE、Google Chrome、Word等的剪切板格式互相兼容。 4、支持表情选择框、图片文件选择框等方式插入表情或图片。 5、...
2、支持插入BMP、JPG、PNG、GIF等格式的图片文件。 3、支持图片和文字的复制剪切粘贴拖放,并与QQ、IE、Google Chrome、Word等的剪切板格式互相兼容。 4、支持表情选择框、图片文件选择框等方式插入表情或图片。 5、...
2003年写的,一直自己使用,...支持图片等对象另存为bmp/jpg图片,完美实现了richedit到bmp/jpg图片的转换,完美解决了qrimage打印预览时空白变黑的问题,完美解决了打印预览汉化问题.希望能对大家有所帮助,有问题欢迎联系我
实例071 利用RichEdit控件实现文字定位与标识 实例072 利用RichEdit控件显示图文数据 2.8 图形类控件典型实例 实例073 图文数据录入 实例074 带有滚动条的图形控件 2.9 滚动条控件典型实例 实例075 自定义...
实例071 利用RichEdit控件实现文字定位与标识 实例072 利用RichEdit控件显示图文数据 2.8 图形类控件典型实例 实例073 图文数据录入 实例074 带有滚动条的图形控件 2.9 滚动条控件典型实例 实例075 自定义...
cc实例082 利用IFS算法绘制自然景物 3.2 图像预览 cc实例083 图片自动预览程序 cc实例084 图片批量浏览 cc实例085 浏览大幅BMP图片 cc实例086 放大和缩小图片 cc实例087 可随鼠标移动的图形 cc实例088...
cc实例071 利用RichEdit控件实现文字定位与标识 cc实例072 利用RichEdit控件显示图文数据 2.8 图形类控件典型实例 cc实例073 图文数据录入 cc实例074 带有滚动条的图形控件 2.9 滚动条...
cc实例071 利用RichEdit控件实现文字定位与标识 cc实例072 利用RichEdit控件显示图文数据 2.8 图形类控件典型实例 cc实例073 图文数据录入 cc实例074 带有滚动条的图形控件 2.9 滚动条...
delphi使用打印预览控件(printBox.dll),支持如下控件直接打印: 1:Grid:DbGrid,StringGrid 2:TreeView 3:Memo,richedit 4: Form 文件打印支持: 1、图片:bmp,jpg,gif 2、Txt,rtf格式 提供丰富的事件和绘图...
2、支持插入BMP、JPG、PNG、GIF等格式的图片文件。 3、支持图片和文字的复制剪切粘贴拖放,并与QQ、IE、Google Chrome、Word等的剪切板格式互相兼容。 4、支持表情选择框、图片文件选择框等方式插入表情或图片
Image editor currently supporting JPEG, PNG, BMP, GIF and ICO image formats. Visualize and modify BLOB fields using the integrated Hex editor. Other features Full Unicode support. Support for ...
支持墙纸格式: JPG 、 BMP 、 PNG 和 GIF ;铃声 (MP3 、 AAC 、 AAC+ 和 WMA) 。 接入技术 蓝牙 (class 1) ;四频 (850 , 900 , 1800 , 1900) ;支持 3G , 802.11b 和 802.11g 。----------------------------...
- fixed bug with expressions in RichEdit - fixed bug in multi-column reports - fixed exception in the report designer - fixed bug with URLs in Open Document Text and Open Document Spreadsheet exports ...