Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年05月08日] [更新 2012年08月24日]　Delphi サンプルプログラム集
673_自アプリ内の TRichEdit のリッチテキスト ( RTF ) 送受信
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
673_RichEdit_Stream.zip　[1,916 KB]　2012年08月24日版 (EXE 同梱)



  • 2012年08月24日
  • STREAMINを使用するコードを追加



自アプリ内でのリッチテキストの送受信


自アプリ、同じアプリケーション内の TRichEdit のテキストの全体または一部を、書式付き、つまりリッチテキストとして送信または受信するサンプルです。

テキストのみのコピーや貼り付けは、プロパティやメソッドでも操作可能です。書式付のコピーや貼り付けも専用のメソッドがあります。EM_XXX 関係のメッセージでも処理できます。
本ページのサンプルは、主にストリームを使用したコードとなっています。





01_TRichEdit のリッチテキストのコード


RTF 形式のテキストを、メモリストリームに保存し、それを TRichEdit で読み込むと書式付きのテキストとして表示することができます。この確認のテストです。もちろん、拡張子が RTF のファイルを、直接 TRichEdit に読み込めば書式付きのテキストとして表示できます。


図1
設計時画面
図2
[Button1] クリック
  • TMemo に RTF ファイルを読み込む
  • RTF 形式の文字列が表示される
図3
[Button2] クリック
  • TMemo の文字列をメモリストリームに格納
  • TRichEdit で、そのメモリストリームを読み込むと、書式付きテキストとして表示される

リスト1
RTF 形式のテキストの表示 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Splitter1: TSplitter;
    RichEdit1: TRichEdit;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.ScrollBars        := ssVertical;
  RichEdit1.ScrollBars    := ssBoth;
  RichEdit1.HideSelection := False;
end;

//=============================================================================
//  [Button1]クリック
//  リッチテキスト形式のテキストをTMemoに読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFilePath : String;
begin
  OpenDialog1.Filter := 'RTFファイル|*.RTF';
  if InitDir = '' then begin
    OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  end;
  if OpenDialog1.Execute then begin
    AFilePath := OpenDialog1.FileName;
    Memo1.Lines.LoadFromFile(AFilePath);
  end;
end;

//=============================================================================
//  [Button2]クリック
//  Memo1に表示しているリッチテキストのコードをストリームに格納
//  RichEditで、そのストリームを読み込むと、書式付きのテキストとして表示される
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AStream : TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try
    Memo1.Lines.SaveToStream(AStream);

    RichEdit1.Clear;
    AStream.Position := 0;
    RichEdit1.Lines.LoadFromStream(AStream);
  finally
    AStream.Free;
  end;
end;

end.



02_EM_STREAMOUT と EM_STREAMIN メッセージによる送受信


TRichEdit のリッチテキストを、他の TRichEdit のリッチテキストとして送信、転送します。
EM_STREAMOUT メッセージを使用します。このメッセージのコールバック関数内で送信元のリッチテキストをメモリストリームに格納します。受信側の TRichEditでは、EM_STREAMIN メッセージで、このメモリストリームを読み込みます。

クリップボードは使用しません。選択範囲だけの転送や、受信側では、挿入モードで受信可能なようにしてみました。
もし、常に全てのリッチテキストを転送するのであれば、EM_STREAMOUT メッセージを使用する必要はあません。また、受信する TRichEdit 側も、全てを受け取り、上書きモードでいいのであれば、次のコードのように、単にメモリストリームを仲介するだけで済みます。必要に応じて CopyFrom 等の関数類も使用できます。

リスト2
リッチテキストを他の TRichEdit に代入 
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
 FStream : TMemoryStream;
begin
  FStream := TMemoryStream.Create;
  try
    //RichEdit1のリッチテキストをFStreamに格納
    FStream.Position := 0;
    RichEdit1.Lines.SaveToStream(FStream);

    //FStreamの内容をRichEdit2に読み込む
    FStream.Position := 0;
    RichEdit2.Lines.LoadFromStream(FStream);
  finally
    FreeAndNil(FStream);
  end;
end;

図4
設計時画面
  • 上が送信元の RichEdit
  • 下が受信側の RichEdit
図5
[読み込み] ボタンをクリック
  • RTF ファイルを選択して表示
  • 図は添付の RTF ファイルを開いたところ
図6
[転送] ボタンをクリック
  • 下の RichEdit に全て転送される
  • [挿入で受信] をチェックすると、受信側では、受信した RTF 文書を現在のカーソル位置に挿入することができる
  • 送信側の選択部分だけを挿入することもできる
図7
選択範囲の転送
  • 任意の範囲を選択
  • [転送] ボタンをクリック
  • 選択範囲だけが、下の RichEdit に表示

このサンプルでは、複数のリッチテキストを結合するテストもできます。
通常、リッチテキストの文書は、単純にストリームに続けて格納しただけでは、複数のリッチテキストをまとめて 1 つの文書にはできません。
  • (1) [読み込み] ボタンでリッチテキストの文書を読み込む
  • (2) [転送] ボタンをクリックすると、下の TRichEdit にその文書が表示される
  • (3) [読み込み] ボタンで、別のリッチテキスト文書を読み込む
  • (4) [挿入で受信] をチェックして、[転送] ボタンをクリックする
の手順で操作します。
下の TRichEdit の文書が 1 つの文書となっていることが確認できます。もちろん、選択部分だけを挿入することもできます。
最初にリッチテキスト文書を送信すると、受信側の入力位置、つまりカーソルは、文書の最後尾になります。ここが挿入位置となります。


リスト3
EM_STREAMOUT と EM_STREAMIN メッセージを使用したリッチテキストの送受信 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, StdActns, Buttons;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    Splitter1: TSplitter;
    RichEdit2: TRichEdit;
    OpenDialog1: TOpenDialog;
    SpeedButton1: TSpeedButton;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses RichEdit;

{$R *.dfm}

var
  FStream    : TMemoryStream;
  FStreamRec : TEditStream;

//-----------------------------------------------------------------------------
//  EM_STREAMINメッセージで使用するコールバック関数
//  FStreamからリッチテキストのデータを取得
//  このコールバック関数は、複数回実行されることがある(データサイズによる)
//-----------------------------------------------------------------------------
function EditStreamCallBackStreamIn(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): Longint; stdcall;
begin
  try
    pcb := FStream.Read(pbBuff^, cb);
    Result:= 0;
  except
    Result := 1;
  end;
end;

//-----------------------------------------------------------------------------
//  EM_STREAMOUTメッセージで使用するコールバック関数
//  FStreamにリッチテキストのデータが格納される
//  このコールバック関数は、複数回実行されることがある(データサイズによる)
//-----------------------------------------------------------------------------
function EditStreamCallBackStreamOut(dwCookie: Longint; pbBuff: PByte;
    cb: Longint; var pcb: Longint): Longint; stdcall;
begin
  try
    pcb := FStream.Write(pbBuff^, cb);
    Result:= 0;
  except
    Result := 1;
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//  リッチテキストデータ格納用のTMemoryStreamを作成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.ScrollBars    := ssBoth;
  RichEdit2.ScrollBars    := ssBoth;
  RichEdit1.HideSelection := False;
  RichEdit2.HideSelection := False;

  FStream := TMemoryStream.Create;
end;

//=============================================================================
//  フォームのOnDestroyイベント処理
//  リッチテキストデータ格納用のTMemoryStreamを破棄
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FStream);
end;

//=============================================================================
//  [読み込み]ボタンクリック
//  リッチテキスト形式のテキストをRichEdit1に読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFilePath : String;
begin
  OpenDialog1.Filter := 'RTFファイル|*.RTF';
  if InitDir = '' then begin
    OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  end;
  if OpenDialog1.Execute then begin
    AFilePath := OpenDialog1.FileName;
    RichEdit1.Lines.LoadFromFile(AFilePath);
    RichEdit1.SetFocus;
  end;
end;

//=============================================================================
//  [転送]ボタン
//
//  RichEdit1の内容をRichEdit2へ送信
//  受信側でEM_STREAMINメッセージを使用してFStreamから取得するコード
//  FStreamRec(TEditStream)の使用には、usesにRichEditが必要
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  Flags : Integer;
begin
  //選択中のテキストがあれば、選択部分のみ送信
  if RichEdit1.SelText = '' then begin
    Flags := SF_RTF;
  end else begin
    Flags := SF_RTF or SFF_SELECTION;
  end;

  //送り側のリッチテキストをEM_STREAMOUTメッセージを使用してFStreamに格納
  FStream.Clear;
  FStreamRec.pfnCallback := @EditStreamCallBackStreamOut;
  //RichEdit1.Perform(EM_STREAMOUT, Flags, LPARAM(@FStreamRec));でも同じ
  SendMessage(RichEdit1.Handle, EM_STREAMOUT, Flags, LPARAM(@FStreamRec));


  //受信側のリッチテキストでEM_STREAMINメッセージを使用してFStreamから取得
  //メモリストリームの位置を先頭に
  FStream.Position := 0;

  //フラグの設定
  //SFF_SELECTIONは挿入モードで受け取る設定
  if CheckBox1.Checked then begin
    Flags := SF_RTF or SFF_SELECTION;
  end else begin
    Flags := SF_RTF;
  end;
  FStreamRec.pfnCallback := @EditStreamCallBackStreamIn;
  //RichEdit2.Perform(EM_STREAMIN, Flags, LPARAM(@FStreamRec));でも同じ
  SendMessage(RichEdit2.Handle, EM_STREAMIN, Flags, LPARAM(@FStreamRec));
end;

end.


もし、送信側のリッチテキストの全てを受信側に送るのであれば、EM_STREAMOUT メッセージを使用する必要はありません。リスト2 のように単にメモリストリームに格納するだけです。
次のコードは、送信側の全てのリッチテキスト文書を、受信側で挿入モードで受け取ります。したがって、メモリストリームに格納する送信側のリッチテキストを変更して、ループ処理すれば、複数のリッチテキスト文書を結合することができます。FStream (TMemoryStream) はグローバル変数にしておく必要があります。

リスト4
送信側の全てのリッチテキストを送信し、受信側では挿入モードで受け取る場合 
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  Flags : Integer;
begin
  //送り側のリッチテキストをFStreamに格納
  FStream.Clear;
  RichEdit1.Lines.SaveToStream(FStream);


  //受信側のリッチテキストでEM_STREAMINメッセージを使用してFStreamから取得
  //メモリストリームの位置を先頭に
  FStream.Position := 0;

  //受信側では常に挿入モードで受信する場合のフラグ
  Flags := SF_RTF or SFF_SELECTION;

  FStreamRec.pfnCallback := @EditStreamCallBackStreamIn;
  //RichEdit2.Perform(EM_STREAMIN, Flags, LPARAM(@FStreamRec));でも同じ
  SendMessage(RichEdit2.Handle, EM_STREAMIN, Flags, LPARAM(@FStreamRec));
end;



03_ [ コピー ] [ 貼り付け ] [元に戻す] 機能の実装  -  TActionManager


RichEdit 間の送受信は、クリップボードを使用した、コピー、貼り付け操作でも可能です。
例えば次のコードは、RichEdit1 の全てを、RichEdit2 に転送します。選択範囲だけをコピーするのであれば、SelectAll は要りません。

リスト5
クリップボードを使用したリッチテキストの送信 
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  RichEdit1.SelectAll;
  RichEdit1.CopyToClipboard;
  RichEdit2.PasteFromClipboard;
end;

本題からはそれますが、TRichEdit のような入力関係コントロールに [コピー] や [貼り付け] 機能を実装するには、TActionListやTActionManager コンポーネントを使用すると便利です。

次の図は、TActionManager の設定画面です。[標準アクションの新規追加]で、[編集] で項目を選択すると、フォームに配置したボタン類、あるいは、TPopupMenu の Action プロパティに、該当する Action を設定するだけで、それらの機能が使用可能となります。


  • 図8
  • アプリケーションに [コピー] や [貼り付け] 機能を実装する

TActionMamager コンポーネントを使用した、[コピー] と [貼り付け] 機能のテストです。
設計時には、SpeedButton の Caption は設定していません。実行時に TActionManager コンポが自動で設定します。もちろん、変更も可能です。また、ボタンクリックのイベントは必要ありません。


図9
設計時画面
図10
[読み込み] ボタンをクリック
  • RTFファイルを選択して表示
図11
RichEdit1 にフォーカス移動
  • RichEdit11 にフォーカス移動してから
  • [全て選択] をクリック
  • [コピー] をクリック
図12
RichEdit2 にフォーカス移動
  • RichEdit2 (下) にフォーカスを移動
  • [貼り付け] をクリック

リスト6
[コピー] や [貼り付け] [元に戻す] 機能のテスト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, StdActns, ActnMan, Buttons,
  ActnList, PlatformDefaultStyleActnCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    Splitter1: TSplitter;
    RichEdit2: TRichEdit;
    OpenDialog1: TOpenDialog;
    ActionManager1: TActionManager;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    EditSelectAll1: TEditSelectAll;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    EditUndo1: TEditUndo;
    SpeedButton4: TSpeedButton;
    FileOpen1: TFileOpen;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  RichEditにフォーカスを持たせたいのでTSpeedButtonを使用
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //実際にはオブジェクト・インスペクタで設定できる
  RichEdit1.ScrollBars    := ssBoth;
  RichEdit2.ScrollBars    := ssBoth;
  RichEdit1.HideSelection := False;
  RichEdit2.HideSelection := False;

  //各スピードボタンにActionを割当て
  //実際にはオブジェクト・インスペクタで設定できる
  SpeedButton1.Action := EditSelectAll1;
  SpeedButton2.Action := EditCopy1;
  SpeedButton3.Action := EditPaste1;
  SpeedButton4.Action := EditUndo1;
end;

//=============================================================================
//  [読み込み]ボタンクリック
//  リッチテキスト形式のテキストをRichEdit1に読み込んで表示
//
//  ファイルを開くも標準アクション[ファイル][TFileOpne]で設定可能
//  それを使用すれば以下のコードも不要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  AFilePath : String;
begin
  OpenDialog1.Filter := 'RTFファイル|*.RTF';
  if InitDir = '' then begin
    OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  end;
  if OpenDialog1.Execute then begin
    AFilePath := OpenDialog1.FileName;
    RichEdit1.Lines.LoadFromFile(AFilePath);
    RichEdit1.SetFocus;
  end;
end;

end.