第6章 コントロール :
プッシュボタンコントロール

第1章では Generic01.dpr で何もしないウィンドウを作った。 その手順を思い出してみよう。 1−3節でも述べたように、メインウィンドウを作成するには以下の手順でコードを書く。

  1. TWndClass レコード を定義する。
  2. Win32OSに、TWndClass レコードを登録する。
  3. 登録した TWndClass レコードを基にして、window を作成する。
  4. 作成した window を表示する。
  5. プログラムが終了しないように、終了の合図があるまでループする。

Win32 では、ボタンやリストボックス、エディット、コンボボックス、スクロールバーなどはアプリケーションを構成する部品として、「登録済み」の子ウィンドウクラスとして定義されている。 これらは標準コントロールと呼ばれている。 つまり、上記の手順 1と2は既に Windows がやってくれている。 ユーザーは3の手順だけをコードに書けばこれらのコントロールを手に入れられる。 子ウィンドウであるので手順4と5ははじめから必要ない。

既に気づいているように、 Delphi の コンポーネントパレットの Standard ページのコンポーネントの大部分は、これらの標準コントロールをVCLでカプセル化したものだ。 この章では、 標準コントロールのうちボタンコントロールについて詳しく紹介し、とくにプッシュボタンコントロールをカプセル化したクラスを作ることにする。 ボタンコントロールは、ウィンドウを作成する CreateWindow( ) APIの第三パラメータである dwStyle の指定を変更することにより、プッシュボタン・チェックボックス・ラジオボタン・グループボックスなどを作ることができる。 グループボックスがボタンの一員であるのは少々おかしい感じがするが、とにかくそういう仕様になっているのだ。 標準コントロールはウィンドウであるからウィンドウ関数を持っているが、これらは Win32 がこれらのクラスを登録するときすでに実装されている。 したがって、ユーザーは標準コントロールのウィンドウ関数のソースコードを見ることはできないが、どのように動作するのかは公表されているので知ることができる。 これらのコントロールを使うためには、結局、デフォルトでインストールされているウィンドウ関数の仕様にしたがったコードを書くことにするか、このウィンドウ関数をサブクラス化してカスタマイズするかを決断しなければならない。

6−0 この章の内容

第6章 コントロール : プッシュボタンコントロール
6−1 ボタンコントロールを使ってみる
6−2 ボタンコントロールの概観
6−3 コントロールのラッパークラスをつくるための方針
6−4 TSelfSubClass、TAPIControl と TAPIButton の実装
6−5 実装コードを調べる
6−6 動的に変更できるスタイル
6−7 RAD環境でのテスト
6−8 まとめ


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

6−1 ボタンコントロールを使ってみる

すでに述べたようにボタンコントロールは、Win32 の登録済みの子ウィンドウの一つである。 この節では、 ボタンコントロールを作ってクリックイベントなどがどのように処理されるのか調べよう。 子ウィンドウといえどもウィンドウには違いないので、CreateWindow( ) APIで作成する。まず手始めに、プッシュボタンとチェックボックスを一つずつ作って、とりあえずこれらのコントロールを使ってみることにしよう。

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

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

program PushButton01;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
const
  ID_BTN1 = 400;
  ID_BTN2 = 401;

var
  Clr: COLORREF;

  hBtn1, hBtn2: HWND;
  L1,L2: TAPILabel;

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

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := Msg.Msg;
  Clr := clrWindow;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,500,360);
  CenterWindow(hWindow);

  L1 := CreateLabel(hWindow,20,50,220,240,'');
  with L1 do begin
    Text := ' Click Test! Menu';
    Margin := 6;
    Color := RGB(220,255,220);
    DrawFrame := true;;
  end;

  L2 := CreateLabel(hWindow,250,50,220,240,'');
  with L2 do begin
    Margin := 6;
    Color := RGB(220,255,220);
    DrawFrame := true;;
  end;
end;

procedure OnTest(hWindow: HWND);
var
  WS: Integer;
begin
  if not IsWindow(hBtn1) then begin
    hBtn1 := CreateWindow('BUTTON',
                          'Push Button',
                          WS_CHILD or WS_VISIBLE or
                          BS_NOTIFY or BS_PUSHBUTTON,
                          40,10,120,32,
                          hWindow,
                          ID_BTN1,
                          hInstance,nil);

    hBtn2 := CreateWindow('BUTTON',
                          'CheckBox',
                          WS_CHILD or WS_VISIBLE or
                          BS_NOTIFY or BS_AUTOCHECKBOX,
                          180,10,120,32,
                          hWindow,
                          ID_BTN2,
                          hInstance,nil);
    L1.Text := 'Push Button!';
  end else begin
    EnableWindow(hBtn1,EnableWindow(hBtn1,true));
    WS := GetWindowLong(hBtn2,GWL_STYLE);
    if (WS and BS_LEFTTEXT)=0 then
      SetWindowLong(hBtn2,GWL_STYLE,WS or BS_LEFTTEXT)
    else
      SetWindowLong(hBtn2,GWL_STYLE,WS-BS_LEFTTEXT);
    InvalidateRect(hBtn2,nil,true);
  end;
end;

procedure OnCommand(var Msg: TMessage);
var
  s: string;
begin
  InitMenuCommand(Msg,OnTest);
  if Msg.LParam = 0 then exit;
  case Msg.WParamHi of
    BN_CLICKED: begin
      SetLength(s,50);
      SetLength(s,GetWindowText(Msg.LParam,PChar(s),50));
      L1.Text := WindowInfo(s,Msg.LParam);
      L2.Text := ClassInfo(Msg.LParam);
    end;
    BN_SETFOCUS, BN_KILLFOCUS: MessageBeep($FFFFFFFF);
  end;
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifPushButton01.zip(15.866kB)

PushButton01.gifさっそく実行してみよう。Test! メニューをクリックするとプッシュボタンとチェックボックスが現れる。 二度目以降で Test! を選ぶとプッシュボタンは有効性が、チェックボックスは左右の配置スタイルが反転する。どちらかをクリックするとラベルにそのウィンドウ情報とクラス情報が表示される。フォーカスが移動するときにはシステムブザーが鳴る。実行時の様子を右図に示す。

コードを見ていこう。 まず作成する二つのボタンのためのウィンドウハンドルを格納するグローバル変数と TAPILabel 型のラベルを二つ宣言しておく。

  hBtn1, hBtn2: HWND;
  L1,L2: TAPILabel;

コントロールをつくるときには、各コントロールを識別する整数番号(コントロールID)が必要なので、二個のボタンのためにグローバル定数を定義しておく。

const
  ID_BTN1 = 400;
  ID_BTN2 = 401;

OnCreate( ) ハンドラではボタンの輪郭を明確にするためにウィンドウの背景色を clrWindow にしてから、ラベルを二つつくっている。OnTest( ) ハンドラでは CreateWindow( ) APIを使ってプッシュボタンとチェックボックスをつくっている。 このハンドラの最初の if 文は、何度メニューをクリックされても、一度だけボタンをつくるために必要だ。 IsWindow( ) APIは、パラメータにウィンドウハンドルを渡すと、すでに対応するウィンドウが存在するときは true を返してくれる。

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

コントロールは、CreateWindow( ) で作られる。 このAPIはメインウィンドウの作成のときに説明した CreateWindowEx( ) と第一パラメータがないことだけが違う。

  function CreateWindow(lpClassName: PChar; 
                       lpWindowName: PChar;
                            dwStyle: DWORD; 
              X, Y, nWidth, nHeight: Integer; 
                         hWndParent: HWND;
                              hMenu: HMENU; 
                          hInstance: HINST; 
                            lpParam: Pointer): HWND;

第一パラメータ lpClassName には作成するウィンドウのクラス名を指定するが、コントロールは Win32 の登録済みのクラスなので 'BUTTON' を指定する。 OSの仕様上、このクラス名は大文字小文字を識別しないので 'Button' でも 'bUTTON' でもかまわない。 第二パラメータ lpWindowName にはコントロールに表示される文字列を指定する。メインウィンドウのときにはタイトルバーに表示される文字列を指定していた。 この文字列は、2−4節で既に説明した SetWindowText( ) APIを使えばいつでも変更できる。 また、GetWindowText( ) APIを使えばいつでも取得できる。

  function GetWindowText(hWnd: HWND; 
                     lpString: PChar; 
                    nMaxCount: Integer): Integer; stdcall;

第二パラメータ lpString には文字列を受け取る PChar 型のバッファを 第三パラメータ nMaxCount にはバッファが受け取ることができる最大文字数を指定する。 戻り値には実際に渡された( #0 を含まない)文字数を返してくれる。CreateWindow( ) の第三パラメータには作成されるウィンドウのスタイルを決定する定義済みの定数を指定する。OnTest( ) ハンドラの例では、WS_ プレフィックスをもつ一般のウィンドウスタイルのほかに BS_プレフィックスをもつボタンスタイルを指定している。 WS_CHILD or WS_VISIBLE はこのウィンドウが子ウィンドウであり作成すると同時に表示されることを指定している。 BS_ のボタンスタイルは、Windows.pas に以下のように定義されている。

const
  { Button Control Styles }
  BS_PUSHBUTTON = 0;     // プッシュボタン
  BS_DEFPUSHBUTTON = 1;  // ダイアログボックス内で Enter キーで選択できるボタン
  BS_CHECKBOX = 2;       // チェックボックス
  BS_AUTOCHECKBOX = 3;   // チェックマークが自動的に変更されるチェックボックス
  BS_RADIOBUTTON = 4;    // ラジオボタン
  BS_3STATE = 5;         // チェック・アンチェックのほか不定を表示するチェックボックス
  BS_AUTO3STATE = 6;     // 三つの状態が自動的に巡回するチェックボックス
  BS_GROUPBOX = 7;       // グループボックス
  BS_USERBUTTON = 8;     // Win32 では使わない
  BS_AUTORADIOBUTTON = 9;// グループ内で自動的に一つだけチェック状態にするラジオボタン
  BS_OWNERDRAW = 11;     // オーナー描画ボタン

  BS_LEFTTEXT = $20;     // チェックボックスとらラジオボタンのチェック欄を右に配置する
  BS_TEXT = 0;           // ボタンはテキストを表示する(デフォルト)
  BS_ICON = $40;         // ボタンはアイコンを表示する
  BS_BITMAP = $80;       // ボタンはビットマップを表示する
  BS_LEFT = $100;        // テキストを左寄せ
  BS_RIGHT = $200;       // テキストを右寄せ
  BS_CENTER = 768;       // テキストを水平方向で中央寄せ
  BS_TOP = $400;         // テキストを上寄せ

  BS_BOTTOM = $800;      // テキストを下寄せ
  BS_VCENTER = 3072;     // テキストを水平方向で中央寄せ
  BS_PUSHLIKE = $1000;   // プッシュボタンのようなチェックボックスまたはラジオボタン
  BS_MULTILINE = $2000;  // 複数行テキストを表示
  BS_NOTIFY = $4000;     // BN_DBLCLK,BN_KILLFOCUS,BN_SETFOCUS 通知メッセージを親に送る
  BS_FLAT = $8000;       // 平坦なボタン
  BS_RIGHTBUTTON = BS_LEFTTEXT;

このうち、BS_PUSHBUTTON から BS_OWNERDRAW まではつくられるボタンの種類を指定するものだ。それ以外はオプションであり、表示テキストの配置の仕方や表示方法をデフォルト以外に設定するときに使われる。 これらのオプションの設定は、ウィンドウ作成後も SetWindowLong( ) APIを使って変更できる。

CreateWindow( ) のパラメータ X, Y, nWidth, nHeight でウィンドウの位置とサイズを指定してから、次のパラメータ hWndParent で親のウィンドウハンドルを指定する。 子ウィンドウの位置は親ウィンドウのクライアント領域の座標で表される。 hMenu パラメータには、上記で説明したコントロールIDを指定する。残りのパラメータは以前の説明と同じだ。

Test! メニューがクリックされたときすでに hBtn1 が有効なウィンドウハンドルである場合は else 以下のコードが実行される。ここでは、EnableWindow( ) APIを使って、プッシュボタンのウィンドウの有効性を反転している。

  function EnableWindow(hWnd: HWND; 
                     bEnable: BOOL): BOOL; stdcall;

この関数は、変更前にウィンドウが有効だったら false、無効だったら true を返してくれるので、コードのように入れ子で二度使うと状態を反転できる。 さらに、チェックボックスのスタイルを調べて、テキストの表示位置を左右に反転している。 変更後の状態を描画するために、SetWindowLong( ) の実行後に InvalidateRect を実行してコントロールを再描画している。

最後に、OnDestroy( ) ハンドラではつくったコントロールをコードで破棄していないことに注目してほしい。 コントロールに限らず一般に子ウィンドウは、親ウィンドウが破棄される直前にOSによって自動的に破棄されると期待して良い。

コントロールは、どのようにメッセージを処理するのだろうか。すでに何度も記したが、コントロールはウィンドウなので、全てのメッセージはOSからコントロールのウィンドウ関数に直接送られる。一般のウィンドウと同じように、メッセージの種類によってメッセージループを経由する場合もあるが、SendMessege( )で直接送られることもある。 ところが、プログラマはこの登録済みのウィンドウクラスのウィンドウ関数に直接アクセスすることはできない。 そこで、メッセージを処理する方法としてコントロールのウィンドウ関数では、プログラマに関心のありそうな出来事にたいしては、親ウィンドウのウィンドウ関数にメッセージを SendMessege( )で送るような仕様になっている。 ボタンコントロールでは、このメッセージは WM_COMMAND である。 第2章で示したようにメニューもこのメッセージを使っていた。 Delphi 付属の Win32.hlp では、

WM_COMMAND 

wNotifyCode = HIWORD(wParam); // notification code 

wID = LOWORD(wParam);         // item, control, or accelerator identifier 
hwndCtl = (HWND) lParam;      // handle of control 

と定義されている。 wNotifyCode は、出来事を識別する16ビットの整数がセットされている。 ボタンコントールの場合は、この値は Message.pas で定義されている以下のいずれかだ。

{ Button Notification Codes }

const
  BN_CLICKED = 0;
  BN_DBLCLK = 5;
  BN_SETFOCUS = 6;
  BN_KILLFOCUS = 7;

このうち、BN_DBLCLK 以下の三つは、ウィンドウスタイルが BS_NOTIFY を含んでいるときだけ送られる。 今回の実装ではこのスタイルを設定しているので、親ウィンドウ関数には上記の全てが通知される。BN_CLICKED はボタンがクリックされたときに送られる。 他の通知コードの意味も定義の名前から明らかだろう。 メニューから送られた WM_COMMAND メッセージの場合は wNotifyCode は常にゼロである。これは上記の定数定義を見ると分かるように BN_CLICKED と区別できない。 wID には、メニューのときと同じでコントロール生成時に指定したコントロールIDが入っている。 hwndCtl には、このメッセージを送ったコントロールのウィンドウハンドルがセットされている。 メニューからのメッセージでは常にゼロがセットされているので、この値がゼロでなければコントロールから送られたものだと識別できる。

TestButton01 プログラムでは、 WM_COMMAND を処理する OnCommand( ) ハンドラで、hwndCtl がゼロでないことを確認してから、wNotifyCode をセレクタにした case 文により、通知メッセージを処理している。 BN_CLICKED のときは hwndCtl をパラメータに指定して GetWindowText( ) を呼び出してウィンドウテキストを取得している。取得した文字列を使って、4−1節で UtilFunc.pas に実装した WindowInfo( )ClassInfo( ) 関数を呼び出し、結果の文字列をラベルに表示している。 BN_SETFOCUSBN_KILLFOCUS のときはシステムブザーを鳴らす。

実行時に示されるウィンドウ情報クラス情報を見てみよう。 まず、クラス情報に示されるウィンドウ関数のアドレスとウィンドウ情報に示されるそれとが一致しており、しかもプッシュボタンとチェックボックスでは同じウィンドウ関数を使っていることを確認してほしい。ウィンドウ関数では、WM_PAINT メッセージの処理をする際に、ウィンドウスタイルの値を参照してボタンイメージを描くかチェックボックスを描くかを判断しているに違いない。 ウィンドウ関数のアドレスの値そのものにも注目してほしい。Win32 では、32ビットのアドレス空間、つまり4Gバイトの仮想メモリを扱うことができるが、そのうち下位2Gバイトがアプリケーション用であり、上位2GバイトはOSによって占有される。 ウィンドウ関数のアドレスが $80000000 より大きいことは、このウィンドウ関数がOSの中にあることを示している。 クラス情報では、 WndExtra が6バイトとられ、ウィンドウ毎にフォーカスの有無やチェックの有無などのその時点でのウィンドウ状態が格納されている。 また、ウィンドウ情報のIDの値が上記で定義した ID_BTN1ID_BTN2 の値になっていることも確認できる。

コントロールがウィンドウであることは、フォーカスを受け取ることができることに反映されている。 フォーカスを得た場合、 プッシュボタンではウィンドウ矩形のすぐ内側に、またチェックボックスでは表示テキストを囲むように点線でフォーカス矩形が描かれる。 フォーカスのあるウィンドウはキーボードメッセージを受け取ることができるが、 ボタンコントロールではスペースキーだけに応答する。スペースキーの打鍵はマウスのクリックに相当するイベントを発生させる。 VCLでは Tab キーを押すことで TabOrder プロパティーの順序でフォーカスを移動することができたが、コントロールのデフォルトのウィンドウ関数は Tab キーの処理をしない。 したがって、Tab キーでフォーカスを移動するには、サブクラス化の手法を用いるなどしてプログラマの責任で行わなければならない。 なお、ダイアログ上に作成されたコントロールのフォーカスは、後に示すように自動的に(作成された順で)Tab キーによる移動ができるようにすることもできる。

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

6−2 ボタンコントロールの概観

前節でボタンコントロールの作り方と使い方を説明したので、標準コントロールに対するイメージが具体的になったことだろう。CreateWindow( ) でつくり、WM_COMMAND メッセージを処理する。 難しいことは何もない。 CreateWindow( )dwStyle パラメータに BS_ プリフィックスをもつ定義済みのスタイルを指定することで、様々な「ボタン」を作ることができることも分かった。ここでは、前節でつくったプログラムを変更して、10種類の「ボタン」を作ってみよう。を使った同様のプログラムを示した C.Petzolt氏に敬意を表して、このプログラムを BtnLook と名付けよう。

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

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

program BtnLook;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
type
  ButtonType = record
    Style: LongInt;
    Text: string;
  end;

const
  Button : array[0..9] of ButtonType
         = ((Style:BS_PUSHBUTTON;        Text:'PushButton'),
            (Style:BS_DEFPUSHBUTTON;     Text:'DefPushButton'),
            (Style:BS_CHECKBOX;          Text:'CheckBox'),
            (Style:BS_AUTOCHECKBOX;      Text:'AutoCheckBox'),
            (Style:BS_RADIOBUTTON;       Text:'RadioButton'),
            (Style:BS_3STATE;            Text:'3State'),
            (Style:BS_AUTO3STATE;        Text:'Auto3State'),
            (Style:BS_GROUPBOX;          Text:'GroupBox'),
            (Style:BS_AUTORADIOBUTTON;   Text:'AutoRadio'),
            (Style:BS_OWNERDRAW;         Text:'OwnerDraw'));

  ID_BUTTON = 400;

var
  Clr: COLORREF;

  hButton: array[0..9] of HWND;
  L1,L2: TAPILabel;
  Flag: Boolean = true;

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

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
  i: integer;
begin
  hWindow := Msg.Msg;
  Clr := clrWindow;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,450,570);
  CenterWindow(hWindow);

  L1 := CreateLabel(hWindow,190,20,220,240,'');
  with L1 do begin
    Margin := 6;
    Color := RGB(220,255,220);
    DrawFrame := true;;
  end;

  L2 := CreateLabel(hWindow,190,270,220,240,'');
  with L2 do begin
    Margin := 6;
    Color := RGB(220,255,220);
    DrawFrame := true;;
  end;

  for i := 0 to 9 do
    hButton[i] :=CreateWindow('button',PChar(Button[i].Text),
                   WS_CHILD or WS_VISIBLE or BS_OWNERDRAW,
                   20,20+40*i,150,32,
                   hWindow,
                   HMENU(ID_BUTTON+i),
                   hInstance,
                   nil);
end;

procedure OnTest(hWindow: HWND);
var
  i: integer;
begin
  if Flag then
    for i := 0 to 9 do ShowWindow(hButton[i],SW_HIDE)
  else
    for i := 0 to 9 do ShowWindow(hButton[i],SW_SHOWNORMAL);
  Flag := not Flag;
end;

procedure OnCommand(var Msg: TMessage);
var
  s: string;
  i: integer;
begin
  InitMenuCommand(Msg,OnTest);
  if Msg.LParam = 0 then exit;
  case Msg.WParamHi of
    BN_CLICKED: begin
      i := Msg.WParamLo - ID_BUTTON;
      SendMessage(hButton[i],BM_SETSTYLE,
              WS_CHILD or WS_VISIBLE or Button[i].Style,1);
      if i = 7 then InvalidateRect(Msg.Msg,nil,true);
      SetLength(s,50);
      SetLength(s,GetWindowText(Msg.LParam,PChar(s),50));
      L1.Text := WindowInfo(s,Msg.LParam);
      L2.Text := ClassInfo(Msg.LParam);
    end;
  end;
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifBtnLook.zip(16.001kB)
BtnLook.gif

実行するとメインウィンドウの左側に10個の灰色の矩形が表示される。上から順にマウスでクリックしていくと様々なボタンに変身してゆくとともに、ラベルにクラス情報とウィンドウ情報が表示される。一番下の矩形だけが変わらない。 このときの様子を右図に示す。 Test! メニューをクリックすると全部のボタンの可視性が切り替わる。

コードを見ていこう。 10個のボタンを for 文を使って作るので、あらかじめボタンのスタイルと表示されるテキストを定義したレコード ButtonType 型の定数配列を定義しておく。さらに、ボタンのIDの始まり番号の定数 ID_BUTTON とボタンのハンドルを格納する配列 hButton[i]TAPILabel 型の変数を二つ、上記の宣言の下に宣言し、OnCreate( ) ハンドラで BS_OWNERDRAW スタイルの10個のオブジェクトを作っている。 したがって、最初に表示される10個の灰色の矩形はオーナー描画ボタンである。 そして OnCommand( ) ハンドラにボタンのクリックハンドラを挿入する。

  if Msg.LParam = 0 then exit;
  case Msg.WParamHi of
    BN_CLICKED: begin
      i := Msg.WParamLo - ID_BUTTON;
      SendMessage(hButton[i],BM_SETSTYLE,
              WS_CHILD or WS_VISIBLE or Button[i].Style,1);
      if i = 7 then InvalidateRect(Msg.Msg,nil,true);
      SetLength(s,50);
      SetLength(s,GetWindowText(Msg.LParam,PChar(s),50));
      L1.Text := WindowInfo(s,Msg.LParam);
      L2.Text := ClassInfo(Msg.LParam);
    end;
  end;

このコードでは、ボタンのハンドルが設定されている Msg.LParam がゼロでないことを確認してから、前節と同じように BN_CLICK の通知メッセージを選り分けている。何番目のボタンを押したかは ID から ID_BUTTON を引くと分かる。そして、SendMessage( ) APIを使って BM_SETSTYLE メッセージをクリックされたボタンに送っている。SendMessage( ) APIについてはこれまでに何度か言及したことはあるが、詳しく説明していなかった。 この関数は、コードとウィンドウ関数の間でメッセージを交換するのに非常によく使われる重要な関数である。

  function SendMessage(hWnd: HWND; 
                        Msg: UINT; 
                     wParam: WPARAM; 
                     lParam: LPARAM): LRESULT; stdcall;

第一パラメータは、メッセージを送る宛先のウィンドウのハンドルを指定する。 その他のパラメータは、メッセージ本体である。 この関数の戻り値の型は、ウィンドウ関数のそれと同じであることに注目してほしい。 この関数は、送り先のウィンドウ関数を抜けてから制御が復帰し、 その戻り値は送り先のウィンドウ関数の戻り値である。ここでは、hWndhButton[i] を設定しているが、もちろん Msg.LParam でも同じである。 Msg には、BM_SETSTYLE メッセージを設定している。Win32.hlp によると、このメッセージは、

BM_SETSTYLE 

wParam =  (WPARAM) LOWORD(dwStyle); // style 
lParam =  MAKELPARAM(fRedraw, 0);   // redraw flag 

であるので、wParam には WS_CHILD or WS_VISIBLE or Button[i].Style を設定し、 lParam には再描画するようにを設定している。 どちらのパラメータも上位ワードは使われていないので、下位ワードを直接設定できる。 OnCommand( ) ハンドラでの次のコードの if 文では、BS_GROUPBOX のときだけ自分が囲む矩形領域を自動的に更新しないので、コードでウィンドウ全体を更新している。 残りのコードは前節のものと同じである。このように、ボタンはウィンドウであるので、SendMessage( ) によりそのウィンドウ関数にメッセージを送って様々なことを制御できる。 ボタンが理解できるボタン特有のメッセージは Message.pas に以下のように定義されている。

{ Button Control Messages }
const
  BM_GETCHECK = $00F0;  // チェック状態の取得
  BM_SETCHECK = $00F1;  // チェック状態の設定
  BM_GETSTATE = $00F2;  // チェック・プッシュ・押し下げ状態の取得
  BM_SETSTATE = $00F3;  // 押し下げ状態の設定
  BM_SETSTYLE = $00F4;  // ボタンスタイルの設定
  BM_CLICK    = $00F5;  // クリック動作のシミュレート。WM_COMMAND も発生する
  BM_GETIMAGE = $00F6;  // ビットマップやアイコンのハンドルを取得
  BM_SETIMAGE = $00F7;  // ビットマップやアイコンのハンドルを設定

このほかに、ウィンドウとして一般的な WM_ プレフィックスのメッセージも幾つか受け取ることができる。

前節では EnableWindow( ) を使ってボタンの有効性を反転させたが、 ここでは Test! メニューで ShowWindow( ) APIを使って全部のボタンの可視性を反転している。 ShowWindow( ) については、第1章ですでに説明した。

Auto のプリフィックスがついたボタンは自分でチェックマークを付ける。 とくに Auto3State はクリックするたびにマークが循環的に変化するのを見ることができる。 GroupBox はクリックイベントを発生しない。 最後の BS_OWNERDRAW スタイルのボタンにはテキストが表示されないが、 ウィンドウ情報からも分かるようにテキストそのものは保持している。 このボタンは自分自身を描画したいときは親ウィンドウ関数に WM_DRAWITEM メッセージを送って描画してもらう。 このような仕様になっているので、コード次第でどのような「ボタン」でも描くことができる最も汎用的ボタンであるといえる。 VCLTBitBtn のようなボタンは、BS_OWNERDRAW スタイルのボタンから作ることができるだろう。

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

6−3 コントロールのラッパークラスをつくるための方針

コントロールは子ウィンドウなので、OSからのあらゆるメッセージを自前で受け取ることができる。 ところがコントロールラッパークラスの作成するとしたとき、このラッパークラスのオブジェクトは、DelphiObject Pascal という言語上のオブジェクトなのでウィンドウメッセージを自動的に受け取ることはない。 以後の便宜のため、二つの用語をここで定義しよう。 CreateWindow( ) APIによってつくられたウィンドウクラスのインスタンスを「ウィンドウオブジェクト」、Object Pascal 言語上のクラスのインスタンスを「パスカルオブジェクト」と呼ぶことにしよう。

GDIObject.pas につくったクラスのインスタンスは、GDI関数の機能をカプセル化したものなので対応するウィンドウオブジェクトは存在していなかった。 ところが標準コントロールのラッパークラスをインスタンス化すると、ウィンドウオブジェクトと、それに一対一に対応するパスカルオブジェクトが生じることになる。 ここで問題になるのは、OSはウィンドウオブジェクトを認識し、あらゆるメッセージの送付やインスタンスの破棄などを行うのに対し、パスカルオブジェクトはウィンドウオブジェクトの作成に関与したあとはOSからその存在を認識されることもなく、メッセージを受け取ることもできないことである。 少なくとも WM_DESTROY メッセージを受け取らなくては、パスカルオブジェクトを破棄することもできない。 一方、プログラマはパスカルオブジェクトのメソッドやプロパティーを使って対応するウィンドウコントロールの動作を制御したいし、イベントも公開したいだろう。 一般に、ラッパークラスは対応するウィンドウクラスの情報を十分に持つように設計できる。しかし、この逆の過程、つまりウィンドウオブジェクトは対応するパスカルオブジェクトの情報を持っていない。 この問題は、 ウィンドウオブジェクトのハンドルの値から、自分自身のラッパーであるパスカルオブジェクトを参照する何らかの手段を設けることができれば解決される。問題を要約すると、 以下のようになる。

T パスカルオブジェクトは対応するウィンドウオブジェクトのメッセージを受け取れない。
U ウィンドウオブジェクトから自分自身のラッパーであるパスカルオブジェクトを参照できない。

より深刻な問題もある。 ボタンの例からも分かるように、コントロールはイベントをメッセージとして親ウィンドウのウィンドウ関数に通知するという仕様になっている。 このような仕様はOOPの思想から外れているだけでなく、自分でイベントを処理するラッパークラスの設計を困難にしている。 パスカルオブジェクトは対応するウィンドウオブジェクトに「送られてくるメッセージ」の他にも、 ウィンドウオブジェクトが「親ウィンドウに送るメッセージ」も捕捉しなければイベントを公開できないことになる。 コントロールがなぜこのような仕様になっているのかは、歴史的な背景もあるのだろうが、例えば、 「CreateWindow( ) APIの最後のパラメータにコールバック関数のアドレスを渡すと、そこに通知メッセージを送るようにする、このパラメータが nil の場合は親ウィンドウに通知する」という仕様にならないものかと思う。 この問題を以下に要約する。

V パスカルオブジェクトがイベントを公開するためには、 コントロールから親ウィンドウに送られるメッセージも捕捉しなければならない。

以上、コントロールのラッパークラスを設計するときの問題点を挙げた。ここでは、これを解決しコントロールのラッパークラスを設計するための方針について検討しよう。 問題点の第一は、

T パスカルオブジェクトは対応するウィンドウオブジェクトのメッセージを受け取れない。

であった。これは、ウィンドウオブジェクトのデフォルトのウィンドウ関数を特定のウィンドウ関数に置き換える、つまり、サブクラス化をすることで解決しよう。 前章までの TSubClass の派生クラスでは、 コンストラクタで自分自身のオブジェクト参照を Dispatcher に登録し、親のウィンドウ関数をサブクラス化して SubClassProc でメッセージを捕捉し、それから Dispatcher を通じてパスカルオブジェクトに配送ていた。 そのとき、SubClassProc の最初のコードでもとの親ウィンドウ関数にメッセージを転送していた。 もとのウィンドウ関数のアドレスは、 DispatcherGetParentProc で取得していた。 ここでは、親をサブクラス化するほかに、ウィンドウオブジェクト自身をサブクラス化して、パスカルオブジェクトにメッセージを配送することにしよう。 サブクラス化による新しいウィンドウ関数を SelfSubClassProc としよう。 ここでも、上記の SubClassProc の場合とおなじように、ウィンドウハンドルから元のウィンドウ関数を取得する仕組みが必要になる。 SubClassProc で参照している Dispatcher オブジェクトに相当するオブジェクトがないので、SelfSubClassProc でウィンドウハンドルだけを知って、それをもとにして、もとのウィンドウ関数を取得する仕組みがなければならない。 この要求にぴったり応えるのが、SetProp( )GetProp( )RemoveProp( )APIである。SetProp( ) は、

 function SetProp(hWnd: HWND; 
              lpString: PChar; 
                 hData: THandle): BOOL; stdcall;

と定義され、ウィンドウに名前付きのプロパティーを付け加える。 第一パラメータはウィンドウのハンドル、第二パラメータは「名前」を指定する。 第三パラメータの型 THandle は、

type
  THandle = Integer;

と定義されている32ビット整数値である。 キャストすればポインタも格納できるので、どんなレコードでも関連づけることができる。 一方、 GetProp( ) APIを使って設定した数値を取り出すことができる。

  function GetProp(hWnd: HWND; 
               lpString: PChar): THandle; stdcall;

この関数は、ウィンドウハンドルと名前を指定するとプロパティーの値を返してくれる。 最後に、パスカルオブジェクトのデストラクタでサブクラス化を解除し、RemoveProp( ) APIでプロパティーを削除する。

  function RemoveProp(hWnd: HWND; 
                  lpString: PChar): THandle; stdcall;

以上の三つのAPI関数で、プロパティーの設定・読み出し・削除を行うことができる。このようにすると、SelfSubClassProc では、コントロールに送られてきたあらゆるメッセージを受け取り、そのウィンドウハンドルからもとのウィンドウ関数のアドレスを知り、それを呼び出すことができるようになる。さて、第二の問題点は、

U ウィンドウオブジェクトから自分自身のラッパーであるパスカルオブジェクトを参照できない。

であるが、もとのウィンドウ関数のアドレスのほかに、自分自身のラッパーであるパスカルオブジェクトの参照(self)も SetProp( ) を使ってウィンドウオブジェクトのプロパティーとして設定すれば、ウィンドウハンドルのみからパスカルオブジェクトを参照できることになるだろう。

最後の問題点は、

V パスカルオブジェクトがイベントを公開するためには、 コントロールから親ウィンドウに送られるメッセージを捕捉しなければならない。

である。これも TGDIObject のときと同様に親ウィンドウをサブクラス化することで解決できる。つまり、TSubClass からの派生クラスとすれば、自動的に親ウィンドウはサブクラス化される。そして、捕捉したいメッセージは、DispatcherTrapMessage( ) メソッドを使ってパスカルオブジェクトのインスタンス参照とともに登録する。

以上の方針を以下にまとめる。

  1. ウィンドウオブジェクトが受け取るあらゆるメッセージをパスカルオブジェクトが受け取るために、自分自身をサブクラス化する。
  2. 自分自身をサブクラス化したときのウィンドウ関数で、ウィンドウハンドルからもとのウィンドウ関数のアドレスとパスカルオブジェクトのインスタンス参照を取得するために、ウィンドウオブジェクトにプロパティーを設ける。
  3. ウィンドウオブジェクトが親ウィンドウに送る WM_COMMAND などのメッセージをパスカルオブジェクトが受け取るために、 ラッパークラスを TSubClass から派生して作成する。

これでコントロールのサブクラス化と親ウィンドウへの通知メッセージを捉えるメカニズムの設計方針が決定したので、いよいよラッパークラスの設計に取り組もう。

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

6−4 TSelfSubClass、TAPIControl と TAPIButton の実装

ここまでの節では、 標準コントロールのうち「ボタン」コントロールを外側から見てきた。 コントロールには、リストボックスやエディット、コンボボックス、スクロールバー、スタティックなどがあるが、その基本仕様は大体同じであり、以下のようにまとめることができる。

  1. コントロールは登録済みの子ウィンドウなので CreateWindow( )CreateWindowEx( ) APIによって作られる。
  2. コントロールには、種類によって使われ方が異なるテキストが関連づけられている。
  3. コントロールの種類は、ウィンドウスタイルを指定することで決定する。
  4. コントロールのウィンドウスタイルには、 種類を指定するものとオプションとして動作を指定する2種類のものがある。
  5. オプションのスタイルには、ウィンドウ作成後に SetWindowLong( ) APIで変更できるものが多い。
  6. コントロールの使用許可・使用禁止は、EnableWindow( ) APIで制御できる。
  7. コントロールの可視性は、ShowWindow( ) APIで制御する。
  8. XS_OWNERDRAW スタイル以外のコントロールは、自己を描画する方法を知っている。
  9. コントロールは、プログラマが必要としているイベントが起こった場合には SendMessage( ) APIを使ってそのことを親ウィンドウに通知する。
  10. コードからコントロールと情報交換する必要があるときは、SendMessage( ) APIでコントロール指定のメッセージを送る。
  11. Win32 OSは、親ウィンドウが破棄される直前に自動的に子ウィンドウを破棄する。
  12. コードからコントロールを破棄するためには、DestroyWindow( ) APIを使う。

このようなコントロールを包み込むラッパーとして、クラスをつくることにはどんな意義があるのだろうか。前章までに本稿で TAPISpeedBtn をつくってきた経験を基にすれば、汎用的な子ウィンドウからプッシュボタンをつくることは簡単にできるだろう。 しかし、エディットやリストボックス、スクロールバーなどはもちろん、チェックボックスでさえゼロからコードで実装するのは簡単ではないし、 そうすべきではない。 ユーザーは、長い間、様々なアプリケーションを使用してきており、これらのコントロールの外観や動作については熟知している。 少しでも外観や動作が異なれば、戸惑うだけだろう。 オブジェクト指向プログラミング(OOP)の利点を強調するまでもなく、 登録済みのコントロールをクラスとして定義することは、仕様を共通化し、インスタンスを簡単に生成できることなど、その意義は十分大きいと考られる。

前章までで、GDIAPI関数の機能をカプセル化したクラスをいくつか GDIObject.pas に作ってきた。 それらのクラスは、 TSubClass から直接派生したクラスである TGDIObject を共通の上位クラスとしていた。 TGDIObject は、それ自体は何もしないクラスであるが、 派生クラスが共通してもつプロパティーやメソッドを実装していた。 ここでは、コントロールのラッパークラスを作る第一歩として、プッシュボタンのラッパークラスをつくることを考えるが、やはり、これまでの経験から、上記のようにすべてのコントロールに共通なプロパティーとメソッドを実装したクラスをつくる必要があるだろう。 このようなクラスを TAPIControl としよう。そして、自分自身をサブクラス化する性質を備えたクラスを TSelfSubClass としよう。つまり、TAPIControl までの階層は、

  TObject - TSubClass - TSelfSubClass - TAPIControl

となる。すべてのコントロールのラッパークラスは、この TAPIControlクラスから派生することにしよう。

上記の基本仕様を参考にして TSelfSubClass のプロパティーとして想定できるものを挙げてみよう。

1. Handle :        自分のウィンドウハンドル。読み出し専用。
2. ID :            コントロールID。生成時に指定する。読み出し専用。

TAPIControl のプロパティーとしては、

1.Dimension : コントロールの位置と大きさ。TRect 型。
2.Enable :    コントロールの有効性。Boolean 型。
3.Visible :   コントロールの可視性。Boolean 型。
4.Caption :   関連づけられる string 型のテキスト。

それでは、さっそく実装することにしよう。

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

まず、APIControl.pasTSelfSubClassTAPIControl クラスを実装しよう。このユニットファイルの全リストを以下に示す。

unit APIControl;

interface

uses
  Windows,
  Messages,
  UtilFunc,
  UTilClass;

type

TAPICreateParams = record
  Caption: string;
  Style: Longint;
  ExStyle: Longint;
  X, Y: Integer;
  Width, Height: Integer;
  WinClassName: array[0..63] of Char;
end;

//----------- TSelfSubClass -----------------------------------------
TSelfSubClass = class(TSubClass)
private
  FHandle: HWND;
  FID: HMenu;
protected
  procedure APICreateParams(var Params: TAPICreateParams); virtual; abstract;
  procedure Initialize; virtual; abstract;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  procedure DestroyObject;
  property Handle: HWND read FHandle;
  property ID: HMenu read FID;
end;

//----------- TAPIContol -------------------------------------------
TAPIControl = class(TSelfSubClass)
private
  function GetCaption: string;
  procedure SetCaption(value: string);
  function GetDimension: TRect;
  procedure SetDimension(value: TRect);
  function GetXPos: integer;
  procedure SetXPos(value: integer);
  function GetYPos: integer;
  procedure SetYPos(value: integer);
  function GetWidth: integer;
  procedure SetWidth(value: integer);
  function GetHeight: integer;
  procedure SetHeight(value: integer);
  function GetEnable: Boolean;
  procedure SetEnable(value:Boolean);
  function GetVisible: Boolean;
  procedure SetVisible(value: Boolean);
protected
  procedure Initialize; override;
public
  destructor Destroy; override;
  property Caption: string read GetCaption write SetCaption;
  property Dimension : TRect read GetDimension write SetDimension;
  property XPos: integer read GetXPos write SetXPos;
  property YPos: integer read GetYPos write SetYPos;
  property Width: integer read GetWidth write SetWidth;
  property Height: integer read GetHeight write SetHeight;
  property Enable: Boolean read GetEnable write SetEnable;
  property Visible: Boolean read GetVisible write SetVisible;
end;

implementation


var
  ID_CONT: integer = 400;

//----------- TSelfSubClass -----------------------------------------
function SelfSubClassProc(hWnd: HWND; Msg: UINT;
                       wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  PascalObject: TSelfSubClass;
  OriginalProc: TFNWndProc;
  SBMsg: TMessage;
begin
  OriginalProc := TFNWndProc(GetProp(hWnd,'WNDPROC'));
  result := CallWindowProc(OriginalProc,hWnd,Msg,wParam,lParam);
  PascalObject := TSelfSubClass(GetProp(hWnd,'OBJECT'));

  case Msg of

    WM_DESTROY: if Assigned(PascalObject) then PascalObject.Free;

  else
    if Assigned(PascalObject) then begin
      SBMsg.Msg := Msg;
      SBMsg.WParam := wParam;
      SBMsg.LParam := lParam;
      SBMsg.Result := 0;
      PascalObject.Dispatch(SBMsg);
      if SBMsg.Result <> 0 then result := SBMsg.Result;
    end;
  end; // case

end;

constructor TSelfSubClass.Create(hParent: HWnd);
var
  Params: TAPICreateParams;
  DefWndProc: TFNWndProc;
begin
  inherited Create(hParent);
  APICreateParams(Params);
  with Params do begin
    FHandle := CreateWindowEx(ExStyle,WinClassName,PChar(Caption),
                Style,X, Y, Width, Height,
                hParent,
                ID_CONT,
                hInstance,
                nil);
  end;

  if IsWindow(FHandle) then begin
    SetProp(FHandle,'OBJECT',Integer(self));
    DefWndProc := TFNWndProc(SetWindowLong(FHandle,
                            GWL_WNDPROC,Integer(@SelfSubClassProc)));
    SetProp(FHandle,'WNDPROC',integer(DefWndProc));
  end;

  FID := ID_CONT; Inc(ID_CONT);

  Initialize;
end;

destructor TSelfSubClass.Destroy;
begin
  SetWindowLong(FHandle,GWL_WNDPROC,GetProp(FHandle,'WNDPROC'));
  RemoveProp(FHandle,'OBJECT');
  RemoveProp(FHandle,'WNDPROC');
  inherited Destroy;
end;

procedure TSelfSubClass.DestroyObject;
begin
  DestroyWindow(FHandle);
end;

//----------- TAPIControl -----------------------------------------
destructor TAPIControl.Destroy;
begin
                        
  inherited Destroy;
end;

procedure TAPIControl.Initialize;
begin
  Dispatcher.TrapMessage(WM_COMMAND,self);
end;

function TAPIControl.GetCaption: string;
var
  s: string;
begin
  SetLength(s,50);
  SetString(result,PChar(s),GetWindowText(FHandle,PChar(s),50));
end;

procedure TAPIControl.SetCaption(value: string);
begin
  SetWindowText(FHandle, PChar(Value));
end;

function TAPIControl.GetDimension: TRect;
begin
  result := SetDim(XPos,YPos,Width,Height);
end;

procedure TAPIControl.SetDimension(value: TRect);
begin
  MoveWindow(FHandle,value.left, value.top,
                   value.right, value.bottom, true);
end;

function TAPIControl.GetXPos: integer;
var
  r: TRect;
  p: TPoint;
begin
  GetWindowRect(FHandle,r);
  p.x := r.Left; p.y := r.Top;
  ScreenToClient(Parent,p);
  result := p.x;
end;

procedure TAPIControl.SetXPos(value: integer);
begin
  ChangeWindowPos(FHandle,value,YPos);
end;

function TAPIControl.GetYPos: integer;
var
  r: TRect;
  p: TPoint;
begin
  GetWindowRect(FHandle,r);
  p.x := r.Left; p.y := r.Top;
  ScreenToClient(Parent,p);
  result := p.y;
end;

procedure TAPIControl.SetYPos(value: integer);
begin
  ChangeWindowPos(FHandle,XPos,value);
end;

function TAPIControl.GetWidth: integer;
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  result := r.Right-r.Left;
end;

procedure TAPIControl.SetWidth(value: integer);
begin
  ChangeWindowSize(FHandle,value,Height);
end;

function TAPIControl.GetHeight: integer;
var
  r: TRect;
begin
  GetWindowRect(FHandle,r);
  result := r.Bottom-r.Top;
end;

procedure TAPIControl.SetHeight(value: integer);
begin
  ChangeWindowSize(FHandle,Width,value);
end;

function TAPIControl.GetEnable: Boolean;
begin
  result := Boolean(IsWindowEnabled(FHandle));
end;

procedure TAPIControl.SetEnable(value: Boolean);
begin
  EnableWindow(FHandle,value);
end;

function TAPIControl.GetVisible: Boolean;
begin
  result := Boolean(IsWindowVisible(FHandle));
end;

procedure TAPIControl.SetVisible(value:Boolean);
begin
  if value then
    ShowWindow(FHandle,SW_SHOWNORMAL)
  else
    ShowWindow(FHandle,SW_HIDE);
end;

end.

このリストのコードを調べるのは次節にまわして、TAPIButton クラスを作成しよう。 宣言部を以下に示す。

//---------- TAPIButton ----------------------------------------------
TAPIButton = class(TAPIControl)
private
  FOnClick: TNotifyMessage;
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
public
  procedure DefaultHandler(var Message); override;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

実装部を以下に示す。

//--------------- TAPIButton ----------------------------------------------
procedure TAPIButton.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'APIButton';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or BS_PUSHBUTTON;
    ExStyle := 0;
    X := 0;
    Y := 0;
    Width := 0;
    Height := 0;
    WinClassName := 'BUTTON';
  end;
end;

procedure TAPIButton.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam = LongInt(FHandle)) and (AMsg.WParamHi = BN_CLICKED) then
         if Assigned(FOnClick) then begin
           AMsg.Msg := UINT(self); // Sender
           OnClick(AMsg);
         end;
  end; // case
end;

これで、TAPIButton クラスまでは完成である。 最後に、インスタンスの作成を簡単にするために、生成関数をつくろう。 宣言部の最後に以下の宣言を追加する。

//
//---------- Create Functions ---------------------------------------
//
function CreateButton(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
                      sOnClick:TNotifyMessage): TAPIButton;

そして、実装部の最後を以下のようにする。

//
//---------- Create Functions ---------------------------------------
//
function CreateButton(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
                      sOnClick:TNotifyMessage): TAPIButton;
begin
  result := TAPIButton.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    OnClick := sOnClick;
  end;
end;

さっそく TAPIButton クラスのインスタンスをつくってテストするコードを PushButton02.dpr に書くことにしよう。 以下に全リストを示す。

program PushButton02;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  Clr: COLORREF;

  Btn1, Btn2, Btn3, Btn4: TAPIButton;
  L1, L2: TAPILabel;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure Btn1Click(var Msg:TMessage);
var
  Sender: TAPIButton;
begin
  Sender := TAPIButton(Msg.Msg);
  L1.Text := WindowInfo(Sender.Caption,Sender.Handle);
  L2.Text := ClassInfo(Sender.Handle);
end;

procedure Btn2Click(var Msg:TMessage);
begin
  Clr := RGB(Random(256),Random(256),Random(256));
  InvalidateRect(Btn2.Parent,nil,true);
end;

procedure Btn3Click(var Msg:TMessage);
begin
  Btn3.DestroyObject;
end;

procedure Btn4Click(var Msg:TMessage);
begin
  DestroyWindow(Btn4.Parent);
end;

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := Msg.Msg;
  Clr := clrBtnFace;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,500,360);
  CenterWindow(hWindow);

  L1 := CreateLabel(hWindow,20,50,220,240,' Click Test! Menu');
  with L1 do begin
    Margin := 6;
    Color := RGB(220,255,220);
    DrawFrame := true;;
  end;

  L2 := CreateLabel(hWindow,250,50,220,240,'');
  with L2 do begin
    Margin := 6;
    Color := RGB(220,255,220);
    DrawFrame := true;;
  end;

  Randomize;
end;

procedure OnTest(hWindow: HWND);
begin
  if not Assigned(Btn1) then begin
    Btn1 := CreateButton(hWindow,30,10,100,32,'Button1',Btn1Click);
    Btn2 := CreateButton(hWindow,140,10,100,32,'Button2',Btn2Click);
    Btn3 := CreateButton(hWindow,250,10,100,32,'SelfDestroy',Btn3Click);
    Btn4 := CreateButton(hWindow,360,10,100,32,'Quit',Btn4Click);
    L1.Text := 'Click Button!!';
  end else begin
    Btn1.Enable := not Btn1.Enable;
    Btn2.Visible := not Btn2.Visible;
  end;
end;

procedure OnCommand(var Msg: TMessage);
begin
  InitMenuCommand(Msg,OnTest);
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;

  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifPushButton02.zip(17.129kB)
PushButton02.gif

以上で完成である。 実行して Test! メニューを選択するとボタンが四つ作られる。 Test! メニューを二回目以降に選択すると、Btn1 の有効性と Btn2 の可視性が反転する。 Btn1 をクリックするとそのボタンのウィンドウ情報とクラス情報がラベルに表示される。 これはクリックイベント( WM_COMMAND )が Dispatcher からパスカルオブジェクトに転送され、イベントとして公開することがうまくいっている証拠である。 クラス情報のウィンドウ関数のアドレスとウィンドウ情報のそれとが異なっていることを確かめてほしい。 ウィンドウ情報に示されるウィンドウ関数のアドレスは、$7FFFFFFF 以下であり、ユーザーアドレスの中にあることが分かる。Btn2 をクリックするとメインウィンドウの背景色がランダムに変更される。 このときの様子を右図に示す。 Btn3 をクリックすると、自分自身が削除される。 これは、自己サブクラスの解除がうまくいっている事を示している。 Btn4 をクリックするとプログラムが終了する。


この節は長くなりすぎたので、次節で実装コードを調べることにしよう。

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

6−5 実装コードを調べる

この節では、 前節で APIControl.pas に実装した TSelfSubClassTAPIContorol クラスとその下位クラス TAPIButton の実装コードを調べよう。

TSelfSubClass は、自分自身のウィンドウオブジェクトを自動的にサブクラス化するクラスであり、親ウィンドウをサブクラス化する TSubClass から派生している。 コンストラクタを見てみよう。

constructor TSelfSubClass.Create(hParent: HWnd);
var
  Params: TAPICreateParams;
  DefWndProc: TFNWndProc;
begin
  inherited Create(hParent);
  APICreateParams(Params);
  with Params do begin
    FHandle := CreateWindowEx(ExStyle,WinClassName,PChar(Caption),
                Style,X, Y, Width, Height,
                hParent,
                ID_CONT,
                hInstance,
                nil);
  end;

  if IsWindow(FHandle) then begin
    SetProp(FHandle,'OBJECT',Integer(self));
    DefWndProc := TFNWndProc(SetWindowLong(FHandle,
                            GWL_WNDPROC,Integer(@SelfSubClassProc)));
    SetProp(FHandle,'WNDPROC',integer(DefWndProc));
  end;

  FID := ID_CONT; Inc(ID_CONT);

  Initialize;
end;

ここでは、最初に継承メソッドを呼び出して親ウィンドウをサブクラス化する。 つぎに、このクラスでは抽象メソッドになっている APICreateParams( ) を呼び出して、 このユニットで定義した TAPICreateParams 型のレコードを組み立てる。

TAPICreateParams = record
  Caption: string;
  Style: Longint;
  ExStyle: Longint;
  X, Y: Integer;
  Width, Height: Integer;
  WinClassName: array[0..63] of Char;
end;

見て分かるように、このレコードの各フィールドは CreateWindowEx( ) APIのパラメータそのものである。 こフィールド変数を用いて、コンストラクタでは、実際に CreateWindowEx( ) を使ってコントロールを作る。 そして、これがうまくいったら SetProp( ) をつかって 'OBJECT' という名前でプロパティーをつくり、自分のインスタンス参照を設定する。 つぎに、ウィンドウ関数のアドレスを SelfSubClassProc に入れ替え、'WNDPROC' プロパティーに元のウィンドウ関数のアドレスを格納する。 コントロールIDは、ID_CONTという整数変数を設定し、 次のコントロールのためにインクリメントしておく。 最後に、 抽象メソッド Initialize を呼び出す。 このようにして、ウィンドウオブジェクトが作られ、プロパティーが設定され、サブクラス化される。 SelfSubClassProc を見てみよう。

function SelfSubClassProc(hWnd: HWND; Msg: UINT;
                       wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  PascalObject: TSelfSubClass;
  OriginalProc: TFNWndProc;
  SBMsg: TMessage;
begin
  OriginalProc := TFNWndProc(GetProp(hWnd,'WNDPROC'));
  result := CallWindowProc(OriginalProc,hWnd,Msg,wParam,lParam);
  PascalObject := TSelfSubClass(GetProp(hWnd,'OBJECT'));

  case Msg of

    WM_DESTROY: if Assigned(PascalObject) then PascalObject.Free;

  else
    if Assigned(PascalObject) then begin
      SBMsg.Msg := Msg;
      SBMsg.WParam := wParam;
      SBMsg.LParam := lParam;
      SBMsg.Result := 0;
      PascalObject.Dispatch(SBMsg);
      if SBMsg.Result <> 0 then result := SBMsg.Result;
    end;
  end; // case

end;

ここでは、GetProp( ) APIをつかってもとのウィンドウ関数を呼び出し、 このメッセージを受け取ったコントロールのラッパーオブジェクトを取得している。 処理をしているメッセージは WM_DESTROY だけである。 ここでは、ウィンドウオブジェクトが破壊されようとしている事を示しているので、 対応するパスカルオブジェクトを解放している。 TSelfSubClass のデストラクタを見てみよう。

destructor TSelfSubClass.Destroy;
begin
  SetWindowLong(FHandle,GWL_WNDPROC,GetProp(FHandle,'WNDPROC'));
  RemoveProp(FHandle,'OBJECT');
  RemoveProp(FHandle,'WNDPROC');
  inherited Destroy;
end;

ここでは、サブクラス化を解除し、二つのプロパティーを削除してから継承メソッドを呼び出している。 これで、自己サブクラス化の仕組みが理解できただろう。 SelfSubClassProc では、WM_DESTROY 以外のメッセージは TMessage 型のレコードに変換されて、パスカルオブジェクトに配送される。 このレコード型は、Dispatcher から送られてくる親ウィンドウのメッセージと同じレコード型にしている。 TSelfSubClassTAPIControl クラスは抽象クラスであるので、メッセージを具体的に処理する DefaultHandler をオーバーライドしていないが、TAPIButton クラスでは、WM_COMMAND を受け取って処理している。 TAPIControlInitialize メソッドでは、DispatcherWM_COMMAND を送ってくれるよう依頼している。

procedure TAPIControl.Initialize;
begin
  Dispatcher.TrapMessage(WM_COMMAND,self);
end;

したがってこのクラスの派生クラスは、この継承メソッドを実行することにより自動的に WM_COMMAND を受け取ることができる。 TAPIButtonDefaultHandler を見てみよう。

procedure TAPIButton.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam = LongInt(FHandle)) and (AMsg.WParamHi = BN_CLICKED) then
         if Assigned(FOnClick) then begin
           AMsg.Msg := UINT(self); // Sender
           OnClick(AMsg);
         end;
  end; // case
end;

ここでは、WM_COMMAND メッセージだけを処理している。 まず、このメッセージを送ったのが自分のウィンドウオブジェクトであること、そして通知メッセージが BN_CLICK であることを確認してからイベントハンドラを呼び出している。 プッシュボタンをつくるには、APICreateParams( ) メソッドをオーバーライドして、CreateWindowEx( ) のパラメータを設定するだけである。

procedure TAPIButton.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'APIButton';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or BS_PUSHBUTTON;
    ExStyle := 0;
    X := 0;
    Y := 0;
    Width := 0;
    Height := 0;
    WinClassName := 'BUTTON';
  end;
end;

TSelfSubClass のこのメソッドは抽象メソッドなので、それをオーバーライドしたメソッドで継承メソッドを呼び出してはいけない。

TAPIControl クラスの残りの実装コードの大部分は SetXXX( ) の形のプロパティーの write アクセスメソッドである。 これらは、対応するプロパティーを保持する private の変数フィールドに値を格納するほかに、指定されたプロパティーをウィンドウオブジェクトに反映させるためにAPIを使っている。 SetCaption( ) では SetWindowText( ) APIを、SetDimension( ) では MoveWindow( ) APIを使っている。

  function MoveWindow(hWnd: HWND; 
     X, Y, nWidth, nHeight: Integer; 
                  bRepaint: BOOL): BOOL; stdcall;

この関数のパラメータは名前から容易に理解できるだろう。 SetEnable( ) では EnableWindow( ) が、SetVisible( ) では ShowWindow( ) APIが使われている。 これらの例から分かるように、 ラッパーオブジェクトのプロパティーの設定を通じて、ウィンドウオブジェクトの機能を設定することができる。 Dimension プロパティーでは、コントロールの位置と大きさを同時に指定していたが、左上の座標 XPosYPos、幅と高さ WidthHeight のプロパティーも設けてある。 これらのアクセスメソッドには、GetWindowRect( ) が使われている。

  function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; stdcall;

hWnd で指定されるウィンドウの位置と大きさが lpRect に返される。

以上で、TAPIButton クラスまでのコードの説明は終わりである。 このクラスまでの階層は、

TObject - TSubClass - TSelfSubClass - TAPIControl - TAPIButton

である。TSubClass で親のウィンドウ関数をサブクラス化し、TSelfSunClass で自分のウィンドウオブジェクトをサブクラス化し、TAPIControl でコントロールのラッパークラスの一般的な性質を装備し、 TAPIButton で具体的に、プッシュボタンのラッパークラスを作成した。 以降の数章にわたり、標準コントロールのラッパークラスを TAPIControl から派生して作成することを通して、Win32 のコントロールに対する理解を深めていくことにしよう。

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

6−6 動的に変更できるスタイル

ボタンコントロールを作成する CreateWindow( ) APIのパラメータについては、6−1節で紹介した。BtnLook で見たように、そのうちウィンドウオブジェクトを作成した後でもコードにより動的にスタイルを設定できるものがあった。プッシュボタンに有効な主なスタイルを以下に示そう。

const
  BS_TEXT = 0;           // ボタンはテキストを表示する(デフォルト)
  BS_LEFT = $100;        // テキストを左寄せ
  BS_RIGHT = $200;       // テキストを右寄せ
  BS_CENTER = 768;       // テキストを水平方向で中央寄せ
  BS_TOP = $400;         // テキストを上寄せ
  BS_BOTTOM = $800;      // テキストを下寄せ
  BS_VCENTER = 3072;     // テキストを水平方向で中央寄せ
  BS_MULTILINE = $2000;  // 複数行テキストを表示
  BS_NOTIFY = $4000;     // BN_DBLCLK,BN_KILLFOCUS,BN_SETFOCUS 通知メッセージを親に送る

BS_NOTIFY を除くとどれもテキストの表示配置のスタイルである。 この定数定義を見ると、これらのスタイルが相互に排他的なビットフラグを設定するものではないことに気づく。 たとえば、水平方向のテキスト配置を制御するスタイルは

  BS_LEFT   = $100;
  BS_RIGHT  = $200;
  BS_CENTER = $300;

であるから、(BS_LEFT or BS_RIGHT)BS_CENTER と同じになる。これらのビットパターンはつぎのようになる。

  BS_LEFT   : XXXX XXXX XXXX XXXX XXXX XX01 XXXX XXXX
  BS_RIGHT  : XXXX XXXX XXXX XXXX XXXX XX10 XXXX XXXX
  BS_CENTER : XXXX XXXX XXXX XXXX XXXX XX11 XXXX XXXX

つまり、下位から数えて9ビット目の桁と10ビット目の桁でテキストの水平方向の位置を決めている。同様に、11,12ビットの桁で垂直方向を決めている。 デフォルトの $0000 は両方向とも中央に配置される。 これに対して BS_MULTILINEBS_NOTIFY は特定の桁のビットが1かゼロかで設定されることが分かるだろう。 このように動的に変更できるスタイルは、コントロールのプロパティーとして設定することができる。 以上のことを、TAPIButton でつくられるウィンドウオブジェクトのウィンドウスタイルをAPIを使って変更するプログラムをつくって確かめよう。

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

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

program PushButton03;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  Clr: COLORREF;

  Btn1: TAPIButton;
  L1: TAPILabel;
  OriginalStyle: LongInt;
  iStyle: integer = 0;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg:TMessage);
begin
  L1.Text := 'Style : $'+
       AIntToHex(GetWindowLong(Btn1.Handle,GWL_STYLE),8);
end;

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := Msg.Msg;
  Clr := clrBtnFace;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,270,190);
  CenterWindow(hWindow);

  L1 := CreateLabel(hWindow,20,80,220,50,' Click Test! Menu');
  with L1 do begin
    Margin := 6;
    DrawFrame := true;;
  end;

  Btn1 := CreateButton(hWindow,55,10,150,60,'Button1',BtnClick);

  OriginalStyle := GetWindowLong(Btn1.Handle,GWL_STYLE);
end;

procedure OnTest(hWindow: HWND);
var
  NewStyle: LongInt;
begin
  case iStyle of
    0: NewStyle := OriginalStyle or BS_LEFT;
    1: NewStyle := OriginalStyle or BS_RIGHT;
    2: NewStyle := OriginalStyle or BS_TOP;
    3: NewStyle := OriginalStyle or BS_BOTTOM;
    4: begin
       NewStyle := OriginalStyle or BS_MULTILINE;
       Btn1.Caption := 'マルチライン'+#13+ 'ボタンです';
       end;
    5: begin
       NewStyle := OriginalStyle;
       Btn1.Caption := 'Button1';
       end;
    else NewStyle := OriginalStyle;
  end;
  SetWindowLong(Btn1.Handle,GWL_STYLE,NewStyle);
  InvalidateRect(Btn1.Handle,nil,true);
  Inc(iStyle);
  if iStyle > 5 then iStyle := 0;
end;

procedure OnCommand(var Msg: TMessage);
begin
  InitMenuCommand(Msg,OnTest);
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifPushButton03.zip(15.750kB)
PushButton03.gif

実行時の様子を右図に示す。 Test!メニューを選択するたびにスタイルが循環的に変更されるのを確認できるだろう。 スタイルの変更は SetWindowLong( ) APIを使い、 その後、InvalidateRect( ) によってウィンドウを再描画している。 ボタンをクリックすると、その時点でのスタイルの値がラベルに表示される。

このプログラムでは、BS_NOTIFY のスタイルを確認していない。 このスタイルを指定すると、ボタンは BN_CLICK のほかに BN_DBLCLKBN_SETFOCUSBN_KILLFOCUS の通知メッセージを WM_COMMANDHIWORD(wParam) として親ウィンドウに送る。したがってこのスタイルを含むボタンは OnDblClickOnGetFocusOnLostFocus のイベントを公開できるようになる。

ここでは、これらの動的に変更できるウィンドウスタイルの設定を TAPIButton のプロパティーやイベントとして装備することはしない。 プロパティーとして装備すれば、たとえばマルチラインボタンなどは簡単につくることができる。読者自身で試してみてほしい。 TAPIButton を継承して新しいクラスをつくるより、TAPIButton のコードを書き直した方が簡単だろう。

6−7 RAD環境でのテスト

メッセージの取得に関して自立する事ができた TAPIButton クラスのオブジェクトは、RAD環境でも使用できるかどうかテストしてみよう。

  1. エクスプローラで 0605RADPushButton という名前のフォルダをつくる。
  2. Delphi をランチャから立ち上げ、デフォルトの Form1 が表示された状態で [ファイル]メニューから[すべて保存]を選んで、0605RADPushButton フォルダに Unit1.pasMain.pas という名前で、 プロジェクトファイルは RADPushButton.dpr という名前で保存する。
  3. 0604PushButton03 フォルダから Skeleton02.dprUtilFunc.pasUtilClass.pasGDIObject.pasAPIControl.pas0605RADPushButton フォルダにコピーする。
  4. スピードメニューから[プロジェクトに追加]を選んで APIControl.pas を追加する。
  5. コンポーネントパレットから下図のように TButtonTPanel を一つずつフォームにドロップする。
  6. Main.pas を以下のようになるように編集する。
  7. f・9を押して、コンパイルして実行する。

Main.pas の全リストを以下に示す。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,
  APIControl;    // ここに追加する!!

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  APIBtn1, APIBtn2, APIBtn3: TAPIButton;

procedure Btn1Click(var Msg:TMessage);
begin
  Form1.Color := clWhite;
end;

procedure Btn2Click(var Msg:TMessage);
begin
  Form1.Color := clBtnFace;
end;

procedure Btn3Click(var Msg:TMessage);
begin
  Form1.Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  APIBtn1 := CreateButton(Form1.Handle,20,20,120,45,'APIBtn1',Btn1Click);
  APIBtn2 := CreateButton(Panel1.Handle,20,20,120,45,'APIBtn2',Btn2Click);
  APIBtn3 := CreateButton(Form1.Handle,20,150,300,45,'Quit',Btn3Click);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Panel1.Visible := not Panel1.Visible;
end;

end.
DownloadExe.gifRADPushButton.zip(164.360kB)
RADPushButton.gif

コンパイルして実行してみよう。 実行時の様子を右図に示す。 三つの TAPIButton クラスのオブジェクトがRAD環境でも正常に動作するのが分かるだろう。 APIBtn1 をクリックするとフォームの背景色が白色になる。 パネルの上にある APIBtn2 をクリックするとフォームの背景色がもとに戻る。VCLのボタン Button1 をクリックすると Panel1 とその上の APIBtn2 が見えなくなる。 もう一度押すと、見えるようになる。 Quit を押すとプログラムが終了する。

以上のテストから、TAPIControl を継承した下位クラスのオブジェクトはRAD環境でも正常に動作する事が期待できる。

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

6−8 まとめ

本章では、 Win32 の登録済み子ウィンドウであるコントロールについて、ボタンクラスを例にとりその一般的側面を解説した。 まず、コードにより CreateWIndow( ) APIをつかってボタンを生成しその使い方を見た。 イベントは、 親ウィンドウに WM_COMMAMND メッセージを SendMessage( ) を使って通知される。 また、ボタンクラスの10種類のコントロールを作成した。 作成後に、SetWindowLong( ) でスタイルを変更できる事を示した。 コントロールのラッパークラスを設計するときの問題点を提示し、その解決策の一例を示した。 そして、以下のような階層でプッシュボタンコントロールのラッパークラスを作成した。

  TObject - TSubClass - TSelfSubClass - TAPIControl - TAPIPushButton

TSubClass から派生することで、コントロールが親に送る WM_COMMAND などの通知を受け取れるようにした。 また、TSelfSubClass では、自分自身をサブクラス化して Win32 が直接コントロールに送ってくる WM_DESTROY などのメッセージを受け取れるようにした。 TAPIControl では、コントロール共通の性質をカプセル化し、それから派生して TAPIPushButton を作成した。 これは、VCLと共存することも確認した。

次章からは、 そのほかのコントロールのラッパークラスを TAPIControl から派生してつくり、コントロールについての理解を深めよう。


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

  1. Skeleton02.dpr (3 kB)
  2. UtilFunc.pas (8 kB)
  3. UtilClass.pas (13 kB)
  4. GDIObject.pas (16 kB)
  5. APIControl.pas (9 kB)



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