让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.