RealICQClient/Backup/Projects/InsRich.pas

unit InsRich;
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs,ActiveX,ComCtrls;
const
 REO_CP_SELECTION    = ULONG(-1);
 REO_BELOWBASELINE   = $00000002;
 REO_RESIZABLE       = $00000001;
 REO_STATIC          = $40000000;
 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));
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 {Copy From RichEdit.pas}
   cpMin: Integer;
   cpMax: Integer;
 end;
 TFormatRange = record
   hdc: Integer;
   hdcTarget: Integer;
   rectRegion: TRect;
   rectPage: TRect;
   chrg: TCharRange;
 end;
 IRichEditOle = interface(System.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;
 function InsertBitmap(Editor: TRichEdit; BmpFile: String): Boolean;

implementation

function InsertBitmap(Editor: TRichEdit; BmpFile: String): Boolean;
var
 FRTF: IRichEditOle;
 FOle: IOleObject;
 FormatEtc: tagFormatETC;
 FStorage: ISTORAGE;
 FClientSite: IOleClientSite;
 FLockBytes: ILockBytes;
 ReObject: TReObject;
 xt: TGuid;
 FTemp: IUnknown;
begin
 Result:=false;  
 if not FileExists(BmpFile) then Exit;
 try
   SendMessage(Editor.Handle, em_GetOleInterFace, 0, LongInt(@FRTF));
   if not Assigned(FRTF) then Exit;
   if CreateILockBytesOnHGlobal(0,true,FLockBytes)<>S_OK then Exit;
   if StgCreateDocfileOnILockBytes(FLockBytes,STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE,0,FStorage)<>S_OK then Exit;
   FormatEtc.cfFormat:=0;
   FormatEtc.ptd:=nil;
   FormatEtc.dwAspect:=DVASPECT_CONTENT;
   FormatEtc.lindex:=-1;
   FormatEtc.tymed:=TYMED_NULL;
   FRTF.GetClientSite(FClientSite);
   //´ÓÎļþÖд´½¨Ò»¸öOle¶ÔÏó
   if OleCreateFromFile(GUID_NULL,PWideChar(WideString(BmpFile)),IID_IUnknown,0,@FormatEtc,FClientSite,FStorage,FOle)<>S_OK then Exit;
   FTemp:=FOle;
   FTemp.QueryInterface(IID_IOleObject, FOle);
   OleSetContainedObject(FOle, true);
   ReObject.cbStruct:=SizeOf(TReObject);
   FOle.GetUserClassID(xt);
   ReObject.clsid:=xt;
   ReObject.cp:=ULong(REO_CP_SELECTION);
   ReObject.dvaspect:=DVASPECT_CONTENT;
   ReObject.dwFlags:=ULong(REO_STATIC) or ULong(REO_BELOWBASELINE);
   ReObject.dwUser:=0;
   ReObject.pOleObj:=FOle;
   ReObject.pOleSite:=FClientSite;
   ReObject.pstg:=FStorage;
   ReObject.sizel.cx:=0;
   ReObject.sizel.cy:=0;
   FRTF.InsertObject(ReObject);
 finally
   FRTF:=nil;
   FOle:=nil;
 end;
 Result:=true;
end;
end.