第３章 ＧＤＩ 入門とスピードボタン
市販のペイント系やドロー系アプリケーション以外の大多数のアプリケーションでは、メインウィンドウのクライアント領域に直接コードで図形や文字を描画することはほとんどない。 それでも、コードによって図形を描くことは自分で書いたコードが目に見えるかたちとして反映されるので、とても楽しいものだ。 ＧＵＩ（グラフィカル・ユーザー・インタフェース）が Windows の重要な側面であることは承知のとおりである。したがって、Win32 には多数のＡＰＩ関数がＧＤＩ（グラフィカル・デバイス・インタフェース）関数として用意されている。 ＶＣＬには、TCanvas というクラスがあって、これらのＧＤＩ関数をつかうためのインタフェースとなっている。 TCanvas のメソッドである TextOut( )、MoveTo( )、LineTo( )、Ellipse( )、Polygon( ) などは、同名のＡＰＩ関数が対応して存在し、TCanvas には実装されていない PolyBezier( )、DrawText( ) などのＡＰＩ関数もコードレベルでは使うことができる。 さらに、パスやリージョンといった重要な概念をＡＰＩ関数をつかって実現できる。
一方、 TCanvas が Handle、Pen、Brush、Font をプロパティーとして持っているということが、このクラスがナマのＡＰＩ関数を使うことより非常に便利なインタフェースとして機能することの最大の理由となっている。 特に、Handle プロパティーに対応するデバイスコンテキストハンドルを TCanvas では巧妙に隠している。 この章では、 ナマの ＡＰＩ描画関数を使ってクライアント領域に図形を描くプログラムをつくることを通して、 TCanvas が隠しているものは何なのかを学ぶ。 この章の始めの２つの節は、このための基礎学習である。 残りの節では、 ＶＣＬの TSpeedButton に似たクラスをつくって、Object Pascal が定義するクラスのインスタンスであるオブジェクトがどのようにメッセージを受け取って処理することができるのか、を調べることに費やす。
3−0 この章の内容
| 第３章 ＧＤＩ 入門とスピードボタン |
| ３−１ ＧＤＩ 入門 |
| ３−２ デバイスコンテキストとは何か？ |
| ３−３ 矩形を描画する：スピードボタンの原型 |
| ３−４ ボタンを描くクラス |
| ３−４−１ TObject を調べる |
| ３−４−２ メッセージ処理ハンドラ |
| ３−４−３ DefaultHandler によるメッセージの処理 |
| ３−５ まとめ |
前の章へ
| 総目次へ
| 次の章へ 
｜３−１ ＧＤＩ 入門
これまでにも、MouseMove.dpr では TextOut( )、GenericColor.dpr では FillRect( ) という文字や図形を描くためのＡＰＩ関数を使用してきた。これらの関数が使われているコードを調べてみると、これらの関数がコードのなかでポツンと単独で使用されているのではなく、前後で幾つかの関数を使用して、「前準備」や「後処理」をしていることに気づく。 例として MouseMove.dpr の文字出力部分を取り出してみると、
DC := GetDC(hWindow);
TextOut( DC, 10, 10,' ',22);
TextOut( DC, 10, 10, PChar(s), Length(s) );
ReleaseDC(hWindow,DC);という具合だ。 TCanvas にも TextOut( ) メソッドがありほとんど等価な機能を持っている。 したがって、Delphi のＶＣＬを使った ＲＡＤプログラミングに習熟している読者に、いちいち描画のためのＧＤＩ関数を説明する必要はないと思われる。しかし、TCanvas クラスを使用できないコードレベルのプログラミングでは、TCanvas が隠している重要な概念と正面から向き合う必要がある。上記のコードの中の TextOut( ) ＡＰＩと TCanvas の TextOut( ) メソッドの間のほとんど唯一の相違は、 TextOut( ) ＡＰＩの第一パラメータであるデバイスコンテキストハンドル（ＨＤＣ型として定義されている）の有無である。 ほとんどのＧＤＩ関数はそのパラメータとしてＨＤＣを要求する。 上記のコードの GetDC( )と ReleaseDC( ) は、TextOut( ) ＡＰＩが要求する ＨＤＣを得るためと使い終わった後に解放するために使っている。 このＯＳから渡されるハンドルであるＨＤＣが識別する「デバイスコンテキスト」とは一体何を表しているものであろうか。
TCanvas クラスは単独で使用されることはまれであり、 TForm や TImage や TPanel といったクラスの部品（プロパティー）として使用される。したがって、TCanvasのメソッドを使って描画するとき、何を対象にして描画するのかを指定する必要がない。コードの文脈からコンパイラは描く対象を見つけることができるからだ。これに対して、ＡＰＩレベルの描画は、 描く対象を指定する必要があるのでＨＤＣをパラメータとして必要とする、 と考えることができる。 デバイスコンテキストをこのように考えることは、誤りではないし、事実上何の不都合もない。 ここでは、抽象論を詳細に論ずることは避けて、コードを通してＧＤＩ関数を使用していくと何が見えてくるか、という経験主義の立場にたって進めていこう。 その後にまとめとして一般的な側面に簡単にふれる。
さっそく幾つかのＧＤＩ関数を使ってウィンドウのクライアント領域に何かを描いてみよう。TestGDI01.dpr を以下の手順でつくる。
- エクスプローラを使って、新しいフォルダを 0301TestGDI01 という名前でつくる。
- 作ったフォルダに、エクスプローラを使って 0207MouseMove から Skeleton01.dpr と UtilFunc.pas をコピーする。
- コピーした Skeleton01.dpr をダブルクリックして Delphi を立ち上げる。
- コードエディタに Skeleton01.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで、TestGDI01.dpr という名前で保存する。
- コードエディタを編集して、以下のリストになるようにする。
- コンパイルして実行する。
以下に TestGDI01.dpr の全リストを示す。
program TestGDI01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,400,300);
CenterWindow(hWindow);
end;
procedure OnTest(hWindow: HWND);
var
DC: HDC;
r: TRect;
s: string;
hOrigPen, hPn: HPEN;
hOrigBrush, hBr: HBRUSH;
begin
GetClientRect(hWindow,r);
s := '幅 : '+AIntToStr(r.Right)+ ' 高さ : '+AIntToStr(r.Bottom);
DC := GetDC(hWindow);
hPn := CreatePen(PS_SOLID,2,RGB(255,0,0));
hOrigPen := SelectObject(DC,hPn);
MoveToEx(DC,0,0,nil);
LineTo(DC,r.Right,r.Bottom);
hBr := CreateSolidBrush(RGB(0,0,255));
hOrigBrush := SelectObject(DC,hBr);
Rectangle(DC,(r.Right div 4),(r.Bottom div 4),
(r.Right*3 div 4),(r.Bottom*3 div 4));
SetBkMode(DC, TRANSPARENT);
SetTextColor(DC,RGB(255,255,255));
DrawText(DC,PChar(s),Length(s),r,DT_SINGLELINE or DT_CENTER or DT_VCENTER);
DeleteObject(SelectObject(DC,hOrigPen));
DeleteObject(SelectObject(DC,hOrigBrush));
ReleaseDC(hWindow,DC);
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
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_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.
TestGDI01.zip(11.464kB)
実行して Test! メニューをクリックすると右図のようになる。 ウィンドウのサイズをいろいろと変えてみてほしい。
このコードで注目する点は、ペンとブラシの使い方と文字列の出力の仕方である。 OnTest( ) ハンドラでデバイスコンテキストハンドルを取得する GetDC( ) ＡＰＩの下の四行は、 太さ２の赤い純色のペンをつくりＤＣに「選択して」から、座標（0,0）からクライアント領域の右下隅までこのペンで線を引く、というものだ。このように、描く線や曲線や図形の枠の属性は「ペン」というリソースをつくり、これをデバイスコンテキストに「選択して」からＧＤＩ描画関数で使う、という方式をとる。 ペンをつくるには、ここでは CreatePen( ) ＡＰＩを使う。
function CreatePen(Style,
Width: Integer;
Color: COLORREF): HPEN; stdcall;このＡＰＩのパラメータは、TPen のプロパティーとほとんど同じだ。Style パラメータは、windows.pas では
const
PS_SOLID = 0;
PS_DASH = 1; { ------- }
PS_DOT = 2; { ....... }
PS_DASHDOT = 3; { _._._._ }
PS_DASHDOTDOT = 4; { _.._.._ }
PS_NULL = 5;
PS_INSIDEFRAME = 6;などと定義されている。 PS_DASH から PS_DASHDOTDOT までのスタイルは、太さ１のときのみ有効であるのも TPen と同じだ。 Width、Color パラメータの説明は不要だろう。 この関数は、Windows がこのパラメータに従って用意したペンのハンドルを返す。 ＤＣにこのペンを選択するには、 SelectObject( ) ＡＰＩを呼び出す。
function SelectObject(DC: HDC;
p2: HGDIOBJ): HGDIOBJ; stdcall;この関数により、ペンだけでなくブラシ、フォント、ビットマップなどをＤＣに選択できる。 従って、この関数の第二パラメータはこれらのリソースのいずれとも違うがキャスト可能な HGDIOBJ というハンドルの型を取っている。 Delphiでは、 他のハンドルと同じように
type HGDIOBJ = Integer;
と定義されているので、いちいち型キャストする必要はない。この関数は、それまでに選択されていた対応するＧＤＩオブジェクトのハンドルを返す。 このプログラムでは、hOrigPen にこれを保存している。 線を描くには、まず「現在のペン位置」を MoveToEx( ) で設定する。 これは、 TCanvas の MoveTo( ) メソッドと同じ働きをする。
function MoveToEx(DC: HDC;
p2, p3: Integer;
p4: PPoint): BOOL; stdcall;最後のパラメータは、もし設定前の位置を保存したければ、TPoint 型のレコードをさす PPoit 型のポインタを指定する。 保存の必要がなければ nil を指定すればよい。 LineTo( ) ＡＰＩは、 現在のペン位置から、指定の位置まで「現在選択されているペン」を使って線を描く。 このときパラメータで指定される座標に「現在のペン位置」が移動するが、 この座標を示す点自体には線が描かれないことに注意すること。
線を描いたら、このプログラムではブラシを作成して選択し、矩形を描いている。 CreateSolidBrush( ) は、純色のブラシを作り、そのハンドルを返す。 指定するパラメータは、COLORREF 型の色だけである。 Rectangle( ) ＡＰＩは、 ペンとブラシを使って矩形を描く。
次にこのプログラムは、 文字列をクライアント領域の真ん中に出力する。 テキスト出力の重要な属性には、「フォント」があるのは承知の通りだが、 フォントはペンやブラシより作成するのがやや難しいので、ここではＤＣのデフォルトフォントを使う。 出力されるテキストの色はフォントの属性ではなく、SetTextColor( ) で指定する。
function SetTextColor(DC: HDC;
Color: COLORREF): COLORREF; stdcall;この関数は、 設定以前のテキストカラーを返す。 SetBkMode( ) ＡＰＩの働きは、 この行をコメントアウトして実行してみるとよく分かる。 このＡＰＩは、テキストが表示される矩形の背景モードを設定する。 ＤＣのデフォルトは OPAQUE であり、描かれるウィンドウの背景色が使われる。 今の場合、COLOR_WINODOWのシステムカラー（通常は白色）が使われるが、テキストの色も白なのでコメントアウトして実行すると白い矩形が見えるだけだ。 SetTextColor( ) の行もコメントアウトするとその中に黒色でテキストが描かれる。 ＤＣのデフォルトのテキストカラーは黒色であることが分かるだろう。 SetBkMode( )の第二パラメータを TRANSPARENT にすると、それ以前の背景の上にテキストだけが描かれる。 DrawText( ) ＡＰＩは、TCanvas には相当するメソッドがない。
function DrawText(hDC: HDC;
lpString: PChar;
nCount: Integer;
var lpRect: TRect;
uFormat: UINT): Integer; stdcall;第二パラメータには出力する文字列を PChar 型で、第三パラメータは出力する文字数を指定する。 文字数は、 Length( ) 関数を使えば、日本語の２バイト文字も正しく出力される。 第三パラメータは出力テキストを書式化する矩形を TRect 型レコードの変数で指定する。このプログラムでは、クライアント領域全体を表す変数 r を指定している。 最後のパラメータは、 書式化の方法を指定する。 windows.pas には、
const
{ DrawText() Format Flags }
DT_TOP = 0; // 上寄せ。デフォルト。
DT_LEFT = 0; // 左寄せ。デフォルト。
DT_CENTER = 1; // 水平方向に中央配置。
DT_RIGHT = 2; // 右寄せ。
DT_VCENTER = 4; // 垂直方向に中央は位置。
DT_BOTTOM = 8; // 下寄せ。DT_SINGLELINEが必要。
DT_WORDBREAK = $10; // 自動改行。
DT_SINGLELINE = $20; // 一行表示
DT_EXPANDTABS = $40; // タブを展開する（幅はデフォルトで８文字）
DT_TABSTOP = $80; // タブストップの幅を設定する
DT_NOCLIP = $100; // クリッピングを行わない
DT_EXTERNALLEADING = $200;// フォントの外部レディングを高さに含める
DT_CALCRECT = $400; // 書式矩形を計算する
DT_NOPREFIX = $800; // ＆を下線と見なさないなどが定義されている。 これらを or 演算子で結合して指定する。 ここでは、 DT_CENTER と DT_VCENTER を指定してクライアント領域の中央に文字列を表示したいが、 DT_VCENTER は DT_SINGLELINE を指定しないと動作しないのでこれも指定する。 これらのパラメータの意味は、 名前から想像できるだろうが、 詳細は Delphi 付属の Win32.hlp で確かめてもらいたい。 この関数は、 テキストの高さを返す。
使い終わったペンやブラシ・フォントなどのリソースは削除しなければならない。 そのためには、まずデバイスコンテキストからの「選択状態」を解除する。 それから削除する。 「選択状態」にあるリソースを削除してはならない。 例えば、自分でつくったペンがＤＣに選択されているときにこれを削除するためには、まず SelectObject( ) を呼び出して保存してあった「以前選択されていたペン」のハンドル hOrigPen を選択する。 それから、DeleteObject( ) ＡＰＩで hPn を指定して削除する。 次の文は、これを一度に行ったものだ。 SelectObject( )は、選択する前のＧＤＩオブジェクトのハンドルを返すことを利用している。
DeleteObject(SelectObject(DC,hOrigPen));
SetTextColor( ) や SetBkMode( ) で変更したＤＣの設定については、 ＨＤＣの解放前にもとに戻す必要はない。 ハンドルを返す CreateXXX( ) ＡＰＩでつくったオブジェクトを使って変更した部分だけ、もとに戻す必要があること、そしてこのようにしてつくったＧＤＩオブジェクトを使用後に削除する必要があることを肝に銘じてほしい。最後に、ReleaseDC( ）でＤＣを解放する。 このプログラムでは、OnTest( ) ハンドラで描画を行っているので、ウィンドウのサイズを変更したり、最小化してから元に戻したりして、再描画されるところで絵が消えてしまうことに注意してほしい。これは、描画のタイミングがウィンドウの再描画のそれと同期していないためである。 次節では WP_PAINT メッセージに同期して描画することにより、この問題は回避される事が分かる。
以上の説明を読んで、ＡＰＩ関数をつかって描画することは煩わしい側面もあるが、難しい事は何もないことが分かってきただろう。 描画関数は、説明を読んで理解するより、実際に使うことのほうが簡単である。
３−２ デバイスコンテキストとは何か？
この節の表題の疑問に答える前にもう一つＧＤＩ関数を使うプログラムを作ろう。
- エクスプローラを使って、新しいフォルダを 0302TestGDI02 という名前でつくる。
- 作ったフォルダに、エクスプローラを使って 0301TestGDI01 から Skeleton01.dpr と UtilFunc.pas をコピーする。
- コピーした Skeleton01.dpr をダブルクリックして Delphi を立ち上げる。
- コードエディタに Skeleton01.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで、TestGDI02.dpr という名前で保存する。
- コードエディタにフォーカスがあるようにしてから、[ Ctrl ] + [ f.12 ] を押して表示されるダイアログから UtilFunc.pas を選んで OK ボタンを押し、コードエディタにユニットファイルを表示させる。
- コードエディタを編集して、以下のリストになるようにする。
- コンパイルして実行する。
ＶＣＬをつかった開発環境では、 オブジェクトインスペクタで TColor 型のプロパティーを設定するときには、 clBlack、clNavy などの定義済みの色のドップダウンリストが開く。似たような色の定数を UtilFunc.pas に定義しよう。 Interface 部の Global Types, Constants and Variables の部分に以下の定義を追加する。
const clrBlack = $000000; clrMaroon = $000080; clrGreen = $008000; clrOlive = $008080; clrNavy = $800000; clrPurple = $800080; clrTeal = $808000; clrGray = $808080; clrSilver = $C0C0C0; clrRed = $0000FF; clrLime = $00FF00; clrYellow = $00FFFF; clrBlue = $FF0000; clrFuchsia = $FF00FF; clrAqua = $FFFF00; clrLtGray = $C0C0C0; clrDkGray = $808080; clrWhite = $FFFFFF;
この定義は COLORREF 型のパラメータを要するＡＰＩ関数にそのまま代入できる。 また、Utility Functions のところに
function clrBtnFace: COLORREF; function clrWindow: COLORREF; function clrGrayText: COLORREF;
の関数を宣言し、対応する実装部に
function clrBtnFace: COLORREF; begin result := GetSysColor(COLOR_BTNFACE); end; function clrWindow: COLORREF; begin result := GetSysColor(COLOR_WINDOW); end; function clrGrayText: COLORREF; begin result := GetSysColor(COLOR_GRAYTEXT); end;
のコードを追加する。 GetSysColor( ) ＡＰＩは、ウィンドウの各部分の現在のシステムカラーを返す。 この色の設定はデスクトップを右クリックして、プロパティーメニューから表示されるダイアログのデザインページでユーザが設定できる。 以下に、TestGDI02.dpr の全リストを示す。
program TestGDI02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
DrawFlag: Boolean;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure Draw1(hWindow: HWND; DC: HDC);
var
i: integer;
begin
SetBkMode(DC,TRANSPARENT);
TextOut(DC,10,10,'Draw1 Function',14);
for i := 0 to 9 do begin
SelectObject(DC,CreatePen(PS_SOLID,i+1,0));
MoveToEx(DC,30,50+i*15,nil);
LineTo(DC,200,50+i*15);
DeleteObject(SelectObject(DC,GetStockObject(BLACK_PEN)));
end;
for i := 0 to 9 do begin
SelectObject(DC,CreatePen(PS_SOLID,i+1,clrRed));
MoveToEx(DC,250,50+i*15,nil);
LineTo(DC,420,50+i*15);
DeleteObject(SelectObject(DC,GetStockObject(BLACK_PEN)));
end;
for i := 0 to 4 do begin
SelectObject(DC,CreatePen(i,1,0));
MoveToEx(DC,30,250+i*10,nil);
LineTo(DC,420,250+i*10);
DeleteObject(SelectObject(DC,GetStockObject(BLACK_PEN)));
end;
end;
procedure Draw2(hWindow: HWND; DC: HDC);
var
pt: array[0..9] of TPoint;
begin
SetBkMode(DC,TRANSPARENT);
TextOut(DC,10,10,'Draw2 Function',14);
SelectObject(DC,CreateSolidBrush(clrRed));
Rectangle(DC,50,50,150,150);
DeleteObject(SelectObject(DC,CreateSolidBrush(clrYellow)));
Ellipse(DC,200,50,300,150);
DeleteObject(SelectObject(DC,CreateSolidBrush(clrLime)));
pt[0].x := 100; pt[0].y := 250;
pt[1].x := 300; pt[1].y := 250;
pt[2].x := 200; pt[2].y := 350;
pt[3].x := 150; pt[3].y := 200;
pt[4].x := 280; pt[4].y := 330;
Polygon(DC,pt,5);
DeleteObject(SelectObject(DC,GetStockObject(WHITE_BRUSH)));
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,470,420);
CenterWindow(hWindow);
DrawFlag := true;
end;
procedure OnTest(hWindow: HWND);
begin
DrawFlag := not DrawFlag;
InvalidateRect(hWindow,nil,true);
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnPaint(var Msg: TMessage);
var
hWindow: HWND;
ps: TPaintStruct;
begin
hWindow := Msg.Msg;
BeginPaint(hWindow,ps);
if DrawFlag then Draw1(hWindow,ps.hdc) else Draw2(hWindow,ps.hdc);
EndPaint(hWindow,ps);
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_PAINT ------------------------------------
WM_PAINT: OnPaint(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- 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.TestGDI02.zip(11.442kB)
実行して Test! メニューをクリックすると右図で示すように Draw1( ) と Draw2( ) 手続きが OnPaint( ) ハンドラで交互に実行される。 TestGDI01.dpr では、OnTest( ) ハンドラで描画していたので WM_PAINT メッセージを受け取るような場合には描画した図形が消えてしまうが、 このプログラムでは OnPaint( ) ハンドラで描画しているので、例えばサイズを変更しても消えることはない。 Draw1( ) と Draw2( ) 手続きを詳しく説明することはしないが、前節の説明でコードを理解できるだろう。 Draw1( ) で描かれる太い線の両端が非常に「汚い」ことに注目すること。
さて、 TestGDI02.exe は筆者のコンピュータでは期待通りに動作する。 この実行ファイルをフロッピーディスクにコピーして他のコンピュータで実行したとき、正常に動作するだろうか。明らかにＭａｃＯＳでの動作は期待できないが、Win32 のＯＳである Windows95 や Windows98 のもとでは正常に動作する事が期待できる。 コンピュータは、DOS/V マシン や PC-9800 かもしれないし、ＣＰＵも機種によって違うだろうし、ビデオカードも表示装置も違うと予想できるのに、正常な動作を期待できるのはなぜか？ それは、上記のコードの中には機種に依存するものがないからである。 機種に依存しないで入出力を実行するコードを書けるのは、明らかに出力場所を指定する ＤＣ のおかげである。 プログラマからみたデバイスコンテキストの正体は、外部機器との間の入出力のための標準インタフェースであると見なすことができる。 実際は、 デバイスコンテキストは表示場所の情報を持った大きな構造体（ Pascal でのレコード）として実装されているらしい。 SelectObject( )や SetBkMode( ) などのＤＣの属性を変化させるＡＰＩは、このレコードの特定のフィールドを書き換えていると考えることができる。
ディスプレイのデバイスコンテキストのハンドル（ＨＤＣ）の取得と解放のためには、すでに何度も使ってきたが次の二組のＡＰＩ関数が主に用いられる。
function BeginPaint(hWnd: HWND; var lpPaint: TPaintStruct): HDC; stdcall; function EndPaint(hWnd: HWND; const lpPaint: TPaintStruct): BOOL; stdcall; function GetDC(hWnd: HWND): HDC; stdcall; function ReleaseDC(hWnd: HWND; hDC: HDC): Integer; stdcall;
このうち前者の組は WM_PAINT メッセージを処理するときにだけ使われる。 まえにも述べたように、 このメッセージを処理して DefWindowProc( ) に渡さないときは、必ずこの関数のペアを実行することが必要である。 ともに第二パラメータは TPaintStruct 型のレコードを指定する。
type
PPaintStruct = ^TPaintStruct;
TPaintStruct = packed record
hdc: HDC;
fErase: BOOL;
rcPaint: TRect;
fRestore: BOOL;
fIncUpdate: BOOL;
rgbReserved: array[0..31] of Byte;
end;BeginPaint( ) では、このレコードの第一フィールドにＨＤＣが返される。 同じものがこの関数の戻り値でもある。第二フィールドが true のときは、この処理ハンドラでウィンドウの背景を更新する必要があることを知らせている。 このウィンドウのクラスの定義で背景ブラシが指定されている場合は、この関数がそのブラシを使って背景を再描画する。 第三フィールドは、再描画することを要請されている更新領域を囲む矩形を返す。 他の３つのフィールドは、 ＯＳが予約している領域でプログラマはアクセスしない。 EndPaint( ) は、ＨＤＣを解放するだけではなく描画処理の後始末をする（らしい）ので、必ず BeginPaint( ) とペアで使うこと。
GetDC( ) と ReleaseDC( ) のペアを使うと、 どの場所のコードからでもＨＤＣにアクセスできる。 ReleaseDC( ) の戻り値は、解放に成功したら１、そうでなければ ０ である。
ＨＤＣを取得した直後は、 ＤＣの中身はデフォルトのフィールド値を持っていると期待できる。 TestGDI01.dpr と TestGDI02.dpr のコードの中での違いは、 後者ではペンやブラシのデフォルトのハンドルを変数に保存していないことである。 デフォルトオブジェクトを知っていれば、解放前にコードで復元できる。 ＤＣの主なデフォルト値を以下に列挙しておく。
・ペン BLACK_PEN （ GetStockObject( ) ＡＰＩでハンドルを取得する） ・ブラシ WHITE_BRUSH （ GetStockObject( ) ＡＰＩでハンドルを取得する） ・フォント SYSTEM_FONT （ GetStockObject( ) ＡＰＩでハンドルを取得する） ・現在のペン位置 (0,0) ・背景モード OPAQUE （ SetBkMode( ) ） ・テキスト色 RGB(0,0,0) （ 黒 ）
などである。 Win32 では、ＯＳが定義済みのＧＤＩオブジェクトを幾つか定義している。
const
{ Stock Logical Objects }
WHITE_BRUSH = 0;
LTGRAY_BRUSH = 1;
GRAY_BRUSH = 2;
DKGRAY_BRUSH = 3;
BLACK_BRUSH = 4;
NULL_BRUSH = 5;
HOLLOW_BRUSH = NULL_BRUSH;
WHITE_PEN = 6;
BLACK_PEN = 7;
NULL_PEN = 8;
OEM_FIXED_FONT = 10;
ANSI_FIXED_FONT = 11;
ANSI_VAR_FONT = 12;
SYSTEM_FONT = 13;
DEVICE_DEFAULT_FONT = 14;
DEFAULT_PALETTE = 15;
SYSTEM_FIXED_FONT = $10;これらのハンドルを取得するには、 GetStockObject( ) ＡＰＩを使って、パラメータに上の定数を指定する。
function GetStockObject(Index: Integer): HGDIOBJ; stdcall
これらのオブジェクトは使用後に解放する必要はないが、DeleteObject( )で解放してもなんの害もない。系統的なコードを書くためには、ストックオブジェクトであるか否かにかかわらず、必ず解放する習慣をつけるとよい。
３−３ 矩形を描画する：スピードボタンの原型
この章の残りの節では、 ＶＣＬの TSpeedButton コンポーネントに似たクラスを作り、Object Pascal のオブジェクトがどのようにしてウィンドウメッセージを受け取って処理するのかを調べる。 TSpeedButton クラスは、 TGraphicControl の派生クラスである。 見かけと機能は似ている TButton クラスは、 TWinControlの派生クラスであり、ウィンドウハンドルをもつ本物のウィンドウである。これに対して、TSpeedButton はＧＤＩ関数を用いて描画されたボタンに似た「絵」にすぎない。 ウィンドウではないからウィンドウ関数を持たないため、単独ではメッセージを受け取ることができないはずであるが、OnClick イベントに応答できるのはなぜだろうか。この疑問の回答の一つが残りの節で示される。
Windows のＯＳの仕様がイベント駆動型のプログラミングスタイルを強制していることは前にも述べた。 ＶＣＬを使ったＲＡＤプログラミングでは、メッセージの伝達機構は巧妙に隠されていて、プログラマはイベントハンドラに処理コードを書くだけでアプリケーションを作ることができる。 TForm はもちろん、コンポーネントがどうしてイベントに応答できるのか不思議に思ったことはないだろうか。 メッセージは、どこからやってくるのだろうか。 すでにこれまでのプログラムで示したように、ウィンドウはウィンドウ関数を持っているので、自分でメッセージを受け取れる。 Handle プロパティーをもつ TWinControl の派生クラスはウィンドウである。 ウィンドウではないクラスは、ウィンドウであるクラスが受け取ったメッセージを「分けてもらっている」か、「横取りしている」か、「のぞき見している」のだ。この章の残りの節と、続く第４章では、Delphi の Object Pascal で独自のクラスをつくりながら、イベント駆動型のプログラミングスタイルにとって重要な「メッセージ伝達機構」について詳しく調べることにしよう。
まず最初の一歩として、ただ矩形を描画してマウスの左ボタンのクリックに応答するだけのプログラムを作ろう。
- エクスプローラを使って、新しいフォルダを 0303SpeedBtn01 という名前でつくる。
- 作ったフォルダに、エクスプローラを使って 0302TestGDI02 から Skeleton01.dpr と UtilFunc.pas をコピーする。
- コピーした Skeleton01.dpr をダブルクリックして Delphi を立ち上げる。
- コードエディタに Skeleton01.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで、SpeedBtn01.dpr という名前で保存する。
- コードエディタを編集して、以下のリストになるようにする。
- コンパイルして実行する。
以下に SpeedBtn01.dpr の全リストを示す。
program SpeedBtn01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
BtnColor: COLORREF;
BtnRect: TRect;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,400,300);
CenterWindow(hWindow);
SetRect(BtnRect,50,50,200,100);
BtnColor := clrBlue;
end;
procedure OnTest(hWindow: HWND);
begin
MessageBeep($FFFFFFFF);
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnPaint(var Msg: TMessage);
var
hWindow: HWND;
ps: TPaintStruct;
hBr: HBRUSH;
begin
hWindow := Msg.Msg;
BeginPaint(hWindow,ps);
hBr := CreateSolidBrush(BtnColor);
FillRect(ps.hdc,BtnRect,hBr);
DeleteObject(hBr);
SetBkMode(ps.hdc,TRANSPARENT);
SetTextColor(ps.hdc,clrWhite);
DrawText(ps.hdc,'SpeedBtn01',10,BtnRect,DT_CENTER or
DT_SINGLELINE or DT_VCENTER);
EndPaint(hWindow,ps);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnLButtonDown(var Msg: TMessage);
var
p: TPoint;
hWindow: HWND;
begin
hWindow := Msg.Msg;
p.x := Msg.LParamLo;
p.y := Msg.LParamHi;
if PtInRect(BtnRect,p) then begin
if BtnColor = clrBlue then
BtnColor := clrRed
else
BtnColor := clrBlue;
InvalidateRect(hWindow,@BtnRect,true);
end;
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_PAINT ------------------------------------
WM_PAINT: OnPaint(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_LBUTTONDOWN ------------------------------
WM_LBUTTONDOWN: OnLButtonDown(AMsg);
//------------- 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.SpeedBtn01.zip(11.312kB)
実行の様子を右図に示す。 描かれた矩形はボタンのようには見えないが、矩形の内側で左クリックすると、色が青と赤に交互に切り替わるのが分かるだろう。 まるで、クリックイベントに応答しているみたいだ。矩形の外側では応答しないし、さらに普通のコンポーネントのように WM_PAINT メッセージに同期して自分自身を再描画している。 上記の例えを借りれば、この「オブジェクト」はメインウィンドウからメッセージを「分けてもらっている」ことになる。
コードを見ていこう。矩形を描くタイミングは WM_PAINT メッセージに同期している。 OnPaint( ) ハンドラでは、グローバル変数の BtnRect と BtnColor を使って FillRect( ) によって矩形を描く。 この関数は、GenericColor.dpr でも使ったので、すでにおなじみだろう。
function FillRect(hDC: HDC;
const lprc: TRect;
hbr: HBRUSH): Integer; stdcall;lprc パラメータで指定される矩形を hbr で指定されるブラシで塗りつぶすものだ。Rectangle( ) と比べると、ブラシをＤＣに選択しなくてもいいこと、カレントペンで枠が描かれないことなど、今の場合は FillRect( ) を使った方が便利だ。 その後、TestGDI01.dpr で使った DrawText( ) によって白抜きの文字列を矩形の中央に出力している。 GenericColor.dpr ですでに WM_LBUTTONUP メッセージの処理ハンドラを示したが、ここでも同様 WM_LBUTTONDOWN メッセージに同期して OnLButtonDown( ) ハンドラでマウスの座標を TPoint 型の変数 p に格納してから、 PtInRect( ) ＡＰＩを呼び出す。
function PtInRect(const lprc: TRect;
pt: TPoint): BOOL; stdcall;この関数は、 pt が lprc の「内側」にある時 true を返すので、if 文を使ってこのときだけ BtnColor を切り替えて、 InvalidateRect( ) により WM_PAINT メッセージを発行する。 このようにして、マウスの位置が矩形の中にあるときだけ矩形の色が切り替わるわけだ。 見かけ上は、この「矩形オブジェクト」自身がマウスイベントに応答しているようであるが、実際はメインウィンドウのウィンドウ関数で描かれた「絵」にすぎない。 それでも、この「矩形オブジェクト」を外側から見た場合、メインウィンドウから WM_PAINT と WM_LBUTTONDOWN メッセージを分けてもらっていると見なすことができる。 メッセージの取得方法は異なるかもしれないが、 ＶＣＬの TGraphicControl の派生クラスは、自分の描かれるウィンドウのウィンドウ関数から幾つかのメッセージを分けてもらう「絵」オブジェクトであると意味で、本節の「スピードボタン」と同じである。 このことは、この「スピードボタン」をクラスとして定義すると、より明確になる。
３−４ ボタンを描くクラス
前節のコードでつくった「矩形を描画してマウスの左ボタンのクリックに応答するだけ」のクラスを作ろう。これは、本稿でつくる最初のクラスである。承知のように Delphi のクラスは、自動的に TObject クラスの派生クラスになる。つまり、
TAnyObject = class
と宣言することは、
TAnyObject = class(TObject)
と宣言することと同じだ。したがって、TObject のすべてのメソッドを継承することになるので、TObject のメソッドについて知っておくことは重要だ。その上で、 TSpeedBtn クラスをつくることにしよう。
３−４−１ TObject を調べる
ユーザーズガイドにも載っているが、TObject の宣言を System.pas から引用してみよう。
TObject = class
constructor Create;
procedure Free;
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
procedure Dispatch(var Message);
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress(const Name: ShortString): Pointer;
function GetInterface(const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): Integer; virtual;
procedure DefaultHandler(var Message); virtual;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
destructor Destroy; virtual;
end;２３個ものメソッドがあるが、これらの機能は TObject をキーワードにしてヘルプから調べることができる。 多くのメソッドは、「直接 ＸＸＸＸメソッドを呼び出さないでください。」という注意があって、Delphi が内部的に使用するメソッドであることが分かる。 ここでは、TObject から直接派生するクラスを沢山つくることになるが、その際、重要な役割を果たす五つのメソッドについてここで調べることにしよう。
constructor Create;
- TObject のコンストラクタである。コンストラクタは、クラスメソッドとして呼び出されると、オブジェクトを作成しメモリを割り当てる。普通のメソッドとして呼び出すと単に、メソッドコードが実行される。 TObject の Create メソッドは、実行コードがないので何もしない。 このメソッドは、宣言を見ると分かるように仮想メソッドではないので、派生クラスは、データの初期化のためには独自のコンストラクタとして Create メソッドを宣言して上書きすることになる。
- procedure Free;
- Free メソッドは，オブジェクトを破棄し割り当てられているメモリを解放する。コンストラクタで作られたオブジェクトを破棄する重要なメソッドであり、オブジェクト参照が nil でなければ自動的にデストラクタ Destroy メソッドを呼び出す。 このメソッドは、仮想メソッドではないので override できない。
- destructor Destroy; virtual;
- デストラクタであるが通常はコードから直接呼ばれることはなく Free メソッドから呼ばれる。 Free メソッドは override できないが、Destroy は仮想メソッドなので override できる。したがって、派生クラスでオブジェクトが廃棄されるときの後始末は、 override した Destroy メソッドの中で実行し、その後に継承メソッドを呼び出してオブジェクトを破棄する。
- procedure Dispatch(var Message);
- Dispatch メソッドは Object Pascal のメッセージ伝達機構の中心を担う重要なメソッドである。 このメソッドは、型なし変数 Message をオブジェクトに配送する。このパラメータは、変数パラメータなので値を返すことができる。 Message はどのようなレコード型でもよいが、唯一の制限はその第一フィールドが（ WM_PAINT とか WM_CREATE とかのような）３２ビットのメッセージＩＤでなければならないことだ。このメソッドを呼び出すと、このフィールドを参照してオブジェクトのメッセージ処理ハンドラを探して、見つかったら Message を渡して結果を返してもらう。 見つからなかったら、次に紹介する DefaultHandler メソッドを呼び出す。
- procedure DefaultHandler(var Message); virtual;
- このメソッドは、Dispatch メソッドがメッセージ処理ハンドラを発見できなかったときに呼び出される。 特定のメッセージをトラップして処理したいクラスは、 メッセージ処理ハンドラをメソッドとして装備するか、DefaultHandler を override してその中に処理コードを書けばよい。Dispatch メソッドを呼び出したルーチンには、Message パラメータを通して値を返すことができる。 inherited キーワードを使って継承メソッドを呼び出すと、上位クラスに対して Dispatch メソッドを実行したときと同じになる。 つまり、上位クラスのメッセージ処理ハンドラを探して、見つかったらそこで処理し、見つからなかったら上位クラスの DefaultHandler が呼び出される。
以上で、TObject のメソッドの説明は終わりであるが、Dispatch と DefaultHandler メソッドについては理解しにくいところがある。以降で具体的な例を挙げて簡単に説明する。
３−４−２ メッセージ処理ハンドラ
メッセージ処理ハンドラをつかって WM_PAINT と WM_LBUTTONDOWN メッセージだけを処理するクラス TSpeedBtn を作ってテストすることにしよう。
- エクスプローラを使って、新しいフォルダを 0304SpeedBtn02 という名前でつくる。
- 作ったフォルダに、エクスプローラを使って 0303SpeedBtn01 から Skeleton01.dpr と UtilFunc.pas をコピーする。
- コピーした Skeleton01.dpr をダブルクリックして Delphi を立ち上げる。
- コードエディタに Skeleton01.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで、SpeedBtn02.dpr という名前で保存する。
- [ファイル]メニューから[新規作成]を選んで、ユニットを作成する。
- 作成したユニット Unit1.pas を[ファイル]メニューから[名前を付けて保存]を選んで Test.pas という名前で 0304SpeedBtn02 フォルダに保存する。
- コードエディタにフォーカスがあるようにしてから、[ Ctrl ] + [ f.12 ] を押して表示されるダイアログから UtilFunc.pas を選んで OK ボタンを押し、コードエディタにユニットファイルを表示させる。
- コードエディタを編集して、以下のリストになるようにする。
- コンパイルして実行する。
まず前準備として、UtilFunc.pas に TRect 型の変数に値を設定する関数 SetDim( ) を作ろう。 Interface 部の function clrGrayText: COLORREF; の宣言の下に
function SetDim(x,y,width,height: Integer):TRect;
と宣言し、Implementation 部の clrGrayText 関数の下に
function SetDim(x,y,width,height: Integer):TRect;
begin
SetRect(result,x,y,width,height);
end;とする。次に Test.pas に TSpeedBtn クラスをつくろう。以下にリストを示す。
unit Test;
interface
uses
windows,
messages,
UtilFunc;
type
TSpeedBtn = class(TObject)
private
FParent: HWND;
FColor: COLORREF;
FRect: TRect;
protected
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
public
constructor Create(hParent: HWND);
property Rect: TRect read FRect write FRect;
end;
implementation
constructor TSpeedBtn.Create(hParent: HWND);
begin
FParent := hParent;
FColor := clrBlue;
end;
procedure TSpeedBtn.WMPaint(var Msg: TWMPaint);
var
hBr: HBRUSH;
DC: HDC;
begin
hBr := CreateSolidBrush(FColor);
DC := GetDC(FParent);
FillRect(DC,FRect,hBr);
DeleteObject(hBr);
SetBkMode(DC,TRANSPARENT);
SetTextColor(DC,clrWhite);
DrawText(DC,'SpeedBtn',8,FRect,DT_CENTER or
DT_SINGLELINE or DT_VCENTER);
ReleaseDC(FParent,DC);
end;
procedure TSpeedBtn.WMLButtonDown(var Msg: TWMLButtonDown);
var
p: TPoint;
begin
p.x := Msg.XPos;
p.y := Msg.YPos;
if PtInRect(FRect,p) then begin
if FColor = clrBlue then FColor := clrRed else FColor := clrBlue;
InvalidateRect(FParent,@FRect,true);
end;
end;
end.このクラスは本稿でつくる最初のクラスなので、詳しく見ていこう。 TSpeedBtn クラスには、一つのプロパティー Rect とコンストラクタ Create(hParent: HWND) がユーザに公開されている。TRect 型レコードの Rect プロパティーは、自分自身を描く矩形を定義している。 また、protected 部のメソッドとして message 指令により WM_PAINT と WM_LBUTTONDOWN メッセージを捕まえて処理する二つの手続きがある。private 部には、親ウィンドウのハンドルを保持する FParent と Rect プロパティーの値を保持する FRect と実装コード内で参照される FColor フィールドがある。実装部のコンストラクタでは、親ウィンドウのハンドルを FParent に格納し、FColor の値を clrBlue に初期化している。 WMPaint( ) と WMLButtonDown( ) メソッドのコードは前節で示した OnOaint( ) と OnLButtonDown( ) とほとんど同じである。 ただし、WMPaint( ) では、渡されるパラメータがメッセージだけであるので、GetDC( ) と ReleaseDC( ) のペアをつかっている。
このクラスを使ってテストするプログラムを SpeedBtn02.dpr につくろう。 以下に全リストを示す。
program SpeedBtn02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
Test in 'Test.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
SP1,SP2: TSpeedBtn;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,400,300);
CenterWindow(hWindow);
SP1 := TSpeedBtn.Create(hWindow);
SP1.Rect := SetDim(50,50,200,100);
SP2 := TSpeedBtn.Create(hWindow);
SP2.Rect := SetDim(50,120,200,170);
end;
procedure OnTest(hWindow: HWND);
begin
MessageBeep($FFFFFFFF);
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnPaint(var Msg: TMessage);
var
hWindow: HWND;
ps: TPaintStruct;
begin
hWindow := Msg.Msg;
BeginPaint(hWindow,ps);
EndPaint(hWindow,ps);
Msg.Msg := WM_PAINT;
SP1.Dispatch(Msg);
SP2.Dispatch(Msg);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnLButtonDown(var Msg: TMessage);
begin
Msg.Msg := WM_LBUTTONDOWN;
SP1.Dispatch(Msg);
SP2.Dispatch(Msg);
end;
procedure OnDestroy(var Msg: TMessage);
begin
SP1.Free;
SP2.Free;
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_PAINT ------------------------------------
WM_PAINT: OnPaint(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_LBUTTONDOWN ------------------------------
WM_LBUTTONDOWN: OnLButtonDown(AMsg);
//------------- 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.SpeedBtn02.zip(12.239kB)
実行すると右図のようになる。 ここでは、OnCreate( ) ハンドラで TSpeedBtn クラスのインスタンスを二つ作成している。 前節のように、コードで見かけ上の「オブジェクト」をつくる場合は複数の「インスタンス」ごとにコードを書き足さなければならないのに較べれば、クラスから複数のインスタンスをつくることは極めて簡単である事が分かるだろう。 これは、クラス型ＯＯＰ（オブジェクト指向プログラミング）の大きな利点の一つである。親ウィンドウからこれらのインスタスへのメッセージの分配するために、OnPaint( ) と OnLButtonDown( ) ハンドラから、インスタンス自身のメソッドである Dispatch（ ）を使っている。 そして最後に、プログラムが終了するときに OnDestroy( ) ハンドラで Free メソッドを使って、インスタンスをメモリから削除している。
この例では、message 指令を用いたメッセージ処理ハンドラをクラスのメソッドにして、Dispatch( ) メソッドで送られてくるメッセージを捕まえて処理するクラスの例を示した。 Delphi の object pascal でのクラスにおけるメッセージの伝達機構がかなり明確になっただろう。 Dispatch( ) メソッドは、TObject のメソッドなので全てのクラスでこのメソッドを使ってオブジェクトにメッセージを送ることができる。
３−４−３ DefaultHandler によるメッセージの処理
ここまでで、メッセージは message 指令をつかったメッセージ処理ハンドラでトラップできることが分かった。もう一つ、メッセージを捕まえられる場所がある。 DefaultHandler である。ここでは、これまでにつくった TSpeedBtn クラスを少しだけ変更して、DefalutHandler でメッセージを処理するクラスの例を示そう。
- エクスプローラを使って、新しいフォルダを 0305SpeedBtn03 という名前でつくる。
- 作ったフォルダに、エクスプローラを使って 0304SpeedBtn02 から SpeedBtn02.dpr と Test.pas と UtilFunc.pas をコピーする。
- コピーした SpeedBtn02.dpr をダブルクリックして Delphi を立ち上げる。
- コードエディタに SpeedBtn02.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで、SpeedBtn03.dpr という名前で保存する。
- コードエディタにフォーカスがあるようにしてから、[ Ctrl ] + [ f.12 ] を押して表示されるダイアログから Test.pas を選んで OK ボタンを押し、コードエディタにユニットファイルを表示させる。
- コードエディタを編集して、以下のリストになるようにする。
- コンパイルして実行する。
Test.pas のコードを以下のように変更する。
unit Test;
interface
uses
windows,
messages,
UtilFunc;
type
TSpeedBtn = class(TObject)
private
FParent: HWND;
FColor: COLORREF;
FRect: TRect;
public
constructor Create(hParent: HWND);
procedure DefaultHandler(var Message); override;
property Rect: TRect read FRect write FRect;
end;
implementation
constructor TSpeedBtn.Create(hParent: HWND);
begin
FParent := hParent;
FColor := clrBlue;
end;
procedure TSpeedBtn.DefaultHandler(var Message);
var
Msg: TMessage;
hBr: HBRUSH;
DC: HDC;
p: TPoint;
begin
Msg := TMessage(Message);
case Msg.Msg of
WM_PAINT:begin
hBr := CreateSolidBrush(FColor);
DC := GetDC(FParent);
FillRect(DC,FRect,hBr);
DeleteObject(hBr);
SetBkMode(DC,TRANSPARENT);
SetTextColor(DC,clrWhite);
DrawText(DC,'SpeedBtn',8,FRect,DT_CENTER or
DT_SINGLELINE or DT_VCENTER);
ReleaseDC(FParent,DC);
end;
WM_LBUTTONDOWN:begin
p.x := Msg.LParamLo;
p.y := Msg.LParamHi;
if PtInRect(FRect,p) then begin
if FColor = clrBlue then FColor := clrRed else FColor := clrBlue;
InvalidateRect(FParent,@FRect,true);
end;
end;
end; // case
end;
end.SpeedBtn03.zip(12.249kB)ここでは、前につくった TSpeedBtn クラスのメッセージ処理ハンドラを削除して、public 部に DefaultHandler( ) をオーバーライドしているだけだ。 DefaultHandler( ) の実装部では、形無し変数を TMessage 型レコードにキャストした後、case 文でメッセージをより分け、WM_PAINT と WM_LBUTTONDOWN だけを処理している。 この例では、 Defaulthandler で継承メソッドを呼び出さないので、上位クラスには全てのメッセージを渡さない。このファイル以外に変更はないので、このままコンパイルして実行することができる。
以上示したように、Dispatch メソッドで渡されるメッセージをトラップして処理するには、message 指令を使ったメッセージ処理ハンドラを実装するか、DefaultHandler を override するかの二通りの方法がある。多数のメッセージを処理するためには、 ウィンドウ関数に似た構造をもつ DefaultHandler を override した方がクラスの宣言の仕方が簡潔になるので、将来ここでつくるクラスはすべて DefaultHandler でメッセージを処理する方式をとることにする。 そしてその際、継承メソッドを呼び出さないことにして、そのクラスで処理するメッセージはそのクラスの DefaultHandler でコードを書くという仕様をとることにしよう。そうすれば、処理コードに冗長性がつきまとうが、上位クラスをさかのぼってコードを探すような煩雑さから解放されるメリットがある。
３−５ まとめ
本章では、各種のＡＰＩ関数をつかってウィンドウのクライアント領域に絵を描く練習をし、ＶＣＬでは隠されているデバイスコンテキストについて調べた。 また、WM_PAINT メッセージに同期して自分自身を描画し、WM_LBUTTONDOWN メッセージを捕まえて処理するクラスを作成することにより、 Delphi の Object Pascal によってつくられたクラス（のインスタンス）に対するメッセージ伝達機構を調べた。
Win32 のシステムにおけるメッセージの伝達は、ウィンドウのウィンドウ関数を通して行われる。 本稿でここまでにつくったプログラムで、作成されたウィンドウはメインウィンドウだけである。 ウィンドウではないオブジェクトがメッセージを受け取るためには、すべてのクラスの上位クラスである TObject のメソッド Dispatch( ) を使って配送する。 クラスでメッセージを受け取って処理するには、message 指令を使ったメッセージ処理ハンドラをメソッドに加えるか、DefaultHandler( ) をオーバーライドする。
ここまでのプログラムファイル