メッセージ受信専用ウィンドウ


redball.gif目次へ戻る

フック関数のインスタンス化 でも言及したが、ＶＣＬでは、MakeObjectInstance() と FreeObjectInstance() という関数を使って、ウィンドウ関数をインスタンス化すること、つまり、クラスのメソッドにすることに成功している。これをつかって、ウィンドウをつくる TWinConttrol の派生クラスでウィンドウ関数をインスタンス化しているのはもちろんだが、そのほかに、TClipboard や TDragObject、TTimer など、ウィンドウは作らないがメッセージを受け取りたい場合にも使われている。このような場合は、ダミーのウィンドウをつくってそのウィンドウ関数をメソッドとして持ち、それをメッセージの受け取り手段として使っている。この機構を関数にしたのが AllocateHWnd() と DeallocateHWnd() のペアである。

function AllocateHWnd(Method: TWndMethod): HWND

procedure DeallocateHwnd(Wnd: HWND);

AllocateHWnd() は、幅と高さがゼロでオーナーのないトップレベルウィンドウをつくって、MakeObjectInstance() をつかってそのウィンドウ関数を TWndMethod 型の Method にしてくれる。これで作られるウィンドウのクラス名は 'TPUtilWindow' であり、タスクバーに現れないように ExStyle に WS_EX_TOOLWINDOW が設定されている。TWndMethod 型は、

type TWndMethod = procedure(var Message: TMessage) of object;

となっている、クラスのメソッドである。DeallocateHwnd() は、AllocateHWnd() の返値であるウィンドウハンドルを設定して呼び出すと、そのウィンドウを破棄し、FreeObjectInstance() を使って、ウィンドウ関数をインスタンス化するために使っていたメモリを解放する。ちょっと試してみよう。Form1 に Button1、Button2、Label1, Label2 を置いて以下のようにする。コンパイルする前に、uses 節を見てほしい。わたしの Ｄ５では MakeObjectInstance() や AllocateHWnd() などは、Forms.pas にあるが、Ｄ６以降では、kylix との関係で Classes.pas に移されているらしい。警告がでないように Classes を uses 節の最後に持ってきて、Forms より先にコンパイラに認識させている。

List 1

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);    
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    AllocHandle:HWND;
    procedure WndMethod(var Msg:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  if AllocHandle = 0 then AllocHandle := AllocateHWnd(WndMethod);
  Randomize;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeallocateHwnd(AllocHandle);
  AllocHandle := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if AllocHandle <> 0 then SendMessage(AllocHandle,WM_APP+200,0,0);
end;

function GetClassNameStr(hWindow:HWND):string;
var
  p:PChar;
  ret:integer;
begin
  GetMem(p,100);
  ret := GetClassName(hWindow,p,100);
  SetString(result,p,ret);
  FreeMem(p);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hWindow:HWND;
begin
  Label1.Caption := GetClassNameStr(AllocHandle);
  hWindow := FindWindow(PChar(Label1.Caption),nil);
  Label2.Caption :=
     Format('AllocHandle : %d %sFindWindow : %d',[AllocHandle,#13,hWindow]);
end;

procedure TForm1.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = WM_APP+200 then
    Color := TColor(Random($1000000))
  else
    with Msg do
      Result := CallWindowProc(@DefWindowProc, AllocHandle, Msg, wParam, lParam);
end;

end.
n00701.gif

実行して、Button1 を押すと、Form1 の背景色がランダムに変更される。Button2 を押すと、ダミーウィンドウのクラス名とそれをつかって FindWindow() で見つけられるかをテストしている。右図のように、トップレベルウィンドウであるので見つけられることが分かる。


コードの説明はほとんどいらないと思うが、インスタンス化した WndMethod を見てみよう。

procedure TForm1.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = WM_APP+200 then
    Color := TColor(Random($1000000))
  else
    with Msg do
      Result := CallWindowProc(@DefWindowProc, AllocHandle, Msg, wParam, lParam);
end;

ここでは、Button1Click から送られた WM_APP+200 メッセージを受信して背景色を変更し、それ以外のメッセージでは Win32 の DefWindowProc に転送している。

このように、ダミーのウィンドウをつくって、インスタンス化したウィンドウ関数で任意のメッセージを受け取ることができる。これは、何の役に立つのだろうか？ TTimer のように、非ビジュアルコンポーネントでメッセージを受け取りたい場合などに非常に便利であることはすぐに分かるだろう。ここでは、ダミーウィンドウが FindWindow() でも見つかるようなトップレベルウィンドウであることを利用して、メッセージをつかったプロセス間通信を試みよう。すでに試したように AllocateHWnd() によって作られるウィンドウのクラス名は 'TPUtilWindow' となっている。このままでは、TTimer を使ったときとぶつかったりするので、AllocateHWnd() を見習って任意のクラス名を使えるようにしてみよう。

まず、ダミーウィンドウをつくってメッセージを受け取る方 (Receiver) のプログラムを以下に示す。

List 2

unit Main;

interface

uses
  Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Classes; // Classes を最後に！

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    AllocHandle:HWND;
    HogeHogeMsg:UINT;
    procedure WndMethod(var Msg:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function AllocMsgWnd(Method: TWndMethod; ClassName:string): HWND;
var
  DummyClass: TWndClass;
begin
  FillChar(DummyClass,SizeOf(TWndClass),#0);
  DummyClass.hInstance := hInstance;
  DummyClass.lpfnWndProc := @DefWindowProc;
  DummyClass.lpszClassName := PChar(ClassName);
  Windows.RegisterClass(DummyClass);

  Result := CreateWindowEx(WS_EX_TOOLWINDOW, DummyClass.lpszClassName,
    '', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result,GWL_WNDPROC,LongInt(MakeObjectInstance(Method)));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if AllocHandle = 0 then
    AllocHandle := AllocMsgWnd(WndMethod,'HogeHogeReceiver');
  HogeHogeMsg := RegisterWindowMessage('HogeHogeMessage');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeallocateHwnd(AllocHandle);
  AllocHandle := 0;
end;

procedure TForm1.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = HogeHogeMsg then
    case Msg.WParam of
      100:Color := clYellow;
      101:Color := clLime;
      102:Color := clFuchsia;
    else
      Color := clBtnFace;
    end
  else
    with Msg do
      Result := CallWindowProc(@DefWindowProc,AllocHandle,Msg,wParam,lParam);
end;

end.

つぎに、メッセージを送る方 (Sender) のプログラムを以下に示す。

List 3

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    HogeHogeMsg:UINT;
    procedure BtnClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BtnClick(Sender: TObject);
var
  hReceiver:HWND;
begin
  hReceiver := FindWindow('HogeHogeReceiver',nil);
  if hReceiver <> 0 then
    SendMessage(hReceiver,HogeHogeMsg,(Sender as TButton).Tag,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Tag := 100;
  Button1.Caption := 'Yellow';
  Button1.OnClick := BtnClick;

  Button2.Tag := 101;
  Button2.Caption := 'Lime';
  Button2.OnClick := BtnClick;

  Button3.Tag := 102;
  Button3.Caption := 'Fuchsia';
  Button3.OnClick := BtnClick;

  Button4.Tag := 103;
  Button4.Caption := 'Default';
  Button4.OnClick := BtnClick;

  HogeHogeMsg := RegisterWindowMessage('HogeHogeMessage');
end;

end.
n00702.gif

両方を実行して、Sender の方のボタンを押すと、Receiver のフォームの背景色がそのとおりに変更される。Sender が登録メッセージを送って wParam で色を指定し、Receiver がそれを受け取って背景色を wParam の指定どおりに変更しているのである。


Receiver のコードを見てみよう。AllocateHWnd() に相当しているのは、

function AllocMsgWnd(Method: TWndMethod; ClassName:string): HWND;
var
  DummyClass: TWndClass;
begin
  FillChar(DummyClass,SizeOf(TWndClass),#0);
  DummyClass.hInstance := hInstance;
  DummyClass.lpfnWndProc := @DefWindowProc;
  DummyClass.lpszClassName := PChar(ClassName);
  Windows.RegisterClass(DummyClass);

  Result := CreateWindowEx(WS_EX_TOOLWINDOW, DummyClass.lpszClassName,
    '', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result,GWL_WNDPROC,LongInt(MakeObjectInstance(Method)));
end;

である。ここでは、インスタンス化したいメソッドの他に、パラメータとしてダミーウィンドウのクラス名を設定できるようにしている。そして、そのクラス名で登録した後、ウィンドウをつくり、そのウィンドウ関数を MakeObjectInstance() でインスタンス化したポインタで入れ替えている。Receiver の FormCreate() イベントハンドラでは、これをつかって WndMethod をインスタンス化した後、

HogeHogeMsg := RegisterWindowMessage('HogeHogeMessage');

を実行して、システムにカスタムメッセージを割り当ててもらう。そして、

procedure TForm1.WndMethod(var Msg: TMessage);
begin
  if Msg.Msg = HogeHogeMsg then
    case Msg.WParam of
      100:Color := clYellow;
      101:Color := clLime;
      102:Color := clFuchsia;
    else
      Color := clBtnFace;
    end
  else
    with Msg do
      Result := CallWindowProc(@DefWindowProc,AllocHandle,Msg,wParam,lParam);
end;

で捕まえて、wParam の値にしたがって Form1 の背景色を変更している。Sender を見てみよう。FormCreate () で、複数の Button の Tag と Caption と OnClick イベントを初期化してから、同じ呪文をつかってカスタムメッセージのＩＤを割り当ててもらった後、

procedure TForm1.BtnClick(Sender: TObject);
var
  hReceiver:HWND;
begin
  hReceiver := FindWindow('HogeHogeReceiver',nil);
  if hReceiver <> 0 then
    SendMessage(hReceiver,HogeHogeMsg,(Sender as TButton).Tag,0);
end;

により、'HogeHogeReceiver' のクラス名を持つトップレベルウィンドウのハンドルを取得し、それにカスタムメッセージを送って、色の変更をさせている。

数値のプロセス間での受け渡しだけではおもしろくないので、上のプログラムをちょっと変更して文字列の受け渡しをためしてみよう。まず、Receiver の方のコードを以下に示す。

List 4

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    AllocHandle:HWND;
    procedure WndMethod(var Msg:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function AllocMsgWnd(Method: TWndMethod; ClassName:string): HWND;
var
  DummyClass: TWndClass;
begin
  FillChar(DummyClass,SizeOf(TWndClass),#0);
  DummyClass.hInstance := hInstance;
  DummyClass.lpfnWndProc := @DefWindowProc;
  DummyClass.lpszClassName := PChar(ClassName);
  Windows.RegisterClass(DummyClass);

  Result := CreateWindowEx(WS_EX_TOOLWINDOW, DummyClass.lpszClassName,
    '', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result,GWL_WNDPROC,LongInt(MakeObjectInstance(Method)));
end;   

procedure TForm1.FormCreate(Sender: TObject);
begin
  if AllocHandle = 0 then
    AllocHandle := AllocMsgWnd(WndMethod,'HogeHogeReceiver');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeallocateHwnd(AllocHandle);
  AllocHandle := 0;
end;

function GetWindowTextStr(hWindow:HWND):string;
var
  p:PChar;
  ret:integer;
begin
  ret := GetWindowTextLength(hWindow);
  GetMem(p,ret+1);
  ret := GetWindowText(hWindow,p,ret+1);
  SetString(result,p,ret);
  FreeMem(p);
end;

procedure TForm1.WndMethod(var Msg: TMessage);
begin
  with Msg do
    Result := CallWindowProc(@DefWindowProc,AllocHandle,Msg,wParam,lParam);
  case Msg.Msg of
    WM_SETTEXT:Label1.Caption := GetWindowTextStr(AllocHandle);
  end;
end;

end.

ほとんど前と同じであるが、WndMethod() だけが違う。先に、DefWindowProc() を実行してから、WM_SETTEXT のときだけ GetWindowTextStr() で文字列を取り出し Label1 に表示する。Sender を見てみよう。

List 5

unit Main;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  hReceiver:HWND;
  s:string;
begin
  hReceiver := FindWindow('HogeHogeReceiver',nil);
  if hReceiver = 0 then exit;
  s := Memo1.Lines.Text;
  SendMessage(hReceiver,WM_SETTEXT,0,LPARAM(PChar(s)));
end;

end.

ここでは、Memo1 のテキストを WM_SETTEXT で Receiver に送っている。

n00703.gif

実行結果を右図に示す。Sender の Button1 を押すと、期待通り Receiver の Label1 に文字列が現れる。Receiver で作るダミーウィンドウのクラス名をもっとややこしくして重複の可能性を排除すると、簡単にメッセージによるプロセス間通信ができることが分かった。これをコンポーネントにするともっと便利だろう。別稿で、メッセージによるプロセス間通信をやや詳しく調べる予定である。


redball.gif目次へ戻る