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







他のアプリへの TRichEdit のリッチテキスト送信


開発者が,コーディングできない,他のアプリの TRichEdit に,自アプリのリッチテキストを送信するテストプログラムです.
クリップボードを使用しない方法は,EM_SETTEXTEX メッセージで,ストリームの内容を共有メモリを介して送信します.

Windows Vista 以降では,メッセージの受信は,UIPI (ユーザーインターフェイス特権の分離の機能) の影響を受けます.したがって,受信側のアプリが管理者権限で実行されている場合,送信側の自アプリも管理者権限で実行していないと,受信側では受信できません.
デバッグ時は,自アプリは管理者権限で実行していることになるので問題ありませんが,作成した EXE を直接実行する場合は注意が必要です.

これは,受信側の問題なので,本ページのサンプルのように,開発者が修正できない他のアプリの場合は,対応策はありません.





01_クリップボードを使用した送信


クリップボードを使用して,TRichEdit のテキストを,書式を含めて他のアプリに送信します.


図1
設計時画面
  • 右が自アプリ
  • 左が他のアプリ.[TargetApp] フォルダ内にある
図2
起動して RT F読み込み
図3
[送信] ボタンをクリック

リスト1
クリップボード経由で,他のアプリの TRichEdit にリッチテキストを貼り付け
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.ScrollBars    := ssBoth;
  RichEdit1.HideSelection := False;
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のリッチテキストを他のアプリのRichEditに送信
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  Flags      : Integer;
  hTargetApp : HWND;
  hRich      : HWND;
  StrSize    : Cardinal;
  StrText    : AnsiString;
begin
  //受信側のアプリのハンドルを取得
  hTargetApp := FindWindow(nil, 'TargetForm');
  if hTargetApp = 0 then exit;

  //受信側のRichEditのハンドルを取得
  hRich := FindWindowEx(hTargetApp, 0, 'TRichEdit', 0);
  if hRich = 0 then exit;

  //選択中のテキストがあるか調査
  //あるときは,選択中のリッチテキストのみを対象とする
  if RichEdit1.SelText = '' then begin
    RichEdit1.SelectAll;
  end;
  //RichEdit1の内容をクリップボードに格納
  RichEdit1.CopyToClipboard;

  //受信側のRichEditのテキストをクリア
  SendMessage(hRich, WM_SETTEXT, 0, LPARAM(nil));
  //クリップのデータを貼り付けるメッセージを送る
  SendMessage(hRich, WM_PASTE, 0, 0);
end;

end.




02_クリップボードを使用しない送信


リッチテキストの場合,プレーンテキストだけであれば,[670_他のアプリへ文字列送信と取得] の方法が利用できますが,リッチテキストの場合は,共有メモリを介して通信する必要があります.
次のコードは,他のアプリの RichEdi tのリッチテキストを,クリップボードを使用しないで送信するサンプルです.手順としては,
  • (1) 自アプリの TRichEdit に EM_STREAMOUT メッセージを送信
  • (2) EM_STREAMOUT のコールバック関数内で,リッチテキストをストリームに保存
  • (3) 保存したストリームの内容を共有メモリに格納
  • (4) EM_SETTEXTEX メッセージで,他のアプリの TRichEdit に送信
となります.共有メモリの操作には,Halbow 資料館の [第8章 他のアプリのウィンドウ情報の取得 - 共有メモリ] のユニットを使用しています.EM_SETTEXTEX メッセージの定義は,Delphi XE にはないので,関係する構造体も含めて定義しています.定数は,Microsoft SDK の値を使用しています.

テキストが選択されていない状態の場合は,全てのテキストを送信し,選択されている場合は,選択されているテキストのみを送信します.この機能を実装するために,EM_STREAMOUT メッセージを使用しています.


図4
起動画面
  • 起動して,[ファイル] でリッチテキストを表示
  • [TargetApp] フォルダ内にある TargetApplication.exe を起動
図5
[転送] ボタンクリック
図6
選択範囲のみの転送
  • 自アプリの選択状態は解除

リスト2
自アプリのリッチテキストを,他のアプリに送信
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses CommonMemoryUnit;

{$R *.DFM}

type
  PSetTextEx = ^TSetTextEx;
  tagSetTextEx = record
    flags : DWORD;
    codepage : UINT;
  end;
  TSetTextEx = tagSetTextEx;
  SETTEXTEX = tagSetTextEx;

const
  EM_SETTEXTEX = WM_USER + 97;
  ST_DEFAULT   = 0;
  ST_KEEPUNDO  = 1;
  ST_SELECTION = 2;
  ST_NEWCHARS  = 4;
  ST_UNICODE   = 3;

var
  FStreamRec : TEditStream;
  FStream    : TStringStream;

//-----------------------------------------------------------------------------
//  EM_STREAMOUTメッセージ用コールバック関数
//-----------------------------------------------------------------------------
function EditStreamCallBack(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;

//=============================================================================
//  リッチテキストファイルを読み込んでTRichEditで表示
//=============================================================================
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);
  end;
end;

//=============================================================================
//  他のTRichEditにクリップボードを使用しないでリッチテキストを転送
//
//  EM_SETTEXTEXメッセージを使用
//  Delphi XEには定義がないので,必要な構造体とともに定義して使用
//
//  Halbow資料館の共有メモリクラスCommonMemoryUnitを利用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  Flags      : Integer;
  hTargetApp : HWND;
  hRich      : HWND;
  SetTextRec : TSetTextEx;
  CM         : TCommMemNT;
  CMRec      : TCommMemNT;
  StrSize    : Cardinal;
  StrText    : AnsiString;
begin
  //受信側のアプリのハンドルを取得
  hTargetApp := FindWindow(nil, 'TargetForm');
  if hTargetApp = 0 then exit;

  //受信側のRichEditのハンドルを取得
  hRich := FindWindowEx(hTargetApp, 0, 'TRichEdit', nil);
  if hRich = 0 then exit;

  //TStringStreamを作成してEM_STREAMOUTで使用するフラグを設定
  FStream := TStringStream.Create('');
  if RichEdit1.SelLength = 0 then begin
    Flags := SF_RTF or SFF_PLAINRTF;
  end else begin
    Flags := SF_RTF or SFF_PLAINRTF or SFF_SELECTION;
  end;
  //EM_STREAMOUTで使用するコールバック関数を指定して処理
  //コールバック関数か戻ると,FStreamにリッチテキストが格納されている
  FStreamRec.pfnCallback := @EditStreamCallBack;
  RichEdit1.Perform(EM_STREAMOUT, Flags, Longint(@FStreamRec));

  //ストリームのデータを文字列にしてAnsiString型に変換
  //EM_SETTEXTEXの引数はAnsiStringでなければならない
  StrText := AnsiString(FStream.DataString);
  StrSize := Length(StrText);

  //共有メモリクラスを生成
  CM    := TCommMemNT.Create(hTargetApp, StrSize);
  CMRec := TCommMemNT.Create(hTargetApp, 100);
  try
    //共有メモリに転送データを格納
    CM.Write(0, Pointer(StrText), StrSize);

    //転送フラグを設定
    //flagsの値によって受信側の貼り付け動作が異なる(上書きとか挿入とか)
    SetTextRec.flags    := ST_DEFAULT;
    SetTextRec.codepage := CP_ACP;
    CMRec.Write(0, @SetTextRec, SizeOf(SetTextRec));
    //転送メッセージ実行
    SendMessage(hRich, EM_SETTEXTEX, WPARAM(CMRec.MemPtr), LPARAM(CM.MemPtr));
  finally
    CM.Free;
    CMRec.Free;
    FStream.Free;
  end;
end;

end.