デバッグウィンドウ？！

redball.gif目次へ戻る

API with VCL のところの 第２,３章 コントロールのメッセージ処理 のコード例のように、わたしは処理途中の結果や解析結果やデバッグのために、TMemo への出力を多用している。その他に MessageBeep() もよく利用する。このような用途では、ShowMessage() を利用する方をよく見かけるが、モーダルフォームの表示はメッセージ処理機構を大幅に乱すので、あきらかに好ましくない。TMemo への出力はShowMessage() より、表示能力の点でも、メッセージ処理を乱さないことの観点からも優れている。しかし、解析や調査ならともかく、本格的なアプリを開発しているときに TMemo をフォームに貼り付けることは、その余地があったとしても、フォームの形を乱し、また、Memo1.Lines.Add() と書くのも冗長であるし、最後の仕上げのときに取り外すのも面倒である。ここでは、自前のデバッグウィンドウを作り、簡単なコマンドで出力できるようなユニットファイルを作ってみよう。

自前のデバッグウィンドウは、VCL を使うとすると TForm に TMemo の Align プロパティーを alClient にして貼り付けると一瞬にして作ることができる。しかし、この場合は *.dfm ファイルが必要になるし、取り外すのが面倒になる。ここでは、ユニットファイルを単独で使用するだけでこの機能を実現するために、SDK 方式で同様のウィンドウを作成する。と言っても、API のところの 第１章 窓をあければ と 第１２章 エディットとメモ のところのコードを少し変更するだけでできあがる。以下にその DebugWndUnit.pas の全リストをしめす。

List 1

unit DebugWndUnit;

interface

uses
  Windows, Messages, Forms, Graphics;

const
  DClear:Char = #1;
  DClose:Char = #2;
  DBeep:Char  = #3;

var
  hDebugWnd:HWND;
  hDebugMemo:HWND;

procedure DOut(const Value:string);

implementation

var
  Fnt:TFont;

function DebugWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  r:TRect;
begin
  Result := 0;

  case Msg of

    WM_CREATE:begin
      hDebugMemo := CreateWindowEx(WS_EX_CLIENTEDGE,
                          'EDIT',
                          '',
                          $54210044 or ES_NOHIDESEL or ES_READONLY,
                          0,0,0,0,
                          hWindow,
                          1234,
                          hInstance,
                          nil);
      Fnt := TFont.Create;
      Fnt.Name := 'ＭＳ ゴシック';
      SendMessage(hDebugMemo,WM_SETFONT,Fnt.Handle,1);
    end;

    WM_SIZE:begin
      GetClientRect(hWindow,r);
      SetWindowPos(hDebugMemo,0,0,0,r.Right,r.Bottom,SWP_NOMOVE or SWP_NOZORDER);
    end;

    WM_DESTROY:begin
      hDebugWnd := 0;
      Fnt.Free;
    end;

  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    exit;
    end;

  end; // case

end;

procedure CreateDebugWnd;
var
  wc: TWndClass;
begin
  wc.lpszClassName   := 'MyDebugWnd';
  wc.lpfnWndProc     := @DebugWndProc;
  wc.style           := CS_VREDRAW or CS_HREDRAW;
  wc.hInstance       := hInstance;
  wc.hIcon           := LoadIcon(0,IDI_APPLICATION);
  wc.hCursor         := LoadCursor(0,IDC_ARROW);
  wc.hbrBackground   := (COLOR_WINDOW+1);
  wc.lpszMenuName    := nil;
  wc.cbClsExtra      := 0;
  wc.cbWndExtra      := 0;

  RegisterClass(wc);

  hDebugWnd := CreateWindowEx(WS_EX_CONTROLPARENT or WS_EX_WINDOWEDGE,
                          'MyDebugWnd',
                          'DebugWnd',
                          WS_VISIBLE or WS_CLIPSIBLINGS or
                          WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW,
                          0,0,
                          300,200,
                          Application.Handle,
                          0,
                          hInstance,
                          nil);

   ShowWindow(hDebugWnd,CmdShow);
   UpDateWindow(hDebugWnd);
end;

procedure Confirm;
begin
  if hDebugWnd = 0 then CreateDebugWnd;
end;

procedure Clear;
var
  s:string;
begin
  s := '';
  SendMessage(hDebugMemo,WM_SETTEXT,0,LPARAM(PChar(s)));
end;

procedure AddALine(const Value:string);
var
  s:string;
begin
  s := value+#13#10;
  SendMessage(hDebugMemo,EM_REPLACESEL,0,LPARAM(PChar(s)));
end;

procedure DOut(const Value:string);
begin
  Confirm;
  case Byte(Value[1]) of
    1:Clear;
    2:DestroyWindow(hDebugWnd);
    3:MessageBeep($FFFFFFFF);
  else
    AddALine(Value);
  end;
end;

end.

このユニットの interface 部を見ると分かるように、他のユニットから見えるのは、三つの Char 型の定数と二つのウィンドウハンドルと DOut( ) 手続きだけである。このユニットファイルをプログラムを保存しているディレクトリにコピーし、uses 節に加えるだけで使用できるようになる。あとで取り外すためには、「プロジェクトに追加」をしない方がよいだろう。それではさっそくこのユニットを使用して、Form1 が生成されるときのイベントハンドラが呼び出される順序を調べてみよう。以下にその全リストを示す。

[館長注]　Doutの引数Valueが空文字の場合例外が発生する。空文字の時の処理を追加してもいいかも知れないが、空文字であると、その部分の通過確認ができないので要注意。

List 2

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 FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  DebugWndUnit;

procedure TForm1.FormActivate(Sender: TObject);
begin
  DOut('Activate');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DOut('Create');
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DOut('Paint');
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  DOut('Resize');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  DOut('Show');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DOut('これは出力テストです');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DOut(DClear);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  DOut(DBeep);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  DOut(DClose);
end;

end.
n01301.gif

実行結果を右図に示した。Button1 を押すと、文字列を一行出力する。Button2 を押すとメモがクリアされる。Button3 を押すとシステムブザーが鳴る。Button4 を押すとデバッグウィンドウが閉じて破棄される。再び、Button1 を押すと一行だけ表示されたデバッグウィンドウが新たに生成されて表示される。アプリが終了すると自動的にデバッグウィンドウも破棄される。


n01302.gif

以上のように、非常に簡単に文字列を表示するウィンドウを動的に作成することができた。リリースバージョンでは、右図のように DOut の部分を //DOut に IDE のエディタで全置換してコメントアウトするとすぐに取り外すことができる。復活するときは逆に置換する。


コードを見てみよう。デバッグウィンドウが無い状態で最初に DOut( ) が実行されたときに Confirm( ) から CreateDebugWnd が呼び出されてウィンドウが作られる。

procedure Confirm;
begin
  if hDebugWnd = 0 then CreateDebugWnd;
end;

このウィンドウは Application ウィンドウの Owned ウィンドウとして作成されるので、ウィンドウとしての動作は、Form2 などと同じである。このウィンドウのウィンドウ関数で WM_CREATE を受け取ったときに Memo が作られる。DOut() では、通常は文字列を AddALine() でこのメモに出力する。

procedure DOut(const Value:string);
begin
  Confirm;
  case Byte(Value[1]) of
    1:Clear;
    2:DestroyWindow(hDebugWnd);
    3:MessageBeep($FFFFFFFF);
  else
    AddALine(Value);
  end;
end;

コマンドは、interface 部の定数定義のように ASCII テーブルの制御文字に相当する定数を最初の Char として受け取ったときに実行される。これは #1 から #31 までで、この部分は２バイト文字の最初の１バイト部分とも重なっていないので、このようにコマンドとして使える。しかし、#10 と #13 は、改行文字なので使わない方がいいだろう。 ウィンドウ関数では、WM_SIZE メッセージを捕まえてウィンドウのクライアント領域にメモのサイズを追随させている。WM_DESTROY ではハンドルをゼロにして、フォントの設定につかった TFont のインスタンスを破棄している。このように、DOut() を一度も使わなければ、このユニットを uses しても、一つもコードが実行されないので安心である。

うーむ、このユニットファイルは便利に使えるだろうか？ こんなのいらない、と思う人がいても不思議ではないが、わたしには便利に使えそうである。

redball.gif目次へ戻る