前の章へ
| 総目次へ
| 次の章へ 
｜第１章では Generic01.dpr で何もしないウィンドウを作った。 その手順を思い出してみよう。 １－３節でも述べたように、メインウィンドウを作成するには以下の手順でコードを書く。
Win32 では、ボタンやリストボックス、エディット、コンボボックス、スクロールバーなどはアプリケーションを構成する部品として、「登録済み」の子ウィンドウクラスとして定義されている。 これらは標準コントロールと呼ばれている。 つまり、上記の手順 １と２は既に Windows がやってくれている。 ユーザーは３の手順だけをコードに書けばこれらのコントロールを手に入れられる。 子ウィンドウであるので手順４と５ははじめから必要ない。
既に気づいているように、 Delphi の コンポーネントパレットの Standard ページのコンポーネントの大部分は、これらの標準コントロールをＶＣＬでカプセル化したものだ。 この章では、 標準コントロールのうちボタンコントロールについて詳しく紹介し、とくにプッシュボタンコントロールをカプセル化したクラスを作ることにする。 ボタンコントロールは、ウィンドウを作成する CreateWindow( ) ＡＰＩの第三パラメータである dwStyle の指定を変更することにより、プッシュボタン・チェックボックス・ラジオボタン・グループボックスなどを作ることができる。 グループボックスがボタンの一員であるのは少々おかしい感じがするが、とにかくそういう仕様になっているのだ。 標準コントロールはウィンドウであるからウィンドウ関数を持っているが、これらは Win32 がこれらのクラスを登録するときすでに実装されている。 したがって、ユーザーは標準コントロールのウィンドウ関数のソースコードを見ることはできないが、どのように動作するのかは公表されているので知ることができる。 これらのコントロールを使うためには、結局、デフォルトでインストールされているウィンドウ関数の仕様にしたがったコードを書くことにするか、このウィンドウ関数をサブクラス化してカスタマイズするかを決断しなければならない。
| 第６章 コントロール ： プッシュボタンコントロール |
| ６－１ ボタンコントロールを使ってみる |
| ６－２ ボタンコントロールの概観 |
| ６－３ コントロールのラッパークラスをつくるための方針 |
| ６－４ TSelfSubClass、TAPIControl と TAPIButton の実装 |
| ６－５ 実装コードを調べる |
| ６－６ 動的に変更できるスタイル |
| ６－７ ＲＡＤ環境でのテスト |
| ６－８ まとめ |
前の章へ
| 総目次へ
| 次の章へ ｜すでに述べたようにボタンコントロールは、Win32 の登録済みの子ウィンドウの一つである。 この節では、 ボタンコントロールを作ってクリックイベントなどがどのように処理されるのか調べよう。 子ウィンドウといえどもウィンドウには違いないので、CreateWindow( ) ＡＰＩで作成する。まず手始めに、プッシュボタンとチェックボックスを一つずつ作って、とりあえずこれらのコントロールを使ってみることにしよう。
以下に 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.
PushButton01.zip(15.866kB)
さっそく実行してみよう。Test! メニューをクリックするとプッシュボタンとチェックボックスが現れる。 二度目以降で Test! を選ぶとプッシュボタンは有効性が、チェックボックスは左右の配置スタイルが反転する。どちらかをクリックするとラベルにそのウィンドウ情報とクラス情報が表示される。フォーカスが移動するときにはシステムブザーが鳴る。実行時の様子を右図に示す。
コードを見ていこう。 まず作成する二つのボタンのためのウィンドウハンドルを格納するグローバル変数と TAPILabel 型のラベルを二つ宣言しておく。
hBtn1, hBtn2: HWND; L1,L2: TAPILabel;
コントロールをつくるときには、各コントロールを識別する整数番号（コントロールＩＤ）が必要なので、二個のボタンのためにグローバル定数を定義しておく。
const ID_BTN1 = 400; ID_BTN2 = 401;
OnCreate( ) ハンドラではボタンの輪郭を明確にするためにウィンドウの背景色を clrWindow にしてから、ラベルを二つつくっている。OnTest( ) ハンドラでは CreateWindow( ) ＡＰＩを使ってプッシュボタンとチェックボックスをつくっている。 このハンドラの最初の if 文は、何度メニューをクリックされても、一度だけボタンをつくるために必要だ。 IsWindow( ) ＡＰＩは、パラメータにウィンドウハンドルを渡すと、すでに対応するウィンドウが存在するときは true を返してくれる。
function IsWindow(hWnd: HWND): BOOL; stdcall;
コントロールは、CreateWindow( ) で作られる。 このＡＰＩはメインウィンドウの作成のときに説明した 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' を指定する。 ＯＳの仕様上、このクラス名は大文字小文字を識別しないので 'Button' でも 'bUTTON' でもかまわない。 第二パラメータ lpWindowName にはコントロールに表示される文字列を指定する。メインウィンドウのときにはタイトルバーに表示される文字列を指定していた。 この文字列は、２－４節で既に説明した SetWindowText( ) ＡＰＩを使えばいつでも変更できる。 また、GetWindowText( ) ＡＰＩを使えばいつでも取得できる。
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( ) ＡＰＩを使って変更できる。
CreateWindow( ) のパラメータ X, Y, nWidth, nHeight でウィンドウの位置とサイズを指定してから、次のパラメータ hWndParent で親のウィンドウハンドルを指定する。 子ウィンドウの位置は親ウィンドウのクライアント領域の座標で表される。 hMenu パラメータには、上記で説明したコントロールＩＤを指定する。残りのパラメータは以前の説明と同じだ。
Test! メニューがクリックされたときすでに hBtn1 が有効なウィンドウハンドルである場合は else 以下のコードが実行される。ここでは、EnableWindow( ） ＡＰＩを使って、プッシュボタンのウィンドウの有効性を反転している。
function EnableWindow(hWnd: HWND;
bEnable: BOOL): BOOL; stdcall;この関数は、変更前にウィンドウが有効だったら false、無効だったら true を返してくれるので、コードのように入れ子で二度使うと状態を反転できる。 さらに、チェックボックスのスタイルを調べて、テキストの表示位置を左右に反転している。 変更後の状態を描画するために、SetWindowLong( ) の実行後に InvalidateRect を実行してコントロールを再描画している。
最後に、OnDestroy( ) ハンドラではつくったコントロールをコードで破棄していないことに注目してほしい。 コントロールに限らず一般に子ウィンドウは、親ウィンドウが破棄される直前にＯＳによって自動的に破棄されると期待して良い。
コントロールは、どのようにメッセージを処理するのだろうか。すでに何度も記したが、コントロールはウィンドウなので、全てのメッセージはＯＳからコントロールのウィンドウ関数に直接送られる。一般のウィンドウと同じように、メッセージの種類によってメッセージループを経由する場合もあるが、SendMessege( )で直接送られることもある。 ところが、プログラマはこの登録済みのウィンドウクラスのウィンドウ関数に直接アクセスすることはできない。 そこで、メッセージを処理する方法としてコントロールのウィンドウ関数では、プログラマに関心のありそうな出来事にたいしては、親ウィンドウのウィンドウ関数にメッセージを SendMessege( )で送るような仕様になっている。 ボタンコントロールでは、このメッセージは WM_COMMAND である。 第２章で示したようにメニューもこのメッセージを使っていた。 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 は、出来事を識別する１６ビットの整数がセットされている。 ボタンコントールの場合は、この値は 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 には、メニューのときと同じでコントロール生成時に指定したコントロールＩＤが入っている。 hwndCtl には、このメッセージを送ったコントロールのウィンドウハンドルがセットされている。 メニューからのメッセージでは常にゼロがセットされているので、この値がゼロでなければコントロールから送られたものだと識別できる。
TestButton01 プログラムでは、 WM_COMMAND を処理する OnCommand( ) ハンドラで、hwndCtl がゼロでないことを確認してから、wNotifyCode をセレクタにした case 文により、通知メッセージを処理している。 BN_CLICKED のときは hwndCtl をパラメータに指定して GetWindowText( ) を呼び出してウィンドウテキストを取得している。取得した文字列を使って、４－１節で UtilFunc.pas に実装した WindowInfo( ) と ClassInfo( ) 関数を呼び出し、結果の文字列をラベルに表示している。 BN_SETFOCUS と BN_KILLFOCUS のときはシステムブザーを鳴らす。
実行時に示されるウィンドウ情報とクラス情報を見てみよう。 まず、クラス情報に示されるウィンドウ関数のアドレスとウィンドウ情報に示されるそれとが一致しており、しかもプッシュボタンとチェックボックスでは同じウィンドウ関数を使っていることを確認してほしい。ウィンドウ関数では、WM_PAINT メッセージの処理をする際に、ウィンドウスタイルの値を参照してボタンイメージを描くかチェックボックスを描くかを判断しているに違いない。 ウィンドウ関数のアドレスの値そのものにも注目してほしい。Win32 では、３２ビットのアドレス空間、つまり４Ｇバイトの仮想メモリを扱うことができるが、そのうち下位２Ｇバイトがアプリケーション用であり、上位２ＧバイトはＯＳによって占有される。 ウィンドウ関数のアドレスが $80000000 より大きいことは、このウィンドウ関数がＯＳの中にあることを示している。 クラス情報では、 WndExtra が６バイトとられ、ウィンドウ毎にフォーカスの有無やチェックの有無などのその時点でのウィンドウ状態が格納されている。 また、ウィンドウ情報のＩＤの値が上記で定義した ID_BTN1 と ID_BTN2 の値になっていることも確認できる。
コントロールがウィンドウであることは、フォーカスを受け取ることができることに反映されている。 フォーカスを得た場合、 プッシュボタンではウィンドウ矩形のすぐ内側に、またチェックボックスでは表示テキストを囲むように点線でフォーカス矩形が描かれる。 フォーカスのあるウィンドウはキーボードメッセージを受け取ることができるが、 ボタンコントロールではスペースキーだけに応答する。スペースキーの打鍵はマウスのクリックに相当するイベントを発生させる。 ＶＣＬでは Tab キーを押すことで TabOrder プロパティーの順序でフォーカスを移動することができたが、コントロールのデフォルトのウィンドウ関数は Tab キーの処理をしない。 したがって、Tab キーでフォーカスを移動するには、サブクラス化の手法を用いるなどしてプログラマの責任で行わなければならない。 なお、ダイアログ上に作成されたコントロールのフォーカスは、後に示すように自動的に（作成された順で）Tab キーによる移動ができるようにすることもできる。
前節でボタンコントロールの作り方と使い方を説明したので、標準コントロールに対するイメージが具体的になったことだろう。CreateWindow( ) でつくり、WM_COMMAND メッセージを処理する。 難しいことは何もない。 CreateWindow( ) の dwStyle パラメータに BS_ プリフィックスをもつ定義済みのスタイルを指定することで、様々な「ボタン」を作ることができることも分かった。ここでは、前節でつくったプログラムを変更して、１０種類の「ボタン」を作ってみよう。Ｃを使った同様のプログラムを示した C.Petzolt氏に敬意を表して、このプログラムを BtnLook と名付けよう。
以下に 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.BtnLook.zip(16.001kB)
実行するとメインウィンドウの左側に１０個の灰色の矩形が表示される。上から順にマウスでクリックしていくと様々なボタンに変身してゆくとともに、ラベルにクラス情報とウィンドウ情報が表示される。一番下の矩形だけが変わらない。 このときの様子を右図に示す。 Test! メニューをクリックすると全部のボタンの可視性が切り替わる。
コードを見ていこう。 １０個のボタンを for 文を使って作るので、あらかじめボタンのスタイルと表示されるテキストを定義したレコード ButtonType 型の定数配列を定義しておく。さらに、ボタンのＩＤの始まり番号の定数 ID_BUTTON とボタンのハンドルを格納する配列 hButton[i]、TAPILabel 型の変数を二つ、上記の宣言の下に宣言し、OnCreate( ) ハンドラで BS_OWNERDRAW スタイルの１０個のオブジェクトを作っている。 したがって、最初に表示される１０個の灰色の矩形はオーナー描画ボタンである。 そして 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( ) ＡＰＩを使って BM_SETSTYLE メッセージをクリックされたボタンに送っている。SendMessage( ) ＡＰＩについてはこれまでに何度か言及したことはあるが、詳しく説明していなかった。 この関数は、コードとウィンドウ関数の間でメッセージを交換するのに非常によく使われる重要な関数である。
function SendMessage(hWnd: HWND;
Msg: UINT;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;第一パラメータは、メッセージを送る宛先のウィンドウのハンドルを指定する。 その他のパラメータは、メッセージ本体である。 この関数の戻り値の型は、ウィンドウ関数のそれと同じであることに注目してほしい。 この関数は、送り先のウィンドウ関数を抜けてから制御が復帰し、 その戻り値は送り先のウィンドウ関数の戻り値である。ここでは、hWnd に hButton[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( ) ＡＰＩを使って全部のボタンの可視性を反転している。 ShowWindow( ) については、第１章ですでに説明した。
Auto のプリフィックスがついたボタンは自分でチェックマークを付ける。 とくに Auto3State はクリックするたびにマークが循環的に変化するのを見ることができる。 GroupBox はクリックイベントを発生しない。 最後の BS_OWNERDRAW スタイルのボタンにはテキストが表示されないが、 ウィンドウ情報からも分かるようにテキストそのものは保持している。 このボタンは自分自身を描画したいときは親ウィンドウ関数に WM_DRAWITEM メッセージを送って描画してもらう。 このような仕様になっているので、コード次第でどのような「ボタン」でも描くことができる最も汎用的ボタンであるといえる。 ＶＣＬの TBitBtn のようなボタンは、BS_OWNERDRAW スタイルのボタンから作ることができるだろう。
コントロールは子ウィンドウなので、ＯＳからのあらゆるメッセージを自前で受け取ることができる。 ところがコントロールラッパークラスの作成するとしたとき、このラッパークラスのオブジェクトは、Delphi の Object Pascal という言語上のオブジェクトなのでウィンドウメッセージを自動的に受け取ることはない。 以後の便宜のため、二つの用語をここで定義しよう。 CreateWindow( ) ＡＰＩによってつくられたウィンドウクラスのインスタンスを「ウィンドウオブジェクト」、Object Pascal 言語上のクラスのインスタンスを「パスカルオブジェクト」と呼ぶことにしよう。
GDIObject.pas につくったクラスのインスタンスは、ＧＤＩ関数の機能をカプセル化したものなので対応するウィンドウオブジェクトは存在していなかった。 ところが標準コントロールのラッパークラスをインスタンス化すると、ウィンドウオブジェクトと、それに一対一に対応するパスカルオブジェクトが生じることになる。 ここで問題になるのは、ＯＳはウィンドウオブジェクトを認識し、あらゆるメッセージの送付やインスタンスの破棄などを行うのに対し、パスカルオブジェクトはウィンドウオブジェクトの作成に関与したあとはＯＳからその存在を認識されることもなく、メッセージを受け取ることもできないことである。 少なくとも WM_DESTROY メッセージを受け取らなくては、パスカルオブジェクトを破棄することもできない。 一方、プログラマはパスカルオブジェクトのメソッドやプロパティーを使って対応するウィンドウコントロールの動作を制御したいし、イベントも公開したいだろう。 一般に、ラッパークラスは対応するウィンドウクラスの情報を十分に持つように設計できる。しかし、この逆の過程、つまりウィンドウオブジェクトは対応するパスカルオブジェクトの情報を持っていない。 この問題は、 ウィンドウオブジェクトのハンドルの値から、自分自身のラッパーであるパスカルオブジェクトを参照する何らかの手段を設けることができれば解決される。問題を要約すると、 以下のようになる。
より深刻な問題もある。 ボタンの例からも分かるように、コントロールはイベントをメッセージとして親ウィンドウのウィンドウ関数に通知するという仕様になっている。 このような仕様はＯＯＰの思想から外れているだけでなく、自分でイベントを処理するラッパークラスの設計を困難にしている。 パスカルオブジェクトは対応するウィンドウオブジェクトに「送られてくるメッセージ」の他にも、 ウィンドウオブジェクトが「親ウィンドウに送るメッセージ」も捕捉しなければイベントを公開できないことになる。 コントロールがなぜこのような仕様になっているのかは、歴史的な背景もあるのだろうが、例えば、 「CreateWindow( ) ＡＰＩの最後のパラメータにコールバック関数のアドレスを渡すと、そこに通知メッセージを送るようにする、このパラメータが nil の場合は親ウィンドウに通知する」という仕様にならないものかと思う。 この問題を以下に要約する。
以上、コントロールのラッパークラスを設計するときの問題点を挙げた。ここでは、これを解決しコントロールのラッパークラスを設計するための方針について検討しよう。 問題点の第一は、
であった。これは、ウィンドウオブジェクトのデフォルトのウィンドウ関数を特定のウィンドウ関数に置き換える、つまり、サブクラス化をすることで解決しよう。 前章までの TSubClass の派生クラスでは、 コンストラクタで自分自身のオブジェクト参照を Dispatcher に登録し、親のウィンドウ関数をサブクラス化して SubClassProc でメッセージを捕捉し、それから Dispatcher を通じてパスカルオブジェクトに配送ていた。 そのとき、SubClassProc の最初のコードでもとの親ウィンドウ関数にメッセージを転送していた。 もとのウィンドウ関数のアドレスは、 Dispatcher の GetParentProc で取得していた。 ここでは、親をサブクラス化するほかに、ウィンドウオブジェクト自身をサブクラス化して、パスカルオブジェクトにメッセージを配送することにしよう。 サブクラス化による新しいウィンドウ関数を SelfSubClassProc としよう。 ここでも、上記の SubClassProc の場合とおなじように、ウィンドウハンドルから元のウィンドウ関数を取得する仕組みが必要になる。 SubClassProc で参照している Dispatcher オブジェクトに相当するオブジェクトがないので、SelfSubClassProc でウィンドウハンドルだけを知って、それをもとにして、もとのウィンドウ関数を取得する仕組みがなければならない。 この要求にぴったり応えるのが、SetProp( )、GetProp( )、RemoveProp( ) のＡＰＩである。SetProp( ) は、
function SetProp(hWnd: HWND;
lpString: PChar;
hData: THandle): BOOL; stdcall;と定義され、ウィンドウに名前付きのプロパティーを付け加える。 第一パラメータはウィンドウのハンドル、第二パラメータは「名前」を指定する。 第三パラメータの型 THandle は、
type THandle = Integer;
と定義されている３２ビット整数値である。 キャストすればポインタも格納できるので、どんなレコードでも関連づけることができる。 一方、 GetProp( ) ＡＰＩを使って設定した数値を取り出すことができる。
function GetProp(hWnd: HWND;
lpString: PChar): THandle; stdcall;この関数は、ウィンドウハンドルと名前を指定するとプロパティーの値を返してくれる。 最後に、パスカルオブジェクトのデストラクタでサブクラス化を解除し、RemoveProp( ) ＡＰＩでプロパティーを削除する。
function RemoveProp(hWnd: HWND;
lpString: PChar): THandle; stdcall;以上の三つのＡＰＩ関数で、プロパティーの設定・読み出し・削除を行うことができる。このようにすると、SelfSubClassProc では、コントロールに送られてきたあらゆるメッセージを受け取り、そのウィンドウハンドルからもとのウィンドウ関数のアドレスを知り、それを呼び出すことができるようになる。さて、第二の問題点は、
であるが、もとのウィンドウ関数のアドレスのほかに、自分自身のラッパーであるパスカルオブジェクトの参照（self)も SetProp( ) を使ってウィンドウオブジェクトのプロパティーとして設定すれば、ウィンドウハンドルのみからパスカルオブジェクトを参照できることになるだろう。
最後の問題点は、
である。これも TGDIObject のときと同様に親ウィンドウをサブクラス化することで解決できる。つまり、TSubClass からの派生クラスとすれば、自動的に親ウィンドウはサブクラス化される。そして、捕捉したいメッセージは、Dispatcher の TrapMessage( ) メソッドを使ってパスカルオブジェクトのインスタンス参照とともに登録する。
以上の方針を以下にまとめる。
これでコントロールのサブクラス化と親ウィンドウへの通知メッセージを捉えるメカニズムの設計方針が決定したので、いよいよラッパークラスの設計に取り組もう。
ここまでの節では、 標準コントロールのうち「ボタン」コントロールを外側から見てきた。 コントロールには、リストボックスやエディット、コンボボックス、スクロールバー、スタティックなどがあるが、その基本仕様は大体同じであり、以下のようにまとめることができる。
このようなコントロールを包み込むラッパーとして、クラスをつくることにはどんな意義があるのだろうか。前章までに本稿で TAPISpeedBtn をつくってきた経験を基にすれば、汎用的な子ウィンドウからプッシュボタンをつくることは簡単にできるだろう。 しかし、エディットやリストボックス、スクロールバーなどはもちろん、チェックボックスでさえゼロからコードで実装するのは簡単ではないし、 そうすべきではない。 ユーザーは、長い間、様々なアプリケーションを使用してきており、これらのコントロールの外観や動作については熟知している。 少しでも外観や動作が異なれば、戸惑うだけだろう。 オブジェクト指向プログラミング（ＯＯＰ）の利点を強調するまでもなく、 登録済みのコントロールをクラスとして定義することは、仕様を共通化し、インスタンスを簡単に生成できることなど、その意義は十分大きいと考られる。
前章までで、ＧＤＩのＡＰＩ関数の機能をカプセル化したクラスをいくつか GDIObject.pas に作ってきた。 それらのクラスは、 TSubClass から直接派生したクラスである TGDIObject を共通の上位クラスとしていた。 TGDIObject は、それ自体は何もしないクラスであるが、 派生クラスが共通してもつプロパティーやメソッドを実装していた。 ここでは、コントロールのラッパークラスを作る第一歩として、プッシュボタンのラッパークラスをつくることを考えるが、やはり、これまでの経験から、上記のようにすべてのコントロールに共通なプロパティーとメソッドを実装したクラスをつくる必要があるだろう。 このようなクラスを TAPIControl としよう。そして、自分自身をサブクラス化する性質を備えたクラスを TSelfSubClass としよう。つまり、TAPIControl までの階層は、
TObject - TSubClass - TSelfSubClass - TAPIControl
となる。すべてのコントロールのラッパークラスは、この TAPIControlクラスから派生することにしよう。
上記の基本仕様を参考にして TSelfSubClass のプロパティーとして想定できるものを挙げてみよう。
１． Handle : 自分のウィンドウハンドル。読み出し専用。 ２． ID : コントロールＩＤ。生成時に指定する。読み出し専用。
TAPIControl のプロパティーとしては、
１．Dimension : コントロールの位置と大きさ。TRect 型。 ２．Enable : コントロールの有効性。Boolean 型。 ３．Visible : コントロールの可視性。Boolean 型。 ４．Caption : 関連づけられる string 型のテキスト。
それでは、さっそく実装することにしよう。
まず、APIControl.pas に TSelfSubClass と TAPIControl クラスを実装しよう。このユニットファイルの全リストを以下に示す。
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.PushButton02.zip(17.129kB)
以上で完成である。 実行して Test! メニューを選択するとボタンが四つ作られる。 Test! メニューを二回目以降に選択すると、Btn1 の有効性と Btn2 の可視性が反転する。 Btn1 をクリックするとそのボタンのウィンドウ情報とクラス情報がラベルに表示される。 これはクリックイベント（ WM_COMMAND )が Dispatcher からパスカルオブジェクトに転送され、イベントとして公開することがうまくいっている証拠である。 クラス情報のウィンドウ関数のアドレスとウィンドウ情報のそれとが異なっていることを確かめてほしい。 ウィンドウ情報に示されるウィンドウ関数のアドレスは、$7FFFFFFF 以下であり、ユーザーアドレスの中にあることが分かる。Btn2 をクリックするとメインウィンドウの背景色がランダムに変更される。 このときの様子を右図に示す。 Btn3 をクリックすると、自分自身が削除される。 これは、自己サブクラスの解除がうまくいっている事を示している。 Btn4 をクリックするとプログラムが終了する。
この節は長くなりすぎたので、次節で実装コードを調べることにしよう。
この節では、 前節で APIControl.pas に実装した TSelfSubClass 、TAPIContorol クラスとその下位クラス 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( ) ＡＰＩのパラメータそのものである。 こフィールド変数を用いて、コンストラクタでは、実際に CreateWindowEx( ) を使ってコントロールを作る。 そして、これがうまくいったら SetProp( ) をつかって 'OBJECT' という名前でプロパティーをつくり、自分のインスタンス参照を設定する。 つぎに、ウィンドウ関数のアドレスを SelfSubClassProc に入れ替え、'WNDPROC' プロパティーに元のウィンドウ関数のアドレスを格納する。 コントロールＩＤは、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( ) ＡＰＩをつかってもとのウィンドウ関数を呼び出し、 このメッセージを受け取ったコントロールのラッパーオブジェクトを取得している。 処理をしているメッセージは 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 から送られてくる親ウィンドウのメッセージと同じレコード型にしている。 TSelfSubClass や TAPIControl クラスは抽象クラスであるので、メッセージを具体的に処理する DefaultHandler をオーバーライドしていないが、TAPIButton クラスでは、WM_COMMAND を受け取って処理している。 TAPIControl の Initialize メソッドでは、Dispatcher に WM_COMMAND を送ってくれるよう依頼している。
procedure TAPIControl.Initialize; begin Dispatcher.TrapMessage(WM_COMMAND,self); end;
したがってこのクラスの派生クラスは、この継承メソッドを実行することにより自動的に WM_COMMAND を受け取ることができる。 TAPIButton の DefaultHandler を見てみよう。
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 の変数フィールドに値を格納するほかに、指定されたプロパティーをウィンドウオブジェクトに反映させるためにＡＰＩを使っている。 SetCaption( ) では SetWindowText( ) ＡＰＩを、SetDimension( ) では MoveWindow( ) ＡＰＩを使っている。
function MoveWindow(hWnd: HWND;
X, Y, nWidth, nHeight: Integer;
bRepaint: BOOL): BOOL; stdcall;この関数のパラメータは名前から容易に理解できるだろう。 SetEnable( ) では EnableWindow( ) が、SetVisible( ) では ShowWindow( ) ＡＰＩが使われている。 これらの例から分かるように、 ラッパーオブジェクトのプロパティーの設定を通じて、ウィンドウオブジェクトの機能を設定することができる。 Dimension プロパティーでは、コントロールの位置と大きさを同時に指定していたが、左上の座標 XPos と YPos、幅と高さ Width、Height のプロパティーも設けてある。 これらのアクセスメソッドには、GetWindowRect( ) が使われている。
function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; stdcall;
hWnd で指定されるウィンドウの位置と大きさが lpRect に返される。
以上で、TAPIButton クラスまでのコードの説明は終わりである。 このクラスまでの階層は、
TObject - TSubClass - TSelfSubClass - TAPIControl - TAPIButton
である。TSubClass で親のウィンドウ関数をサブクラス化し、TSelfSunClass で自分のウィンドウオブジェクトをサブクラス化し、TAPIControl でコントロールのラッパークラスの一般的な性質を装備し、 TAPIButton で具体的に、プッシュボタンのラッパークラスを作成した。 以降の数章にわたり、標準コントロールのラッパークラスを TAPIControl から派生して作成することを通して、Win32 のコントロールに対する理解を深めていくことにしよう。
ボタンコントロールを作成する CreateWindow( ) ＡＰＩのパラメータについては、６－１節で紹介した。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
つまり、下位から数えて９ビット目の桁と１０ビット目の桁でテキストの水平方向の位置を決めている。同様に、１１，１２ビットの桁で垂直方向を決めている。 デフォルトの $0000 は両方向とも中央に配置される。 これに対して BS_MULTILINE や BS_NOTIFY は特定の桁のビットが１かゼロかで設定されることが分かるだろう。 このように動的に変更できるスタイルは、コントロールのプロパティーとして設定することができる。 以上のことを、TAPIButton でつくられるウィンドウオブジェクトのウィンドウスタイルをＡＰＩを使って変更するプログラムをつくって確かめよう。
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.PushButton03.zip(15.750kB)
実行時の様子を右図に示す。 Test!メニューを選択するたびにスタイルが循環的に変更されるのを確認できるだろう。 スタイルの変更は SetWindowLong( ) ＡＰＩを使い、 その後、InvalidateRect( ) によってウィンドウを再描画している。 ボタンをクリックすると、その時点でのスタイルの値がラベルに表示される。
このプログラムでは、BS_NOTIFY のスタイルを確認していない。 このスタイルを指定すると、ボタンは BN_CLICK のほかに BN_DBLCLK 、BN_SETFOCUS 、BN_KILLFOCUS の通知メッセージを WM_COMMAND の HIWORD(wParam) として親ウィンドウに送る。したがってこのスタイルを含むボタンは OnDblClick や OnGetFocus、 OnLostFocus のイベントを公開できるようになる。
ここでは、これらの動的に変更できるウィンドウスタイルの設定を TAPIButton のプロパティーやイベントとして装備することはしない。 プロパティーとして装備すれば、たとえばマルチラインボタンなどは簡単につくることができる。読者自身で試してみてほしい。 TAPIButton を継承して新しいクラスをつくるより、TAPIButton のコードを書き直した方が簡単だろう。
メッセージの取得に関して自立する事ができた TAPIButton クラスのオブジェクトは、ＲＡＤ環境でも使用できるかどうかテストしてみよう。
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.RADPushButton.zip(164.360kB)
コンパイルして実行してみよう。 実行時の様子を右図に示す。 三つの TAPIButton クラスのオブジェクトがＲＡＤ環境でも正常に動作するのが分かるだろう。 APIBtn1 をクリックするとフォームの背景色が白色になる。 パネルの上にある APIBtn2 をクリックするとフォームの背景色がもとに戻る。ＶＣＬのボタン Button1 をクリックすると Panel1 とその上の APIBtn2 が見えなくなる。 もう一度押すと、見えるようになる。 Quit を押すとプログラムが終了する。
以上のテストから、TAPIControl を継承した下位クラスのオブジェクトはＲＡＤ環境でも正常に動作する事が期待できる。
本章では、 Win32 の登録済み子ウィンドウであるコントロールについて、ボタンクラスを例にとりその一般的側面を解説した。 まず、コードにより CreateWIndow( ) ＡＰＩをつかってボタンを生成しその使い方を見た。 イベントは、 親ウィンドウに WM_COMMAMND メッセージを SendMessage( ) を使って通知される。 また、ボタンクラスの１０種類のコントロールを作成した。 作成後に、SetWindowLong( ) でスタイルを変更できる事を示した。 コントロールのラッパークラスを設計するときの問題点を提示し、その解決策の一例を示した。 そして、以下のような階層でプッシュボタンコントロールのラッパークラスを作成した。
TObject - TSubClass - TSelfSubClass - TAPIControl - TAPIPushButton
TSubClass から派生することで、コントロールが親に送る WM_COMMAND などの通知を受け取れるようにした。 また、TSelfSubClass では、自分自身をサブクラス化して Win32 が直接コントロールに送ってくる WM_DESTROY などのメッセージを受け取れるようにした。 TAPIControl では、コントロール共通の性質をカプセル化し、それから派生して TAPIPushButton を作成した。 これは、ＶＣＬと共存することも確認した。
次章からは、 そのほかのコントロールのラッパークラスを TAPIControl から派生してつくり、コントロールについての理解を深めよう。
ここまでのプログラムファイル