前の章へ
| 総目次へ
| 次の章へ 
｜ここまでの本稿では、第２章から５章まででメインウィンドウに絵を描くＡＰＩの機能を包み込んで、スピードボタンやラベルなどのクラスを作ってきた。 これらは、基本クラス TGDIObject から派生したものだった。また、タイマやドラグドロップの機能のラッパークラスは TSubClass から派生して作った。第６章から９章にかけては、Win32 の定義済みのクラスであるコントロールのラッパークラスを作成した。これらは、基本クラス TAPIControl から派生して作られた。ここまでで、Win32 のアプリケーションの基本構造やメッセージ伝達機構についてかなりの理解が得られたここと思う。 またクラス化することで、機能がコンパクトに包み込まれ、コードの再利用性が高まり、保守が容易になり、コードが理解しやすくなったことには同意が得られるだろう。 これらは、すべてＯＯＰの利点でもある。 Delphi が Pascal 言語ではなく、Object Pascal 言語であることの恩恵である。 Delphi には、ＶＣＬという素晴らしいクラスライブラリがあるにもかかわらず、本稿で貧相で（そして多分不完全な）クラスを独自に作成したのは、Object Pascal という言語を用いて、ＶＣＬの下に深く埋もれている Win32 の構造やＡＰＩの機能を理解したかったためである。 このことの副次的効用として、非常に小さな実行ファイルを作ることができることも見逃せない。
ここまでで Delphi のＲＡＤ環境でのコンポーネントパレットにあるコンポーネントの幾つかに対応するクラスを作成してきたのであるが、その土台である TForm に対応するメインウィンドウはコードベースのままであった。 コントロールのラッパークラスの作成はひとまずお休みにして、この章では、 メインウィンドウのラッパークラスを作成し、 新しい骨格プログラム Skeleton03.dpr を作成する。 通常、一つしかインスタンスを作らないメインウィンドウをクラス化する事にどんな意義があるだろうか。 上記のＯＯＰの利点はもちろんであるが、 クラス化する過程で汎用ウィンドウの機能を制御するウィンドウサポート関数について学ぶ機会が得られることは大きな意義がある。
この章では、 本稿で最初につくるの汎用ウィンドウクラスとして、シングルドキュメントインタフェース（ＳＤＩ）のメインウィンドウのラッパークラスを作ることにしよう。
| 第１０章 メインウィンドウのクラス化とウィンドウサポートＡＰＩ |
| １０−１ Skeleton02 のラッパークラスを作成する |
| １０−２ イベントの公開 |
| １０−３ プロパティー、メソッドの装備 |
| １０−４ Skeleton03 プログラム |
| １０−５ サイズ固定ウィンドウ |
| １０−６ インスタンスを一つに限定する |
| １０−７ まとめ |
前の章へ
| 総目次へ
| 次の章へ ｜汎用ウィンドウの一般的側面を調べる前に、この節ではいままで使ってきた骨格プログラム Skeleton02.dpr で作られるメインウィンドウのラッパークラスを作成しよう。そうすれば、一般的なメインウィンドウを設計するときの問題点が浮かび上がってくるだろう。
Skeleton02 ではメインルーチンの最初の実行コードとして UtilFunc.pas に実装している関数でメインウィンドウを作成していた。
MakeMainWindow(@MainWndProc);
この関数の引数はウィンドウ関数のアドレスだけであり、第１章で説明したとおりの手順でウィンドウを作成していた。つまり、
である。以下にその実装コードを示す。
function MakeMainWindow(WndProc:TFNWndProc): HWND;
var
wc: TWndClass;
hWindow: HWND;
s: string;
begin
s := GetExeName;
wc.lpszClassName := PChar(s);
wc.lpfnWndProc := WndProc;
wc.style := CS_VREDRAW or CS_HREDRAW;
wc.hInstance := hInstance;
wc.hIcon := LoadIcon(0,IDI_APPLICATION);
wc.hCursor := LoadCursor(0,IDC_ARROW);
wc.hbrBackground := (COLOR_WINDOW+1);
wc.lpszMenuName := nil;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
RegisterClass( wc );
hWindow := CreateWindowEx(WS_EX_CONTROLPARENT or WS_EX_WINDOWEDGE,
PChar(s),
PChar(s),
WS_VISIBLE or WS_OVERLAPPEDWINDOW,
200,100,
300,200,
0,
0,
hInstance,
nil);
ShowWindow(hWindow,CmdShow);
UpDateWindow(hWindow);
result := hWindow;
end;問題は、この関数を実行するタイミングである。 Skeleton02 ではウィンドウ関数がプログラム領域に公開されているので、トラップするメッセージの処理をあらかじめ case 文の中に書いておくことができた。しかし、メインウィンドウのラッパークラスを作成するためにはウィンドウ関数はクラスの実装部に移されてしまうのでウィンドウを作成する前にあらかじめ処理コードを挿入することは出来ない。 しかし、イベントとして公開することができるので、何も問題がないように思われる。問題は、もしこのラッパークラスのコンストラクタで上の関数を実行すると WM_CREATE メッセージを捕まえることができない、ということだ。つまり、
MainWnd := TMainWindow.Create(...); MainWnd.OnCreate := OnMainCreate;
のようなコードを書いても、二行目が実行される以前に WM_CREATE メッセージが Defaulthandler( ) を通り抜けてしまうため、 OnMainCreate ハンドラは永久に呼び出されないのだ。 このように、パスカルオブジェクトの生成時にウィンドウオブジェクトを同時に生成すると、OnCreate イベントの公開が困難になる。 ＲＡＤ環境でのプログラミングでは、設計時にオブジェクトインスペクタをつかって設定した値を実行時に参照できるのでこのような困難がない。 ここでは、 インスタンス生成時にまずパスカルオブジェクトを生成し、各イベントハンドラを設定してからウィンドウオブジェクトを生成するメソッドを呼び出すことにする。 そうするとウィンドウオブジェクト生成時にはイベントハンドラが確定しているので、DefaultHandler( ) から呼び出すことができる。 ウィンドウオブジェクトが破棄されるときは、 ウィンドウ関数からパスカルオブジェクトも自動的に破棄されるようにしよう。
以上のような方針で、とにかくメイウィンドウのラッパークラスを作成してみよう。
最初に APIWindow.pas に TAPIWindow クラスを実装する。このユニットファイルの全リストを以下に示す。
unit APIWindow;
interface
uses
Windows,
Messages,
UtilFunc;
type
TCreateParamsEx = record
dwExStyle: DWORD;
lpClassName: PChar;
lpWindowName: PChar;
dwStyle: DWORD;
X, Y, nWidth, nHeight: Integer;
hWndParent: HWND;
hMenu: HMENU;
hInstance: HINST;
lpParam: Pointer;
end;
//-------------- TAPIWindow -----------------------------------
TOnClassParams = procedure (var WC:TWndClass);
TOnWindowParams = procedure (var CP:TCreateParamsEx);
TAPIWindow = class(TObject)
private
FHandle: HWND;
FParent: HWND;
FClassName: string;
FColor: COLORREF;
FOnClassParams: TOnClassParams;
FOnWindowparams: TOnWindowParams;
FOnCreate: TNotifyMessage;
FOnDestroy: TNotifyMessage;
FOnCommand: TNotifyMessage;
procedure SetColor(value:COLORREF);
protected
procedure APIClassParams(var WC:TWndClass); virtual;
procedure APICreateParams(var CP:TCreateParamsEx); virtual;
public
constructor Create(hParent:HWND;ClassName:string);virtual;
destructor Destroy; override;
procedure DefaultHandler(var Message);override;
procedure DoCreate;virtual;
property Handle: HWND read FHandle;
property Parent: HWND read FParent;
property Color: COLORREF read FColor write SetColor;
property OnClassParams: TOnClassParams read FOnClassParams
write FOnClassParams;
property OnWindowParams: TOnWindowParams read FOnWindowParams
write FOnWindowparams;
property OnCreate: TNotifyMessage read FOnCreate write FOnCreate;
property OnDestroy: TNotifyMessage read FOnDestroy write FOnDestroy;
property OnCommand: TNotifyMessage read FOnCommand write FOnCommand;
end;
implementation
{---------------------------------------------------------------------
Custom Window Procedure
----------------------------------------------------------------------}
function CustomWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
WPMsg: TMessage;
Wnd: TAPIWindow;
pCS: PCreateStruct;
begin
Result := 0;
if Msg = WM_NCCREATE then begin
pCS := Pointer(LParam);
SetProp(hWindow,'OBJECT',integer(pCS^.lpCreateParams));
TAPIWindow(pCS^.lpCreateParams).FHandle := hWindow;
end;
WPMsg.Msg := Msg;
WPMsg.WParam := WParam;
WPMsg.LParam := LParam;
WPMsg.Result := 0;
Wnd := TAPIWindow(GetProp(hWindow,'OBJECT'));
case Msg of
{------------------ WM_DESTROY --------------------------------}
WM_DESTROY: begin
if Assigned(Wnd) then begin
Wnd.Dispatch(WPMsg);
Wnd.Free;
end;
end;
{--------- 他のメッセージをオブジェクトに Dispatch する ----}
else begin
if Assigned(Wnd) then Wnd.Dispatch(WPMsg);
if WPMsg.Result = 0 then
Result := DefWindowProc( hWindow, Msg, wParam, lParam )
else Result := WPMsg.Result;
end;
end; // case
end;
//-------------------- TAPIWindow ---------------------------
constructor TAPIWindow.Create(hParent:HWND;ClassName:string);
begin
FParent := hParent;
FClassName := ClassName;
FColor := clrBtnFace;
end;
destructor TAPIWindow.Destroy;
begin
RemoveProp(FHandle,'OBJECT');
inherited Destroy;
end;
procedure TAPIWindow.APIClassParams(var WC:TWndClass);
begin
WC.lpszClassName := PChar(FClassName);
WC.lpfnWndProc := @CustomWndProc;
WC.style := CS_VREDRAW or CS_HREDRAW;
WC.hInstance := hInstance;
WC.hIcon := LoadIcon(0,IDI_APPLICATION);
WC.hCursor := LoadCursor(0,IDC_ARROW);
WC.hbrBackground := ( COLOR_WINDOW+1 );
WC.lpszMenuName := nil;
WC.cbClsExtra := 0;
WC.cbWndExtra := 0;
If Assigned(FOnClassParams) then FOnClassParams(WC);
end;
procedure TAPIWindow.APICreateParams(var CP:TCreateParamsEx);
begin
CP.dwExStyle := 0;
CP.lpClassName := PChar(FClassName);
CP.lpWindowName := PChar(FClassName);
CP.dwStyle := WS_VISIBLE or WS_OVERLAPPEDWINDOW;
CP.X := 200;
CP.Y := 100;
CP.nWidth := 300;
CP.nHeight := 200;
CP.hWndParent := FParent;
CP.hMenu := 0;
CP.hInstance := hInstance;
CP.lpParam := self;
If Assigned(FOnWindowParams) then FOnWindowParams(CP);
end;
procedure TAPIWindow.DefaultHandler(var Message);
var
AMsg:TMessage;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_CREATE: if Assigned(FOnCreate) then OnCreate(AMsg);
WM_DESTROY: if Assigned(FOnDestroy) then OnDestroy(AMsg);
WM_COMMAND: if Assigned(FOnCommand) then OnCommand(AMsg);
WM_ERASEBKGND: AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);
end; // case
TMessage(Message).result := AMsg.result;
end;
procedure TAPIWindow.DoCreate;
var
WC: TWndClass;
CP: TCreateParamsEx;
begin
APIClassParams(WC);
RegisterClass(WC);
APICreateParams(CP);
CreateWindowEx(CP.dwExStyle,
CP.lpClassName,
CP.lpWindowName,
CP.dwStyle,
CP.X,
CP.Y,
CP.nWidth,
CP.nHeight,
CP.hWndParent,
CP.hMenu,
CP.hInstance,
CP.lpParam);
ShowWindow( FHandle, CmdShow );
UpDateWindow(FHandle);
end;
procedure TAPIWindow.SetColor(value: COLORREF);
begin
if FColor = value then Exit;
FColor := value;
InvalidateRect(FHandle,nil,true);
end;
end.これで TAPIWindow クラスは完成である。このクラスは、宣言を見れば分かるように、 自分自身のウィンドウハンドルを保持する Handle プロパティー、親のウィンドウハンドルを保持する Parent プロパティー、そして クライアント領域の背景色を設定する Color プロパティーを持っている。コンストラクタを見てみよう。
constructor TAPIWindow.Create(hParent:HWND;ClassName:string); begin FParent := hParent; FClassName := ClassName; FColor := clrBtnFace; end;
コンストラクタでは、private 領域のインスタンス変数に規定値を割り当てているだけだ。 メインウィンドウでは、親ウィンドウがないのでゼロを指定する。実際に、ウィンドウオブジェクトを作成する DoCreate メソッドを見てみよう。
procedure TAPIWindow.DoCreate;
var
WC: TWndClass;
CP: TCreateParamsEx;
begin
APIClassParams(WC);
RegisterClass(WC);
APICreateParams(CP);
CreateWindowEx(CP.dwExStyle,
CP.lpClassName,
CP.lpWindowName,
CP.dwStyle,
CP.X,
CP.Y,
CP.nWidth,
CP.nHeight,
CP.hWndParent,
CP.hMenu,
CP.hInstance,
CP.lpParam);
ShowWindow( FHandle, CmdShow );
UpDateWindow(FHandle);
end;ここでは、protected 部の APIClassParams( ) メソッドを使って TWndClass 型のレコード WC を作成し、システムに登録している。 その後、 APICreateParams( ) メソッドを使ってこのユニットで定義した TCreateParamsEx 型のレコード CP を組立て、そのフィールドをつかって CreateWindowEx( ) でウィンドウを作成し、表示している。APIClassParams( ) メソッドを見てみよう。
procedure TAPIWindow.APIClassParams(var WC:TWndClass); begin WC.lpszClassName := PChar(FClassName); WC.lpfnWndProc := @CustomWndProc; WC.style := CS_VREDRAW or CS_HREDRAW; WC.hInstance := hInstance; WC.hIcon := LoadIcon(0,IDI_APPLICATION); WC.hCursor := LoadCursor(0,IDC_ARROW); WC.hbrBackground := ( COLOR_WINDOW+1 ); WC.lpszMenuName := nil; WC.cbClsExtra := 0; WC.cbWndExtra := 0; If Assigned(FOnClassParams) then FOnClassParams(WC); end;
このコードは既におなじみのものである。 クラス名にはコンストラクタで指定された文字列を使い、ウィンドウ関数には実装部にある CustomWndProc( ) を指定している。 このメソッドは仮想メソッドなので下位クラスでオーバーライドすることにより、任意のウィンドウクラスを登録できる。 さらにこのクラスを使うのに便利なように、このユニットで定義した TOnClassParams 型のイベントハンドラを呼び出して、クラス定義を変更する機会をあたえている。APICreateParams( ) メソッドを見てみよう。
procedure TAPIWindow.APICreateParams(var CP:TCreateParamsEx); begin CP.dwExStyle := 0; CP.lpClassName := PChar(FClassName); CP.lpWindowName := PChar(FClassName); CP.dwStyle := WS_VISIBLE or WS_OVERLAPPEDWINDOW; CP.X := 200; CP.Y := 100; CP.nWidth := 300; CP.nHeight := 200; CP.hWndParent := FParent; CP.hMenu := 0; CP.hInstance := hInstance; CP.lpParam := self; If Assigned(FOnWindowParams) then FOnWindowParams(CP); end;
このコードもおなじみの CreateWindowEx( ) のパラメータをレコードを使って組み立てているだけである。 最後に、このウィンドウ定義を変更する機会を与えるために、このユニットで定義している TOnWindowParams 型のイベントハンドラを呼び出している。 注目してほしいのは、最後の lpParam フィールドに自分自身のインスタンス参照である self を指定している点である。 これにより、ウィンドウ関数に自分のパスカルオブジェクトを知らせているのである。 ウィンドウ関数の最初コード部分を見てみよう。
if Msg = WM_NCCREATE then begin
pCS := Pointer(LParam);
SetProp(hWindow,'OBJECT',integer(pCS^.lpCreateParams));
TAPIWindow(pCS^.lpCreateParams).FHandle := hWindow;
end;ここでパスカルオブジェクトのインスタンス参照を使ってウィンドウオブジェクトにそれを 'OBJECT' というプロパティーに設定している。筆者が Skeleton02 で実験したところ、メインウィンドウが作られてウィンドウ関数に WM_CREATE メッセージが届けられるまでに以下のメッセージが届く事が分かった。
WM_GETMINMAXINFO = 36 = $24 //ウィンドウのサイズと位置が変更されようとしている WM_NCCREATE = 129 = $81 //ウィンドウが作られようとしている. WM_CREATE より前に届く WM_NCCALCSIZE = 131 = $83 //クライアント領域のサイズと位置を計算する WM_CREATE = 1 = $1 //ウィンドウが作られ、表示されようとしている
ここで WM_NCCREATE と WM_CREATE メッセージは同じ情報を伝える。
WM_NCCREATE lpcs = (LPCREATESTRUCT) lParam; // initialization data WM_CREATE lpcs = (LPCREATESTRUCT) lParam; // structure with creation data
この LPCREATESTRUCT は、windows.pas に定義されている PCreateStruct に相当し、TCreateStruct レコードへのポインタである。
type
PCreateStructA = ^TCreateStructA;
PCreateStruct = PCreateStructA;
TCreateStructA = packed record
lpCreateParams: Pointer;
hInstance: HINST;
hMenu: HMENU;
hwndParent: HWND;
cy: Integer;
cx: Integer;
y: Integer;
x: Integer;
style: Longint;
lpszName: PAnsiChar;
lpszClass: PAnsiChar;
dwExStyle: DWORD;
end;このレコードの定義を見れば分かるように、CreateWindowEx( ) によってウィンドウがつくられるときのパラメータそのものが WM_NCCREATE と WM_CREATE メッセージの lParam を通してアクセスできるわけである。 上記のウィンドウ関数のコードでは、lpCreateParams フィールドからパスカルオブジェクトへのインスタンス参照を受け取って、ウィンドウへのプロパティーの設定とパスカルオブジェクトのウィンドウハンドルの設定を行っている。 これ以後、このプロパティーを使ってパスカルオブジェクトにアクセスできるわけである。
ウィンドウ関数では、WM_DESTROY メッセージだけが特別扱いで、パスカルオブジェクトに Dispatch した後、パスカルオブジェクトを廃棄している。他のメッセージは、単にパスカルオブジェクトに Dispatch しているだけである。 TAPIWindow クラスのデストラクタを見てみよう。
destructor TAPIWindow.Destroy; begin RemoveProp(FHandle,'OBJECT'); inherited Destroy; end;
ここで、ウィンドウオブジェクトのプロパティーを解除している。DefaultHandler を見てみよう。
procedure TAPIWindow.DefaultHandler(var Message);
var
AMsg:TMessage;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_CREATE: if Assigned(FOnCreate) then OnCreate(AMsg);
WM_DESTROY: if Assigned(FOnDestroy) then OnDestroy(AMsg);
WM_COMMAND: if Assigned(FOnCommand) then OnCommand(AMsg);
WM_ERASEBKGND: AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);
end; // case
TMessage(Message).result := AMsg.result;
end;ここでは、三つのメッセージを捕まえてイベントハンドラを呼び出している。 WM_ERASEBKGND では、Color プロパティーを使ってブラシハンドルを戻している。
TAPIWindow をテストするプログラム TestMainWindow01.dpr の全リストを以下に示す。
program TestMainWindow01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TAPIWindow;
Btn1,Btn2: TAPIButton;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure Btn1Click(var Msg: TMessage);
begin
MainWnd.Color := RGB(Random(256),Random(256),Random(256));
end;
procedure Btn2Click(var Msg: TMessage);
begin
DestroyWindow(MainWnd.Handle);
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,300,200);
CenterWindow(hWindow);
Btn1 := CreateButton(hWindow,10,10,170,40,'ChangeColor',Btn1Click);
Btn2 := CreateButton(hWindow,10,60,170,40,'Quit',Btn2Click);
Randomize;
end;
procedure OnTest(hWindow: HWND);
begin
MainWnd.Color := clrYellow;
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TAPIWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.
TestMainWindow01.zip(15.022kB)
実行すると右図のようになる。 上のボタンを押すとクライアント領域の背景色がランダムに変化する。下のボタンを押すとプログラムが終了する。Test! メニューを選択すると背景色が黄色になる。
メイン手続きを見れば分かるように、 最初にパスカルオブジェクトを生成し、イベントハンドラを設定してから DoCreate メソッドでウィンドウオブジェクトを作成している。 メニューやボタンは OnCreate ハンドラの中で作成される。 このプロジェクトファイルと Skeleton02.dpr を比較すると、 ウィンドウ関数が無く、メッセージ処理ハンドラだけでできている上のプロジェクトファイルはすっきりとした構造になっているのが分かるだろう。
前節で作成した TAPIWindow クラスでは WM_CREATE、WM_DESTROY、WM_COMMAND の三つのメッセージに対してだけイベントハンドラを公開していた。 ウィンドウ関数からは、１００を越える種類のメッセージが送られてくる。問題は、どのメッセージを捕捉してイベントにするか、ということだ。 インスタンスごとに必要とするメッセージは異なるだろうし、だからといって全てのメッセージをイベントにすることは非現実的だ。ＶＣＬの TForm クラスには、現時点で ２１個のイベントが装備されている。このうち頻繁に使われるのは、 OnCreate や OnClose などごくわずかであろう。 逆にイベントにないメッセージの処理が必要なときは、message 指令を使ってメッセージ処理ハンドラをコードで追加するか、TForm1 で DefaultHandler( ) をオーバーライドしなければならない。ＲＡＤ環境では、 TForm の派生クラスである TForm1 が自動的につくられるので任意のメッセージを捕捉するのは、上記のように簡単だ。しかし、本稿でこれまでに行ってきたようなコードベースのプログラミング環境では、メインウィンドウのインスタンスを作るたびに、カスタム化した派生クラスを自動的につくることは容易にできないので、任意のメッセージを捕捉する何らかの仕掛けが必要になる。
上記の問題を解決するために、まずウィンドウ関数の仕様について考えよう。ウィンドウ関数は、Windows システムから呼び出されるので、そのパラメータの型と個数・順序および戻り値の型や呼び出し規約などはシステムによって決められている。 したがって、ウィンドウ関数をクラスのメソッドにして、インスタンス化することは出来ない。 なぜなら、クラスのメソッドは、呼び出されるときに暗黙のうちにインスタンスの参照ポインタを受け取る仕様になっているからだ。ＶＣＬでは、Forms.pas に定義されている手続きを使って、この問題を巧妙に回避することに成功している。 ここでは、全てのインスタンスはただ一つの共通のウィンドウ関数 CustomWndProc を使うことにしよう。 このウィンドウ関数は、インスタンスのユーザーがどんなメッセージを必要としているのか予め知ることが出来ないので、送られてくる全てのメッセージを TMessage レコードの形でパスカルオブジェクトに転送している。 このレコードの Msg フィールドは Messages.pas に定義されているように Cardinal 型である。 Win32 では Cardinal は３２ビットの符号なし整数である。 つぎに、メッセージを処理するメッセージハンドラを記憶するにはどうしたら良いか考えよう。 コントロールのラッパークラスでは TNotifyMessage 型を定義して、 イベントハンドラの型として使ってきた。 これは、SizeOf( ) 関数をつかってみれば分かるように、単なる３２ビットのポインタである。 以上のことから、インスタンスのユーザーが捕捉したいメッセージを（例えば WM_SIZE のように）３２ビットの符号なし整数で指定し、さらにこのメッセージの処理ハンドラのポインタを指定する（たとえば OnSize のように）と自動的にメッセージが捕捉されて処理ハンドラを呼び出すようにしよう。 これは、クラスの内部に、これらの値を保持する integer の配列を private フィールドとして設け、メソッドにより上記のふたつの値を代入していくことで実現できる。
以上の方針にしたがって、TAPIWindow クラスから派生して任意のメッセージを捕獲できる TAPIWindow2 クラスを作成してテストしよう。
最初に APIWindow.pas の uses 節に UtilClass を追加してから、TAPIWindow2 クラスを作成しよう。宣言部を以下に示す。
//-------------- TAPIWindow2 ---------------------------------- TAPIWindow2 = class(TAPIWindow) private FTrapMessage: TIntegerList; FTrapHandler: TIntegerList; FNumHandler: integer; public constructor Create(hParent:HWND;ClassName:string);override; destructor Destroy; override; procedure DefaultHandler(var Message); override; procedure Trap(Msg: UINT; Hndlr: TNotifyMessage); property NumHandler: integer read FNumHandler; end;
この宣言を見ても分かるように、Trap( ) メソッドで任意のメッセージをイベントハンドラに結びつけている。 private 部の TIntegerList 型の FTrapMessage が捕獲するメッセージを、FTrapHandler が対応するイベントハンドラのアドレスを保持している。 実装部を以下に示す。
//-------------- TAPIWindow2 ----------------------------------
constructor TAPIWindow2.Create(hParent:HWND;ClassName:string);
begin
inherited Create(hParent,ClassName);
FTrapMessage := TIntegerList.Create($10,$10);
FTrapHandler := TIntegerList.Create($10,$10);
end;
destructor TAPIWindow2.Destroy;
begin
FTrapMessage.Free;
FTrapHandler.Free;
inherited Destroy;
end;
procedure TAPIWindow2.DefaultHandler(var Message);
var
AMsg:TMessage;
i: integer;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_CREATE:if Assigned(FOnCreate) then OnCreate(AMsg);
WM_COMMAND:if Assigned(FOnCreate) then OnCommand(AMsg);
WM_DESTROY:if Assigned(FOnDestroy) then OnDestroy(AMsg);
WM_ERASEBKGND:AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);
else if FNumHandler > 0 then begin
i := FTrapMessage.Search(integer(AMsg.Msg));
if i <> -1 then TNotifyMessage(FTrapHandler[i])(AMsg);
end;
end; // case
TMessage(Message).result := AMsg.result;
end;
procedure TAPIWindow2.Trap(Msg: UINT; Hndlr: TNotifyMessage);
begin
Inc(FNumHandler);
FTrapMessage[FNumHandler-1] := integer(Msg);
FTrapHandler[FNumHandler-1] := integer(@Hndlr);
end;以上で TAPIWindow2 クラスは完成である。 このクラスをテストするプログラムを TestMainWindow02.dpr に作ろう。 以下に全リストを示す。
program TestMainWindow02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TAPIWindow2;
Btn1,Btn2: TAPIButton;
L1,L2: TAPILabel;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure Btn1Click(var Msg: TMessage);
begin
MainWnd.Color := RGB(Random(256),Random(256),Random(256));
end;
procedure Btn2Click(var Msg: TMessage);
begin
DestroyWindow(MainWnd.Handle);
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,400,300);
CenterWindow(hWindow);
Btn1 := CreateButton(hWindow,10,10,170,40,'ChangeColor',Btn1Click);
Btn2 := CreateButton(hWindow,10,60,170,40,'Quit',Btn2Click);
L1 := CreateLabel(hWindow,200,10,170,30,'');
L2 := CreateLabel(hWindow,200,50,170,30,'');
Randomize;
end;
procedure OnTest(hWindow: HWND);
begin
MainWnd.Color := clrYellow;
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
procedure MainMouseMove(var Msg: TMessage);
begin
L1.Text := 'X : '+AIntToStr(Msg.LParamLo) + #9 +
' Y : '+ AIntToStr(Msg.LParamHi);
end;
procedure MainSize(var Msg: TMessage);
begin
if Assigned(L2) then
L2.Text := 'X : '+AIntToStr(Msg.LParamLo) + #9 +
' Y : '+ AIntToStr(Msg.LParamHi);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TAPIWindow2.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
Trap(WM_MOUSEMOVE,MainMouseMove);
Trap(WM_SIZE,MainSize);
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.TestMainWindow02.zip(16.410kB)
実行すると左図のようになる。 ここでは Trap( ) メソッドをつかって WM_MOUSEMOVE と WM_SIZE メッセージを捕獲し、それぞれのイベントハンドラでマウスポインタの位置とクライアント領域の大きさをラベルに表示している。 ウィンドウのサイズを変更するとそのことがラベルの内容に反映される。
前節までで、 メインウィンドウを作成し、任意のメッセージを処理できるようになった。しかし、ウィンドウの位置やサイズなどは、関数を使って設定していた。明らかにこれらはウィンドウの属性であり、ラッパークラスのプロパティーやメソッドとすべきものだ。 原理的にはウィンドウハンドルさえ取得できれば、そのウィンドウの位置、サイズ、タイトル、背景色、可視性、カーソル、アイコンなどの多くの属性をＡＰＩを使って変更することができる。 しかし、ナマのＡＰＩを使うより、せっかくラッパークラスを作成したのだから、クラスのプロパティーを通してこれらのウィンドウ属性を取得・変更できるようにした方が格段に便利だろう。 前節で作成した TAPIWindow2 クラスから派生してこのようなプロパティーやメソッドを装備したクラスを作成して、一応の完成ということにしよう。
ここでは、汎用ウィンドウ特有のプロパティーを持った TAPIWindow3 というクラスを TAPIWindow2 から派生して作り、さらに TAPIWindow3 から派生してシングルドキュメントインタフェースのメインウィンドウのラッパークラス TSDIMainWindow を作る。 したがって、このクラスまでの階層は、
TObject - TAPIWindow - TAPIWindow2 - TAPIWindow3 - TSDIMainWindow
となる。 それでは、APIWindow.pas に TAPIWindow3 以降を作成しよう。宣言部を以下に示す。
//-------------- TAPIWindow3 ---------------------------------- TAPIWindow3 = class(TAPIWindow2) private FCursor: HCURSOR; function GetWidth: integer; procedure SetWidth(value: integer); function GetHeight: integer; procedure SetHeight(value: integer); function GetVisible: Boolean; procedure SetVisible(value: Boolean); function GetEnable: Boolean; procedure SetEnable(value:Boolean); public procedure DefaultHandler(var Message);override; property Width: integer read GetWidth write SetWidth; property Height: integer read GetHeight write SetHeight; property Visible: Boolean read GetVisible write SetVisible; property Enable: Boolean read GetEnable write SetEnable; property Cursor: HCURSOR read FCursor write FCursor; end; //-------------- TSDIMainWindow ---------------------------------- TMaxMinRestore = (Max,Min,Restore); TSDIMainWindow = class(TAPIWindow3) private function GetXPos: integer; procedure SetXPos(value: integer); function GetYPos: integer; procedure SetYPos(value: integer); function GetTitle: string; procedure SetTitle(s: string); function GetIcon: HICON; procedure SetIcon(value: HICON); function GetClientWidth: integer; procedure SetClientWidth(value: integer); function GetClientHeight: integer; procedure SetClientHeight(value: integer); function GetState: TMaxMinRestore; procedure SetState(value: TMaxMinRestore); public constructor Create(hParent:HWND;ClassName:string);override; procedure Center; procedure Close; property XPos: integer read GetXPos write SetXPos; property YPos: integer read GetYPos write SetYPos; property Title: string read GetTitle write SetTitle; property Icon: HICON read GetIcon write SetIcon; property ClientWidth: integer read GetClientWidth write SetClientWidth; property ClientHeight: integer read GetClientHeight write SetClientHeight; property State: TMaxMinRestore read GetState write SetState; end;
TAPIWindow3 では、ウィンドウの幅と高さ、可視性と有効性、カーソルの形状をプロパティーとしている。一方、 これから派生した TSDIMainWindow では、ウィンドウの位置、タイトル、アイコン、クライアント領域の幅と高さ、最小化・最大化・復帰の状態を表すプロパティーを装備している。 また、ウィンドウを画面の中央に表示するメソッド Center と閉じてプログラムを終了する Close メソッドも装備している。実装部を以下に示す。
//-------------- TAPIWindow3 ----------------------------------
procedure TAPIWindow3.DefaultHandler(var Message);
var
AMsg:TMessage;
i: integer;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_CREATE: if Assigned(FOnCreate) then OnCreate(AMsg);
WM_DESTROY: if Assigned(FOnDestroy) then OnDestroy(AMsg);
WM_COMMAND: if Assigned(FOnCommand) then OnCommand(AMsg);
WM_ERASEBKGND: AMsg.result := EraseBkGnd(FHandle,FColor,AMsg.WParam);
WM_SETCURSOR : if AMsg.LParamLo = HTCLIENT then begin
SetCursor(FCursor);
AMsg.Result := 1;
end;
else if FNumHandler > 0 then begin
i := FTrapMessage.Search(integer(AMsg.Msg));
if i <> -1 then TNotifyMessage(FTrapHandler[i])(AMsg);
end;
end; // case
TMessage(Message).result := AMsg.result;
end;
function TAPIWindow3.GetWidth: integer;
var
r: TRect;
begin
GetWindowRect(FHandle,r);
result := r.Right-r.Left+1;
end;
procedure TAPIWindow3.SetWidth(value: integer);
var
r: TRect;
begin
GetWindowRect(FHandle,r);
ChangeWindowSize(FHandle,value,(r.Bottom-r.Top+1));
end;
function TAPIWindow3.GetHeight: integer;
var
r: TRect;
begin
GetWindowRect(FHandle,r);
result := r.Bottom-r.Top+1;
end;
procedure TAPIWindow3.SetHeight(value: integer);
var
r: TRect;
begin
GetWindowRect(FHandle,r);
ChangeWindowSize(FHandle,(r.Right-r.Left+1),value);
end;
function TAPIWindow3.GetVisible: Boolean;
begin
result := IsWindowVisible(FHandle);
end;
procedure TAPIWindow3.SetVisible(value: Boolean);
begin
if value then
ShowWindow(FHandle,SW_SHOW)
else
ShowWindow(FHandle,SW_HIDE);
end;
function TAPIWindow3.GetEnable: Boolean;
begin
result := Boolean(IsWindowEnabled(FHandle));
end;
procedure TAPIWindow3.SetEnable(value: Boolean);
begin
EnableWindow(FHandle,value);
end;
//-------------- TSDIMainWindow ----------------------------------
constructor TSDIMainWindow.Create(hParent:HWND;ClassName:string);
begin
inherited Create(hParent,ClassName);
FCursor := LoadCursor(0,IDC_ARROW);
end;
procedure TSDIMainWindow.Center;
begin
CenterWindow(FHandle);
end;
procedure TSDIMainWindow.Close;
begin
DestroyWindow(FHandle);
end;
function TSDIMainWindow.GetXPos: integer;
var
r: TRect;
begin
GetWindowRect(FHandle,r);
result := r.Left;
end;
procedure TSDIMainWindow.SetXPos(value: integer);
begin
ChangeWindowPos(FHandle,value,YPos);
end;
function TSDIMainWindow.GetYPos: integer;
var
r: TRect;
begin
GetWindowRect(FHandle,r);
result := r.Top;
end;
procedure TSDIMainWindow.SetYPos(value: integer);
begin
ChangeWindowPos(FHandle,XPos,value);
end;
function TSDIMainWindow.GetTitle: string;
var
s: string;
len: integer;
begin
SetLength(s,100);
len := GetWindowText(FHandle,PChar(s),100);
SetLength(s,len);
result := s;
end;
procedure TSDIMainWindow.SetTitle(s: string);
begin
SetWindowText(FHandle, PChar(s));
end;
function TSDIMainWindow.GetIcon: HICON;
begin
result := GetClassLong(FHandle,GCL_HICON);
end;
procedure TSDIMainWindow.SetIcon(value: HICON);
begin
SetClassLong(FHandle,GCL_HICON,value);
end;
function TSDIMainWindow.GetClientWidth: integer;
var
r: TRect;
begin
GetClientRect(FHandle,r);
result := r.Right+1;
end;
procedure TSDIMainWindow.SetClientWidth(value: integer);
begin
ChangeWindowSize(FHandle,(value+Width-ClientWidth-1),Height);
end;
function TSDIMainWindow.GetClientHeight: integer;
var
r: TRect;
begin
GetClientRect(FHandle,r);
result := r.Bottom+1;
end;
procedure TSDIMainWindow.SetClientHeight(value: integer);
begin
ChangeWindowSize(FHandle,Width,(value+Height-ClientHeight));
end;
procedure TSDIMainWindow.SetState(value: TMaxMinRestore);
begin
case value of
Max: ShowWindow(FHandle,SW_SHOWMAXIMIZED);
Min: ShowWindow(FHandle,SW_SHOWMINIMIZED);
Restore: ShowWindow(FHandle,SW_RESTORE);
end;
end;
function TSDIMainWindow.GetState: TMaxMinRestore;
begin
if IsZoomed(FHandle) then
result := Max
else
if IsIconic(FHandle) then
result := Min
else
result := Restore;
end;TAPIWindow3 クラスのコードから調べよう。Visible プロパティーは対応する private フィールドを持たず、取得・設定ともアクセスメソッドによって行う。
function TAPIWindow3.GetVisible: Boolean;
begin
result := IsWindowVisible(FHandle);
end;
procedure TAPIWindow3.SetVisible(value: Boolean);
begin
if value then
ShowWindow(FHandle,SW_SHOW)
else
ShowWindow(FHandle,SW_HIDE);
end;取得メソッドは IsWindowVisible( ) ＡＰＩの結果を戻しているだけだ。
function IsWindowVisible(hWnd: HWND): BOOL; stdcall;
設定メソッドは、ShowWindow( ) ＡＰＩで行っている。
function ShowWindow(hWnd: HWND;
nCmdShow: Integer): BOOL; stdcall;nCmdShow に設定できる値を以下に示す。
const
{ ShowWindow() Commands }
SW_HIDE = 0; //ウィンドウを隠し、他のウィンドウをアクティブにする
SW_SHOWNORMAL = 1; //ウィンドウを表示し、アクティブにする
SW_NORMAL = 1;
SW_SHOWMINIMIZED = 2; //ウィンドウをアクティブにし、最小化する
SW_SHOWMAXIMIZED = 3; //ウィンドウをアクティブにし、最大化する
SW_MAXIMIZE = 3;
SW_SHOWNOACTIVATE = 4;//ウィンドウを通常表示する
SW_SHOW = 5; //ウィンドウを通常表示し、アクティブにする
SW_MINIMIZE = 6; //ウィンドウを最小化し、次のＺオーダーのウィンドウをアクティブにする
SW_SHOWMINNOACTIVE = 7;//ウィンドウを最小化表示する
SW_SHOWNA = 8; //ウィンドウを通常表示する
SW_RESTORE = 9; //ウィンドウを最小化・最大化から通常表示にし、アクティブにする
SW_SHOWDEFAULT = 10; //アプリケーション起動時の設定で表示する
SW_MAX = 10;このコードでは SW_SHOW と SW_HIDE を使ってウィンドウの可視性を設定している。
Enable プロパティーでは、取得メソッドで IsWindowEnabled( )、設定メソッドで EnableWindow( ) ＡＰＩを使っている。
function IsWindowEnabled(hWnd: HWND): BOOL; stdcall; function EnableWindow(hWnd: HWND; bEnable: BOOL): BOOL; stdcall;
bEnable パラメータが true で使用可、false で使用不可にする。 使用不可の状態ではキーボードやマウスからの入力を受け付けない。
Cursor プロパティーは、HCURSOR 型であり、アクセスメソッドはなく private 部の FCursor を参照して以下のよう WM_SETCURSOR メッセージを DefaultHandler で処理している。
WM_SETCURSOR: if AMsg.LParamLo = HTCLIENT then begin
SetCursor(FCursor);
AMsg.Result := 1;
end;WM_SETCURSOR は、マウスがウィンドウの中を動き、キャプチャされていないときにウィンドウ関数に送られてくる。
WM_SETCURSOR hwnd = (HWND) wParam; // handle of window with cursor nHittest = LOWORD(lParam); // hit-test code wMouseMsg = HIWORD(lParam); // mouse-message identifier
処理コードでは、nHittest が HTCLIENT である、つまり、マウスがクライアント領域にあることを確認してから、SetCursor( ) ＡＰＩでカーソルを表示している。
function SetCursor(hCursor: HICON): HCURSOR; stdcall;
この関数は、以前に設定されていたカーソルハンドルを返す。 このメッセージでカーソルを設定したときはゼロ以外の値を返すようにする。
TSDIMainWindow クラスのコードを調べよう。 ウィンドウの位置を決める XPos と YPos プロパティーは取得・設定ともアクセスメソッドで行っている。 例えば、XPos プロパティーでは、
function TSDIMainWindow.GetXPos: integer; var r: TRect; begin GetWindowRect(FHandle,r); result := r.Left; end; procedure TSDIMainWindow.SetXPos(value: integer); begin ChangeWindowPos(FHandle,value,YPos); end;
GetWindowRect( ) ＡＰＩは、ウィンドウの境界矩形をスクリーン座標で取得する。このクラスは子ウィンドウではなくメインウィンドウなので、スクリーン座標のままでよい。子ウィンドウの場合は、親ウィンドウのクライアント領域の座標へ変換しなければならない。
function GetWindowRect(hWnd: HWND;
var lpRect: TRect): BOOL; stdcall;ChangeWindowPos( ) と ChangeWindowSize( ) は、すでに UtilFunc.pas に定義してある SetWindowPos( ) ＡＰＩの機能を細分化した関数である。 このＡＰＩについてはすでに 2-4 節で説明した。
ClientWidth と ClientHeight プロパティーは、クライアント領域のサイズが設定値になるようにウィンドウ全体の大きさを調節する。 この方が、 Width や Height プロパティーより使いやすいだろう。 Title プロパティーのアクセスメソッドでは GetWindowText( ) ＡＰＩと SetWindowText( ) ＡＰＩを使っている。これはボタンコントロールのときと同じだ。 State プロパティーはこのユニットで定義した TMaxMinRestore = (Max,Min,Restore) の列挙型である。 取得・設定メソッドを見てみよう。
procedure TSDIMainWindow.SetState(value: TMaxMinRestore);
begin
case value of
Max: ShowWindow(FHandle,SW_SHOWMAXIMIZED);
Min: ShowWindow(FHandle,SW_SHOWMINIMIZED);
Restore: ShowWindow(FHandle,SW_RESTORE);
end;
end;
function TSDIMainWindow.GetState: TMaxMinRestore;
begin
if IsZoomed(FHandle) then
result := Max
else
if IsIconic(FHandle) then
result := Min
else
result := Restore;
end;IsZoomed( ) ＡＰＩは、指定のウィンドウが最大化されていれば true を返す。 IsIconic( ) ＡＰＩは、指定のウィンドウが最小化されていれば true を返す。 設定メソッドでは上で説明した ShowWindow( ) を使っている。
Icon プロパティーは、HICON 型のアイコンハンドルである。 ここでは、SetClassLong( ) を使ってアイコンを変更している。
以上でメインウィンドウのラッパークラスの作成はひとまず終える。 TestMainWindow03.dpr にこれらのクラスをテストするコードを書こう。以下に全リストを示す。
program TestMainWindow03;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
Btn: array[0..5] of TAPIButton;
L1,L2: TAPILabel;
TT: TAPITimer;
const
BtnTitle: array[0..5] of string = ('Change Icon,Title',
'Change Position','Maximize','Restore','Change Cursor','Quit');
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg: TMessage);
begin
case TAPIButton(Msg.Msg).Data of
0: begin
MainWnd.Icon := LoadIcon(0,IDI_WINLOGO);
MainWnd.Title := 'タイトルを変えました';
end;
1: begin
MainWnd.XPos := 50;
MainWnd.YPos := 50;
end;
2: MainWnd.State := Max;
3: MainWnd.State := Restore;
4: begin
MainWnd.Cursor := LoadCursor(0,IDC_WAIT);
TT.On;
end;
5: MainWnd.Close;
end;
end;
procedure MainMouseMove(var Msg: TMessage);
begin
L1.Text := 'X : '+AIntToStr(Msg.LParamLo) + #9 +
' Y : '+ AIntToStr(Msg.LParamHi);
end;
procedure MainSize(var Msg: TMessage);
begin
L2.Text := 'X : '+AIntToStr(Msg.LParamLo) + #9 +
' Y : '+ AIntToStr(Msg.LParamHi);
end;
procedure OnTimer(var Msg: TMessage);
begin
MainWnd.Cursor := LoadCursor(0,IDC_ARROW);
TT.Off;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
i: integer;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
for i := 0 to 5 do begin
Btn[i] := CreateButton(hWindow,10,10+40*i,150,30,BtnTitle[i],BtnClick);
Btn[i].Data := i;
end;
L1 := CreateLabel(hWindow,200,10,150,30,'');
L2 := CreateLabel(hWindow,200,50,150,30,'');
TT := CreateTimer(hWindow,2000,OnTimer);
with MainWnd do begin
Trap(WM_MOUSEMOVE,MainMouseMove);
Trap(WM_SIZE,MainSize);
ClientWidth := 360;
ClientHeight := 260;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
MainWnd.Color := clrYellow;
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.TestMainWindow03.zip(17.267kB)
実行すると右図のようになる。MainCreate( ) ハンドラで６個のボタンをつくり、それぞれのクリックでアイコンやタイトルを変更したり、位置の変更、最大化、サイズ復帰、砂時計カーソルへの変更（約２秒間）、プリケーションを終了したりしている。 その他は、TestMainWindow02 と同じである。
前節まで、メインウィンドウのラッパークラスを作ってテストしてきた。この節では、前節のプロジェクトファイルからクラスをテストするコードを削除して、これまでに使ってきた骨格プログラム Skeleton02.dpr に代わる新しい骨格プログラム Skeleton03.dpr を作ることにしよう。
Skeleton03.dpr の全リストを以下に示す。
program Skeleton03;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
with MainWnd do begin
ClientWidth := 360;
ClientHeight := 260;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
MessageBeep($FFFFFFFF);
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.Skeleton03.zip(13.290kB)
コードを見れば分かるように、ウィンドウ関数が APIWindow.pas に移動したので、末尾の小さいメインルーチンを除くと、ほとんどがイベントハンドラのためのスペースになっている。 もしメニューが不要であれば、OnTest( ) や MainCommand( ) ハンドラがいらなくなり、ＲＡＤ環境で Form1 を表示するだけのプログラムより短いコードになることが理解できるだろう。 上記の Skeleton03.dpr をコンパイルすると、実行プログラムのサイズは筆者の Delphi 3.1 の環境では 22,016 バイトであった。クラスを使ったために Skeleton02.exe より４キロバイトほど大きくなっている。
Skeleton03 で作られるメインウィンドウは、ユーザが矩形境界をマウスでドラグするとサイズを変更できる。これは、上位クラスの TAPIWindow の APICreateParams( ) メソッドでウィンドウスタイルとして以下のように設定していたからだ。
CP.dwStyle := WS_VISIBLE or WS_OVERLAPPEDWINDOW;
この WS_OVERLAPPEDWINDOW スタイルは Windows.pas で以下のように定義されている。
WS_OVERLAPPEDWINDOW = WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU or
WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX;この中の WS_THICKFRAME スタイルがサイズ変更境界を指定している。 アプリケーションによってはメインウィンドウのサイズをユーザに変更させたくない場合もあるだろう。 Skeleton03 でも WM_GETMINMAXINFO メッセージを捕まえて処理することでサイズ変更を阻止できる。ここでは、TAPIWindow で実装されていた OnWindowParams イベントハンドラで WS_THICKFRAME と WS_MAXIMIZEBOX スタイルを除いたスタイルを指定することで、ユーザがサイズ変更できないメインウィンドウを作ってみよう。
コードは簡単なので、以下に全リストを示す。
program SizeFix01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
with MainWnd do begin
ClientWidth := 360;
ClientHeight := 260;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
MainWnd.Width := 450;
MainWnd.Height := 200;
//MainWnd.State := Max;
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
procedure MainWindowParams(var CP:TCreateParamsEx);
begin
CP.dwStyle := WS_VISIBLE or WS_OVERLAPPED or WS_CAPTION or
WS_SYSMENU or WS_MINIMIZEBOX;
CP.dwExStyle := WS_EX_OVERLAPPEDWINDOW;
CP.lpWindowName := 'サイズ固定ウィンドウ';
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnWindowParams := MainWindowParams;
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.SizeFix01.zip(13.385kB)
実行すると右の図のようになり、ユーザはマウスによってサイズ変更できない。最大化ボタンは使用不可になっているし、システムメニューも最大化とサイズ変更の項目は使用できなくなっている。 MainWindowParams ハンドラでは、ウィンドウスタイルと拡張スタイルとタイトルを変更しているだけだ。 作られたウィンドウのクライアント領域の境界がくぼんで表示されるのは拡張スタイルに WS_EX_OVERLAPPEDWINDOW を指定しているからだ。 このようなウィンドウでも、OnTest( ) ハンドラで示してあるようにプログラムコードではサイズ変更や最大化はできる。
本節で示したように、 OnWindowParams や OnClassParams ハンドラでクラス属性やウィンドウ属性を簡単に変更できるので、いろいろなウィンドウスタイルを試してみることができる。
アプリケーションの中には、インスタンスを一つしか起動できないものがある。このような機能は、ミューテックス (mutex) を使って実現できるが、 ここでは９-５節でしめしたように、実行中のメインウィンドウから自分と同じクラスを使用しているものの有無を調べることにより、この機能を実現しよう。
９-５節では、EnumWindows( ) ＡＰＩをつかって実行中のメインウィンドウを列挙していた。 ここでは、この関数をカプセル化した関数を UtilFunc.pas につくって、もし自分と同じクラスのウィンドウがあったなら、そのことを表示してプログラムを終了する事にしよう。 ClassInfo( ) 関数の下に、以下の宣言を追加する。
procedure FindOtherInstance(classname: string);
そして対応する実装部に以下のコードを書く。
var
cn: string = '';
function FindOtherWndProc(hWindow: HWND; lData: LPARAM):BOOL; stdcall;
var
c: array[0..100] of Char;
begin
GetClassName(hWindow,c,100);
if string(c) = cn then begin
PInteger(LData)^ := hWindow;
result := false;
end else begin
PInteger(LData)^ := 0;
result := true;
end;
end;
procedure FindOtherInstance(classname: string);
var
FindWnd: HWND;
begin
cn := classname;
EnumWindows(@FindOtherWndProc,LPARAM(@FindWnd));
if FindWnd <> 0 then begin
MessageBox(0, 'このアプリケーションは既に起動されています',
'おしらせ',MB_ICONINFORMATION or MB_OK);
ShowWindow(FindWnd,SW_RESTORE);
SetForegroundWindow(FindWnd);
Halt(0);
end;
end;この関数は、クラス名を受け取って EnumWindows( ) を呼び出し、もし同じクラスを使っているウィンドウを見つけたら、メッセージボックスを表示して、見つけたウィンドウを一番手前に表示して自分のプログラムを終了する。 見つけられなかったら何もしない。 OneInst.dpr でこの関数を使ってテストするには、メインルーチンを以下のようにするだけだ。
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
FindOtherInstance('MyClassName');
MainWnd := TSDIMainWindow.Create(0,'MyClassName');
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.OneInst.zip(13.306kB)
ここでは、最初に実行されるコードとして FindOtherInstance( ) を呼び出している。 クラス名は任意であり、ここでは 'MyClassName' の文字列リテラルを使っているが、もちろんこれまでと同じ GetExeName でもよい。 コンパイルして、エクスプローラから二つ目のインスタンスを起動すると右のようなメッセージボックスを表示して、最初のインスタンスが表示される。 これは、期待通りの動作である。
本章では、 いままでコードでつくってきたメインウィンドウのラッパークラスを作成した。 まず、基本的な汎用ウィンドウを作る機能を包み込んだ TAPIWindow クラスを APIWindow.pas に作成した。 次に、 これから派生して、任意のメッセージを捕獲してイベントハンドラを呼び出せる TAPIWIndow2 クラスを作成した。 さらにこれから派生して、汎用ウィンドウの基本属性をプロパティーとして持つ TAPIWindow3 クラスを作成し、これから派生してＳＤＩのメインウィンドウのラッパークラス TSDIMainWindow クラスを作成した。
TSDIMainWindow クラスを使用した新しい骨格プログラム Skeleton03 を作成した。 この骨格プログラムを用いて、ユーザにサイズ変更を許さないメインウィンドウの作り方や、インスタスを一つに限定する方法を示した。
ここまでのプログラムファイル