unit CoupledInputUnit;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    Button1: TButton;
    Button2: TButton;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RichEdit2Enter(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FOriginalProc : TWndMethod;
    procedure SubClassProc(var Msg:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  スクロールバーを表示する場合は予め表示しておかないと，スクロールバーの表
//  示位置が乱れてしまうようだ．
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Clear;
  RichEdit2.Clear;

  RichEdit1.HideScrollBars := False;
  RichEdit2.HideScrollBars := False;

  RichEdit1.ScrollBars := ssVertical;
  RichEdit2.ScrollBars := ssVertical;

  RichEdit1.HideSelection := False;
  RichEdit2.HideSelection := False;
end;

//=============================================================================
//  アプリ終了時
//  RichEdit1のウィンドウプロシージャーを変更していたら元に戻す
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Assigned(FOriginalProc) then begin
    RichEdit1.WindowProc := FOriginalProc;
  end;
end;

//=============================================================================
//  [連動入力開始]
//  RichEdit1のウィンドウプロシージャーをSubClassProcというメソッドに変更する
//  RichEdit1の新しいWindowProc(SubClassProc)を定義してからSetFocusしてしまう
//  と都合が悪い．
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit1.SetFocus;

  FOriginalProc := RichEdit1.WindowProc;
  RichEdit1.WindowProc := SubClassProc;
end;

//=============================================================================
//  [連動入力停止]
//  RichEdit1のウィンドウプロシージャーを元に戻す
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Assigned(FOriginalProc) then begin
    RichEdit1.WindowProc := FOriginalProc;
    RichEdit1.SetFocus;
  end;
end;

//=============================================================================
//  RichEdit1の新しいウィンドウプロシージャー
//  ここでは全てのメッセージをRichEdit2に送っている．
//=============================================================================
procedure TForm1.SubClassProc(var Msg: TMessage);
begin
  FOriginalProc(Msg);

  //RichEdit2.Perform(Msg.Msg, Msg.WParam, Msg.LParam);でも同じ
  SendMessage(RichEdit2.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

//=============================================================================
//  RichEdit2にフォーカスが移動したら連動入力を止める
//  SubClassProc内で全てのメッセージを処理してしまっているので，RichEdit1の
//  OnExitでは連動入力を停止することはできない．
//=============================================================================
procedure TForm1.RichEdit2Enter(Sender: TObject);
begin
  if Assigned(FOriginalProc) then begin
    RichEdit1.WindowProc := FOriginalProc;
  end;
end;

end.