RICHEDIT中插入图象,源代码公开啦!高分求救,将此代码更改成为能将插入的图片进行移动、图片缩放、图片进行透明处理等。
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;implementationfunction 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.