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.

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.