第２４章 ダイアログボックスの研究 その２

前章では､ 様々な方法でモーダルダイアログボックスを作成して表示する方法を調べた｡ そして、TDlgTemplate 型レコードを使って、コントロールを持たないモーダルダイアログボックスを作成して表示する機能をカプセル化して TModalDialog クラスを作成した。コントロールは、このクラスの OnInitDialog イベントハンドラでラッパークラスを使って作られ、コントロールのメッセージ処理はそのラッパークラスのプロパティーやメソッドを使って行った。本章の前半では、TModalDialog クラスを使って、さまざまなカスタムモーダルダイアログを作ってみよう｡ 本章の後半では、モードレスダイアログについて調べることにする。

２４−０ この章の内容

第２４章 ダイアログボックスの研究 その２
２４−１ アバウトダイアログ
２４−１−１ 関数の集まりとしての実装
２４−１−２ 派生クラスとしての実装
２４−２ インプットボックス
２４−３ スプラッシュウィンドウ
２４−４ モードレスダイアログをつくる
２４−５ ふつうのポップアップウィンドウ
２４−６ モードレスダイアログクラス
２４−７ さまざまなウィンドウスタイル
２４−８ まとめ


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

２４−１ アバウトダイアログ

骨格プログラム Skeleton03.dpr では、About... メニューを選択すると表示されるモーダルダイアログは、Win32 ＡＰＩの MessageBox( ) 関数を使って表示していた。本節では、前章で作った TModalDialog クラスを使って、アバウトダイアログを作成する例を示そう｡ Win32 のコモンダイアログは、「関数」として実装されている。これらの関数は、ダイアログのインスタンスを作成して表示し、ユーザ入力の結果を戻す｡ プログラマの観点からは、関数自体はインスタンスを作る必要もなくすぐに使うことができて便利である｡ ここでも、アバウトダイアログを作成して表示する関数を作ろう｡ ただし､ その関数の実装方法には二つの方法がある。インスタンスを作成して表示し、コントロールのメッセージを処理して結果を戻す、という機能を「関数の集まり」として作成する方法と、もう一つは TModalDialog から派生してカスタマイズし例えば TMyAboutDialog というクラスを作成し、このインスタンスを作成する「関数」をユーザに提供するという方法である｡ ここでは、この二つの方法を試してみよう｡

２４−１−１ 関数の集まりとしての実装

前章で、TModalDialog クラスのインスタンスを作成して表示する例を示した｡ ここでは、この機能を「関数の集まり」としてまとめることにより、ユーザに同等の機能を一つの関数を呼び出すだけで実現するようにしよう。

  1. エクスプローラを使って、新しいフォルダを 2401MyAbout01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2306VariousStyles フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで MyAbout01.dpr という名前で保存する｡
  5. [ファイル]メニューから[新規作成...]を選んで表示されるダイアログから、「ユニット」を選んで新しくユニットファイルを作成し､ これを MyDialog.pas として保存する｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

最初に MyDialog.pas に ShowMyAbout1( ) という関数を作ろう。全リストを以下に示す｡

unit MyDialog;

interface

uses
  windows,
  messages,
  UtilFunc,
  APIWindow,
  APIControl,
  GDIObject;

//---------------- ShowMyAbout1 ------------------------------
function ShowMyAbout1(hOwner:HWND; text:string):integer;

implementation

//---------------- ShowMyAbout1 ------------------------------
var
  AboutDLG: TModalDialog;
  AboutOk: TAPIButton;
  AboutPanel: TAPIPanel;
  AboutLabel: TAPILabel;
  AboutText: string;

procedure AboutOK1Click(var Msg: TMessage);
begin
  AboutDLG.Close(IDOK);
end;

procedure InitAbout(var Msg:TMessage);
begin
  AboutPanel := CreatePanel(AboutDLG.Handle,10,10,240,120);
  with AboutPanel do begin
    OuterEdge := esSunken;
    InnerEdge := esRaised;
    EdgeWidth := 3;
    Color := RGB(255,230,230);
  end;
  AboutLabel := CreateLabel(AboutPanel.Handle,0,0,240,120,'');
  with AboutLabel do begin
    Margin := 7;
    BKMode := TRANSPARENT;
    Font.Name := 'ＭＳ Ｐ明朝';
    Font.Size := 12;
    TextAlign := DT_CENTER;
    Text := AboutText;
  end;
  AboutOK := CreateButton(AboutDLG.Handle,80,140,100,30,
                             '&O K',AboutOK1Click);
end;

function ShowMyAbout1(hOwner:HWND; text:string):integer;
begin
  AboutDLG := CreateModalDialog(hOwner,50,50,260,180,0,InitAbout);
  AboutDLG.Color := RGB(160,200,200);
  AboutText := text;
  result := AboutDLG.Show;
end;

end.

このユニットファイルの interface 部には、

function ShowMyAbout1(hOwner:HWND; text:string):integer;

としか宣言されていないので、このユニットのユーザには、この関数だけが見える｡ 実装部のすぐ下で 

var
  AboutDLG: TModalDialog;
  AboutOk: TAPIButton;
  AboutPanel: TAPIPanel;
  AboutLabel: TAPILabel;
  AboutText: string;

と宣言されているので、実装部においてこれらの変数はグローバルである｡ ShowMyAbout1( ) では、TModalDialog クラスのインスタンスを作り、プロパティを設定してから Show メソッドを呼び出して、実際にダイアログウィンドウを作成して表示している。このときの WM_INITDIALOG メッセージを処理する InitAbout( ) ハンドラでは､ パネルとラベルとボタンを作成し、各々のプロパティーを設定している｡ ボタンを押すと IDOK (=1) を返してダイアログが閉じる。このように、実装部では、グローバル変数を宣言し、ダイアログ作成・表示関数を実行して、メッセージハンドラを二つ実装しているだけである。

この関数をテストするプログラムを MyAbout01.dpr に書こう｡ Skeleton03.dpr から変更する必要があるのは OnTest( ) ハンドラを以下のようにするだけだ｡

procedure OnTest(hWindow: HWND);
var
  s:string;
begin
  s := 'Object Pascal API Program'+#13#13+
       'by Delphian Inc.,'+#13#13+
       'Created by Delphi3.1'+#13+
       '( 2000年7月23日 )';
  ShowMyAbout1(hWindow,s);
end;

DownloadExe.gifMyAbout.zip(17.715kB)
MyAbout01.gif

実行して、Test! メニューを選択すると右図のようなダイアログボックスが表示される｡ ボタンを押すか [ESC] キーを押すとこのダイアログが閉じる｡

本項では、About ダイアログを作成して表示する機能を関数の集まりとして実装した｡

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

２４−１−２ 派生クラスとしての実装

前章で作った TModalDialog クラスから派生し、カスタマイズして TMyAbout クラスを作成して About... ダイアログを実装することを考えよう｡ 前項の関数の集まりをクラスに書き換えてしまえばよいわけである｡ 早速作ってテストしてみよう｡

  1. エクスプローラを使って、新しいフォルダを 2402MyAbout02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2401MyAbout01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで MyAbout02.dpr という名前で保存する｡
  5. [ファイル]メニューから[新規作成...]を選んで表示されるダイアログから、「ユニット」を選んで新しくユニットファイルを作成し､ これを MyDialog.pas として保存する｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

最初に MyDialog.pas に TMyAbout クラスとそのインスタンス作成関数を作ろう｡ 全リストを以下に示す｡

unit MyDialog;

interface

uses
  windows,
  messages,
  UtilFunc,
  APIWindow,
  APIControl,
  GDIObject;

//---------------- ShowMyAbout2 ------------------------------
function ShowMyAbout2(hOwner:HWND; text:string):integer;


implementation

//---------------- ShowMyAbout2 ------------------------------
type
TMyAbout = class(TModalDialog)
private
  FOKButton:TAPIButton;
  FPanel: TAPIPanel;
  FLabel: TAPILabel;
  FText: string;
protected
public
  constructor Create(hOwner:HWND);override;
  procedure DefaultHandler(var Message); override;
  property Text:string read FText write FText;
end;

constructor TMyAbout.Create(hOwner:HWND);
begin
  inherited Create(hOwner);
  PosX := 50;
  PosY := 50;
  ClientWidth := 260;
  ClientHeight := 180;
end;

procedure AboutOK2Click(var Msg: TMessage);
var
  Obj: TMyAbout;
begin
  Obj := TMyAbout(GetProp(TAPIButton(Msg.Msg).Parent,'PASCAL'));
  Obj.Close(IDOK);
end;

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

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_INITDIALOG: begin
      InitWidthHeight;
      PosX := PosX;
      PosY := PosY;
      Color := RGB(160,200,200);
      FPanel := CreatePanel(Handle,10,10,240,120);
      with FPanel do begin
        OuterEdge := esSunken;
        InnerEdge := esRaised;
        EdgeWidth := 3;
        Color := RGB(255,230,230);
      end;
      FLabel := CreateLabel(FPanel.Handle,0,0,240,120,'');
      with FLabel do begin
        Margin := 7;
        BKMode := TRANSPARENT;
        Font.Name := 'ＭＳ Ｐ明朝';
        Font.Size := 12;
        TextAlign := DT_CENTER;
        Text := FText;
      end;
      FOKButton := CreateButton(Handle,80,140,100,30,
                                 '&O K',AboutOK2Click);
      if Assigned(OnInitDialog) then OnInitDialog(AMsg);
    end;

    WM_ERASEBKGND:
      TMessage(Message).result :=
                 EraseBkGnd(Handle,Color,AMsg.WParam);

    WM_COMMAND: if AMsg.WParamLo = ID_CANCEL then Close(ID_CANCEL);

  end;
end;

function ShowMyAbout2(hOwner:HWND; text:string):integer;
var
  AboutDLG: TMyAbout;
begin
  AboutDLG := TMyAbout.Create(hOwner);
  AboutDLG.Text := text;
  result := AboutDLG.Show;
end;

end.

ここでも interface 部には、

function ShowMyAbout2(hOwner:HWND; text:string):integer;

だけなので、他のユニットからはこの関数だけが見える｡ 実装部には、クラス定義とその実装の両方がある。クラス定義を見てみよう｡

TMyAbout = class(TModalDialog)
private
  FOKButton:TAPIButton;
  FPanel: TAPIPanel;
  FLabel: TAPILabel;
  FText: string;
protected
public
  constructor Create(hOwner:HWND);override;
  procedure DefaultHandler(var Message); override;
  property Text:string read FText write FText;
end;

このように、ダイアログボックス上に作られるボタンや、ラベル、パネルなどのコントロールのラッパーオブジェクトもクラスのフィールドに取り込んでいる。そして、コンストラクタと DefaultHandler( ) をオーバーライドし、新たに Text プロパティーを追加している｡ インスタンス作成関数の実装部を見てみよう。

function ShowMyAbout2(hOwner:HWND; text:string):integer;
var
  AboutDLG: TMyAbout;
begin
  AboutDLG := TMyAbout.Create(hOwner);
  AboutDLG.Text := text;
  result := AboutDLG.Show;
end;

ここでは、作成・表示されるモーダルダイアログボックスは、この関数のローカル変数となっている｡ Show メソッドから復帰すると自動的にウィンドウオブジェクトもパスカルオブジェクトも破棄されるので、ローカル変数で十分である｡ ダイアログに表示されるテキストは、派生クラスのプロパティーとして設定されている｡ コントロールは、DefaultHandler( ) の WM_INITDIALOG メッセージの処理部で作られている｡ ボタンのクリックハンドラは、本稿の仕様ではクラスのメソッドにできないので普通の関数となっている｡

このクラスをテストする MyAbout02.dpr は、前項と同じように Skeleton03.dpr の OnTest( ) ハンドラを以下のようにするだけである｡

procedure OnTest(hWindow: HWND);
var
  s:string;
begin
  s := 'Object Pascal API Program'+#13#13+
       'by Delphian Inc.,'+#13#13+
       'Created by Delphi3.1'+#13+
       '( 2000年7月23日 )';
  ShowMyAbout2(hWindow,s);
end;

DownloadExe.gifMyAbout02.zip(17.795kB)
MyAbout02.gif

実行して、Test! メニューを選択すると右図のように前項と同じダイアログボックスが表示される。

この項では、TModalDialog から派生してカスタムダイアログクラスを作成して表示する方法を示した｡

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

２４−２ インプットボックス

前節では、TModalDialog クラスを使ってアプリケーション固有のダイアログボックスを作成する二つの方法を示した｡ ＲＡＤのフォームデザイナを利用できないコードベースのプログラミングでは、アプリケーション固有のダイアログを作る多くの場面で、どちらかの方法でダイアログボックスを作成することになる。アバウトダイアログのような単純なダイアログボックスを作成するなら、関数の集まりとして手軽に作成する方が簡単だろう｡ しかし、複雑なダイアログボックスの場合は､ コードがクラス定義とその実装にまとまっているカスタムクラスを作る方が、筆者としては好みである｡ コントロールのイベントハンドラをクラスメソッドにできないのは残念であるが、コードの再利用性と維持の容易さという点で、カスタムクラスを作る方法の方が優れているように思う｡ この方式は､ Delphi のＲＡＤでフォームデザイナを使ってダイアログボックスを作成すると、自動的に TForm クラスから派生して TForm2 クラスを作成する過程とほとんど同じである｡
VCLInputBox.gif

Delphi のＶＣＬには InputBox( ) という関数があって、右図のようなモーダルダイアログボックスを表示して、アプリケーションはユーザから一行の文字列を受け取ることができる｡ 本節では､ このダイアログの機能をカスタムクラスを作成することにより実現してみよう｡

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

最初に APIWindow.pas に TModalDialog から派生して TInputBox クラスを作成しよう。uses 節に APIControl と GDIObject を追加する。そして、宣言部に以下の宣言を追加する。

//---------------- AInputBox ------------------------------
type
TInputBox = class(TModalDialog)
private
  FLabel:TAPILabel;
  FEdit: TAPIEdit;
  FOK: TAPIButton;
  FCancel: TAPIButton;
  FPrompt:string;
  FDefault:string;
public
  constructor Create(hOwner:HWND);override;
  procedure DefaultHandler(var Message); override;
  property Prompt:string read FPrompt write FPrompt;
  property DefString:string read FDefault write FDefault;
end;

function AInputBox(hOwner:HWND;ATitle,APrompt,ADefault:string):string;

この宣言を見れば分かるように､ ダイアログボックス上のコントロールをクラスのフィールドに取り込んでいる｡ そして、コンストラクタと DefaultHandler( ) をオーバーライドしている｡ さらに、二つの string 型のプロパティーを追加している｡ 実装部を以下に示す｡

//---------------- AInputBox ------------------------------
var
  resultString:string;

constructor TInputBox.Create(hOwner:HWND);
begin
  inherited Create(hOwner);
  Style := Style or WS_CAPTION or WS_SYSMENU;
  FPosX := 50;
  FPosY := 50;
  FClientWidth := 300;
  FClientHeight := 120;
end;

procedure OKClick(var Msg: TMessage);
var
  Obj: TInputBox;
begin
  Obj := TInputBox(GetProp(TAPIButton(Msg.Msg).Parent,'PASCAL'));
  Obj.Close(IDOK);
end;

procedure CancelClick(var Msg: TMessage);
var
  Obj: TInputBox;
begin
  Obj := TInputBox(GetProp(TAPIButton(Msg.Msg).Parent,'PASCAL'));
  Obj.Close(IDCANCEL);
end;

procedure EditChange(var Msg: TMessage);
begin
  resultString := TAPIEdit(Msg.Msg).Text;
end;

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

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_INITDIALOG: begin
      InitWidthHeight;
      PosX := FPosX;
      PosY := FPosY;
      Title := FTitle;
      FLabel := CreateLabel(FHandle,10,10,280,30,FPrompt);
      FLabel.BkMode := TRANSPARENT;
      FEdit := CreateEdit(FHandle,10,45,280,30,FDefault,EditChange);
      FOK := CreateButton(FHandle,40,80,100,30,'&O K',OKClick);
      FCancel := CreateButton(FHandle,160,80,100,30,'&Cancel',CancelClick);
      if Assigned(OnInitDialog) then OnInitDialog(AMsg);
    end;

    WM_COMMAND: if AMsg.WParamLo = ID_CANCEL then Close(ID_CANCEL);

  end;
end;

function AInputBox(hOwner:HWND;ATitle,APrompt,ADefault:string):string;
var
  AInputBox: TInputBox;
  ret:integer;
begin
  AInputBox := TInputBox.Create(hOwner);
  with AInputBox do begin
    Title := ATitle;
    Prompt := APrompt;
    DefString := ADefault;
  end;
  ret := AInputBox.Show;
  if ret = IDOK then result := resultString else result := ADefault;
end;

コンストラクタで幾つかのプロパティー値を初期化したあと、DefautHandler( ) の WM_INITDIALOG メッセージの処理部分でことロールを作成している｡ インスタンス作成関数 AInputBox( ) では、このクラスのインスタンスをつくり、プロパティーを設定してから Show メソッドを呼び出して、ダイアログウィンドウを作成して表示している｡ 戻り値が IDOK のときだけ、実装部のグローバル変数 resultString を使ってユーザ入力を戻している｡

この「関数」をテストするプログラムを InputBox.dpr に作成する。以下に全リストを示す｡

program InputBox;

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;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------

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

  L1 := CreateLabel(hWindow,10,10,340,30,'Default');

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

procedure OnTest(hWindow: HWND);
begin
  L1.Text := AInputBox(hWindow,'InputBox',
               '適当に文字列を入れてください',L1.Text);
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.gifInputBox.zip(17.877kB)
InputBox.gif

実行して、Test! メニューを選択すると、右図のようなモーダルダイアログボックスが表示され、一行の文字列を入力することができる｡ ＯＫボタンを押すとその文字列が、メインウィンドウのラベルに表示される。

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

２４−３ スプラッシュウィンドウ

アプリケーションによっては、起動時にアプリケーションの名前を記した華やかなスプラッシュウィンドウを表示するものが多い｡ その多くは、モードレスダイアログボックスであるが、ときどきモーダルダイアログを見かけることがある｡ Delphi を起動すると表示されるスプラッシュウィンドウは、表示中でもオブジェクトインスペクタやコードエディタや Form1 の作成のためのハードディスクへのアクセスが続いているので分かるようにモードレスである｡ 本稿で作るような小さなアプリケーションでは、ハードディスクからロードしてメモリに吸い上げるのに要する時間はわずかなので、スプラッシュウィンドウを表示する必要はないだろう｡ それでも、スプラッシュウィンドウを表示したくなる誘惑に、ときとして負けることがある。ここでは、モーダルダイアログボックスをスプラッシュウィンドウとして表示する方法を試してみよう｡

  1. エクスプローラを使って、新しいフォルダを 2404Splash という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2403InputBox フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Splash.dpr という名前で保存する｡
  5. [ファイル]メニューから[新規作成...]を選んで表示されるダイアログから、「ユニット」を選んで新しくユニットファイルを作成し､ これを MyDialog.pas として保存する｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

最初に MyDialog.pas に TModalDialog から派生して TMySplash クラスを作成しよう。ここでは、スプラッシュウィンドウに本稿のトップページのロゴをビットマップとして表示する。MyDialog.pas の全リストを以下に示す｡

unit MyDialog;

interface

uses
  windows,
  messages,
  UtilFunc,
  UtilClass,
  APIWindow,
  APIControl,
  GDIObject;

//----------------- MySplashDlg ---------------------------
type
TMySplash = class(TModalDialog)
private
  FBitmap:HBITMAP;
  FDispTime:integer;
  FOnPaint:TNotifyMessage;
  FTimer:TAPITimer;
public
  procedure DefaultHandler(var Message); override;
  property Bitmap:HBITMAP read FBitmap write FBitmap;
  property DispTime:integer read FDispTime write FDispTime;
  property OnPaint:TNotifyMessage read FOnPaint write FOnPaint;
end;

implementation

//----------------- MySplashDlg ---------------------------
procedure TMySplash.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin

  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_INITDIALOG: begin
      InitWidthHeight;
      Center;
      Title := 'My Splash';
      if FDispTime = 0 then FDispTime := 1000;
      FTimer := CreateTimer(Handle,FDispTime,nil);
      FTimer.On;
      if Assigned(OnInitDialog) then OnInitDialog(AMsg);
      TMessage(Message).Result := AMsg.Result;
    end;

    WM_TIMER: begin
      FTimer.Off;
      Close(1);
    end;

    WM_ERASEBKGND:
      TMessage(Message).result :=
                 EraseBkGnd(Handle,Color,AMsg.WParam);

    WM_PAINT: begin
      if Assigned(FOnPaint) then OnPaint(AMsg);
      TMessage(Message).Result := AMsg.Result;
    end;

    WM_DESTROY: begin
      if Assigned(OnDestroy) then OnDestroy(AMsg);
      If FBitmap <> 0 then DeleteObject(FBitmap);
    end;

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

end.

TMySplash はビットマップを一定時間表示したいので、時間を計る TAPITimer を private フィールドに追加し、その表示時間を設定する DispTime プロパティーと、表示するビットマップハンドルを保持する Bitmap プロパティーを追加し､ WM_PAINT メッセージを処理する OnPaint イベントを公開している。WM_TIMER と WM_PAINT メッセージを処理するために DefaultHandler( ) をオーバーライドしている。以下のようなビットマップのリソース記述ファイルをに作成してコンパイルする。なお、ロゴのビットマップは ＷＥＢ からダウンロードして、gif ファイルから title02.bmp に変換しておく。

//
//  MyRes.rc
//

SPLASH BITMAP "title02.bmp"

これらのクラスとリソースを使ってスプラッシュウィンドウを表示するプログラムを Splash.dpr に作ろう｡ 以下に全リストを示す｡

program Splash;

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

  {$R MyRes.res}

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

  SplashDLG: TMySplash;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure SplashPaint(var Msg:TMessage);
var
  ps:TPaintStruct;
begin
  if SplashDLG.Bitmap = 0 then exit;
  BeginPaint(SplashDLG.Handle,ps);
    DrawBitmap(ps.hdc,SplashDLG.Bitmap,10,10);
  EndPaint(SplashDLG.Handle,ps);
  Msg.Result := 1;
end;

procedure DisplaySplash;
begin
  SplashDLG := TMySplash.Create(0);
  with SplashDLG do begin
    ClientWidth := 410;
    ClientHeight := 210;
    DispTime := 2000;
    Color := clrGreen;
    Bitmap := LoadBitmap(hInstance,'SPLASH');
    OnPaint := SplashPaint;
    Show;
  end;
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);
begin
  DisplaySplash;
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

  DisplaySplash;

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

  Halt(MessageLoopNormal);


end.

DownloadExe.gifSplash.zip(17.990kB)
Splash.gif

実行すると右図のようなスプラッシュウィンドウが約２秒間表示される。Test! メニューを選択しても同じことが起こる｡

コードを見てみよう。メインプロシージャでメインウィンドウを作る前に、DisplaySplash 手続きを使って、オーナーウィンドウなしのモーダルダイアログを作成して表示している｡ 表示時間を２秒にし、リソースからビットマップをロードしてハンドルを Bitmap プロパティーにセットしている｡ ダイアログを表示するときに WM_PAINT メッセージを受け取るので OnPaint イベントハンドラが実行される。ここでは、ビットマップを表示しているだけだ｡ ここで使っている DrawBitmap( ) は、１９−４ ビットマップの表示 で作ったものである｡ ダイアログが閉じられると Show メソッドから復帰して DisplaySplash 手続きから戻るので、メインプロシージャでメインウィンドウが作成される｡

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

２４−４ モードレスダイアログをつくる

この章の残りの部分は、モードレスダイアログについて調べることにする。モードレスダイアログを作って表示するＡＰＩは、以下の４つである｡

function CreateDialog(hInstance: HINST; 
                 lpTemplateName: PChar;
                     hWndParent: HWND; 
                   lpDialogFunc: TFNDlgProc): HWND;

function CreateDialogParam(hInstance: HINST; 
                      lpTemplateName: PChar;
                          hWndParent: HWND; 
                        lpDialogFunc: TFNDlgProc; 
                         dwInitParam: LPARAM): HWND; stdcall;

function CreateDialogIndirect(hInstance: HINST; 
                       const lpTemplate: TDlgTemplate;
                             hWndParent: HWND; 
                           lpDialogFunc: TFNDlgProc): HWND;

function CreateDialogIndirectParam(hInstance: HINST; 
                            const lpTemplate: TDlgTemplate;
                                  hWndParent: HWND; 
                                lpDialogFunc: TFNDlgProc; 
                                 dwInitParam: LPARAM): HWND; stdcall;

これらのＡＰＩの宣言を見てみると２３−１ モーダルダイアログボックスをつくる で紹介したモードレスダイアログを作って表示する関数と１対１に対応していることが分かるだろう｡ パラメータは全く同じである。モーダルダイアログの作成表示関数との重要な相違点は、上の関数は、呼び出し後すぐに制御を戻すことと、そして、関数の戻り値がつくられたダイアログのウィンドウハンドルであることである｡ モードレスダイアログは、表示しても同じプロセスの他のウィンドウにアクセスできるので、モーダルループは必要なく、すぐに制御を戻すのは理解できるだろう｡ モードレスダイアログを閉じるのは､ 一般のウィンドウを閉じるのと同じように DestroyWindow( ) ＡＰＩを使う。

function DestroyWindow(hWnd: HWND): BOOL; stdcall;

したがって、モードレスダイアログは定義済みの「ダイアログボックスクラス」というより一般のポップアップウィンドウとみなしたほうが分かり易いでろう。この節では､ CreateDialogIndirect( ) ＡＰＩを使ってモードレスダイアログをコードで作成して表示してみよう。

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

以下に ModelessDialog01.dpr の全リストを示す｡

program ModelessDialog01;

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;

  hDlg:HWND;

  CloseBtn: TAPIButton;
  GB: TAPIGroupBox;
  RG: TRadioGroup;

  SelectedColor: integer;

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

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure CloseClick(var Msg: TMessage);
begin
  DestroyWindow(hDlg);
  hDlg := 0;
end;

procedure RGChange(var Msg:TMessage);
begin
  SelectedColor := RG.CheckIndex;
  MainWnd.Color := CLR[SelectedColor];
end;

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

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

      CloseBtn := CreateButton(hDialog,10,190,120,30,'&Close',
                                CloseClick);
      Exit;
    end;
    WM_COMMAND:
      case LOWORD(WParam) of
        IDCANCEL: begin
          DestroyWindow(hDialog);
          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;
begin
  GetMem(pMyTmp,SizeOf(TDlgTemplate)+10);
  ZeroMemory(pMyTmp,SizeOf(TDlgTemplate)+10);
  pMyTmp^.style := WS_POPUP or WS_VISIBLE or
                   WS_CAPTION;
  pMyTmp^.x := 100;
  pMyTmp^.y := 0;
  pMyTmp^.cx := 0;
  pMyTmp^.cy := 0;
  hDlg := CreateDialogIndirect(hInstance,pMyTmp^,hWindow,@DialogFunc);
  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
//------------------------------------------------------------
var
  Msg: TMsg;
begin

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

  while GetMessage(Msg,0,0,0) do begin
    if (hDlg=0) or
         (not Boolean(IsDialogMessage(hDlg,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

  Halt(Msg.wParam);

end.
DownloadExe.gifModelessDialog01.zip(15.922kB)
ModelessDialog01.gif

実行して、Test! メニューをクリックすると、右図に示したような前章でつくったモードダルダイアログと同じモードレスダイアログが表示される。マウスでクリックすると、メイウィンドウにアクセスできること、ダイアログがアクティブなときは [TAB] キーでプッシュボタンとラジオボタンの間のフォーカスが移動できること、ラジオボタン間のフォーカスは上下矢印キーで移動できること、[ESC] キーを押すとダイアログボックスを閉じることができること、など、「普通」のダイアログボックスと同じ機能が実現できていることが確かめられる。

コードを見てみよう。モードレスダイアログボックスを作って表示している OnTest( ) ハンドラを見てみよう｡

procedure OnTest(hWindow: HWND);
var
  pMyTmp: PDlgTemplate;
begin
  GetMem(pMyTmp,SizeOf(TDlgTemplate)+10);
  ZeroMemory(pMyTmp,SizeOf(TDlgTemplate)+10);
  pMyTmp^.style := WS_POPUP or WS_VISIBLE or
                   WS_CAPTION;
  pMyTmp^.x := 100;
  pMyTmp^.y := 0;
  pMyTmp^.cx := 0;
  pMyTmp^.cy := 0;
  hDlg := CreateDialogIndirect(hInstance,pMyTmp^,hWindow,@DialogFunc);
  FreeMem(pMyTmp);
end;

ここでは、TDlgTemplate レコードへのポインタを使って、CreateDialogIndirect( ) でモードレスダイアログを作成して、戻り値をグローバル変数 hDlg に格納している｡ ダイアログ関数 DialogFunc( ) では、WM_INITDIALOG メッセージの処理部でダイアログ上のコントロールを作成して初期化している。そして、WM_COMMAND の LOWORD(WParam) = IDCANCEL のとき、DestroyWindow( ) で閉じている｡ この処理がないと [ESC] キーで閉じることができない｡ それでは、[TAB] キーによるフォーカスの移動や、[ESC] キーを押すと WM_COMMAND メッセージが発行されるのは、どの部分のコードによるのだろうか。実はメッセージループのところがいつもと違っているのである｡

  while GetMessage(Msg,0,0,0) do begin
    if (hDlg=0) or
         (not Boolean(IsDialogMessage(hDlg,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

  Halt(Msg.wParam);

この while ループの中の if 文 では、hDlg が zero でなく、かつ IsDialogMessage(hDlg,Msg) が true を返すときは、TranslateMessage( ) 以下にメッセージを渡さず､ 通常のメッセージループを実行していない｡ 

function IsDialogMessage(hDlg: HWND; 
                    var lpMsg: TMsg): BOOL; stdcall;

このＡＰＩは、メッセージキューから取り出してきた lpMsg メッセージが、hDlg で識別されるモードレスダイアログに向けられてきたと判断したときは、true を返し、フォーカスの移動などのダイアログ特有の機能を実現しているのである。この関数のおかげでプログラマは、フォーカスの移動や [ESC] キーによる WM_COMMAND を発行するためのコードを書かなくて済むのである。上のような形のメッセージループを使うと、モードレスダイアログだけでなくメインウィンドウの上のコントロールについても自動的に [TAB] キーによるフォーカスの移動を実現できる。

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

２４−５ ふつうのポップアップウィンドウ

前節では、CreateDialogIndirect( ) ＡＰＩを使って､ モードレスダイアログボックスを作った｡ そこで分かったように、このような「ダイアログボックスクラス」専用の関数を使ってモードレスダイアログをつくり、ダイアログ関数でメッセージを処理する、というスキームは、モードレスダイアログボックスの場合、あまり有り難みがない。それは、モーダルループが必要なく、コントロールのメッセージは、そのラッパーオブジェクトのイベントハンドラで処理しているからである｡ いっそのこと、一般の「所有されたポップアップウィンドウ」を作ったほうが、拡張ウィンドウスタイルなどを設定できるほか、慣れ親しんだウィンドウ関数が使えて便利だろう｡ ここでは、骨格プログラム Skeleton03.dpr で作られるメインウィンドウと同じラッパークラス TSDIMainWindow を使って、一般の所有されたポップアップウィンドウを作成して、モードレスダイアログとして使ってみよう｡

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

以下に ModelessDialog02.dpr の全リストを示す｡

program ModelessDialog02;

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;

  hDlg:HWND;

  ModelessDLG: TSDIMainWindow;
  CloseBtn: TAPIButton;
  GB: TAPIGroupBox;
  RG: TRadioGroup;

  SelectedColor: integer;

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

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure CloseClick(var Msg: TMessage);
begin
  DestroyWindow(hDlg);
  hDlg := 0;
end;

procedure RGChange(var Msg:TMessage);
begin
  SelectedColor := RG.CheckIndex;
  MainWnd.Color := CLR[SelectedColor];
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure ModelessDLGCreate(var Msg:TMessage);
var
  p:TPoint;
begin
  ChangeWindowSize(ModelessDLG.Handle,130,250);
  p.x := 200; p.y := 5;
  ClientToScreen(MainWnd.Handle,p);
  ChangeWindowPos(ModelessDLG.Handle,p.x,p.y);
  SetWindowText(ModelessDLG.Handle,'SelectBkColor');

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

  CloseBtn := CreateButton(ModelessDLG.Handle,10,190,100,30,'&Close',CloseClick);
end;

procedure ModelessDLGCommand(var Msg:TMessage);
begin
  if Msg.WParamLo = IDCANCEL then ModelessDLG.Close;
end;

procedure ModelessDLGDestroy(var Msg:TMessage);
begin
  hDlg := 0;
end;

procedure ModelessWindowParams(var CP:TCreateParamsEx);
begin
  CP.dwExStyle := WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE;
  CP.dwStyle := WS_POPUP or WS_VISIBLE or WS_CAPTION or
                WS_SYSMENU or WS_BORDER;
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);
begin
  ModelessDLG := TSDIMainWindow.Create(hWindow,'ModelessDLG');
  with ModelessDLG do begin
    OnWindowParams := ModelessWindowParams;
    OnCreate := ModelessDLGCreate;
    OnDestroy := ModelessDLGDestroy;
    OnCommand := ModelessDLGCommand;
  end;
  ModelessDLG.DoCreate;
  hDlg := ModelessDLG.Handle;
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
//------------------------------------------------------------
var
  Msg: TMsg;
begin

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

  while GetMessage(Msg,0,0,0) do begin
    if (hDlg=0) or
         (not Boolean(IsDialogMessage(hDlg,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

  Halt(Msg.wParam);

end.

DownloadExe.gifModelessDialog02.zip(15.917kB)
ModelessDialog02.gif

実行すると、右図のようなモードレスダイアログを表示して、前節の場合と同じように動作するのを確かめることができる。前節でつくられたダイアログと見かけがちょっと違うのは、拡張ウィンドウスタイルを設定しているからである｡ このように、ダイアログクラスとまったく関係なく所有されたポップアップウィンドウを作成しても、同じように動作する事が分かった｡

コードを見てみよう。OnTest( ) ハンドラで TSDIMainWindow クラスを使ってウィンドウを作成している。

procedure OnTest(hWindow: HWND);
begin
  ModelessDLG := TSDIMainWindow.Create(hWindow,'ModelessDLG');
  with ModelessDLG do begin
    OnWindowParams := ModelessWindowParams;
    OnCreate := ModelessDLGCreate;
    OnDestroy := ModelessDLGDestroy;
    OnCommand := ModelessDLGCommand;
  end;
  ModelessDLG.DoCreate;
  hDlg := ModelessDLG.Handle;
end;

ここでは、メインウィンドウを作成するときと同じように、クラスのインスタンスを作成してからイベントハンドラを設定した後､ DoCreate メソッドを呼び出してウィンドウオブジェクトを作成している｡ そして、メッセージループの IsDialogMessage( ) で使われるダイアログハンドルを設定している｡ ウィンドウスタイルを設定する ModelessWindowParams ハンドラを見てみよう。

procedure ModelessWindowParams(var CP:TCreateParamsEx);
begin
  CP.dwExStyle := WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE;
  CP.dwStyle := WS_POPUP or WS_VISIBLE or WS_CAPTION or
                WS_SYSMENU or WS_BORDER;
end;

ここでは、作成されるダイアログウィンドウのウィンドウスタイルと拡張スタイルを設定し直している。前節で示したようなダイアログテンプレートを使ってモードレスダイアログを作成する場合は､ 拡張ウィンドウスタイルを設定できなかったので、この節での作成方法の方がいろいろなダイアログを作成できることが分かるだろう｡ ダイアログ内でのメッセージ処理は前節と同じようにコントロールのラッパークラスのイベントハンドラで行っている。また、ダイアログ自身のメッセージ処理は、ダイアログ関数ではなく、TSDIMainWindow クラスのイベントハンドラで行っている。

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

２４−６ モードレスダイアログクラス

この節では、前節で試みた一般の「所有されたポップアップウィンドウ」を作成して表示する機能をカプセル化してモードレスダイアログボックスクラスを作ることを考える｡ 前節と同じように TSDIMainWindow またはその上位クラスから派生して作ることもできるが、モーダルダイアログクラス TModalDialog との整合性をとるために、TAPIDialog クラスから派生して作ることにしよう。それではさっそく作り始めよう｡

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

最初に、UtilFunc.pas に、モードレスダイアログを使うときのメッセージループを関数化したものを実装しよう｡ 宣言部の MessageLoopAccel( ) の下に以下の宣言を追加する｡

function MessageLoopModeless(var hDlg:HWND): integer;

そして、実装部の対応する場所に以下のコードを挿入する。

function MessageLoopModeless(var hDlg:HWND): integer;
var
  Msg: TMsg;
begin
  while GetMessage(Msg,0,0,0) do begin
    if (hDlg=0) or
         (not Boolean(IsDialogMessage(hDlg,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
  result := Msg.wParam;
end;

この関数の引数は、ダイアログウィンドウのハンドルであるが、変数渡しにしているのはアクセレレータのときと同じように途中での変更を可能にするためである。それでは、APIWindow.pas に TModelessDialog クラスを作成しよう｡ 宣言部を以下に示す｡

//--------------- TModelessDialog -------------------------------
type
TModelessDialog = class(TAPIDialog)
private
  FClassName:string;
  FExStyle: DWORD;
  FPhDialog: PInteger;
  FOnCreate: TNotifyMessage;
protected
public
  constructor Create(hOwner:HWND;ClassName:string);virtual;
  destructor Destroy; override;
  procedure DefaultHandler(var Message); override;
  function Show:HWND;
  procedure Close;
  procedure Center;
  property ExStyle:DWORD read FExStyle write FExStyle;
  property PhDialog: PInteger read FPhDialog write FPhDialog;
  property OnCreate :TNotifyMessage read FOnCreate write FOnCreate;
end;

function CreateModelessDialog(hOwner:HWND;clsnm:string;x,y,cw,ch:integer;
                 ExStyle,Style:DWORD;sOnCreate:TNotifyMessage):TModelessDialog;

このクラスは、TAPIDialog から派生しており、コンストラクタを上書きしている。そして、デストラクタと DefaultHandler( ) をオーバーライドしている。Close と Center メソッドは、TModalDialog と同じである｡ ExStyle プロパティーを追加して拡張ウィンドウスタイルを指定できるようにしている｡ 整数へのポインタである PInteger 型の PhDialog プロパティーには、メッセージループに渡すウィンドウハンドルを保持するグローバル変数のアドレスを指定する。こうすると、グローバル変数を通して動的にダイアログハンドルの値を変更できる。実装部を以下に示す｡

//--------------- TModelessDialog -------------------------------
constructor TModelessDialog.Create(hOwner:HWND;ClassName:string);
begin
  FHandle := 0;
  FOwner := hOwner;
  FColor := clrBtnFace;
  FStyle := WS_POPUP or WS_VISIBLE or WS_CAPTION or
            WS_SYSMENU or WS_DLGFRAME;
  FExStyle := WS_EX_TOOLWINDOW;
  FClassName := ClassName;
  FTitle := 'APIModolessDialog';
end;

destructor TModelessDialog.Destroy;
begin
  RemoveProp(FHandle,'OBJECT');
  inherited Destroy;
end;

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

  AMsg := TMessage(Message);

  case AMsg.Msg of

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

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

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

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

    WM_ACTIVATE: begin
      if (AMsg.WParamLo<>WA_INACTIVE) and (FPhDialog<>nil) then
        FPhDialog^ := FHandle;
    end;
  end;
end;

function TModelessDialog.Show:HWND;
var
  WC:TWndClass;
begin
  WC.lpszClassName   := PChar(FClassName);
  WC.lpfnWndProc     := @CustomWndProc;
  WC.style           := CS_VREDRAW or CS_HREDRAW;
  WC.hInstance       := hInstance;
  WC.hIcon           := 0;
  WC.hCursor         := LoadCursor(0,IDC_ARROW);
  WC.hbrBackground   := ( COLOR_BTNFACE+1 );
  WC.lpszMenuName    := nil;
  WC.cbClsExtra      := 0;
  WC.cbWndExtra      := 0;

  RegisterClass(WC);

  FHandle := CreateWindowEx(FExStyle,
                            PChar(FClassName),
                            PChar(FTitle),
                            FStyle,
                            0,
                            0,
                            100,
                            100,
                            FOwner,
                            0,
                            hInstance,
                            self);

  ShowWindow( FHandle, CmdShow );
  UpDateWindow(FHandle);
  result := FHandle;
end;

procedure TModelessDialog.Close;
begin
  DestroyWindow(FHandle);
end;

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

function CreateModelessDialog(hOwner:HWND;clsnm:string;x,y,cw,ch:integer;
                 ExStyle,Style:DWORD;sOnCreate:TNotifyMessage):TModelessDialog;
begin
  result := TModelessDialog.Create(hOwner,clsnm);
  if ExStyle <> 0 then result.ExStyle := ExStyle;
  if Style <> 0 then result.Style := Style;
  result.PosX := x;
  result.PosY := y;
  result.ClientWidth := cw;
  result.ClientHeight := ch;
  result.OnCreate := sOnCreate;
end;

コンストラクタでは、プロパティーを初期化しているだけである｡ 上書きしたので継承メソッドは呼び出さない｡ Show メソッドでは、第１章と同じようにしてウィンドウを作成している。つまり、ウィンドウクラスを定義して登録し、それを参照して CreateWindowEx( ) でウィンドウを作成している｡ ただし、hWndParent フィールドにはオーナーウィンドウのハンドルを設定している。そして、ウィンドウ関数には、TSDIMainWindow クラスが使っているものと同じ関数を設定している｡ DefaultHandler( ) では、WM_ACTIVATE メッセージを捕まえて処理している。

    WM_ACTIVATE: begin
      if (AMsg.WParamLo<>WA_INACTIVE) and (FPhDialog<>nil) then
        FPhDialog^ := FHandle;
    end;

このメッセージは、ウィンドウがアクティブになってフォーカスを得たとき、またはインアクティブになってフォーカスを失うとき、失う方に最初に送られ、次に得る方に送られてくる。Delphi に付属する Win32.hlp では、

WM_ACTIVATE 
fActive = LOWORD(wParam);           // activation flag 
fMinimized = (BOOL) HIWORD(wParam); // minimized flag 
hwnd = (HWND) lParam;               // window handle

となっている。fActive に設定されているのは、Windows.pas に定義されている以下の定数である。

const
  { WM_ACTIVATE state values }
  WA_INACTIVE = 0;     // インアクティブになる
  WA_ACTIVE = 1;       // マウスクリック以外でアクティブになる
  WA_CLICKACTIVE = 2;  // マウスクリックによってアクティブになる

fMinimized が true のときは、そのウィンドウがアイコン化されていることを示す｡ hwnd には、fActrive が WA_INACTIVE のときは、アクティブになるウィンドウのハンドルが入っている。逆に、WA_ACTIVE または WA_CLICKACTIVE のときは、インアクティブになるウィンドウのハンドルが入っている｡ TModelessDialog クラスの DefaultHandler( ) では、このメッセージを受け取ったときアクティブになるときは、メッセージループで参照するダイアログハンドルを保持するグローバル変数に自分のウィンドウハンドルの値を設定している｡ このようにして、[TAB] キーによるフォーカスの移動やニーモニックによるコントロールへのアクセス（今までの例では、"C" キーによる Close ボタンのプッシュ）を動的に変更できるわけである｡

それでは、ModelessDialogClass01.dpr にこのクラスをテストするプログラムを書く｡ 以下に全リストを示す｡

program ModelessDialogClass01;

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;

LB: TAPIListBox;
  Btn: TAPIButton;

  hDlg:HWND;

  ModelessDLG: TModelessDialog;
  CloseBtn: TAPIButton;
  GB: TAPIGroupBox;
  RG: TRadioGroup;

  SelectedColor: integer;

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

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure CloseClick(var Msg: TMessage);
begin
  ModelessDLG.Close;
end;

procedure RGChange(var Msg:TMessage);
begin
  SelectedColor := RG.CheckIndex;
  MainWnd.Color := CLR[SelectedColor];
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure ModelessDLGCreate(var Msg:TMessage);
begin
  with ModelessDLG do begin
    ClientWidth := 130;
    ClientHeight := 230;
    PosX := 200;
    PosY := 5;
    Title := 'SelectBkColor';
    PhDialog := @hDlg;
  end;

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

  CloseBtn := CreateButton(ModelessDLG.Handle,10,190,100,30,'&Close',CloseClick);
end;

procedure MainActivate(var Msg:TMessage);
begin
  if Msg.WParamLo <> WA_INACTIVE then hDlg := MainWnd.Handle;
end;

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

  LB := CreateListBox(hWindow,10,10,150,100,nil);
  Btn := CreateButton(hWindow,10,120,150,30,'TestFocus',nil);

  hDlg := hWindow;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
    Trap(WM_ACTIVATE,MainActivate);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  ModelessDLG := TModelessDialog.Create(hWindow,'ModelessDLG');
  with ModelessDLG do begin
    PhDialog := @hDlg;
    OnCreate := ModelessDLGCreate;
  end;
  ModelessDLG.Show;
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(MessageLoopModeless(hDlg));

end.

DownloadExe.gifModelessDialogClass01.zip(17.276kB)
ModelessDialogClass01.gif

実行すると、メインウィンドウにリストボックスとボタンが作られる。[TAB] キーを押すと交互にフォーカスが移動することを確かめてほしい。Test! メニューを選択すると右図のようなモードレスダイアログが表示され、前節と同じように動作する。マウスでメインウィンドウをクリックすると、メインウィンドウがアクティブになって、[TAB] キーによるフォーカスの移動ができるようになる。これは、上のコードを見れば分かるようにメインウィンドウでも WM_ACTIVATE メッセージを処理してグローバル変数 hDlg に自分のハンドルを設定しているからである｡ このようにすると、複数のモードレスダイアログがあっても、hDlg の値を自動的に変更してダイアログボックス特有の処理を全てのウィンドウで行うことができる｡

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

２４−７ さまざまなウィンドウスタイル

モーダルダイアログボックスのときと同じように、さまざまなウィンドウスタイルをモードレスダイアログについても調べてみよう｡ 前節の実装方法では、拡張ウィンドウスタイルも設定できるのでウィンドウスタイルのバリエーションは増えている。一般のポップアップウィンドウであるから、メインウィンドウに設定できるスタイルと同じものである。

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

以下に ManyStyles.dpr の全リストを示す｡

program ManyStyles;

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:TModelessDialog;
  hDlg:HWND;

  BG:TBtnGroup;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure MDCreate(var Msg:TMessage);
begin
  BG.Enable := false;
end;

procedure MDDestroy(var Msg:TMessage);
begin
  BG.Enable := true;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BGClick(var Msg: TMessage);
begin
  MD := CreateModelessDialog(MainWnd.Handle,'Many_Styles',
                                   50,50,200,100,0,0,MDCreate);
  MD.OnDestroy := MDDestroy;
  MD.PhDialog := @hDlg;
  case Msg.WParam of
    1:MD.ExStyle := WS_EX_CLIENTEDGE;
    2:MD.Style := WS_POPUP or WS_VISIBLE or WS_DLGFRAME;
    3:MD.ExStyle := WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE;
    4:begin
        MD.Style := WS_POPUP or WS_VISIBLE or WS_DLGFRAME;
        MD.ExStyle := WS_EX_CLIENTEDGE;
      end;
    5:MD.ExStyle := WS_EX_STATICEDGE or WS_EX_CLIENTEDGE;
    6:begin
        MD.Style := WS_POPUP or WS_VISIBLE or WS_DLGFRAME;
        MD.ExStyle := WS_EX_STATICEDGE;
      end;
    7:begin
        MD.Style := WS_POPUP or WS_VISIBLE;
        MD.ExStyle := WS_EX_TRANSPARENT;
      end;
  end;
  MD.Show;
end;

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

  BG := CreateBtnGroup(hWindow,true,10,10,480,240,8,BGClick);
  BG.Interval := 3;
  BG.Captions[0] := 'Default ; Default';
  BG.Captions[1] := 'Default ; WS_EX_CLIENTEDGE';
  BG.Captions[2] := 'WS_POPUP or WS_VISIBLE or WS_DLGFRAME ; Default';
  BG.Captions[3] := 'Default ; WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE';
  BG.Captions[4] := 'WS_POPUP or WS_VISIBLE or WS_DLGFRAME ; WS_EX_CLIENTEDGE';
  BG.Captions[5] := 'Default ; WS_EX_STATICEDGE or WS_EX_CLIENTEDGE';
  BG.Captions[6] := 'WS_POPUP or WS_VISIBLE or WS_DLGFRAME ; WS_EX_STATICEDGE';
  BG.Captions[7] := 'WS_POPUP or WS_VISIBLE ; WS_EX_TRANSPARENT';

  with MainWnd do begin
    ClientWidth := 500;
    ClientHeight := 260;
    Center;
    Trap(WM_ACTIVATE,MainActivate);
  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(MessageLoopModeless(hDlg));

end.

DownloadExe.gifManyStyles.zip(15.763kB)
ManyStyles.gif

実行すると、右図のように８個のボタンを持つボタングループが作られる。各キャプションには押すと作られるモードレスダイアログのスタイルと拡張スタイルが表示されている｡ ボタンを押すとモードレスダイアログが表示される。このとき、ボタングループのボタンが使用不可になるのでモーダルダイアログのように見えるが、メインウィンドウをクリックするとタイトルバーの色が変わってフォーカスを得るので、モードレスダイアログであることが分かるだろう｡ TModelessDialog クラスのインスタンス変数を一つだけしかつかっていないため、複数のダイアログを作らせないためにダイアログ表示中は、ボタンを使用不可にしている。ダイアログを閉じるには、ダイアログにフォーカスをおいて [ESC] を押すと良い｡ 以下に、各スタイルのときのダイアログのキャプチャ画面を示す｡
MS01.gif

Default = WS_POPUP or WS_VISIBLE or WS_CAPTION or WS_SYSMENU or WS_DLGFRAME
Default = WS_EX_TOOLWINDOW
MS02.gif

Default
WS_EX_CLIENTEDGE
MS03.gif

WS_POPUP or WS_VISIBLE or WS_DLGFRAME
Default
MS04.gif

Default
WS_EX_TOOLWINDOW or WS_EX_CLIENTEDGE
MS05.gif

WS_POPUP or WS_VISIBLE or WS_DLGFRAME
WS_EX_CLIENTEDGE
MS06.gif

Default
WS_EX_STATICEDGE or WS_EX_CLIENTEDGE
MS07.gif

WS_POPUP or WS_VISIBLE or WS_DLGFRAME
WS_EX_STATICEDGE
MS08.gif

WS_POPUP or WS_VISIBLE
WS_EX_TRANSPARENT （透明ウィンドウ）

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

２４−８ まとめ

本章の前半では､ 前章で作った TModalDialog クラスをつかってカスタマイズしたモーダルダイアログをつくる方法を調べた。後半では、モードレスダイアログの作成方法を調べ､ 一般の所有されたポップアップウィンドウを作成する機構をカプセル化してモードレスダイアログクラスとして TModelessDialog を作成し、テストした｡

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 (35 kB)


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