Delphi - Képek megjelenítése a TRichEdit komponensben

forráskód letöltése
A TRichEdit komponens alapesetben nem támogatja a képek megjelenítését, annak ellenére, hogy egy RTF állomány tartalmazhat ilyet.

Mellékelt példa bemutatja, hogy ezen hiányosságot miként küszöbölhetjük ki. A mellékelt példaprogram megnyitása előtt az OleRichEdit.pas-ban lévő komponenst telepítenie kell a Delphi alá.

A megoldáshoz csupán annyi a teendőnk, hogy az IRichEditOleCallback interfészt implementáljuk a TRichEdit komponenshez.

Ehhez létrehozunk egy új komponenst a TRichEdit-ből származtatva, majd felülírjuk a CreateHandle metódusát. Ez akkor kerül majd meghívásra, mikor a TRichEdit-nek létrejön az ablak azonosítója.
  TOleRichEdit = class(TRichEdit)
  protected
    procedure CreateHandle; override;
  end;
Itt a CreateHandle-nél már küldhetünk üzenetet a komponensnek. Az EM_SETOLECALLBACK üzenet küldésével beállíthatjuk az általunk létrehozott IRichEditOleCallback interfészt.
procedure TOleRichEdit.CreateHandle;
begin
  inherited CreateHandle;
  Perform(EM_SETOLECALLBACK, 0, longint(
      TRichEditOleCallback.Create(Self) as 
      IRichEditOleCallback));
end;
Az interfész létrehozása előtt deklarálnunk kell az IRichEditOleCallback-ot, mivel ezt a Delphi unit-jaiban "elfelejtették" megtenni.
  IRichEditOleCallback=interface(IUnknown)
    ['{C7B7FB1E-D4ED-4E2B-A20D-BC7022FA4090}']
    function GetNewStorage: IStorage; safecall;
    procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
          out Doc: IOleInPlaceUIWindow; 
          var FrameInfo: TOleInPlaceFrameInfo); safecall;
    procedure ShowContainerUI(fShow: boolean); safecall;
    procedure QueryInsertObject(const ClsID: TCLSID; 
          Stg: IStorage; CP: Longint); safecall;
    procedure DeleteObject(OleObj: IOleObject); safecall;
    procedure QueryAcceptData(dataobj: IDataObject; 
          var cfFormat: TClipFormat; reCO: DWORD; 
          fReally: boolean; hMetaPict: HGlobal); safecall;
    function ContextSensitiveHelp(fEnterMode: boolean):
           HResult; stdcall;
    function GetClipboardData(const ChRg: TCharRange;
           reCO: DWORD; out DataObj: IDataObject): HResult; stdcall;
    procedure GetDragDropEffect(fDrag: boolean; 
          grfKeyState: DWORD; var dwEffect: DWORD); safecall;
    procedure GetContextMenu(SelType: Word; OleObj: 
           IOleObject; const ChRg: TCharRange; var Menu: HMenu); 
           safecall;

  end;



A helyes működéshez persze nem lesz szükségünk az összes fenti metódusra, de a deklarációjukat nem hagyhatjuk el.

Most, hogy adott az interfész deklarációja, már létrehozhatunk belőle egy objektumot TRichEditOleCallback néven.
  TRichEditOleCallback=class(TInterfacedObject, 
        IRichEditOleCallback)
  private
    FOwner: TRichEdit;

  protected
    function GetNewStorage: IStorage; safecall;
    procedure GetInPlaceContext(out Frame: IOleInPlaceFrame; 
         out Doc: IOleInPlaceUIWindow; var FrameInfo:
         TOleInPlaceFrameInfo); safecall;
    procedure ShowContainerUI(fShow: boolean); safecall;
    procedure QueryInsertObject(const ClsID: TCLSID; 
         Stg: IStorage; CP: Longint); safecall;
    procedure DeleteObject(OleObj: IOleObject); safecall;
    procedure QueryAcceptData(dataobj: IDataObject; 
         var cfFormat: TClipFormat; reCO: DWORD; 
         fReally: boolean; hMetaPict: HGlobal); safecall;
    function ContextSensitiveHelp(fEnterMode: boolean): 
         HResult; stdcall;
    function GetClipboardData(const ChRg: TCharRange; 
         reCO: DWORD; out DataObj: IDataObject): HResult; stdcall;
    procedure GetDragDropEffect(fDrag: boolean; 
         grfKeyState: DWORD; var dwEffect: DWORD); safecall;
    procedure GetContextMenu(SelType: WORD; OleObj: IOleObject; 
         const ChRg: TCharRange; var Menu: HMenu); safecall;

  public
    constructor Create(AOwner: TRichEdit);
    destructor Destroy; override;

  end;
Itt az érdemi munkát a GetInPlaceContext eljárásnál kell elvégeznünk. Itt kell megadnunk azokat az információkat az interfész részére, melyek szükségesek a beágyazott objektumok megjelenítéséhez.
procedure TRichEditOleCallback.GetInPlaceContext(
    out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow;
    var FrameInfo: TOleInPlaceFrameInfo);
var
  form: TCustomForm;
begin
  form:=ValidParentForm(FOwner);
  if form.OleFormObject=nil then begin
    TOleForm.Create(form);
  end;
  Frame:=form.OleFormObject as IOleInPlaceFrame;
  Doc:=nil;
  FrameInfo.hWndFrame:=form.Handle;
  FrameInfo.fMDIApp:=false;
  FrameInfo.hAccel:=0;
  FrameInfo.cAccelEntries:=0;
end;