第23章 ダイアログボックスの研究 その1

ダイアログボックスはメニューの次に重要なユーザインタフェースである。 アプリケーションは、ダイアログボックスを表示することにより、 メニューより複雑な操作を通してユーザと対話することができる。この章と次章では、ダイアログボックスについて調べよう。

DelphiVCLを使ったRADプログラミングでは、メインフォーム以外の新しいフォームをつくって、そのフォームの Show または ShowModal メソッドにより表示してダイアログボックスとしている。したがって、メインフォームとダイアログボックスのフォームには、本質的な差がない。逆に言えば、全てのフォームがダイアログボックスであるとも言える。 実際、デフォルトでつくられる TForm1 のインスタンスについて4−1 クラス情報とウィンドウ情報 で調べたように、 Form1Application ウィンドウに所有された(owned) ウィンドウである。 ’所有された' ということは、 オーナーウィンドウより必ず手前に表示され、オーナーが破棄されるときは道連れになることを意味している。

Win32 のコードベースのプログラミングでは、ダイアログボックスの本質は WS_POPUP スタイルを含む '所有された' ポップアップウィンドウである。 したがって、コードで CreateWindowEx( ) APIを使ってゼロからつくることができる。 しかし、ボタンやリストボックスをゼロからつくることがないように、ダイアログボックスを汎用のポップアップウィンドウとしてつくることは稀である。 実は、ボタンやリストボックスやエディットなどの標準コントロールと同じように、ダイアログボックス自体が Win32 の定義済みクラスなのである。 筆者は、これを知って驚いたことを覚えている。標準コントロールは、その各々が使用目的が限定された子ウィンドウであることから、システムがユーザインタフェースを統一するために定義済みのクラスとしてプログラマに提供する、という考え方は納得できるものだろう。 しかし、ダイアログボックスは、アプリケーションによって、非常に広い用途があり、単一のクラスとして定義できるようにするとは考えられないことだ。 事実、そのとおりであり、標準コントロールとは違って 'DIALOGBOX' という名前のクラスがあるわけではない。 その代わりに、本章で示すように、ダイアログボックスは、普通のウィンドウとは違った方法でつくり、メッセージの処理もウィンドウ関数ではなくダイアログ関数で処理する、という独特の方法を用いることを強制する。このように、Win32 には、ダイアログボックスをつくる仕組みとそれを制御するための多数のAPI関数がある。 汎用のウィンドウではなく、定義済みのクラスであるという意味は、まさしく、「ダイアログボックスクラス」のインスタンスを特別の仕組みでつくり、特別の関数で制御する方法に反映されているのである。

23−0 この章の内容

第23章 ダイアログボックスの研究 その1
23−1 モーダルダイアログボックスをつくる
23−2 ラッパーコントロールを使う
23−3 モーダルループについて考える
23−4 ダイアログテンプレートレコードを使う
23−5 モーダルダイアログクラス
23−6 さまざまなスタイル
23−7 まとめ


| arrw18c.gif 前の章へ | 総目次へ | 次の章へ arrw18d.gif

23−1 モーダルダイアログボックスをつくる

ダイアログボックスには、モード付き(モーダル:Modal)とモードなし(モードレス:Modeless)の二種類があることはご存じであろう。 本稿でこれまでにあつかった ChooseFont( )GetOpenFilename( )GetSaveFilename( ) で表示されるコモンダイアログは、すべてモーダルダイアログボックスである。 また、骨格プログラムの 'About...' メニューで、MessageBox( ) 関数を使って表示していたダイアログボックスもモーダルである。 モーダルダイアログボックスは、それを閉じない限り、そのアプリケーションの他のウィンドウにアクセスできない。 これに対して、 ペイントのツールボックスやメモ帳の「検索」コモンダイアログは、表示中でも他のウィンドウにアクセスできるモードレスダイアログである。 この節から以降しばらくの間、モーダルダイアログボックスについて調べることにする。

モーダルダイアログボックスをつくるAPIは、次の四つである。

function DialogBox(hInstance: HINST; 
                  lpTemplate: PChar;
                  hWndParent: HWND; 
                lpDialogFunc: TFNDlgProc): Integer;
                
function DialogBoxParam(hInstance: HINST; 
                   lpTemplateName: PChar;
                       hWndParent: HWND; 
                     lpDialogFunc: TFNDlgProc; 
                      dwInitParam: LPARAM): Integer; stdcall;
                      
function DialogBoxIndirect(hInstance: HINST; 
              const lpDialogTemplate: TDlgTemplate;
                          hWndParent: HWND; 
                        lpDialogFunc: TFNDlgProc): Integer;
                        
function DialogBoxIndirectParam(hInstance: HINST; 
                   const lpDialogTemplate: TDlgTemplate;
                               hWndParent: HWND; 
                             lpDialogFunc: TFNDlgProc; 
                              dwInitParam: LPARAM): Integer; stdcall;

全ての関数に共通なパラメータ hInstance には、そのプロセスのインスタンスハンドルを設定する。Delphi では、デフォルトグローバル変数「 hInstance 」を設定する。hWndParent には、このダイアログのオーナーとなるウィンドウのハンドルを設定する。lpDialogFunc には、ダイアログボックスからのメッセージを処理する「ダイアログ関数」のアドレスを設定する。ダイアログ関数の型である TFNDlgProcWindows.pas

type
  TFarProc = Pointer; 
  TFNDlgProc = TFarProc;

と定義されているので、単なる型なしポインタであるが、Win32.hlp で調べると以下のような形の関数へのポインタであることが分かる。

function DialogFunc(hDialog: HWnd;
                        Msg: UINT; 
                     WParam: WPARAM;
                     LParam: LPARAM): Bool; stdcall;

これを見ると分かるように、パラメータは普通のウィンドウ関数と全く同じだ。 しかし、その戻り値の型が Bool であることが違っている。 上に述べたように、ダイアログボックスは標準コントロールと同じ Win32 の定義済みクラスである。したがって、マイクロソフトの社員でないとそのウィンドウ関数のソースを見ることはできない。 その代わりに、プログラマが自分でサブクラス化しなくてもメッセージを受け取れるようにダイアログ関数にメッセージを渡してくれる仕組みになっている。 CreateWindow( ) でつくった汎用ウィンドウのウィンドウ関数の WM_CREATE メッセージに相当する WM_INITDIALOG メッセージについては、先に定義済みのウィンドウ関数のコードが実行される。それ以外のメッセージについては、 このダイアログ関数の呼び出しのほうが先に実行される。 WM_INITDIALOG 以外のメッセージをダイアログ関数で処理したときは、ノンゼロ (true) の値を戻す処理しなかったときは、ゼロ (false) を戻すことになっている。 WM_INITDIALOG の処理では、 もし処理コードで SetFocus( ) APIを使ってダイアログの中の特定のコントロールにフォーカスを移したときはゼロ (false) を戻し、そうでないときはノンゼロ (true) を戻さなければならない。 これ以外は、これまで本稿で扱ってきたウィンドウ関数と同様に処理すればよい。

DialogBox( )DialogBoxParam( ) の第二パラメータ lpTemplateName には、ダイアログリソースの名前を設定する。クラスライブラリを使わないコードベースのプログラミングでは、ダイアログボックスの定義はリソースファイルに記述するのが標準の作法である。ダイアログボックス上に作成される標準コントロールの定義もこのダイアログリソースに記述されることになっている。 つまり、この仕組みを利用すると CreateWindow( ) を一度も使うことなく多数のコントロールを持ったダイアログボックスをつくることができるのである。 筆者は、このことを本で読んで知った直後、「反則だー!」と叫んでしまった。 うーむ、リソースファイル恐るべし。複雑なダイアログボックスを作成するためのリソースファイルを自動的につくりだすリソースエディタというアプリケーションもある。しかし、19−2 最初のリソースファイル で見たように、リソース記述ファイルはテキストファイルなので普通のエディタでも作成できる。

DialogBoxIndirect( )DialogBoxIndirectParam( ) の第二パラメータ lpDialogTemplate には、作成するダイアログボックスの定義を記述する TDlgTemplate 型レコードを設定する。

type
  PDlgTemplate = ^TDlgTemplate;
  TDlgTemplate = packed record
    style: DWORD;
    dwExtendedStyle: DWORD;
    cdit: Word;
    x: SHORT;
    y: SHORT;
    cx: SHORT;
    cy: SHORT;
  end;

このレコードを使ったダイアログボックスの作成については、後の節で調べることにする。

XXXXXParam( ) 関数は、対応する関数より dwInitParam パラメータが多いだけである。 このパラメータには、アプリケーション独自のデータを設定することができる。そうするとダイログ関数に WM_INITDAILOG メッセージの LParam としてこのデータが渡される。

モーダルダイアログボックスを閉じるには、

function EndDialog(hDlg: HWND; 
                nResult: Integer): BOOL; stdcall;

を使う。hDlg には、ダイアログウィンドウのハンドルを指定する。nResult には、このダイアログを作った、上に挙げた四つの関数への戻り値を設定する。ここが重要であるが、つまり、EndDialog( ) が実行されたあとで、例えば DialogBox( ) 関数から実行シークエンスが戻り、戻り値が確定するのである。 したがって、モーダルダイアログが表示されている間は、このダイアログを作ったコードの実行は、DialogBox( ) のところで止まっているのである。 このことについては、あとでもう少し詳細に検討しよう。

モーダルダイアログボックスからの戻り値には、MessageBox( ) などで使われる一般的な値がいくつか Windows.pas に定義されている。

const
  { Dialog Box Command IDs }
  IDOK = 1;          ID_OK = IDOK;
  IDCANCEL = 2;      ID_CANCEL = IDCANCEL;
  IDABORT = 3;       ID_ABORT = IDABORT;
  IDRETRY = 4;       ID_RETRY = IDRETRY;
  IDIGNORE = 5;      ID_IGNORE = IDIGNORE;
  IDYES = 6;         ID_YES = IDYES;
  IDNO = 7;          ID_NO = IDNO;
  IDCLOSE = 8;       ID_CLOSE = IDCLOSE;
  IDHELP = 9;        ID_HELP = IDHELP;

これらは、プログラムのどの部分からも見えるので、これらの値を使って戻り値を設定することもできる。

この節では、 「標準の作法」にしたがって DialogBox( ) 関数を使ってリソースからモーダルダイアログボックスを作成することを試みよう。

  1. エクスプローラを使って、新しいフォルダを 2301TestModal という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2208AccelClass02 フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで TestModal.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

ここで作るモーダルダイアログボックスは、プッシュボタン、リストボックス、それに、ここまでの本稿では取り上げなかったラベルの子ウィンドウに相当するスタティックコントロールを各1個ずつ持っている。これらのコントロールのIDは、リソースファイルからもプログラムからも参照しなければならないので、インクルードファイルで定義しなければならない。エディタで以下のようなテキストファイルを作る。

{       Name : ControlID.inc
   Description : Include file for TestModal
}
const
  ID_BUTTON = 800;
  ID_LISTBOX = 801;
  ID_STATIC = 802;

これを、2301TestModal フォルダに 'ControlID.inc' という名前で保存する。つぎに、テキストエディタで以下のようなリソース記述ファイルを作る。

/////////////////////////////////////////////////////
//        File: MYRES.RC
//     
// Description: The resource for the TestModal program
/////////////////////////////////////////////////////

#include "ControlID.inc"

// Test Dialog
MYDIALOG DIALOG 100, 10, 100, 100
CAPTION "Test DialogBox"
STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION | WS_SYSMENU
BEGIN
  DEFPUSHBUTTON "&O K",ID_BUTTON,10,80,80,15
  LISTBOX ID_LISTBOX,10,20,80,65
  LTEXT "Selected Color",ID_STATIC,10,5,80,10
END

これを、やはり 2301TestModal フォルダに 'MyRes.rc' という名前で保存する。ダイアログボックスをつくるためのリソース記述ファイルの一般的な書式については、ここでは説明しないが、 上記のファイルの内容については簡単に説明する必要があるだろう。 'MYDIALOG' がこのリソースの名前であり、つぎの 'DIALOG' がこのリソースがダイアログボックスであることを示している。 つぎの4つの数値は、 このダイアログボックスのオーナーウィンドウからの相対位置(100,10)と、幅と高さ(100,100)を指定している。 'CAPTION' はこのダイアログウィンドウのウィンドウテキストが "Test DialogBox" であると設定している。'STYLE' 文では、このダイアログウィンドウのウィンドウスタイルを設定している。'|' は、の文法で論理和を表し、Delphi のパスカルの or に相当する。ここでは、ダイアログフレームを持ち、システムメニューとキャプションを持ったポップアップウィンドウを作っている。 'BEGIN''END' の間にダイアログボックスで使用するコントロールを記述する。最初の句がコントロールの種類、次にウィンドウテキスト、その後にコントロールID、さらに、ダイアログボックス内の位置と幅と高さを指定している。

よく知られているように、デスクトップを右クリックしてプロパティーを選んで表示される「画面のプロパティー」ダイアログの「ディスプレイの詳細」から、そのシステム全体で使われるフォントの大きさを指定できる。ダイアログボックスのリソース記述ファイルに使われる位置や幅や高さを指定する数値の単位は、ユーザのシステムフォントの大小に自動的に対応するために、ダイアログ単位という単位を使っているのである。 現在のユーザの環境におけるダイアログ単位を取得するには、

function GetDialogBaseUnits: Longint; stdcall;

というパラメータなしのAPIを使う。この関数が返す32bit値の上位16ビットが垂直方向の、下位16ビットが水平方向のダイアログベース単位を表している。これを使って、ダイアログ単位とピクセル単位を変換するには、

pixelX = (dialogunitX * baseunitX) / 4 
pixelY = (dialogunitY * baseunitY) / 8 

dialogunitX = (pixelX * 4) / baseunitX 
dialogunitY = (pixelY * 8) / baseunitY 

の計算式を使う。 実際に、現在の環境で試すには Sekeleton03.dprOnTest( ) ハンドラを以下のようにする。

procedure OnTest(hWindow: HWND);
var
  ret,buX,buY:integer;
  duX, duY: single;
  sx,sy:string;
begin
  ret := GetDialogBaseUnits;
  buX := LOWORD(ret);
  buY := HIWORD(ret);
  duX := buX/4; Str(duX:5:3,sx);
  duY := buY/8; Str(duY:5:3,sy);
  L1.Text := 'DialogBaseUnit X = '+AIntToStr(buX)+#13+
             'DialogBaseUnit Y = '+AIntToStr(buY)+#13#13+
             'Dialog Unit X = '+sx+' pixels'+#13+
             'Dialog Unit Y = '+sy+' pixels'
end;
DialogBaseUnit.gif

筆者の現在の環境での結果を右図に示す。

さて、インクルードファイルとダイアログのリソース記述ファイルができたので、19−3 リソースコンパイラ で作ったリソースコンパイラでコンパイルして、同じフォルダに MyRes.res ができたら成功である。 このリソースを使ってモーダルダイアログを表示するプログラムを TestModal.dpr に作ろう。 以下に全リストを示す。

program TestModal;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

  {$R MyRes.res}

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------

  {$I ControlID.inc}

var
  MainWnd: TSDIMainWindow;

  L1,L2: TAPILabel;
  Timer: TAPITimer;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure LBAddString(hDlg:HWND;s:string);
begin
  SendDlgItemMessage(hDlg,ID_LISTBOX,LB_ADDSTRING,0,LPARAM(PChar(s)));
end;

procedure ChangeLabel(hDlg:HWND);
var
  len,index: integer;
  PC:PChar;
begin
  index := SendDlgItemMessage(hDlg,ID_LISTBOX,LB_GETCURSEL,0,0);
  len := SendDlgItemMessage(hDlg,ID_LISTBOX,LB_GETTEXTLEN,WPARAM(index),0);
  GetMem(PC,len+1);  // +1 for null-terminator
  SendDlgItemMessage(hDlg,ID_LISTBOX,LB_GETTEXT,WParam(index),LPARAM(PC));
  SendDlgItemMessage(hDlg,ID_STATIC,WM_SETTEXT,0,LPARAM(PC));
  FreeMem(PC);
end;

function DialogFunc(hDialog: HWnd; AMessage, WParam: UINT;
               LParam: LPARAM): Bool; stdcall;
begin
  Result := True;
  case AMessage of
    WM_INITDIALOG: begin
      LBAddString(hDialog,'Red');
      LBAddString(hDialog,'Green');
      LBAddString(hDialog,'Blue');
      Exit;
    end;
    WM_COMMAND:
      case LOWORD(WParam) of
        IDCANCEL,ID_BUTTON: begin
          EndDialog(hDialog, 1);
          Exit;
        end;
        ID_LISTBOX: begin
          case HIWORD(WParam) of
            LBN_SELCHANGE:begin
              case SendDlgItemMessage(hDialog,ID_LISTBOX,LB_GETCURSEL,0,0) of
                0: L2.Color := clrRed;
                1: L2.Color := clrGreen;
                2: L2.Color := clrBlue;
              end;
              ChangeLabel(hDialog);
            end;
          end;
          exit;
        end;
      end;
  end;
  Result := False;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure OnTimer(var Msg:TMessage);
begin
  L1.Color := RGB(Random(256),Random(256),Random(256));
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  L1 := Createlabel(hWindow,10,10,100,100,'');
  L1.DrawFrame := true;
  L2 := Createlabel(hWindow,120,10,100,100,'');
  L2.DrawFrame := true;

  Timer := CreateTimer(hWindow,500,OnTimer);
  Timer.On;

  Randomize;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  DialogBox(hInstance,'MyDialog',hWindow,@DialogFunc);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifTestModal.zip(17.047kB)
TestModal.gif

実行すると、二つのラベルが作られ、左側のラベルの背景色がタイマにより約0.5秒ごとにランダムな色に変更されている。 ここで、Test! メニューを選ぶと右図のようなダイアログボックスがモード付きで表示される。ここで注目してほしいのは、モーダルダイアログが表示されているときにも WM_TIMER メッセージがメインウィンドウのウィンドウ関数に送られ、左側のラベルの背景色の変更が中断しないことである。 つまり、モーダルループの最中でもメッセージのやりとりは正常に行われているのである。 次に確認してほしいことは、ダイアログが表示されているときに [TAB] キーを押すとプッシュボタンとリストボックスの間でフォーカスが移動することである。 また、どちらにフォーカスがある時でも、[ESC] キーか [ENTER] キーを押すとダイアログボックスが閉じることを確認してほしい。さらに、プッシュボタンのキャプション 'O K''O' の文字の下には下線が引かれているので、どちらにフォーカスがある場合でも [ALT] + O キーを押すと、このプッシュボタンを押したことと同じことになることである。 このような、ダイアログボックス特有の動作は、上のコードにより実現しているのではなく、 システムの中にあるダイアログボックスのウィンドウ関数の中のコードで実現しているのである。 このことからも、 ダイアログボックスが Win32 の定義済みのクラスであることが実感できるだろう。

さて、ダイアログボックスのなかのリストボックスの項目を一つ選ぶと、そのうえのラベル(スタティックコントロール)にその文字列が表示され、同時にメインウィンドウの右側のラベルの背景色がその色に変更される。

コードを見てみよう。 最初のほうで {$R MyRes.res}{$I ControlID.inc} のコンパイラ指令をつかってリソースとインクルードファイルの内容を取り込んでいる。 MainCreate( ) では、ラベルを二つと、タイマを一つつくってすぐにオンにしている。 OnTest( ) ハンドラを見てみよう。

procedure OnTest(hWindow: HWND);
begin
  DialogBox(hInstance,'MyDialog',hWindow,@DialogFunc);
end;

ここでは、上で説明した DialogBox( ) 関数を使って、リソースのデータからモーダルダイアログを作成している。 戻り値は無視している。 ダイアログ関数を見てみよう。

function DialogFunc(hDialog: HWnd; AMessage, WParam: UINT;
               LParam: LPARAM): Bool; stdcall;
begin
  Result := True;
  case AMessage of
    WM_INITDIALOG: begin
      LBAddString(hDialog,'Red');
      LBAddString(hDialog,'Green');
      LBAddString(hDialog,'Blue');
      Exit;
    end;
    WM_COMMAND:
      case LOWORD(WParam) of
        IDCANCEL,ID_BUTTON: begin
          EndDialog(hDialog, 1);
          Exit;
        end;
        ID_LISTBOX: begin
          case HIWORD(WParam) of
            LBN_SELCHANGE:begin
              case SendDlgItemMessage(hDialog,ID_LISTBOX,LB_GETCURSEL,0,0) of
                0: L2.Color := clrRed;
                1: L2.Color := clrGreen;
                2: L2.Color := clrBlue;
              end;
              ChangeLabel(hDialog);
            end;
          end;
          exit;
        end;
      end;
  end;
  Result := False;
end;

まず、WM_INITDIALOG では、LBAddString( ) 関数をつかってリストボックスに文字列を三つ追加している。

procedure LBAddString(hDlg:HWND;s:string);
begin
  SendDlgItemMessage(hDlg,ID_LISTBOX,LB_ADDSTRING,0,LPARAM(PChar(s)));
end;

この関数を見ると分かるように、リソースから作られたダイアログボックスの中のコントロールについては、プログラマはコントロールIDの値しか知らないので、すぐに SendMessage( ) を使ってメッセージを送ることができない。 そこで、この関数で使っている SendDlgItemMessage( ) API関数を使う。

function SendDlgItemMessage(hDlg: HWND; 
                      nIDDlgItem: Integer;
                             Msg: UINT; 
                          wParam: WPARAM;
                          lParam: LPARAM): Longint; stdcall;

ここで、hDlg には、ダイアログウィンドウのハンドルを、nIDDlgItem には、メッセージを送るコントロールのコントロールIDを設定する。あとのパラメータは、SendMessage( ) と同じである。 また、戻り値も同じである。 このように、ウィンドウハンドルの値が分からず、コントロールIDだけを知っている場合に使うために、Dlg の文字がついたダイアログを制御するためのAPI関数が多数ある。 ここでは、リストボックスに LB_ADDSTRING メッセージを送って文字列を追加している。これについては、第8章 リストボックス で説明した。 リストボックスの選択状態が変化すると WM_COMMAND メッセージが送られてきて、その LOWORD(WParam) にはコントロールIDが、HIWORD(WParam) には LBN_SELCHANGE が設定されているのも、通常のウィンドウ関数と同じである。 ここでは、リストボックスに LB_GETCURSEL メッセージを送って、選択項目のインデックス値を返してもらい、それにより右側のラベルの背景色を変更し、ChangeLabel( ) 関数でスタティックコントロールの文字列を選択文字列に変更している。

procedure ChangeLabel(hDlg:HWND);
var
  len,index: integer;
  PC:PChar;
begin

  index := SendDlgItemMessage(hDlg,ID_LISTBOX,LB_GETCURSEL,0,0);
  len := SendDlgItemMessage(hDlg,ID_LISTBOX,LB_GETTEXTLEN,WPARAM(index),0);
  GetMem(PC,len+1);  // +1 for null-terminator
  SendDlgItemMessage(hDlg,ID_LISTBOX,LB_GETTEXT,WParam(index),LPARAM(PC));
  SendDlgItemMessage(hDlg,ID_STATIC,WM_SETTEXT,0,LPARAM(PC));
  FreeMem(PC);
end;

まず、選択項目のインデックスを取得し、それを使ってその項目の文字列の長さを取得し、メモリにバッファを作って文字列を受け取り、それを WM_SETTEXT メッセージを送ってスタティックラベルに文字列を設定している。

さて、ボタンを押すと WM_COMMAMD とともに ID_BUTTON のコントロールIDがダイアログ関数に送られてくる。また、[ESC] キーを押すと、やはり WM_COMMAND とともに IDCANCEL (=2)が送られてくる。このとき、EndDialog( ) によりダイアログボックスを閉じている。 ここでは、結果として DialogBox( ) 関数にを戻している。

この節では、リソースからコントロールを持ったモーダルダイアログボックスを作成して、メッセージを処理する方法の一例を示した。 まとめると、

  1. ダイアログボックスで使うコントロールのIDを定義するインクルードファイルをつくる。
  2. ダイアログリソース記述ファイルを作る。
  3. リソース記述ファイルをコンパイルして、リソースファイルをつくる。
  4. プログラムでリソースをもとにして、DialogBox( ) または DialogBoxParam( ) API関数を使ってモーダルダイアログとして表示する。
  5. ダイアログ関数でユーザ入力によるメッセージを処理する。
  6. 特定のユーザ入力に応答して、EndDialog( ) でモーダルダイアログボックスを閉じる。
  7. このダイアログボックスを作った DialogBox( ) または DialogBoxParam( ) API関数への戻り値は、EndDialog( ) の第二パラメータで指定する。

redball.gifこの章の目次へ戻る

23−2 ラッパーコントロールを使う

前節では、ダイアログボックスをつくる「標準の作法」であるリソースファイルを使って、コントロールを三つ持つモーダルダイアログボックスを DialogBox( ) APIを使って作成・表示した。 つまり、四つのウィンドウを作るのに一度も CreateWindow( ) を使わなかったのである。 このようにして作成されたダイアログボックスの場合、ダイアログボックス本体はともかく、プッシュボタンやリストボックスやラベル(スタティック)などのメッセージを処理するには、裸のコントロールの場合と同じように、ダイアログ関数の中のコードでメッセージを捕まえ、さらに LB_ADDSTRING のような低レベルのメッセージを送ることによりコントロールを遠隔操作しなければならなかった。これではあまりに不便なので、この節では、何もないダイアログボックスの本体はリソースファイルから作り、コントロールは、ここまでの本稿で作ってきたラッパークラスを使うことにしよう。 そうすれば、ユーザからの入力によるメッセージ処理は、ラッパークラスのメソッドやプロパティー、イベントハンドラを使うことにより簡単に処理できるだろう。

  1. エクスプローラを使って、新しいフォルダを 2302UsingWrapper という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2301TestModal フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで UsingWrapper.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

コントロールをラッパークラスで作成するので、インクルードファイルは不要になった。まず、何もないダイアログボックス本体のリソース記述ファイルを作成しよう。これは、前節でつくったリソース記述ファイルから、コントロールの部分を除いたものとなる。

/////////////////////////////////////////////////////
//        File: MYRES.RC
//     
// Description: The resource for the UsingWrapper program
/////////////////////////////////////////////////////

// Test Dialog
MYDIALOG DIALOG 100, 10, 100, 100
CAPTION "Test DialogBox"
STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION | WS_SYSMENU
BEGIN

END

これを、2302UsingWrapper フォルダに 'MyRes.rc' という名前で保存し、 前節と同じようにリソースコンパイラでコンパイルし、'MyRes.res' という名前のリソースファイルを作成する。 これを使って、 前節と同じようなモーダルダイアログボックスを作成・表示するプログラムを UsingWrapper.dpr につくろう。以下に全リストを示す。

program UsingWrapper;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

  {$R MyRes.res}

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  L1,L2,L3: TAPILabel;
  Timer: TAPITimer;
  Btn1: TAPIButton;
  LB1: TAPIListBox;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg:TMessage);
begin
  L3.Text := LB1.SelText;
  case LB1.SelIndex of
    0: L2.Color := clrRed;
    1: L2.Color := clrGreen;
    2: L2.Color := clrBlue;
  end;
end;

procedure Btn1Click(var Msg:TMessage);
begin
  EndDialog(Btn1.Parent,1);
end;

function DialogFunc(hDialog: HWnd; AMessage, WParam: UINT;
               LParam: LPARAM): Bool; stdcall;
begin
  Result := True;
  case AMessage of
    WM_INITDIALOG: begin
      L3 := CreateLabel(hDialog,10,10,180,30,'Selected Color');
      LB1 := CreateListBox(hDialog,10,45,180,130,LB1SelChange);
      LB1.AddString('Red');
      LB1.AddString('Green');
      LB1.AddString('Blue');
      Btn1 := CreateButton(hDialog,20,180,160,30,'&O K',Btn1Click);
      Exit;
    end;
    WM_COMMAND:
      case LOWORD(WParam) of
        IDCANCEL: begin
          EndDialog(hDialog, 1);
          Exit;
        end;
      end;
  end;
  Result := False;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure OnTimer(var Msg:TMessage);
begin
  L1.Color := RGB(Random(256),Random(256),Random(256));
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  L1 := CreateLabel(hWindow,10,10,100,100,'');
  L1.DrawFrame := true;
  L2 := CreateLabel(hWindow,120,10,100,100,'');
  L2.DrawFrame := true;

  Timer := CreateTimer(hWindow,500,OnTimer);
  Timer.On;

  Randomize;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  DialogBox(hInstance,'MyDialog',hWindow,@DialogFunc);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifUsingWrapper.zip(18.624kB)
UsingWrapper.gif

実行すると、図のように前節のダイアログとほとんど同じ動作をする事が確認できるだろう。 このように、本稿で作ったコントロールのラッパークラスを使って、コントロールをダイアログボックス上に作成しても、やはり、[TAB] キーでフォーカスを移動できるし、[ALT]+O キーでプッシュボタンを押すことができることを確認してほしい。

コードを見てみよう。 プッシュボタンとリストボックスとラベルは、ダイアログ関数の WM_INITDIALOG メッセージの処理のときに作られる。そして、ユーザによるリストボックスの選択項目の変更やプッシュボタンのクリックなどのメッセージ処理は、ラッパークラスのイベントハンドラ中でプロパティーやメソッドを使って処理されているので、前節のコードと比較すると劇的に簡単になっていることが分かるだろう。 これらのオブジェクトは、ダイアログボックスウィンドウを親にしているので、ダイアログボックスが閉じられると自動的に破棄される。したがって、ダイアログボックスが表示されていないときに、これらのインスタンス参照にアクセスしてはならない。また、アクセスする必要もないだろう。

redball.gifこの章の目次へ戻る

23−3 モーダルループについて考える

前節までで、リソースファイルを使ってモーダルダイアログボックスを作成して表示し、ユーザ入力によるメッセージを処理する例を示した。モーダルダイアログボックスが表示されると、同じアプリケーションの他のウィンドウは使用不可の外観になるが、WM_TIMER メッセージは正常に処理されることが分かった。また、メインウィンドウの上のラベルの背景色も変更できるので WM_PAINT などのメッセージループを通る「普通の」メッセージも正常に処理されるのも分かっただろう。つまり、モーダルダイアログボックスを表示中でも、メインウィンドウのウィンドウ関数によるメッセージ処理は正常に行われているのである。

さて、DialogBox( ) 関数は、表示されたモーダルダイアログが EndDialog( ) 関数によって閉じられるまで、復帰しない。このことの意味について考えてみよう。 一般的に考えて、数分、あるいは数時間、数日間も復帰しない関数はどのようにしてつくるのだろうか。例えば、円周率を1兆桁計算する関数を作成したとする。この関数を、ウィンドウズアプリケーションのメニュー選択コマンドによって実行したら、どうなるのだろうか。Win16Windows3.1 のようなプリエンプティブでないマルチタスキング環境では、CPUはひたすら計算ロジックを実行するので、すべてのアプリケーションが実行できなくなり、ウィンドウズ全体がコオリツイテしまうだろう。 しかし、Windows95 以降の Win32 のプリエンプティブなマルチタスキング環境では、 実行のタイムスライスの割り当て・解除はシステムが行っているので、他のアプリケーションがコオリツクようなことはないだろう。では、関数を起動したウィンドウはどうなるのだろうか? このことを実際に試してみよう。筆者は円周率を1兆桁計算する関数を作成することはできないが、無限ループを持った関数は簡単に作成できるので、これで試してみよう。

  1. エクスプローラを使って、新しいフォルダを 2303InfiniteLoop という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2302UsingWrapper フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで InfiniteLoop.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

InfiniteLoop.dpr の全リストを以下に示す。

program InfiniteLoop;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  L1: TAPILabel;
  Timer: TAPITimer;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure InfinitLoop;
var
  Flag:Boolean;
begin
  Flag := true;
  while Flag do begin

  end;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure OnTimer(var Msg:TMessage);
begin
  L1.Color := RGB(Random(256),Random(256),Random(256));
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  L1 := Createlabel(hWindow,10,10,100,100,'');
  L1.DrawFrame := true;

  Timer := CreateTimer(hWindow,500,OnTimer);
  Timer.On;

  Randomize;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  InfinitLoop;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifInfiniteLoop.zip(16.510kB)
InfiniteLoop.gif

実行すると、右図のようにラベルが1つ作られて、タイマにより約0.5秒ごとにその背景色がランダムに変更されている。ここで、Test! メニューを選択して無限ループを持った関数を実行すると....、文字通りこのアプリケーションはコオリツクことが確かめられる。ラベルの背景色の更新やメニューの選択はもちろん、システムメニューや「閉じるボタン」にも応答しないし、マウスでタイトルバーをドラグして移動することもできない。 このようなときでも、他のアプリケーションの実行には何の問題もない。ワードを起動して文書を作成できるし、 ソリテアで遊ぶこともできる。InfiniteLoop.exe を終了させるには、 IDEから実行した場合は、 「実行(R)」メニューの「プログラムの終了(E)」から終了できるし、 エクスプローラからダブルクリックして起動したときは、[ALT]+[Ctrl]+[DEL] キーを押して表示されるダイアログから終了できる。

InfiniteLoop.exe の動作から、次のようなことが分かった。

  1. InfiniteLoop.exe は、一般的な意味で、プログラム上のバグは無い、独立したアプリケーションである。(しょうもない「アプリ」であることは確かですが....。)
  2. 無限ループを実行すると、このスレッド内のメッセージ伝達が完全に阻止される。したがって、あらゆるウィンドウ関数は実行されない。
  3. このようなときでも、他のアプリケーションに無限ループの実行による影響が及ぶことはない。

この2.について考えよう。ウィンドウ関数にメッセージが届けられるのには、二つの経路があると思われる。WM_PAINT のような一般的なメッセージは、1−3−5 メッセージループ で説明したように、メッセージループによりメッセージキューから取り出されて、DispatchMessage( ) 関数の実行によってシステム経由でウィンドウ関数を起動する。このとき、DispatchMessage( ) 関数は、ウィンドウ関数の戻り値を戻すので、起動したウィンドウ関数が終了するまで復帰しない。 もう一つの経路は、 コントロールからの WM_COMMAND のようなメッセージで SendMessage( ) 関数を通してシステムによりウィンドウ関数が起動される場合である。 このときも、SendMessage( ) はウィンドウ関数の戻り値を返すので、起動したウィンドウ関数が終了するまで復帰しない。 つまり、ユーザ入力により無限ループを実行し始めると、これを呼び出したウィンドウ関数から復帰することができなくなるので、メッセージループもシステムのメッセージ伝達機構もコオリツクのだろうと考えられる。

さて、かなり遠回りをしてしまったが、この節の主題であるモーダルループについて考えよう。 DialogBox( ) 関数がすぐに復帰せずに、モーダルダイアログが閉じられるまで何日でも待つことができるのは、もちろん、円周率を計算しているからではなく、ループ構造をもった関数を実行しているからに違いない。 そして、その間もメッセージ伝達機構が阻止されていないことを考えると、きっとメッセージループに似た構造のループを実行しているに違いない。 DialogBox( ) 関数がどのように実装されているのか、そのソースはマイクロソフトの社員でないと見ることはできない。 しかし、このようなモーダルループは、コードでシミュレートすることはできるだろう。 実際、Delphi のクラスライブラリであるVCLや、マイクロソフトのメジャーなクラスライブラリであるMFCでは、モーダルダイアログボックスは DialogBox( ) 関数のような「ダイアログボックスクラス」専用の関数を使ってつくるのではなく、CreateWindow( ) で汎用のポップアップウィンドウとして作成されているらしい。したがって、モーダルループも自前のコードでシミュレートしているのだ。VCLの場合は、TForm クラスの ShowModal( ) メソッドからたどっていくと、このループを発見できる。ちなみに、通常のメッセージループは、TApplication クラスの Run メソッドからたどっていくと見つけることができる。

redball.gifこの章の目次へ戻る

23−4 ダイアログテンプレートレコードを使う

前節までで、リソースファイルからダイアログボックスを作成し、ユーザ入力のメッセージの処理を裸のコントロールと本稿でつくったラッパークラスを使って処理をする例を示した。 また、モーダルループについて簡単に考察した。 本稿のような、小さなクラスライブラリを使ってコードでウィンドウズアプリケーションを作る場合、つねにダイアログリソースをリンクしなければならないのは、明らかに不便である。 この節では、まだ試していない DialogBoxIndirect( ) 関数か DialogBoxIndirectParam( ) 関数を使ってモーダルダイアログを作成してみよう。これらの関数の第二パラメータには、以下のようなレコード型の変数を設定する。

type
  PDlgTemplate = ^TDlgTemplate;
  TDlgTemplate = packed record
    style: DWORD;             // ダイアログウィンドウのスタイル
    dwExtendedStyle: DWORD;   // 拡張ウィンドウスタイル。ダイアログの作成のときは使わない
    cdit: Word;               // このテンプレートに含まれる項目(コントロールなど)の数
    x: SHORT;                 // 左上の表示位置のX座標(ダイアログボックス単位)
    y: SHORT;                 // 左上の表示位置のY座標(ダイアログボックス単位) 
    cx: SHORT;                // 幅(ダイアログボックス単位)
    cy: SHORT;                // 高さ(ダイアログボックス単位)
  end;

このレコードは、実際は、cdit フィールドで指定したコントロール項目を設定するフィールドが末尾に続く可変長のレコードである。 ここでは、何もないダイアログボックスを作るので、cdit フィールドの値をゼロにする。それでは、早速、このレコード型を使ってモーダルダイアログボックスを作成してみよう。

  1. エクスプローラを使って、新しいフォルダを 2304UsingTemplate という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2303InfiniteLoop フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで UsingTemplate.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

UsingTemplate.dpr の全リストを以下に示す。

program UsingTemplate;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  SelectColorOK: TAPIButton;
  GB: TAPIGroupBox;
  RG: TRadioGroup;

  SelectedColor: integer;

const
  CLR: array[0..4] of COLORREF =
       (clrRed,clrGreen,clrBlue,clrAqua,clrLime);

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure SelectColorOKClick(var Msg: TMessage);
begin
  EndDialog(SelectColorOK.Parent,RG.CheckIndex);
end;

function DialogFunc(hDialog: HWnd; AMessage, WParam: UINT;
               LParam: LPARAM): Bool; stdcall;
begin
  Result := True;
  case AMessage of
    WM_INITDIALOG: begin
      ChangeWindowSize(hDialog,300,220);
      SetWindowText(hDialog,'SelectBkColor');

      GB := CreateGroupBox(hDialog,10,10,120,170,'SelectColor');
      RG := CreateRadioGroup(hDialog,true,25,30,100,140,5,nil);
      RG.Captions[0] := '&Red';
      RG.Captions[1] := '&Green';
      RG.Captions[2] := '&Blue';
      RG.Captions[3] := '&Aqua';
      RG.Captions[4] := '&Lime';
      RG.SetCheck(SelectedColor);

      SelectColorOK := CreateButton(hDialog,170,140,100,30,'&O K',
                                SelectColorOKClick);
      Exit;
    end;
    WM_COMMAND:
      case LOWORD(WParam) of
        IDCANCEL: begin
          EndDialog(hDialog,100);
          Exit;
        end;
      end;
  end;
  Result := False;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);


  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
var
  pMyTmp: PDlgTemplate;
  ret: integer;
begin
  GetMem(pMyTmp,SizeOf(TDlgTemplate)+10);
  ZeroMemory(pMyTmp,SizeOf(TDlgTemplate)+10);
  pMyTmp^.style := DS_MODALFRAME or WS_POPUP or WS_VISIBLE or
                   WS_CAPTION or WS_SYSMENU;
  pMyTmp^.x := 50;
  pMyTmp^.y := 10;
  pMyTmp^.cx := 100;
  pMyTmp^.cy := 100;
  ret := DialogBoxIndirect(hInstance,pMyTmp^,hWindow,@DialogFunc);
  if ret <> 100 then begin
    MainWnd.Color := CLR[ret];
    SelectedColor := ret;
  end;
  FreeMem(pMyTmp);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifUsingTemplate.zip(17.249kB)
UsingTemplate.gif

実行して、Test! メニューを選択すると右図のようなモーダルダイアログボックスが表示される。 このとき、[TAB] キーを使ってラジオボタンとプッシュボタンの間のフォーカスが移動できることが確かめられる。 また、ラジオボタン間のフォーカスは上下の矢印キーで移動できることも分かる。 さらに、[ALT]+Lキーで 'Lime' のラジオボタンを選択できることも確認できる。プッシュボタンを押すとラジオボタンでチェックされている色に、メインウィンドウの背景色が変更される。[ESC] キーで閉じたときは、変更されない。 二度目以降でダイアログを表示したときは、現在の背景色のラジオボタンがチェックされている。

コードを調べよう。 OnTest( ) ハンドラでモーダルダイアログボックスを作成して表示している。

procedure OnTest(hWindow: HWND);
var
  pMyTmp: PDlgTemplate;
  ret: integer;
begin
  GetMem(pMyTmp,SizeOf(TDlgTemplate)+10);
  ZeroMemory(pMyTmp,SizeOf(TDlgTemplate)+10);
  pMyTmp^.style := DS_MODALFRAME or WS_POPUP or WS_VISIBLE or
                   WS_CAPTION or WS_SYSMENU;
  pMyTmp^.x := 50;
  pMyTmp^.y := 10;
  pMyTmp^.cx := 100;
  pMyTmp^.cy := 100;
  ret := DialogBoxIndirect(hInstance,pMyTmp^,hWindow,@DialogFunc);
  if ret <> 100 then begin
    MainWnd.Color := CLR[ret];
    SelectedColor := ret;
  end;
  FreeMem(pMyTmp);
end;

ここでは、TDlgTemplate レコードを直接使わずに、そのレコードを指すポインタを使っている。 そして、そのポインタに、GetMem( )TDlgTemplate レコードのサイズより、10バイト多めにメモりを割り当てている。実は、 TDlgTemplate レコード型の変数を使って DialogBoxIndirect( ) API関数でモーダルダイアログを作ろうとすると、筆者の環境では必ず失敗するのである。 上で述べたように、このレコードの cdit フィールドにゼロを設定して、コントロールなしのダイアログボックスを作ろうとしても、TDlgTemplate レコードだけでは、どういうわけかうまくいかないのだ。 しかし、ポインタを使って、それに10バイトほど多めにメモリを割り当てるとうまくゆくことが分かった。そのかわり、各フィールド値を設定するには、上のコードのようにポインタの逆参照を利用する。 ここでは、ZeroMemory( ) を使って、全てのフィールドをゼロで初期化した後、 style フィールドには、前節までのリソースで設定したのと同じウィンドウスタイルを設定している。そして、表示位置と幅と高さをダイアログボックス単位で設定している。それから、DialogBoxIndirect( ) APIにより、モーダルダイアログボックスを作成して表示している。「閉じるボタン」や[ESC] キーで閉じたときは、 100を戻すので、それ以外は戻り値を参照し、定義済みの色をメインウィンドウの背景色に設定し、そのインデックス値をグローバル変数 SelectedColor に格納している。 最後に、 割り当てたメモリを開放する。ダイアログ関数を見てみよう。

function DialogFunc(hDialog: HWnd; AMessage, WParam: UINT;
               LParam: LPARAM): Bool; stdcall;
begin
  Result := True;
  case AMessage of
    WM_INITDIALOG: begin
      ChangeWindowSize(hDialog,300,220);
      SetWindowText(hDialog,'SelectBkColor');

      GB := CreateGroupBox(hDialog,10,10,120,170,'SelectColor');
      RG := CreateRadioGroup(hDialog,true,25,30,100,140,5,nil);
      RG.Captions[0] := '&Red';
      RG.Captions[1] := '&Green';
      RG.Captions[2] := '&Blue';
      RG.Captions[3] := '&Aqua';
      RG.Captions[4] := '&Lime';
      RG.SetCheck(SelectedColor);

      SelectColorOK := CreateButton(hDialog,170,140,100,30,'&O K',
                                SelectColorOKClick);
      Exit;
    end;
    WM_COMMAND:
      case LOWORD(WParam) of
        IDCANCEL: begin
          EndDialog(hDialog,100);
          Exit;
        end;
      end;
  end;
  Result := False;
end;

ここでは、WM_INITDIALOG メッセージを捕まえて、ダイアログの幅と高さを変更し、タイトル文字列を設定している。 そして、グループボックスとチェックグループとプッシュボタンを作成している。また、「閉じるボタン」や [ESC] キーによって閉じられるときは、100を返すようにしている。'OK' ボタンの OnClick( ) ハンドラを見てみよう。

procedure SelectColorOKClick(var Msg: TMessage);
begin
  EndDialog(SelectColorOK.Parent,RG.CheckIndex);
end;

ここでは、選択されているラジオボタンのインデックスを返して、ダイアログボックスを閉じている。

以上、本節ではリソースを使わないでモーダルダイアログボックスを作成して表示する一例を示した。

redball.gifこの章の目次へ戻る

23−5 モーダルダイアログクラス

この節では、前節までで調べてきたモーダルダイアログボックスを作成して表示し、コントロールからのメッセージを処理する機構をカプセル化して、モーダルダイアログボックスクラスを作成したい。23−3 モーダルループについて考える で考察したように、 VCLMFCなどの大がかりなクラスライブラリでは、 汎用のポップアップウィンドウを作成して、モーダルループと、ダイアログ特有のフォーカス移動やショートカットキーの機能を、自前のコードでシミュレートしている。 本稿では、 このアプローチを採用せず、前節で調べたようにダイアログテンプレートを使ってコントロールを持たないダイアログボックスを作る機構をカプセル化しよう。 そうすれば、 WM_INITDIALOG メッセージを捕まえて、本稿で作成してきたコントロールのラッパークラスを使ってコントロールを作成できるし、それからのメッセージの処理もコントロールのイベントハンドラで処理できる。 さらに、モーダルループやフォーカス移動、ショートカットキーの機能をシミュレートする必要もない。

ダイアログボックスウィンドウに対するメッセージの流れは、ウィンドウ関数の一部がダイアログ関数として公開されているので、一般のコントロールのようにサブクラス化によってメッセージの流れをのぞき見る必要はない。 したがって、 TObject から直接派生してクラスを作成できる。デストラクタによるパスカルオブジェクトの開放は、ダイアログ関数で WM_DESTROY メッセージを捕まえて行えばよいだろう。 6−3 コントロールのラッパークラスをつくるための方針 において、標準コントロールのラッパークラスを設計するときにウィンドウオブジェクトのウィンドウハンドルの値から、そのラッパーであるパスカルオブジェクトを参照するために SetProp( ) APIを使ってウィンドウにラッパーオブジェクトのインスタンス参照をプロパティーとして設置した。 今回も、この方法によりダイアログウィンドウにそのラッパーオブジェクトのインスタンス参照をプロパティーとして設置することにより、ウィンドウハンドルからラッパーオブジェクトを参照できるようにしよう。 そうするためには、ダイアログ関数にそのダイアログを作ったラッパークラスのインスタンス参照を渡す必要がある。 10−1 Skeleton02 のラッパークラスを作成する において、メインウィンドウのラッパークラスの上位クラスである TAPIWindow を作ったとき、CreateWindowEx( ) の最後のパラメータに自分自身のインスタンス参照 self を設定し、ウィンドウ関数で WM_NCCREATE メッセージを捕まえて、その LParam の値としてオブジェクト参照をウィンドウ関数に渡すことができた。前節で、モーダルダイアログボックスを作成・表示するときに使った DialogBoxIndirect( ) 関数は、モーダルダイアログが閉じられるまで復帰しないのでこの方法は使えない。 しかし、ダイアログ関数にオブジェクト参照を渡すのにピッタリの関数がある。DialogBoxIndirectParam( ) である。 この関数もモーダルダイアログが閉じられるまで復帰しないのは同じであるが、 最後のパラメータである dwInitParam: LPARAM の値が WM_INITDIALOG メッセージの LParam としてダイアログ関数に渡されるのである。 これにインスタンス参照を設定すれば、WM_INITDAILOG メッセージを捕まえて、その LParam の値からこのダイアログボックスを作ったラッパーオブジェクトを知ることができるだろう。

以上の方針にしたがって、APIWindow.pasTModalDialog クラスを作成してテストしよう。

  1. エクスプローラを使って、新しいフォルダを 2305ModalDialogClass という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2304UsingTemplate フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで ModalDialogClass.dpr という名前で保存する。
  5. [Ctrl]+[f.12] キーを押して、表示されるダイアログから APIWindow.pas を選んでコードエディタに表示させる。
  6. コードエディタで以下のように編集する。
  7. [F.9]でコンパイルして実行する。

最初に、APIWindow.pasTAPIDialog クラスと、それから派生して TModaldialog クラスを作成しよう。宣言部を以下に示す。

//--------------- TAPIDialog -------------------------------
type
TAPIDialog = class(TObject)
private
  FHandle: HWND;
  FOwner: HWND;
  FStyle: DWORD;
  FTitle: string;
  FPosX: integer;
  FPosY: integer;
  FColor: COLORREF;
  FWidth:integer;
  FHeight:integer;
  FClientWidth:integer;
  FClientHeight:integer;
  FIcon: HICON;
  FOnInitDialog: TNotifyMessage;
  FOnCommand: TNotifyMessage;
  FOnDestroy: TNotifyMessage;
  procedure SetTitle(value: string);
  procedure SetPosX(value: integer);
  procedure SetPosY(value: integer);
  function GetWidth: integer;
  procedure SetWidth(value: integer);
  function GetHeight: integer;
  procedure SetHeight(value: integer);
  function GetClientWidth: integer;
  procedure SetClientWidth(value: integer);
  function GetClientHeight: integer;
  procedure SetClientHeight(value: integer);
  procedure SetColor(value: COLORREF);
  procedure SetIcon(value:HICON);
protected
  procedure InitWidthHeight;
public
  constructor Create(hOwner:HWND);virtual;
  destructor Destroy; override;
  property Owner: HWND read FOwner;
  property Handle: HWND read FHandle write FHandle;
  property Style: DWORD read FStyle write FStyle;
  property Title: string read FTitle write SetTitle;
  property PosX:integer read FPosX write SetPosX;
  property PosY:integer read FPosY write SetPosY;
  property Width: integer read GetWidth write SetWidth;
  property Height: integer read GetHeight write SetHeight;
  property ClientWidth: integer read GetClientWidth write SetClientWidth;
  property ClientHeight: integer read GetClientHeight write SetClientHeight;
  property Color: COLORREF read FColor write SetColor;
  property Icon: HICON read FIcon write SetIcon;
  property OnInitDialog: TNotifyMessage
                  read FOnInitDialog write FOnInitDialog;
  property OnCommand: TNotifyMessage
                  read FOnCommand write FOnCommand;
  property OnDestroy: TNotifyMessage
                  read FOnDestroy write FOnDestroy;
end;

//--------------- TModalDialog -------------------------------
TModalDialog = class(TAPIDialog)
private
protected
public
  constructor Create(hOwner:HWND);override;
  procedure DefaultHandler(var Message); override;
  function Show:integer;
  procedure Close(rslt: integer);
  procedure Center;
end;

function CreateModalDialog(hOwner:HWND;x,y,cw,ch:integer;
                           Style:DWORD;sOnInit:TNotifyMessage):TModalDialog;

TAPIDialog は、幅や高さなどのウィンドウの一般的な性質をプロパティーとして持ち、WM_INITDIALOGWM_COMMAND、と WM_DESTROY メッセージに相当するイベントハンドラを装備している。 一方、これから派生した TModalDialog クラスは、実際にメッセージを捕捉する DefaultHandler( ) とモーダルダイアログを作って表示する Show メソッド、ダイアログを閉じる Close( ) メソッド、ダイアログを画面の中央に配置する Center メソッドを持っている。 実装部を以下に示す。

//--------------- TAPIDialog -------------------------------
constructor TAPIDialog.Create(hOwner:HWND);
begin
  FHandle := 0;
  FOwner := hOwner;
  FColor := clrBtnFace;
end;

destructor TAPIDialog.Destroy;
begin
  inherited Destroy;
end;

procedure TAPIDialog.SetTitle(value: string);
begin
  FTitle := value;
  if FHandle <> 0 then
    SetWindowText(FHandle,PChar(value));
end;

procedure TAPIDialog.SetPosX(value: integer);
var
  pt: TPoint;
begin
  FPosX := value;
  if FHandle <> 0 then begin
    pt.x := value;
    pt.y := FPosY;
    ClientToScreen(FOwner,pt);
    ChangeWindowPos(FHandle,pt.x,pt.y);
  end;
end;

procedure TAPIDialog.SetPosY(value: integer);
var
  pt: TPoint;
begin
  FPosY := value;
  if FHandle <> 0 then begin
    pt.x := FPosX;
    pt.y := value;
    ClientToScreen(FOwner,pt);
    ChangeWindowPos(FHandle,pt.x,pt.y);
  end;
end;

function TAPIDialog.GetWidth: integer;
var
  r: TRect;
begin
  if FHandle  = 0 then
    result := FWidth
  else begin
    GetWindowRect(FHandle,r);
    result := r.Right-r.Left;
  end;
end;

procedure TAPIDialog.SetWidth(value: integer);
var
  r: TRect;
begin
  if FHandle = 0 then
    FWidth := value
  else begin
    GetWindowRect(FHandle,r);
    ChangeWindowSize(FHandle,value,(r.Bottom-r.Top));
  end;
end;

function TAPIDialog.GetHeight: integer;
var
  r: TRect;
begin
  if FHandle = 0 then
    result := FHeight
  else begin
    GetWindowRect(FHandle,r);
    result := r.Bottom-r.Top;
  end;
end;

procedure TAPIDialog.SetHeight(value: integer);
var
  r: TRect;
begin
  if FHandle = 0 then
    FHeight := value
  else begin
    GetWindowRect(FHandle,r);
    ChangeWindowSize(FHandle,(r.Right-r.Left),value);
  end;
end;

function TAPIDialog.GetClientWidth: integer;
var
  r: TRect;
begin
  if FHandle = 0  then
    result := FClientWidth
  else begin
    GetClientRect(FHandle,r);
    result := r.Right;
  end;
end;

procedure TAPIDialog.SetClientWidth(value: integer);
begin
  if FHandle = 0 then
    FClientWidth := value
  else
    ChangeWindowSize(FHandle,(value+Width-ClientWidth),Height);
end;

function TAPIDialog.GetClientHeight: integer;
var
  r: TRect;
begin
  if FHandle = 0 then
    result := FClientHeight
  else begin
    GetClientRect(FHandle,r);
    result := r.Bottom;
  end;
end;

procedure TAPIDialog.SetClientHeight(value: integer);
begin
  if FHandle = 0 then
    FClientHeight := value
  else
    ChangeWindowSize(FHandle,Width,(value+Height-ClientHeight));
end;

procedure TAPIDialog.InitWidthHeight;
begin
  ChangeWindowSize(FHandle,100,100);
  if FClientWidth <> 0 then
    SetClientWidth(FClientWidth)
  else
    if FWidth <> 0 then SetWidth(FWidth);

  if FClientHeight <> 0 then
    SetClientHeight(FClientHeight)
  else
    if FHeight <> 0 then SetHeight(FHeight);
end;

procedure TAPIDialog.SetColor(value: COLORREF);
begin
  if  FColor = value then Exit;
  FColor := value;
  if FHandle <> 0 then InvalidateRect(FHandle,nil,true);
end;

procedure TAPIDialog.SetIcon(value:HICON);
begin
  FIcon := value;
  if FHandle <> 0 then SetClassLong(FHandle,GCL_HICON,value);
end;

//--------------- TModalDialog -------------------------------
function ModalDlgProc(hDlg: HWND; Msg: UINT;
                     wparam, lparam: integer):BOOL; stdcall;
var
  AMsg: TMessage;
  Obj: integer;
begin
  result := true;
  AMsg.Msg := Msg;
  AMsg.WParam := wparam;
  AMsg.LParam := lparam;
  AMsg.Result := 0;
  case Msg of
    WM_INITDIALOG: begin
      SetProp(hDlg,'PASCAL',lparam);
      AMsg.Result := 1;
      TAPIDialog(lparam).Handle := hDlg;
      TAPIDialog(lparam).Dispatch(AMsg);
      result := Bool(AMsg.Result)
    end;

    WM_COMMAND: begin
      Obj := GetProp(hDlg,'PASCAL');
      if Obj <> 0 then TAPIDialog(Obj).Dispatch(AMsg);
    end;

    WM_DESTROY: begin
      Obj := GetProp(hDlg,'PASCAL');
      if Obj <> 0 then begin
        TAPIDialog(Obj).Dispatch(AMsg);
        TAPIDialog(Obj).Free;
      end;
      RemoveProp(hDlg,'PASCAL');
    end;

  else begin
    Obj := GetProp(hDlg,'PASCAL');
      if Obj = 0 then
        result := false
      else begin
        TAPIDialog(Obj).Dispatch(AMsg);
        result := BOOL(AMsg.Result);
      end;
    end;
  end;
end;

constructor TModalDialog.Create(hOwner:HWND);
begin
  inherited Create(hOwner);
  FStyle := DS_MODALFRAME or WS_POPUP or WS_VISIBLE;
  FTitle := 'APIModalDialog';
end;

procedure TModalDialog.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_INITDIALOG: begin
      SetIcon(FIcon);
      InitWidthHeight;
      SetPosX(FPosX);
      SetPosY(FPosY);
      SetWindowText(FHandle,PChar(FTitle));
      if Assigned(FOnInitDialog) then OnInitDialog(AMsg);
      TMessage(Message).Result := AMsg.Result;
    end;

    WM_ERASEBKGND:
      TMessage(Message).result :=
                 EraseBkGnd(FHandle,FColor,AMsg.WParam);

    WM_DESTROY: begin
      if Assigned(FOnDestroy) then OnDestroy(AMsg);
    end;

    WM_COMMAND: if Assigned(FOnCommand) then
                  OnCommand(AMsg)
                else if AMsg.WParamLo = ID_CANCEL then
                        Close(ID_CANCEL);

  end;
end;

function TModalDialog.Show:integer;
var
  pMyTmp: PDlgTemplate;
begin
  GetMem(pMyTmp,SizeOf(TDlgTemplate)+10);
  ZeroMemory(pMyTmp,SizeOf(TDlgTemplate)+10);
  pMyTmp^.style := FStyle;
  result := DialogBoxIndirectParam(hInstance,pMyTmp^,
                                   FOwner,@ModalDlgProc,integer(self));
  FreeMem(pMyTmp);
end;

procedure TModalDialog.Close(rslt: integer);
begin
  EndDialog(FHandle,rslt);
end;

procedure TModalDialog.Center;
begin
  CenterWindow(FHandle);
end;

//--------------------------------------------------------------

function CreateModalDialog(hOwner:HWND;x,y,cw,ch:integer;
                           Style:DWORD;sOnInit:TNotifyMessage):TModalDialog;
begin
  result := TModalDialog.Create(hOwner);
  if Style <> 0 then result.Style := Style;
  result.PosX := x;
  result.PosY := y;
  result.ClientWidth := cw;
  result.ClientHeight := ch;
  result.OnInitDialog := sOnInit;
end;

TAPIDialog クラスの実装コードは、以前に作った TSDIMainWindow クラスの実装とほぼ同じである。 ただ、実際にダイアログウィンドウが作られた後でないと、ウィンドウの位置や幅、アイコンなどを設定できないので、ハンドル (FHandle) がゼロのときは、単に private フィールドの変数に格納するだけである。そして、実際にダイアログが作られて WM_INITDIALOG を処理するときにこのフィールドを参照してダイアログウィンドウの属性を変更する。TModalDialog クラスの Show メソッドを見てみよう。

function TModalDialog.Show:integer;
var
  pMyTmp: PDlgTemplate;
begin
  GetMem(pMyTmp,SizeOf(TDlgTemplate)+10);
  ZeroMemory(pMyTmp,SizeOf(TDlgTemplate)+10);
  pMyTmp^.style := FStyle;
  result := DialogBoxIndirectParam(hInstance,pMyTmp^,
                                   FOwner,@ModalDlgProc,integer(self));
  FreeMem(pMyTmp);
end;

ここでは、前節で行ったのと同じように、TDlgTemplate を使って DialogBoxIndirectParam( ) APIによりモーダルダイアログボックスを作成して表示している。この関数の最後のパラメータに自分自身のインスタンス参照 self を設定して、ダイアログ関数にラッパーオブジェクトを知らせている。ダイアログ関数の WM_INITDIALOG メッセージの処理コードを見てみよう。

    WM_INITDIALOG: begin
      SetProp(hDlg,'PASCAL',lparam);
      AMsg.Result := 1;
      TAPIDialog(lparam).Handle := hDlg;
      TAPIDialog(lparam).Dispatch(AMsg);
      result := Bool(AMsg.Result)
    end;

ここでは、LParam でこのダイアログをつくったラッパーオブジェクトのインスタンス参照を受け取り、ウィンドウに 'PASCAL' という名前でそれをプロパティーにして格納し、TAPIDialog クラスにキャストして、Handle プロパティーをセットし、このメッセージをパスカルオブジェクトに配送している。 そのとき、Result フィールドは、このメッセージの処理で SetFocus( ) を使わないことを前提にしてノンゼロ値にしている。 OnInitDialog イベントハンドラで SetFocus( ) を使って、特定のコントロールにフォーカスを設定したときは、Result フィールドをゼロにして戻せばよい。 TModalDialogDefaultHandler( )WM_INITDIALOG メッセージ処理部を見てみよう。

    WM_INITDIALOG: begin
      SetIcon(FIcon);
      InitWidthHeight;
      SetPosX(FPosX);
      SetPosY(FPosY);
      SetWindowText(FHandle,PChar(FTitle));
      if Assigned(FOnInitDialog) then OnInitDialog(AMsg);
    end;

ここでは、すでにウィンドウハンドルが確定したので WM_INITDIALOG の処理として、幅と高さ、表示位置、アイコン、タイトルをプロパティーを参照して初期化している。その後、OnInitDialog イベントハンドラを呼び出している。 Close( ) メソッドを見てみよう。

procedure TModalDialog.Close(rslt: integer);
begin
  EndDialog(FHandle,rslt);
end;

ここでは、パラメータを戻り値にして EndDialog( ) を呼び出しているだけである。 ダイアログ関数の WM_DESTROY メッセージの処理部を見てみよう。

   WM_DESTROY: begin
      Obj := GetProp(hDlg,'PASCAL');
      if Obj <> 0 then begin
        TAPIDialog(Obj).Dispatch(AMsg);
        TAPIDialog(Obj).Free;
      end;
      RemoveProp(hDlg,'PASCAL');
    end;

ここでは、ハンドル値を参照してプロパティーからオブジェクト参照を取り出し、メッセージを配送して戻ってきてからパスカルオブジェクトを破棄している。そして、プロパティーをウィンドウオブジェクトから取り除いている。このようにして、モーダルダイアログが閉じられるとき、自動的にそのラッパーオブジェクトも破棄される。最後に TModalDialog クラスのインスタンス作成関数の実装部を見てみよう。

function CreateModalDialog(hOwner:HWND;x,y,cw,ch:integer;
                           Style:DWORD;sOnInit:TNotifyMessage):TModalDialog;
begin
  result := TModalDialog.Create(hOwner);
  if Style <> 0 then result.Style := Style;
  result.PosX := x;
  result.PosY := y;
  result.ClientWidth := cw;
  result.ClientHeight := ch;
  result.OnInitDialog := sOnInit;
end;
ここでは、ラッパーオブジェクトのインスタンスを作成してから、関数のパラメータをプロパティーに設定している。Style パラメータがゼロのときは、コンストラクタで設定したデフォルトスタイル DS_MODALFRAME or WS_POPUP or WS_VISIBLE が初期値となる。

以上で作成した TModalDialog クラスをテストするプログラムを ModalDialogClass.dpr に書こう。 以下に全リストを示す。

program ModalDialogClass;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  MDLG: TModalDialog;
  SelectColorOK: TAPIButton;
  GB: TAPIGroupBox;
  RG: TRadioGroup;
  GBtn: TBtnGroup;

  SelectedColor: integer;

const
  CLR: array[0..4] of COLORREF = (clrRed,clrGreen,clrBlue,clrAqua,clrLime);

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure SelectColorOKClick(var Msg: TMessage);
begin
  MDLG.Close(RG.CheckIndex);
end;

procedure GBtnClick(var Msg: TMessage);
begin
  case Msg.WParam of
    0: MDLG.ClientWidth := MDLG.ClientWidth+10;
    1: MDLG.ClientHeight := MDLG.ClientHeight+10;
    2: MDLG.PosX := MDLG.PosX+10;
    3: MDLG.PosY := MDLG.PosY+10;
    4: MDLG.Title := 'Title Changed';
    5: MDLG.Color := clrWhite;
    6: MDLG.Center;
  end;
end;

procedure MDLGInitDialog(var Msg:TMessage);
begin
  GB := CreateGroupBox(MDLG.Handle,10,10,120,170,'SelectColor');
  RG := CreateRadioGroup(MDLG.Handle,true,25,30,100,140,5,nil);
  RG.Captions[0] := '&Red';
  RG.Captions[1] := '&Green';
  RG.Captions[2] := '&Blue';
  RG.Captions[3] := '&Aqua';
  RG.Captions[4] := '&Lime';
  RG.SetCheck(SelectedColor);
  SelectColorOK := CreateButton(MDLG.Handle,10,190,120,30,'&O K',
                                               SelectColorOKClick);
  GBtn := CreateBtnGroup(MDLG.Handle,true,140,20,150,200,7,GBtnClick);
  GBtn.Captions[0] := 'Change &Width';
  GBtn.Captions[1] := 'Change &Height';
  GBtn.Captions[2] := 'Change &XPos';
  GBtn.Captions[3] := 'Change &YPos';
  GBtn.Captions[4] := 'Change &Title';
  GBtn.Captions[5] := 'Change &Color';
  GBtn.Captions[6] := 'C&enter';
end;

procedure MDLGCommand(var Msg:TMessage);
begin
  if Msg.WParamLo = ID_CANCEL then MDLG.Close(100);
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);


  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
var
  ret: integer;
begin
  MDLG := CreateModalDialog(hWindow,50,50,300,230,0,MDLGInitDialog);
  MDLG.Style := MDLG.Style or WS_CAPTION or WS_SYSMENU;
  MDLG.Icon := MainWnd.Icon;
  MDLG.Title := 'SelectBkColor';
  MDLG.OnCommand := MDLGCommand;
  ret := MDLG.Show;
  if ret <> 100 then begin
    MainWnd.Color := CLR[ret];
    SelectedColor := ret;
  end;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifModalDialogClass.zip(18.671kB)
ModalDialogClass.gif

実行して、Test! メニューを選択すると右図のようなモーダルダイアログボックスが表示される。このダイアログの左側半分は前節のプログラムと同じ動作をする。 右側のボタングループには、7個のボタンがあって、ダイアログボックスの幅、高さ、表示位置、タイトル、背景色を変更するテストをしている。 最後のボタンは、Center メソッドをテストしている。

実際にモーダルダイアログボックスを作っている OnTest( ) ハンドラを見てみよう。

procedure OnTest(hWindow: HWND);
var
  ret: integer;
begin
  MDLG := CreateModalDialog(hWindow,50,50,300,230,0,MDLGInitDialog);
  MDLG.Style := MDLG.Style or WS_CAPTION or WS_SYSMENU;
  MDLG.Icon := MainWnd.Icon;
  MDLG.Title := 'SelectBkColor';
  MDLG.OnCommand := MDLGCommand;
  ret := MDLG.Show;
  if ret <> 100 then begin
    MainWnd.Color := CLR[ret];
    SelectedColor := ret;
  end;
end;

ここでは、インスタンス作成関数でインスタンスを作成しプロパティーを設定してから Show メソッドを呼び出している。そして閉じたときの戻り値により、メインウィンドウの背景色を変更している。

redball.gifこの章の目次へ戻る

23−6 さまざまなスタイル

前節で作った TModalDialog クラスを利用して、ウィンドウスタイルをいろいろ変えてモーダルダイアログボックスを作ってみよう。

  1. エクスプローラを使って、新しいフォルダを 2306VariousStyles という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2305ModalDialogClass フォルダの Skeleton03.dprUtilFunc.pasGDIObject.pasUtilClass.pasAPIControl.pasAPIWindow.pas をコピーする。
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる。
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで VariousStyles.dpr という名前で保存する。
  5. コードエディタで以下のように編集する。
  6. [F.9]でコンパイルして実行する。

以下に VariousStyles.dpr の全リストを示す。

program VariousStyles;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  MD:TModalDialog;

  BG:TBtnGroup;

  Btn: TAPIButton;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg:TMessage);
begin
  MD.Close(ID_OK);
end;

procedure InitDialog(var Msg:TMessage);
begin
  Btn := CreateButton(MD.Handle,60,65,80,30,'&O K',BtnClick);
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BGClick(var Msg: TMessage);
begin
  MD := CreateModalDialog(mainWnd.Handle,50,50,200,100,0,InitDialog);
  case Msg.WParam of
    1:MD.Style := MD.Style or WS_CAPTION;
    2:MD.Style := MD.Style or WS_CAPTION or WS_SYSMENU;
    3:MD.Style := MD.Style or WS_CAPTION or WS_THICKFRAME;
    4:MD.Style := WS_POPUPWINDOW or WS_CAPTION;
    5:MD.Style := WS_POPUP or WS_VISIBLE;
    6:MD.Style := WS_POPUP or WS_VISIBLE or WS_BORDER;
    7:MD.Style := WS_POPUP or WS_VISIBLE or WS_THICKFRAME;
  end;
  MD.Icon := MainWnd.Icon;
  MD.Show;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  BG := CreateBtnGroup(hWindow,true,10,10,340,240,8,BGClick);
  BG.Interval := 3;
  BG.Captions[0] := 'Default';
  BG.Captions[1] := 'Default or WS_CAPTION';
  BG.Captions[2] := 'Default or WS_CAPTION or WM_SYSMENU';
  BG.Captions[3] := 'Default or WS_CAPTION or WS_THICKFRAME';
  BG.Captions[4] := 'WS_POPUPWINDOW or WS_CAPTION';
  BG.Captions[5] := 'WS_POPUP or WS_VISIBLE';
  BG.Captions[6] := 'WS_POPUP or WS_VISIBLE or WS_BORDER';
  BG.Captions[7] := 'WS_POPUP or WS_VISIBLE or WS_THICKFRAME';

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifVariousStyles.zip(18.008kB)
VariousStles.gif

実行すると、右図のように8個のボタンを持つボタングループが作られる。それぞれのボタンを押すと、キャプションに示されたとおりのモーダルダイアログボックスが表示される。デフォルトスタイルは、DS_MODALFRAME or WS_POPUP or WS_VISIBLE である。

以下に、それぞれのスタイルと表示されたダイアログボックスのキャプチャ画像を示す。

Style0.gifDefault = DS_MODALFRAME or WS_POPUP or WS_VISIBLE

Style1.gifDefault or WS_CAPTION

Style2.gifDefault or WS_CAPTION or WM_SYSMENU

Style3.gifDefault or WS_CAPTION or WS_THICKFRAME

Style4.gifWS_POPUPWINDOW or WS_CAPTION

Style5.gifWS_POPUP or WS_VISIBLE

Style6.gifWS_POPUP or WS_VISIBLE or WS_BORDER

Style7.gifWS_POPUP or WS_VISIBLE or WS_THICKFRAME

redball.gifこの章の目次へ戻る

23−7 まとめ

本章では、最初に、リソースファイルからモーダルダイアログボックスを作成する方法を調べた。 そして、ダイアログボックスを作成し、その中のコントロールからのメッセージを処理し、閉じる機構をテストした。 次に、モーダルダイアログボックス本体はリソースから、その中のコントロールはラッパークラスを使った例を示した。 さらに、モーダルダイアログボックスを表示しているときのモーダルループについて簡単に考察した。 また、TDlgTemplate 型レコードを使ってモーダルダイアログを作成する方法を調べ、この機構をカプセル化して TModalDialog クラスを作成しテストした。 最後に、モーダルダイアログボックスの様々なウィンドウスタイルについて例を示した。

redball.gifこの章の目次へ戻る


ここまでのプログラムファイル

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (19 kB)
  3. UtilClass.pas (74 kB)
  4. GDIObject.pas (21 kB)
  5. APIControl.pas (64 kB)
  6. APIWindow.pas (29 kB)



redball.gifこの章の目次へ戻る