お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"TRichEditに OLE 機能を追加する（その１）" 



RichEdit コントロールには OLE クライアントとなるためのインタフェースが用
意されていますが、標準では使えません。このため TRichEdit は単なる文字装
飾にとどまっていますが、OLE インタフェースをつないであげると、ビットマッ
プや Excel の表などを埋め込んで使うことができます。

以下は、自分の作品を作る前に実験で書いたもので、そのまま成長しなかったた
め ^^;、すべての機能はインプリメントしてありません。具体的には、インプ
レースオブジェクト編集に対応していないなどです。それでも、グラフィックの
入った状態で編集できるメリットはあると思いますので、公開します。これを見
て、間違えているところを直したり、拡張してくださる方がいらっしゃるとうれ
しく思います。

使い方は普通の TRichEdit とほとんど同じですが、

RichEditEx1.UseOle := True;

とすると OLE 機能が有効となり、

RichEditEx1.UseOle := False;

とすると、もとの OLE 機能のない RichEdit に戻ります。実行時にセットして
ください。



unit RichEditEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Clipbrd, Ole2, RichEdit;

{$A-}

const
  EM_CANPASTE = WM_USER + 50;
  EM_PASTESPECIAL = WM_USER + 64;
  EM_FINDTEXT = WM_USER + 56;
  DVASPECT_CONTENT =  1;
  EM_GETOLEINTERFACE = WM_USER + 60;
  EM_SETOLEINTERFACE = WM_USER + 70;
  RECO_PASTE = 0;
  RECO_DROP = 1;
  RECO_COPY = 2;
  RECO_CUT  = 3;
  RECO_DRAG = 4;

type
  TRePasteSpecial = record
    dwAspect:LongInt;
    dwParam:LongInt;
  end;

  TReObject = record
    cbStruct:DWORD;       // Size of structure
    cp:LongInt;           // 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:TPoint;          // 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;

  TCharRange = record
    cpMin: LongInt;
    cpMax: LongInt;
  end;

  TFindText = record
    range: TCharRange;
    text: PChar;
  end;

  IRichEditOle = class(IUnknown)
  public
    function GetClientSite(var clientSite: IOleClientSite):
HResult;virtual;stdcall;abstract;
    function GetObjectCount: LongInt;virtual;stdcall;abstract;
    function GetLinkCount: LongInt;virtual;stdcall;abstract;
    function GetObject(iob:LongInt; var reobject:TReObject ;
dwFlags:LongInt):HResult;virtual;stdcall;abstract;
    function InsertObject(var
reobject:TReObject):HResult;virtual;stdcall;abstract;
    function ConvertObject:HResult;virtual;stdcall;abstract;
    function ActivateAs:HResult;virtual;stdcall;abstract;
    function SetHostNames:HResult;virtual;stdcall;abstract;
    function SetLinkAvailable:HResult;virtual;stdcall;abstract;
    function SetDvAspect:HResult;virtual;stdcall;abstract;
    function HandsOffStrage:HResult;virtual;stdcall;abstract;
    function SaveComplated:HResult;virtual;stdcall;abstract;
    function InPlaceDeactivate:HResult;virtual;stdcall;abstract;
    function ContextSensitiveHelp:HResult;virtual;stdcall;abstract;
    function GetClipboardData(var range:TCharRange;reco:LongInt;var obj:
IDataObject):HResult;virtual;stdcall;abstract;
    function ImportDataObject(var
obj:IDataObject;cf:TClipFormat;metaPict:HGlobal):HResult;virtual;stdcall
;abstract;
  end;

  IRichEditOleCallback = class(IUnknown)
  public
    function GetNewStorage(var
Storage:IStorage):HResult;virtual;stdcall;abstract;
    function GetInPlaceContext(var frame:IOleInPlaceFrame; var
doc:IOleInPlaceUIWindow; var
frameInfo:TOleInPlaceFrameInfo):HResult;virtual;stdcall;abstract;
    function
ShowContainerUI(fShow:BOOL):HResult;virtual;stdcall;abstract;
    function QueryInsertObject(var clsid:TCLSID; var Storage:IStorage;
cp:LongInt):HResult;virtual;stdcall;abstract;
    function DeleteObject(var
obj:IOleObject):HResult;virtual;stdcall;abstract;
    function QueryAcceptData(var dataobj:IDataObject; var
cfFormat:TClipFormat;reco:LongInt;fReally:BOOL;metaPict:HGlobal):HResult
;virtual;stdcall;abstract;
    function
ContextSensitiveHelp(enterMode:BOOL):HResult;virtual;stdcall;abstract;
    function GetClipboardData(var chrg:TCharRange;reco:LongInt;var
dataobj:IDataObject):HResult;virtual;stdcall;abstract;
    function GetDragDropEffect(flag:BOOL; grfKeyState:LongInt ; var
dwEffect:LongInt):HResult;virtual;stdcall;abstract;
    function GetContextMenu(seltyp:Word ; var oleobj:IOleObject ; var
chrg:TCharRange ; var menu:HMenu):HResult;virtual;stdcall;abstract;
  end;

  TRichEditOleCallback = class(IRichEditOleCallback)
  public
    function QueryInterface(const iid: TIID; var obj): HResult;
override;
    function AddRef: Longint; override;
    function Release: Longint; override;
    function GetNewStorage(var Storage:IStorage):HResult;override;
    function GetInPlaceContext(var frame:IOleInPlaceFrame; var
doc:IOleInPlaceUIWindow; var
frameInfo:TOleInPlaceFrameInfo):HResult;override;
    function ShowContainerUI(fShow:BOOL):HResult;override;
    function QueryInsertObject(var clsid:TCLSID; var Storage:IStorage;
cp:LongInt):HResult;override;
    function DeleteObject(var obj:IOleObject):HResult;override;
    function QueryAcceptData(var dataobj:IDataObject; var
cfFormat:TClipFormat;reco:LongInt;fReally:BOOL;metaPict:HGlobal):HResult
;override;
    function ContextSensitiveHelp(enterMode:BOOL):HResult;override;
    function GetClipboardData(var chrg:TCharRange;reco:LongInt;var
dataobj:IDataObject):HResult;override;
    function GetDragDropEffect(flag:BOOL; grfKeyState:LongInt ; var
dwEffect:LongInt):HResult;override;
    function GetContextMenu( seltyp:Word ; var oleobj:IOleObject ; var
chrg:TCharRange ; var menu:HMenu):HResult;override;
    constructor Create(Owner:IRichEditOle);
  private
    FRefCount:Integer;
    FRichEditOle:IRichEditOle;
    FOleClientSite:IOleClientSite;
    FOleInPlaceSite:IOleInPlaceSite;
    FAdviseSink:IAdviseSink;
    FLockBytes:ILockBytes;
  end;

  TRichEditEx = class(TRichEdit)
  private
    FUseOle:Boolean;
    FRefCount:Integer;
    FRichEditOle:IRichEditOle;
    FRichEditOleCallback:TRichEditOleCallback;
    FMSH_MOUSEWHEEL:Integer;
    function GetCursorX:Integer;
    function GetCursorY:Integer;
  public
    procedure SetUseOle(flag:Boolean);
    procedure PasteFromClipboard;
    procedure CopyToClipboard;
    constructor Create(Owner:TComponent);override;
    destructor Destroy;override;
    function GetClipboardData(var range:TCharRange;reco:LongInt;var obj:
IDataObject):HResult;
    function ImportDataObject(var
obj:IDataObject;cf:TClipFormat;metaPict:HGlobal):HResult;
    property UseOle:Boolean read FUseOle write SetUseOle;
    property OleInterface:IRichEditOle read FRichEditOle;
    property CursorX:Integer read GetCursorX;
    property CursorY:Integer read GetCursorY;
  end;

procedure Register;

３００行を越えてしまうため、implementation 以下は次の発言に分割します。

               98/2/8(Sun) 00:32am [AirCraft 97開発] HHH02417 DUDE

Original document by DUDE            氏 ID:(PFF01344)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum