很简单, 就3个函数, 直接看代码吧
unit RichEditBmp;
{
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 = $;
REO_GETOBJ_POLEOBJ = $;
REO_GETOBJ_PSTG = $;
REO_GETOBJ_POLESITE = $;
REO_GETOBJ_ALL_INTERFACES = $;
// 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 = $; // No flags
REO_READWRITEMASK = $0000003F; // Mask out RO bits
REO_DONTNEEDPALETTE = $; // Object doesn't need palette
REO_BLANK = $; // Object is blank
REO_DYNAMICSIZE = $; // Object defines size always
REO_INVERTEDSELECT = $; // Object drawn all inverted if sel
REO_BELOWBASELINE = $; // Object sits below the baseline
REO_RESIZABLE = $; // Object may be resized
REO_LINK = $; // Object is a link (RO)
REO_STATIC = $; // Object is static (RO)
REO_SELECTED = $; // Object selected (RO)
REO_OPEN = $; // Object open in its server (RO)
REO_INPLACEACTIVE = $; // Object in place active (RO)
REO_HILITED = $; // Object is to be hilited (RO)
REO_LINKAVAILABLE = $; // Link believed available (RO)
REO_GETMETAFILE = $; // Object requires metafile (RO)
// flags for IRichEditOle::GetClipboardData(),
// IRichEditOleCallback::GetClipboardData() and
// IRichEditOleCallback::QueryAcceptData()
RECO_PASTE = $; // paste from clipboard
RECO_DROP = $; // drop
RECO_COPY = $; // copy to the clipboard
RECO_CUT = $; // cut to the clipboard
RECO_DRAG = $; // drag
EM_GETOLEINTERFACE = WM_USER + ;
IID_IUnknown: TGUID =
(D1:$;D2:$;D3:$;D4:($C0,$,$,$,$,$,$,$));
IID_IOleObject: TGUID =
(D1:$;D2:$;D3:$;D4:($C0,$,$,$,$,$,$,$));
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 ;
function TriggerFrameChange: WordBool; dispid ;
function GetFilePath: WideString; dispid ;
procedure ShowText(const Text: WideString); dispid ;
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(AREHandle: THandle; const FileName: string): Boolean; overload;
function InsertBitmap(AREHandle: THandle; Bitmap: TBitmap): Boolean; overload;
function InsertGif(AREHandle: THandle; const FileName: string): Boolean;
implementation
function GetRichEditOle(hRichEdit: THandle): IRichEditOle;
begin
SendMessage(hRichEdit, EM_GETOLEINTERFACE, , Longint(@Result));
end;
function GetImage(Bitmap: TBitmap): HBITMAP;
var
Dest: HBitmap;
DC, MemDC: HDC;
OldBitmap: HBITMAP;
begin
DC := GetDC();
MemDC := CreateCompatibleDC(DC);
try
Dest := CreateCompatibleBitmap(DC, Bitmap.Width, Bitmap.Height);
OldBitmap := SelectObject(MemDC, Dest);
BitBlt(MemDC, , , Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, , , SRCCOPY);
SelectObject(MemDC, OldBitmap);
finally
DeleteDC(MemDC);
ReleaseDC(, 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, );
medium.unkForRelease := nil;
if medium.hBitmap = 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 := -; // Index = Not applicaple
FmEtc.tymed := TYMED_GDI; // Storage medium = HBITMAP handle
SetData(FmEtc, Stgm, True);
end;
function InsertBitmap(AREHandle: 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(AREHandle);
Assert(ReOle <> nil, 'RichEditOle is null!');
ReOle.GetClientSite(OleSite);
OleCheck(CreateILockBytesOnHGlobal(, True, LockBytes));
Assert(LockBytes <> nil, 'LockBytes is null!');
OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, , Storage));
Assert(Storage <> nil, 'Storage is null!');
OleCheck(OleCreateFromFile(GUID_NULL, PWideChar(WideString(FileName)),
IID_IUnknown, , @FormatEtc, OleSite, Storage, TempOle));
OleCheck(TempOle.QueryInterface(IID_IOleObject, OleObject));
OleCheck(OleSetContainedObject(OleObject, True));
Assert(OleObject <> nil, 'OleObject is null!');
FillChar(ReObj, Sizeof(ReObj), );
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 := ;
ReObj.sizel.cx := ;
ReObj.sizel.cy := ;
ReOle.InsertObject(ReObj);
Result := True;
end;
function InsertBitmap(AREHandle: THandle; Bitmap: TBitmap): Boolean;
var
nIRE: IRichEditOle;
nBMP: TBitmapOle;
nIOleSite: IOleClientSite;
nIStorage: IStorage;
nILockBytes: ILockBytes;
nIOleObject: IOleObject;
nREObj: TReObject;
begin
nIRE := GetRichEditOle(AREHandle);
Assert(nIRE <> nil, 'RichEditOle is null');
nBMP := TBitmapOle.Create;
try
nBMP.SetBitmap(GetImage(Bitmap));
nIRE.GetClientSite(nIOleSite);
OleCheck(CreateILockBytesOnHGlobal(, True, nILockBytes));
Assert(nILockBytes <> nil, 'LockBytes is null');
OleCheck(StgCreateDocfileOnILockBytes(nILockBytes,
STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, , nIStorage));
Assert(nIStorage <> nil, 'Storage is null');
nBMP.GetOleObject(nIOleSite, nIStorage, nIOleObject);
OleCheck(OleSetContainedObject(nIOleObject, True));
FillChar(nREObj, Sizeof(nREObj), );
nREObj.cbStruct := Sizeof(nREObj);
OleCheck(nIOleObject.GetUserClassID(nREObj.clsid));
nREObj.cp := REO_CP_SELECTION;
nREObj.dvaspect := DVASPECT_CONTENT;
nREObj.poleobj := nIOleObject;
nREObj.polesite := nIOleSite;
nREObj.pstg := nIStorage;
nIRE.InsertObject(nREObj);
Result := True;
finally
nBMP.Free;
end;
end;
function InsertGif(AREHandle: THandle; const FileName: string): Boolean;
var
ReOle: IRichEditOle;
OleSite: IOleClientSite;
Storage: IStorage;
LockBytes: ILockBytes;
OleObject: IOleObject;
ReObj: TReObject;
Animator: IGifAnimator;
begin
ReOle := GetRichEditOle(AREHandle);
Assert(ReOle <> nil, 'RichEditOle is null!');
Assert(FileName <> '', 'FileName is null!');
ReOle.GetClientSite(OleSite);
OleCheck(CreateILockBytesOnHGlobal(, True, LockBytes));
Assert(LockBytes <> nil, 'LockBytes is null!');
OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, , 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), );
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 := ;
ReObj.poleobj := OleObject;
ReObj.polesite := OleSite;
ReObj.pstg := Storage;
ReObj.sizel.cx := ;
ReObj.sizel.cy := ;
ReOle.InsertObject(ReObj);
Result := True;
end;
end.