前の章へ
| 総目次へ
| 次の章へ 
｜Delphi のＩＤＥにおいて、コンポーネントパレットの Win32 のページにあるのは、Windows95 以降に導入されたコモンコントロールをカプセル化したコンポーネントである｡ これらのコンポーネントには、タブコントロール、リストビュー、ツリービュー、リッチエディット、トラックバー、ステータスバー、アップダウン、プログレスバー、ツールバーなどがある｡ これらを使えば、より洗練された外観を持つアプリケーションを作成することができる｡ 本章以降、しばらくの間、これらのコモンコントロールについて調べてゆくことにしよう｡
前の章へ
| 総目次へ
| 次の章へ ｜コモンコントロールもボタンやリストボックスなどの標準コントロールと同様、Win32 で予め登録済みの子ウィンドウである｡ したがって､その実装内容に立ち入ることはできないが、実装の仕方が標準コントロールより洗練されているので、ＡＰＩレベルでの使用方法は標準コントロールよりもむしろ簡単である｡ ただし、多機能であるので操作自体は複雑であるが。リッチエディット以外のコモンコントロールは、Win32 システムの comctl32.dll に含まれている関数を呼び出して使用する｡ このＤＬＬは、Windows のバージョンアップにしたがって改訂されているので、特に、Windows95 ユーザはその全てのＡＰＩ関数やメッセージやレコード型などを使用できるとは限らない。しかし、Windows95 に最新のインターネットエクスプローラをインストールすると comctl32.dll も自動的にバージョンアップされる。筆者も Windows95 ユーザであるが、現時点での最新の ＩＥ５ をインストールしている。このとき、comctl32.dll のバージョンは、5.80 である。 Delphi では、このＤＬＬとのインターフェースユニットは Commctrl.pas である｡ このユニットを uses 節に加えて、初期化として InitCommonControls 手続きを実行するとＤＬＬがメモリにロードされてコモンコントロールを使い始めることができる｡
procedure InitCommonControls; stdcall;
初期化として、InitCommonControls 手続きの代わりに InitCommonControlsEx( ) を実行することが推奨されている｡
function InitCommonControlsEx(var ICC: TInitCommonControlsEx): Bool;
この関数のパラメータは、以下のようなレコードである｡
type
PInitCommonControlsEx = ^TInitCommonControlsEx;
TInitCommonControlsEx = packed record
dwSize: DWORD; // このレコードのサイズ
dwICC: DWORD; // どのクラスを使うかを指定するフラグ
end;dwICC フィールドに設定できる定数は以下のうちの一つまたは複数を指定する｡
const ICC_LISTVIEW_CLASSES = $00000001; // listview, header ICC_TREEVIEW_CLASSES = $00000002; // treeview, tooltips ICC_BAR_CLASSES = $00000004; // toolbar, statusbar, trackbar, tooltips ICC_TAB_CLASSES = $00000008; // tab, tooltips ICC_UPDOWN_CLASS = $00000010; // updown ICC_PROGRESS_CLASS = $00000020; // progress ICC_HOTKEY_CLASS = $00000040; // hotkey ICC_ANIMATE_CLASS = $00000080; // animate ICC_WIN95_CLASSES = $000000FF; // 以上全部 ICC_DATE_CLASSES = $00000100; // month picker, date picker, time picker, updown ICC_USEREX_CLASSES = $00000200; // comboex ICC_COOL_CLASSES = $00000400; // rebar (coolbar) control
例えば､ ツリービューとステータスバーを使用する場合は、
var ICC: TInitCommonControlsEx;
と宣言しておき、
ICC.dwSize := SizeOf(TInitCommonControlsEx); ICC.dwICC := ICC_TREEVIEW_CLASSES or ICC_BAR_CLASSES; InitCommonControlsEx(ICC);
とする。上の定数定義を見れば分かるように、ICC.dwICC := $7FF とすると全て使えるようになる｡
初期化が終わるとすぐにコモンコントロールを作成できるようになる｡ 登録済みの子ウィンドウであるから CreateWindowEx( ) にそのコントロールのクラス名を指定して作成できる｡ 多くの場合、コントロールを作成するには、CreateWindowEx( ) を使うよりコントロール特有の生成関数が定義されているので、そちらを使った方が簡単である｡ 例えば、ステータスバーの場合は、後に示すように CreateStatusWindow( ) という関数を使って作成する。標準コントロールのときと同じように、コントロールのスタイルは、コントロールごとに定義済みの定数を使って設定する。
プログラムコードから、コントロールを遠隔操作するには、コントロールごとに定義されているメッセージを SendMessage( ) で送ってやることは、標準コントロールの場合と同じである。
標準コントロールの場合は、コントロールに何か興味深い出来事が起こると、スクロールバーコントロール以外の多くの標準コントロールでは、親ウィンドウに WM_COMMAND メッセージを送って、通知していた｡ コモンコントロールの場合は、親ウィンドウに WM_NOTIFY メッセージを送ることでイベントを知らせる｡ Delphi に付属の Win32.hlp によれば、
WM_NOTIFY idCtrl = (int) wParam; // コントロールのＩＤ pnmh = (LPNMHDR) lParam; // TNMHdr レコードへのポインタ
lParam の示すレコード型は Windows.pas で以下のように定義されている｡
type
PNMHdr = ^TNMHdr;
TNMHdr = packed record
hwndFrom: HWND; // このメッセージを送ったコントロールのウィンドウハンドル
idFrom: UINT; // このメッセージを送ったコントロールのＩＤ
code: Integer; { NM_ code }
end;このレコードの code フィールドには、出来事の内容が以下のような定数で通知される。
const
NM_FIRST = 0- 0; { generic to all controls }
NM_LAST = 0- 99;
NM_OUTOFMEMORY = NM_FIRST-1; // メモリが足りません
NM_CLICK = NM_FIRST-2; // 左クリックされた
NM_DBLCLK = NM_FIRST-3; // 左ダブルクリックされた
NM_RETURN = NM_FIRST-4; // フォーカスがあって、[ENTER] キーが押された
NM_RCLICK = NM_FIRST-5; // 右クリックされた
NM_RDBLCLK = NM_FIRST-6; // 右ダブルクリックされた
NM_SETFOCUS = NM_FIRST-7; // フォーカスを得た
NM_KILLFOCUS = NM_FIRST-8; // フォーカスを失った多くの場合､ WM_NOTIFY の lParam は TNMHdr 型のレコードを単独に指すポインタではなく、TNMHdr レコードを先頭フィールドに持つ、より大きなレコード型を指していることがある｡ 例えばツールバーが親ウィンドウに送る WM_NOTIFY メッセージの lParam は
type
PNMToolBarA = ^TNMToolBarA;
PNMToolBar = PNMToolBarA;
TNMToolBarA = packed record
hdr: TNMHdr;
iItem: Integer;
tbButton: TTBButton;
cchText: Integer;
pszText: PAnsiChar;
end;
TNMToolBar = TNMToolBarA;のようなレコード型へのポインタであることがある。先頭は、必ず TNMHdr レコード型なので、この部分だけをアクセスすることもできる。全部のフィールドにアクセスするためには､ lParam の値を PNMToolBar ポインタにキャストすればよい。そうすれば逆参照とフィールドを指定するだけでその値を取得できる｡
さて、一般論はこのくらいにして具体的にコントロールを作って操作してみよう｡ この章では､ 比較的簡単なコモンコントロールとしてステータスバーを取り上げ、ＡＰＩレベルでの使用方法を調べてから､ それをカプセル化したクラスを作成しよう｡
コモンコントロールの最初の例として、最も使用頻度が高いと思われるステータスバーから始めることにしよう｡ ステータスバーは、CreateWindow( ) にクラス名として STATUSCLASSNAME を指定して作成することができる｡
const STATUSCLASSNAME = 'msctls_statusbar32';
しかし、CreateStatusWindow( ) を使った方が便利である｡
function CreateStatusWindow(Style: Longint;
lpszText: PChar;
hwndParent: HWND;
wID: UINT): HWND; stdcall;Style には、WS_CHILD を必ず含める｡ 通常は、WS_VISIBLE も指定する｡ lpszText には、ステータスバーに最初に表示される文字列を指定する｡ これは nil でもかまわない｡ hwndParent には親ウィンドウのハンドルを、wID にはコントロールＩＤを設定する｡ CreateStatusWindow( ) は成功すると、作成したステータスバーのウィンドウハンドルを返す｡
CreateStatusWindow( ) でステータスバーを作成するとき、その位置とサイズを設定しなくて良いことに気づく｡ これは、親ウィンドウの下部に適切なサイズで作成されるからだ｡ 親ウィンドウの上部、メニューバーの直ぐ下に配置するときは、Style に CCS_TOP を含める｡
const CCS_TOP = $00000001;
ステータスバーを作成したら、これを制御するために標準コントロールと同じように SendMessage( ) でメッセージを送ることにより、遠隔操作する｡ ステータスバーが理解できるメッセージを以下に示す｡
const SB_SETTEXTA = WM_USER+1; SB_GETTEXTA = WM_USER+2; SB_GETTEXTLENGTHA = WM_USER+3; SB_SETTEXTW = WM_USER+11; SB_GETTEXTW = WM_USER+13; SB_GETTEXTLENGTHW = WM_USER+12; SB_SETTEXT = SB_SETTEXTA; // 表示テキストの設定 SB_GETTEXT = SB_GETTEXTA; // 表示テキストの取得 SB_GETTEXTLENGTH = SB_GETTEXTLENGTHA; // 表示テキストの長さを取得 SB_SETPARTS = WM_USER+4; // 分割部分の設定 SB_GETPARTS = WM_USER+6; // 分割部分の取得 SB_GETBORDERS = WM_USER+7; // 水平垂直境界の取得 SB_SETMINHEIGHT = WM_USER+8; // 最小高さの設定 SB_SIMPLE = WM_USER+9; // 分割部分の表示のOn/Off SB_GETRECT = WM_USER + 10;// 一つの分割部分の境界矩形の取得
この中で、よく使われるものについて Delphi 付属の Win32.hlp で調べよう｡
SB_SETPARTS wParam = (WPARAM) nParts; lParam = (LPARAM) (LPINT) aWidths;
wParam には分割する個数（２５５未満）を設定する｡ lParam には、各分割部分のＸ座標を設定したゼロベースの integer の配列の最初の要素のアドレスを指定する｡ ０番目の分割部分が最も左側に配置される｡ 最右端の部分の幅に -1 を設定するとステータスバーの右端に追随するようになる｡ 成功したら true を返す｡
SB_GETPARTS wParam = (WPARAM) nParts; lParam = (LPARAM) (LPINT) aRightCoord;
分割部分のＸ座標を取得する｡ wParam には取得する部分の数を指定する｡ 現在の分割数が分からないときは、wParam、lParam ともにゼロを設定すると、このメッセージの戻り値として実際の分割個数を取得できる。その後あらためて、取得した個数を wParam に設定し､ lParam には、wParamで指定した以上の要素を含むゼロベースの integer 配列の最初の要素のアドレスを指定すると各分割部分のＸ座標が得られる｡
SB_SETTEXT wParam = (WPARAM) iPart or uType; lParam = (LPARAM) (LPSTR) szText;
特定の分割部分にテキストを出力する。wParam の iPart には出力する分割部分を指定するゼロベースのインデックス（２５５以下）を指定する｡ uType は、通常ゼロ（デフォルト）であるが、その場合はくぼんだ矩形内にテキストが表示される｡ uType には、ゼロほかに以下のスタイルを指定することもできる｡
const SBT_OWNERDRAW = $1000; // オーナー描画（ここでは説明しない） SBT_NOBORDERS = $0100; // 平面 SBT_POPOUT = $0200; // 盛り上がった境界矩形 SBT_RTLREADING = $0400; // アラビア語のように右から左へ表示
lParam には PChar 型の文字列を integer にキャストして指定する｡
SB_GETTEXTLENGTH wParam = (WPARAM) iPart; lParam = 0;
表示されているテキストの長さを文字数で取得する｡ wParam には取得する文字列が表示されている分割部分のゼロベースインデックスを指定する｡ 成功すると、戻り値の下位ワードに文字数が返される｡ 上位ワードには、SB_SETTEXT で指定した表示スタイル uType に相当する量が取得される｡ これにより、文字列の取得のためのバッファの大きさと表示スタイルを同時に取得できる｡
SB_GETTEXT wParam = (WPARAM) iPart; lParam = (LPARAM) (LPSTR) szText;
表示されているテキストを取得する｡ wParam には、取得するテキストが表示されている分割部分のゼロベースのインデックスを指定する｡ lParam には、文字列を受け取る PChar 型のバッファを integer にキャストして指定する｡ 戻り値は､ SB_GETTEXTLENGTH のときと同じである｡
SB_SIMPLE wParam = (WPARAM) (BOOL) fSimple; lParam = 0;
このメッセージで wParam をゼロ以外の値を設定すると、ステータスバーは分割部分のない形式で表示される｡ このときの文字列の取得・設定にはインデックスとして２５５を指定する｡ wParam をゼロに設定してこのメッセージを送ると、いつでも分割部分を表示する通常形式に戻すことができる。
SB_SETMINHEIGHT wParam = (WPARAM) minHeight; lParam = 0;
表示部分の高さを wParam にピクセル単位で設定する。その後、再描画するためにステータスバーに wParam と lParam をともに zero に設定して、WM_SIZE メッセージを送る。ステータスバーの実際の高さは、これで設定した値と境界の高さの２倍（上下分）との和になる。
SB_GETRECT wParam = (WPARAM) iPart; lParam = (LPARAM) (LPRECT) lprc;
各部の境界矩形を取得する｡ wParam には境界矩形を取得する部分の zero ベースのインデックスを、lParam には TRect 型変数のアドレスを設定する。成功すると true を返す｡
SB_GETBORDERS wParam = 0; lParam = (LPARAM) (LPINT) aBorders;
このメッセージを使って境界の太さを取得する。lParam には、３つの要素を持つ integer の配列のアドレスを integer 型にキャストして設定する。このメッセージを送出した後では､ 一番目の要素には水平境界の太さが、２番目の要素には垂直境界の太さが、３番目の要素には、セパレータの太さが設定されている｡
メッセージに関して、最後に重要なことは親ウィンドウが受け取る WM_SIZE である｡ CreateStatusWindow( ) でステータスバーを作成した直後は、親ウィンドウの下部に適切なサイズで配置されるが､ 親ウィンドウのサイズが変更されたとき、ステータスバーはそのことを知る手段を持っていないので自動的にサイズ変更を行うことが出来ない｡ ところが親ウィンドウのウィンドウ関数から WM_SIZE を wParam と lParam とともに SendMessage( ) で送ってやるだけで、思い通りの自動サイズ調整が行われる｡ プログラマはサイズの計算をしなくてもよいのだ。
ここまでの知識を使って、ステータスバーをコードで作って制御するプログラムを作ろう｡
以下に、TStatusbar01.dpr の全リストを示す｡
program Statusbar01;
uses
windows,
messages,
CommCtrl,
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
//------------------------------------------------------------
type
PNMMouse = ^TNMMouse;
TNMMouse = packed record
hdr: TNMHdr;
ItemSpec:DWORD;
ItemData:DWORD;
pt:TPoint;
HtInfo:LPARAM;
end;
const
SBN_SIMPLEMODECHANGE = -880;
ID_StatusBar1 = 500;
ID_StatusBar2 = 501;
var
MainWnd: TSDIMainWindow;
hSB1,hSB2: HWND;
L1: TAPILabel;
BG: TBtnGroup;
FlagSimple:Boolean = true;
ft: TAPICFont;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
function SBSetText(hHandle:HWND;PartsNo:Integer;
uType:integer;Txt:string):Boolean;
begin
Result := Boolean(SendMessage(hHandle,SB_SETTEXT,PartsNo or uType,
integer(PChar(Txt))));
end;
function SBGetText(hHandle:HWND;PartsNo:Integer):string;
var
pc:PChar;
len:integer;
begin
GetMem(pc,200);
len := SendMessage(hHandle,SB_GETTEXT,PartsNo,integer(pc));
SetString(result,pc,LOWORD(len));
FreeMem(pc);
end;
function SBGetStyle(hHandle:HWND;PartsNo:Integer):integer;
var
len:integer;
begin
len := SendMessage(hHandle,SB_GETTEXTLENGTH,PartsNo,0);
result := HIWORD(len);
end;
function SBGetRect(hHandle:HWND;PartsNo:integer):TRect;
begin
SendMessage(hHandle,SB_GETRECT,PartsNo,integer(@result));
end;
procedure SBGetBorder;
var
IA: array[0..2] of integer;
begin
SendMessage(hSB1,SB_GETBORDERS,0,integer(@IA[0]));
L1.Text := 'Get Borders'+#13#13+
'Horizontal : '+AIntToStr(IA[0])+#13+
'Vertical : '+AIntToStr(IA[1])+#13+
'Separator : '+AIntToStr(IA[2]);
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure MainSize(var Msg:TMessage);
begin
SendMessage(hSB1,Msg.Msg,Msg.WParam,Msg.LParam);
SendMessage(hSB2,Msg.Msg,Msg.WParam,Msg.LParam);
end;
procedure MainNotify(var Msg:TMessage);
var
PInfo: PNMMouse;
hdr: TNMHdr;
s:string;
begin
MessageBeep($FFFFFFFF);
PInfo := Pointer(Msg.LParam);
hdr := PInfo^.hdr;
case hdr.code of
NM_CLICK: s := 'LClicked!';
NM_DBLCLK: s := 'LDblClicked';
NM_RCLICK: s := 'RClicked';
NM_RDBLCLK: s := 'RDblClicked';
SBN_SIMPLEMODECHANGE: s := 'Simple Changed';
else
s := 'Other Message : '+AIntToStr(hdr.code);
end;
s := s+#13+'Handle : '+AIntToStr(hdr.hwndFrom)+#13+
' ID : '+AIntToStr(hdr.idFrom);
if hdr.code <> SBN_SIMPLEMODECHANGE then
s := s+#13+'Parts No. : '+AIntToStr(PInfo^.ItemSpec);
L1.Text := s;
end;
procedure BGClick(var Msg:TMessage);
var
IA: array[0..2] of Integer;
s:string;
hBr:HBRUSH;
DC:HDC;
begin
case Msg.WParam of
0:begin
IA[0] := 100; IA[1] := 270; IA[2] := -1;
SendMessage(hSB1,SB_SETPARTS,3,integer(@IA[0]));
end;
1:begin
SendMessage(hSB1,SB_SIMPLE,integer(FlagSimple),0);
FlagSimple := not FlagSimple;
end;
2:begin
SendMessage(hSB1,SB_SIMPLE,0,0);
SBSetText(hSB1,0,0,'Part 0 です');
SBSetText(hSB1,1,SBT_POPOUT,'Part 1 です');
SBSetText(hSB1,2,SBT_NOBORDERS,'Part 2 です');
InvalidateRect(hSB1,nil,true);
end;
3:begin
SendMessage(hSB1,SB_SIMPLE,0,0);
s := 'GetText'+#13+
'Part 0 : '+SBGetText(hSB1,0)+#13+
'Part 1 : '+SBGetText(hSB1,1)+#13+
'Part 2 : '+SBGetText(hSB1,2);
s := s+#13+'Style'+#13+
'Part 0 : $'+AIntToHex(SBGetStyle(hSB1,0),4)+#13+
'Part 1 : $'+AIntToHex(SBGetStyle(hSB1,1),4)+#13+
'Part 2 : $'+AIntToHex(SBGetStyle(hSB1,2),4);
L1.Text := s;
end;
4:begin
hBr := CreateSolidBrush(clrRED);
DC := GetDC(hSB1);
FillRect(DC,SBGetRect(hSB1,1),hBr);
ReleaseDC(hSB1,DC);
DeleteObject(hBr);
end;
5:SBGetBorder;
6: ft.SetHandle(hSB1);
7: ft.ResetHandle(hSB1);
8: begin
SendMessage(hSB1,SB_SETMINHEIGHT,30,0);
SendMessage(MainWnd.Handle,WM_SIZE,0,0);
end;
end;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
ICC: TInitCommonControlsEx;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
ICC.dwSize := SizeOf(ICC);
ICC.dwICC := ICC_BAR_CLASSES;
InitCommonControlsEx(ICC);
hSB1 := CreateStatusWindow(WS_CHILD or WS_VISIBLE,
'Test Statusbar',hWindow,ID_StatusBar1);
hSB2 := CreateStatusWindow(WS_CHILD or WS_VISIBLE or CCS_TOP,
'Test Statusbar',hWindow,ID_StatusBar2);
L1 := CreateLabel(hWindow,10,50,360,230,'');
BG := CreateBtnGroup(hWindow,true,380,30,110,270,9,BGClick);
BG.Captions[0] := '3 Parts';
BG.Captions[1] := 'Toggle Simple';
BG.Captions[2] := 'Set Text';
BG.Captions[3] := 'Get Text';
BG.Captions[4] := 'Get Rect';
BG.Captions[5] := 'Get Border';
BG.Captions[6] := 'Set Font';
BG.Captions[7] := 'Reset Font';
BG.Captions[8] := 'Set Height';
ft := TAPICFont.Create;
with ft do begin
Name := 'ＭＳ Ｐ明朝';
Size := 14;
Bold := true;
GetHandle;
end;
with MainWnd do begin
Trap(WM_SIZE,MainSize);
Trap(WM_NOTIFY,MainNotify);
ClientWidth := 500;
ClientHeight := 330;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
ft.Free;
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.
StatusBar01.zip(19.403kB)
実行すると右図のようにクライアント領域の上下にステータスバーがつくられる｡ ボタングループとラベルもつくられる。
コードを見ながら、以下のようにして動作をテストしてみよう｡ 最初に、uses 節に Commctrl を付け加える｡ MainCreate( ) ハンドラでは、コモンコントロールの使用準備として、
ICC.dwSize := SizeOf(ICC); ICC.dwICC := ICC_BAR_CLASSES; InitCommonControlsEx(ICC);
を実行している｡ 次にステータスバーを作る｡
hSB1 := CreateStatusWindow(WS_CHILD or WS_VISIBLE,
'Test Statusbar',hWindow,ID_StatusBar1);
hSB2 := CreateStatusWindow(WS_CHILD or WS_VISIBLE or CCS_TOP,
'Test Statusbar',MainWnd.Handle,ID_StatusBar2);ステータスバーのハンドル hSB1, hSB2 はグローバル変数としている｡ ここで、メインウィンドウの境界をドラグしてサイズを変更してみよう。上下のステータスバーは、親ウィンドウのサイズの変更にきちんと追随していることが確かめられる｡ これは､メインウィンドウの WM_SIZE メッセージをトラップして、
procedure MainSize(var Msg:TMessage); begin SendMessage(hSB1,Msg.Msg,Msg.WParam,Msg.LParam); SendMessage(hSB2,Msg.Msg,Msg.WParam,Msg.LParam); end;
により、各ステータスバーにエコーバックしているからだ。次にボタングループの '3 Parts' ボタンを押すと、下のステータスバーが３分割される。
IA[0] := 100; IA[1] := 270; IA[2] := -1; SendMessage(hSB1,SB_SETPARTS,3,integer(@IA[0]));
最後の分割領域のＸ座標を -1 に設定して、右端を親ウィンドウの幅にあわせている｡ここで、マウスで上下のステータスバーの各分割部分をクリックするとシステムブザーが鳴って、その情報がラベルに示される｡ これは、前節で示したコモンコントロールの通知メッセージのうち、左クリック、左ダブルクリック、右クリック、右ダブルクリックをトラップして、MainNotify( ) ハンドラで処理しているからだ｡ これらの通知メッセージが WM_NOTIFY メッセージで送られてきたときは、lParam は TNMMouse レコード型へのポインタであり、その ItemSpec フィールドには、そのときのマウスがどの分割部分にあるかについてのインデックスが入っている｡ 筆者の Delphi ver.3.1 の CommCtrl.pas には、TNMMouse 型レコードが定義されていないので、このプログラムでは、冒頭でこのレコード型を定義している｡
次に 'Toggle Simple' ボタンを押すと、下のステータスバーが３分割のものと分割なしのものとが入れ替わる。このときも、システムブザーが鳴って、WM_NOTIFY メッセージを受け取っていることが分かる。このときの通知は､ 最新のヘルプを読むと SBN_SIMPLEMODECHANGE というものであるが、これも筆者のバージョンでは定義されていないので、定数として冒頭で定義している。このように、ステータスバーは、分割部分がない「シンプルモード」と分割されている「ステータスモード」の二つのモードがあり、SB_SIMPLE メッセージを送って切り替えられる。表示されていない一方のモードの状態は保存されている｡ 'Toggle Simple' を押すと交互に切り替わる様子が分かるだろう｡
次に 'Set Text' ボタンを押すと、下のステータスバーの各分割部分のテキストが設定されるとともに、真ん中の分割部分は盛り上がったスタイルに､ 右端の分割部分は平面のスタイルに変更される。これは、SBSetText( ) ヘルパ関数を使って設定される。
function SBSetText(hHandle:HWND;PartsNo:Integer;
uType:integer;Txt:string):Boolean;
begin
Result := Boolean(SendMessage(hHandle,SB_SETTEXT,PartsNo or uType,
integer(PChar(Txt))));
end;この関数の意味は､ 上記の SB_SETTEXT メッセージの説明から理解できるだろう｡ 'Get Text' ボタンを押すと、各分割部分のテキストとスタイルが取得されて、ラベルに表示される｡ テキストを取得する SBetText( ) 関数を見てみよう。
function SBGetText(hHandle:HWND;PartsNo:Integer):string; var pc:PChar; len:integer; begin GetMem(pc,200); len := SendMessage(hHandle,SB_GETTEXT,PartsNo,integer(pc)); SetString(result,pc,LOWORD(len)); FreeMem(pc); end;
取得すべきテキストの長さは、すでに説明したように SB_GETTEXTLENGTH メッセージを送って取得できるが､ ここでは十分に大きいバッファをつくって文字列を取得している｡
'Get Rect' ボタンを押すと下のステータスバーの真ん中の分割部分が赤く塗りつぶされる｡ 実行コードを見てみよう。
4:begin
hBr := CreateSolidBrush(clrRED);
DC := GetDC(hSB1);
FillRect(DC,SBGetRect(hSB1,1),hBr);
ReleaseDC(hSB1,DC);
DeleteObject(hBr);
end;ここでは、本稿の最初のほうの章でよく使った FillRect( ) を使って SBGetRect( ) で求めた分割部分の矩形領域を赤く塗りつぶしている。分割部分の矩形領域を取得できると、それぞれの区画に画像を表示したり、後で取り上げるプログレスバーなどのコントロールを配置できる｡
'Set Font' ボタンを押すと、第１６章でつくった TAPICFont クラスのインスタンスの SetHandle( ) メソッドを使ってステータスバーに表示されるテキストのフォントが変更される。このことは、ステータスバーにも WM_SETFONT メッセージを送ってフォントを変更できることを示している｡ このとき、ステータスバーの高さが、設定されたフォントを表示できるように自動的に変更されることに気づく｡ このときでも、'Get Rect' ボタンは正しく動作することが確かめられる｡ 'Reset Font' ボタンをおすと、ResetHandle( ) メソッドを使ってデフォルトフォントに戻される。
'Set Height' ボタンを押すと、下のステータスバーの高さが変更される。このときステータスバーに SB_SETMINHEIGHT メッセージを送るが、そのあとに WM_SIZE メッセージをメインウィンドウを通して送って再描画している｡ SB_SETMINHEIGHT で十分大きな高さを設定すると、フォントの変更による高さの自動調整機能が働かなくなることが分かった。もとに戻すときは、高さをゼロに設定すればよい｡
以上で、ステータスバーの使い方が分かったので、次節以降でこれらのコードのラッパークラスを作成することにしよう｡
前節で見たようにコモンコントロール自体の使用方法は、標準コントロールとほとんど同じである｡ つまり、ウィンドウを作成し、SendMessage( ) でメッセージを送って遠隔操作し、通知メッセージを受け取って処理する、という具合である。この節では、前節のコードをまとめて、ステータスバーのラッパークラスを作成することを考える｡ 本稿でつくったボタンやリストボックスなどの標準コントロールのラッパークラスは APIControl.pas の TAPIControl クラスから派生したものである。コモンコントロールのラッパークラスも同様にして TAPIControl から派生してつくることができるが､ ここでは新しいユニットに作成することにしよう｡ 前節で見たように､ ステータスバーは自分の位置を確定するためには親ウィンドウの WM_SIZE メッセージを必要とする。また、何かイベントが起こると WM_NOTIFY メッセージを親ウィンドウに送ることにより、プログラムに通知する。このような仕様のため、コモンコントロールのラッパークラスは、親ウィンドウが受け取るメッセージを盗み見ることができれば、メッセージループから送られたメッセージも、また自分が親ウィンドウに送ったメッセージも捕まえることができるだろう｡ ここでは、コモンコントロールのラッパークラスの派生元になる TCmCtrl クラス を TSubClass から派生して作ろう｡ そして、TCmCtrl から派生して、ステータスバーのラッパークラス TAPIStatusBar を作ることにしよう｡
最初に、CmCtrl.pas に TCmCtrl クラスを実装しよう｡ 以下に全リストを示す｡
unit CmCtrl;
interface
uses
Windows,
Messages,
CommCtrl,
UtilFunc,
UTilClass;
type
TNotifyNotify = procedure (var Msg:TMessage;NMHdr:TNMHdr);
PNMMouse = ^TNMMouse;
TNMMouse = packed record
hdr: TNMHdr;
ItemSpec:DWORD;
ItemData:DWORD;
pt:TPoint;
HtInfo:LPARAM;
end;
TEffRect = record
Mark:integer;
ID: integer;
end;
const
SBN_SIMPLEMODECHANGE = -880;
type
//------------------ TCmCtrl --------------------------------------
TCmCtrl = class(TSubClass)
private
FHandle: HWND;
FID: HMenu;
FOnClick:TNotifyNotify;
FOnDblClick:TNotifyNotify;
FOnRClick:TNotifyNotify;
FOnRDblClick:TNotifyNotify;
function GetEnable: Boolean;
procedure SetEnable(value:Boolean);
function GetVisible: Boolean;
procedure SetVisible(value: Boolean);
protected
procedure CreateControl; virtual; abstract;
public
constructor Create(hParent: HWND); override;
destructor Destroy; override;
property Handle: HWND read FHandle;
property ID: HMenu read FID;
property Enable: Boolean read GetEnable write SetEnable;
property Visible: Boolean read GetVisible write SetVisible;
property OnClick:TNotifyNotify read FOnClick write FOnClick;
property OnDblClick:TNotifyNotify read FOnDblClick write FOnDblClick;
property OnRClick:TNotifyNotify read FOnRClick write FOnRClick;
property OnRDblClick:TNotifyNotify read FOnRDblClick write FOnRDblClick;
end;
implementation
var
ID_CmCtrl:integer = 1000;
//------------------ TCmCtrl --------------------------------------
constructor TCmCtrl.Create(hParent: HWND);
begin
inherited Create(hParent);
Dispatcher.TrapMessage(WM_NOTIFY,self);
InitCommonControls;
end;
destructor TCmCtrl.Destroy;
begin
DestroyWindow(FHandle);
inherited Destroy;
end;
function TCmCtrl.GetEnable: Boolean;
begin
result := Boolean(IsWindowEnabled(FHandle));
end;
procedure TCmCtrl.SetEnable(value: Boolean);
begin
EnableWindow(FHandle,value);
end;
function TCmCtrl.GetVisible: Boolean;
begin
result := Boolean(IsWindowVisible(FHandle));
end;
procedure TCmCtrl.SetVisible(value:Boolean);
begin
if value then
ShowWindow(FHandle,SW_SHOWNORMAL)
else
ShowWindow(FHandle,SW_HIDE);
end;
end.TCmCtrl クラスは、TSubClass から派生し、コンストラクタとデストラクタをオーバーライドし、Handle、ID、Enable、Visible、プロパティーを装備し、マウスのクリックなどのイベントを装備している｡ これらのメソッドやプロパティーはその名前から容易に機能が分かるだろう。コンストラクタでは、
constructor TCmCtrl.Create(hParent: HWND); begin inherited Create(hParent); Dispatcher.TrapMessage(WM_NOTIFY,self); InitCommonControls; end;
とし、継承メソッドを呼び出したあとに Dispatcher に親ウィンドウの WM_NOTIFY メッセージを送ってくれるよう依頼している｡ そして、InitCommonControls により、コモンコントロールライブラリを初期化している｡
destructor TCmCtrl.Destroy; begin DestroyWindow(FHandle); inherited Destroy; end;
デストラクタでは、このクラスが包み込むウィンドウオブジェクトを廃棄している。したがって､ コントロールを動的に廃棄するときは、このクラスを Free で廃棄すればよい。親ウィンドウが廃棄されるときは、Dispatcher がこのクラスを廃棄してくれる。
このクラスの protected 部には CreateControl というメソッドがあり、このメソッドで継承クラスで具体的なコントロールを作成する。このメソッドは抽象メソッドなので、このクラスのインスタンスをつくることはできない｡ また、DefaultHandler をオーバーライドしていないので、イベントを呼び出すのは、このクラスの継承クラスの責任である｡ もちろん全てのイベントを公開する必要はないので継承先で必要なものだけ実装すればよい｡ このクラスは、ただコモンコントロールの基本的なフレームを定義しているだけである｡
つぎに、TCmCtrl クラスから派生して、具体クラス TAPIStatusbar を作成しよう。宣言部を以下に示す｡
//----------------- TAPIStatusBar -----------------------------------
TSBTextStyle = (SUNKEN, NOBORDER, RAISED);
TAPIStatusBar = class(TCmCtrl)
private
FPartsWidth: array [0..9] of integer;
FTextStyle: array [0..9] of TSBTextStyle;
FTOP:Boolean;
FSimple:Boolean;
FMinHeight:integer;
FOnSize: TNotifyMessage;
FOnSimpleChange:TNotifyNotify;
procedure SetTOP(value:Boolean);
function GetNumParts:integer;
procedure SetNumParts(val:integer);
function GetPartsWidth(i:integer):integer;
procedure SetPartsWidth(i,val:integer);
function GetText(i:integer):string;
procedure SetText(i:integer;s:string);
function GetTextStyle(i:integer):TSBTextStyle;
procedure SetTextStyle(i:integer;style:TSBTextStyle);
procedure SetSimple(val:Boolean);
function GetSimpleText:string;
procedure SetSimpleText(value:string);
function GetRect(value:integer):TRect;
procedure SetMinHeight(value:integer);
protected
procedure CreateControl;override;
public
constructor Create(hParent:HWND); override;
procedure DefaultHandler(var Message);override;
procedure Invalidate;
property TOP:Boolean read FTOP write SetTOP;
property NumParts:integer read GetNumParts write SetNumParts;
property PartsWidth[i:integer]:integer read GetPartsWidth
write SetPartsWidth;
property Text[i:integer]:string read GetText write SetText;
property TextStyle[i:integer]:TSBTextStyle read GetTextStyle
write SetTextStyle;
property Simple:Boolean read FSimple write SetSimple;
property SimpleText:string read GetSimpleText write SetSimpleText;
property Rect[i:integer]: TRect read GetRect;
property MinHeight:integer read FMinHeight write SetMinHeight;
property OnSize:TNotifyMessage read FOnSize write FOnSize;
property OnSimpleChange:TNotifyNotify read FOnSimpleChange
write FOnSimpleChange;
end;
function CreateStatusBar(hParent:HWND;Top:Boolean):TAPIStatusbar;前節で調べたメッセージやイベントを思い出すと、これらのプロパティーやメソッドの機能はその名前から想像できるだろう｡ プライベート部の FPartsWidth と FTextStyle は、分割部分の幅とスタイルを格納する配列であるが、要素の数が１０個なので、この実装では１０個までの分割ができる。実装部を以下に示す｡
//------------ TAPIStatusBar ------------------------------------------------
constructor TAPIStatusBar.Create(hParent:HWND);
var
i: integer;
begin
inherited Create(hParent);
CreateControl;
Dispatcher.TrapMessage(WM_SIZE,self);
for i := 0 to 9 do FPartsWidth[i] := 80;
end;
procedure TAPIStatusBar.CreateControl;
begin
FHandle := CreateStatusWindow(WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or
WS_CLIPSIBLINGS or CCS_TOP,'APIStatusBar',Parent,ID_CmCtrl);
FID := ID_CmCtrl;
inc(ID_CmCtrl);
end;
procedure TAPIStatusBar.DefaultHandler(var Message);
var
AMsg:TMessage;
phdr: PNMHdr;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_SIZE: begin
SendMessage(FHandle,AMsg.Msg,AMsg.WParam,AMsg.LParam);
if (AMsg.WParam+AMsg.LParam) = 0 then exit;
AMsg.Msg := UINT(self);
if Assigned(FOnSize) then OnSize(AMsg);
end;
WM_NOTIFY:begin
phdr := Pointer(AMsg.LParam);
if FHandle <> phdr^.hwndFrom then exit;
AMsg.Msg := UINT(self); // Sender
case phdr^.code of
NM_CLICK:if Assigned(FOnClick) then FOnClick(AMsg,phdr^);
NM_DBLCLK:if Assigned(FOnDblClick) then FOnDblClick(AMsg,phdr^);
NM_RCLICK:if Assigned(FOnRClick) then FOnRClick(AMsg,phdr^);
NM_RDBLCLK:if Assigned(FOnRDblClick) then FOnRDBlClick(AMsg,phdr^);
SBN_SIMPLEMODECHANGE:if Assigned(FOnSimpleChange) then
FOnSimpleChange(AMsg,phdr^);
end;
end;
end;
end;
procedure TAPIStatusBar.Invalidate;
begin
SendMessage(FHandle,WM_SIZE,0,0);
end;
procedure TAPIStatusBar.SetTOP(value:Boolean);
var
st: integer;
begin
FTOP := value;
st := GetWindowLong(FHandle,GWL_STYLE);
if value then
st := st or CCS_TOP
else
st := st and (not CCS_TOP);
SetWindowLong(FHandle,GWL_STYLE,st);
Invalidate;
end;
function TAPIStatusBar.GetNumParts: integer;
begin
result := SendMessage(FHandle,SB_GETPARTS,0,0);
end;
procedure TAPIStatusBar.SetNumParts(val: integer);
var
PartsX: array [0..9] of integer;
i: integer;
begin
if val > 9 then exit;
if val = 1 then begin
PartsX[0] := -1;
SendMessage(FHandle,SB_SETPARTS,1,integer(@PartsX[0]));
end else begin
PartsX[0] := FPartsWidth[0];
for i := 1 to val-1 do PartsX[i] := PartsX[i-1]+FPartsWidth[i];
PartsX[val-1] := -1;
SendMessage(FHandle,SB_SETPARTS,val,integer(@PartsX[0]));
end;
end;
function TAPIStatusBar.GetPartsWidth(i: integer): integer;
begin
if i > 9 then begin
result := 0;
exit;
end;
result := FPartsWidth[i];
end;
procedure TAPIStatusBar.SetPartsWidth(i,val: integer);
begin
if i > 9 then exit;
FPartsWidth[i] := val;
SetNumParts(NumParts);
end;
function TAPIStatusBar.GetText(i: integer): string;
var
Len: integer;
begin
if (i > 9) and not (i = 255) then exit;
SetLength(result,200);
Len := LOWORD(SendMessage(FHandle,SB_GETTEXT,i,integer(PChar(result))));
SetLength(result,Len);
end;
procedure TAPIStatusBar.SetText(i: integer; s: string);
var
ts: integer;
begin
if i > 9 then
if i = 255 then begin
SendMessage(FHandle,SB_SETTEXT,i,integer(PChar(s)));
exit;
end
else
exit;
case FTextStyle[i] of
NOBORDER: ts := SBT_NOBORDERS;
RAISED: ts := SBT_POPOUT;
else
ts := 0;
end;
SendMessage(FHandle,SB_SETTEXT,i or ts,integer(PChar(s)));
end;
function TAPIStatusBar.GetTextStyle(i: integer): TSBTextStyle;
begin
result := FTextStyle[i];
end;
procedure TAPIStatusBar.SetTextStyle(i: integer; style: TSBTextStyle);
var
s: string;
begin
FTextStyle[i] := style;
s := GetText(i);
SetText(i,s);
InvalidateRect(FHandle,nil,true);
end;
procedure TAPIStatusBar.SetSimple(val: Boolean);
begin
if FSimple = val then exit;
FSimple := val;
SendMessage(FHandle,SB_SIMPLE,integer(val),0);
end;
function TAPIStatusBar.GetSimpleText:string;
begin
result := GetText(255);
end;
procedure TAPIStatusBar.SetSimpleText(value:string);
begin
SetText(255,value);
end;
function TAPIStatusBar.GetRect(value:integer):TRect;
begin
if value = -2 then
GetClientrect(FHandle,result)
else
SendMessage(FHandle,SB_GETRECT,value,integer(@result));
end;
procedure TAPIStatusBar.SetMinHeight(value:integer);
begin
FMinHeight := value;
SendMessage(FHandle,SB_SETMINHEIGHT,value,0);
Invalidate;
end;
function CreateStatusBar(hParent:HWND;Top:Boolean):TAPIStatusbar;
begin
result := TAPIStatusbar.Create(hParent);
result.TOP := Top;
end;CreateControl メソッドではステータスバーを作成している｡
procedure TAPIStatusBar.CreateControl;
begin
FHandle := CreateStatusWindow(WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or
WS_CLIPSIBLINGS or CCS_TOP,'APIStatusBar',Parent,ID_CmCtrl);
FID := ID_CmCtrl;
inc(ID_CmCtrl);
end;ここでは、ウィンドウスタイルに CCS_TOP を設定しているので、デフォルトでクライアント領域の上部に設置されるステータスバーを作成している。CCS_TOP スタイルの設定の on/off はウィンドウ作成後もできるが、デフォルトで下に設置されるステータスバーを作成してから CCS_TOP を設定して上配置にすると、右端下の「サイズグリップ」を取ることができないので、デフォルトで上配置のものを作成することにした｡ 下配置にするには TOP プロパティーを false にするとよい。この設定メソッドを見てみよう。
procedure TAPIStatusBar.SetTOP(value:Boolean);
var
st: integer;
begin
FTOP := value;
st := GetWindowLong(FHandle,GWL_STYLE);
if value then
st := st or CCS_TOP
else
st := st and (not CCS_TOP);
SetWindowLong(FHandle,GWL_STYLE,st);
Invalidate;
end;このようにして、value が false のときはウィンドウスタイルから CCS_TOP ビットフラグ部分を倒している。CreateControl メソッドはコンストラクタから呼ばれている｡
constructor TAPIStatusBar.Create(hParent:HWND); var i: integer; begin inherited Create(hParent); CreateControl; Dispatcher.TrapMessage(WM_SIZE,self); for i := 0 to 9 do FPartsWidth[i] := 80; end;
そして、そのあと Dispatcher に親ウィンドウの WM_SIZE メッセージを送ってくれるよう依頼している｡ DefaultHandler を見てみよう。
procedure TAPIStatusBar.DefaultHandler(var Message);
var
AMsg:TMessage;
phdr: PNMHdr;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_SIZE: begin
SendMessage(FHandle,AMsg.Msg,AMsg.WParam,AMsg.LParam);
if (AMsg.WParam+AMsg.LParam) = 0 then exit;
AMsg.Msg := UINT(self);
if Assigned(FOnSize) then OnSize(AMsg);
end;
WM_NOTIFY:begin
phdr := Pointer(AMsg.LParam);
if FHandle <> phdr^.hwndFrom then exit;
AMsg.Msg := UINT(self); // Sender
case phdr^.code of
NM_CLICK:if Assigned(FOnClick) then FOnClick(AMsg,phdr^);
NM_DBLCLK:if Assigned(FOnDblClick) then FOnDblClick(AMsg,phdr^);
NM_RCLICK:if Assigned(FOnRClick) then FOnRClick(AMsg,phdr^);
NM_RDBLCLK:if Assigned(FOnRDblClick) then FOnRDBlClick(AMsg,phdr^);
SBN_SIMPLEMODECHANGE:if Assigned(FOnSimpleChange) then
FOnSimpleChange(AMsg,phdr^);
end;
end;
end;
end;ここでは、親の WM_SIZE メッセージを捕まえてウィンドウオブジェクトに転送している。また、WM_NOTIFY メッセージを捕まえて イベントハンドラを呼び出している｡ これらのイベントハンドラの型は、TCmCtrl をつくるときに定義した
TNotifyNotify = procedure (var Msg:TMessage;NMHdr:TNMHdr);
である。あとの実装コードは前節のコードとほぼ同じである｡
それでは、このクラスをテストするプログラムを Statusbar02.dpr に作成しよう｡ 以下に全リストを示す｡
program Statusbar02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas',
CmCtrl in 'CmCtrl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
SB:TAPIStatusbar;
L1: TAPILabel;
BG: TBtnGroup;
ft: TAPICFont;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure BGClick(var Msg:TMessage);
var
hBr:HBRUSH;
DC:HDC;
begin
case Msg.WParam of
0:begin
SB.NumParts := 3;
SB.PartsWidth[0] := 200;
SB.PartsWidth[1] := 80;
end;
1:SB.Simple := not SB.Simple;
2:begin
SB.Simple := false;
SB.Text[0] := 'Part 0 です';
SB.Text[1] := 'Part 1 です';
SB.Text[2] := 'Part 2 です';
SB.TextStyle[1] := RAISED; SB.TextStyle[2] := NOBORDER;
end;
3:begin
SB.Simple := false;
L1.Text := 'GetText'+#13+
'Part 0 : '+SB.Text[0]+#13+
'Part 1 : '+SB.Text[1]+#13+
'Part 2 : '+SB.Text[2];
end;
4:begin
hBr := CreateSolidBrush(clrRED);
DC := GetDC(SB.Handle);
FillRect(DC,SB.Rect[1],hBr);
ReleaseDC(SB.Handle,DC);
DeleteObject(hBr);
end;
5: ft.SetHandle(SB.Handle);
6: ft.ResetHandle(SB.Handle);
7: SB.MinHeight := SB.MinHeight+10;
8: SB.MinHeight := 0;
end;
end;
procedure SBClick(var Msg:TMessage;NMHdr:TNMHdr);
var
P: PNMMouse;
begin
MessageBeep($FFFFFFFF);
P := Pointer(Msg.LParam);
L1.Text := 'Clicked!'+#13+
'Handle : '+AIntToStr(P^.hdr.hwndFrom)+#13+
' ID : '+AIntToStr(P^.hdr.idFrom)+#13+
'Parts No. : '+AIntToStr(P^.ItemSpec);
end;
procedure SBSimpleChange(var Msg:TMessage;NMHdr:TNMHdr);
begin
if SB.Simple then
L1.Text := 'SimpleChange! Now in SimpleMode'
else
L1.Text := 'SimpleChange! Now in StatusMode';
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
SB := CreateStatusBar(hWindow,false);
SB.OnClick := SBClick;
SB.OnSimpleChange := SBSimpleChange;
SB.SimpleText := 'シンプルモードのテキストです';
L1 := CreateLabel(hWindow,10,10,360,230,'');
BG := CreateBtnGroup(hWindow,true,380,10,110,270,9,BGClick);
BG.Captions[0] := '3 Parts';
BG.Captions[1] := 'Toggle Simple';
BG.Captions[2] := 'Set Text';
BG.Captions[3] := 'Get Text';
BG.Captions[4] := 'Get Rect';
BG.Captions[5] := 'Set Font';
BG.Captions[6] := 'Reset Font';
BG.Captions[7] := 'Set Height';
BG.Captions[8] := 'Reset Height';
ft := TAPICFont.Create;
with ft do begin
Name := 'ＭＳ Ｐ明朝';
Size := 14;
Bold := true;
GetHandle;
end;
with MainWnd do begin
ClientWidth := 500;
ClientHeight := 330;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
ft.Free;
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.Statusbar02.zip19.356kB)
実行すると右図のようになる。前節のプログラムとほぼ同じように動作するのが分かるだろう｡ ただし、マウスイベントは左クリックしか処理していない｡ また、SB_GETBORDERS メッセージを送るようなメソッドを装備していないので、必要なときは前節と同じように SendMessage( ) で取得してほしい｡
第１４章 スクロールバー で ShowScrollBar( ) ＡＰＩをつかってメインウィンドウやパネルやボタン（！）に標準スクロールバーを設置する例を示した｡ 標準スクロールバーが設置されると、設置されたウィンドウのクライアント領域が自動的に変更されて、ボタンやパネルの輪郭が自動的に正しく表示される。このとき GetClientRect( ) も変更後の値を返してくれる。本章で取り上げているステータスバーや後の章で調べるツールバーなどは、親ウィンドウのクライアント領域の上下に配置される。ステータスバーやツールバーとエディットコントロールを使ってエディタをつくることを考えてみると､ エディットをどのように配置したらよいのだろうか。ツールバーとステータスバーは、メインウィンドウのサイズに自動的に追随して、クライアント領域の上下に自動的に配置される。このとき、エディットコントロールの配置を決めるためには、これらのコントロールに覆われていないクライアント領域の矩形領域を計算しなければならないのだろうか。たしかに、これらのコントロールの占めている領域を GetWindowRect( ) を使って取得することができるので、計算によってエディットの配置を決めることができるだろう。CommCtrl.pas には、このときのような問題に対処するために、GetEffectiveClientRect( ) という関数がある。この節では、この関数を試してみよう｡
早速 GetEffectiveClientRect( ) 関数を試してみよう｡
procedure GetEffectiveClientRect(hWnd: HWND;
lprc: PRect;
lpInfo: PINT); stdcall;hWnd には、取得したいクライアント領域を持つウィンドウのハンドルを指定する。lprc には、取得した矩形領域を設定する TRect 型の変数のアドレスを指定する。lpInfo には、ステータスバーやツールバーなど、有効クライアント領域の計算で考慮したいコントロールのＩＤを設定した整数の配列のアドレスを設定する｡ この配列の具体的形は、以下の例で示す｡
以下に、EffectiveRect01.dpr の全リストを示す｡
program EffectiveRect01;
uses
windows,
messages,
CommCtrl, // ここを追加
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas',
CmCtrl in 'CmCtrl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
type
TEffRect = record
Mark:integer;
ID: integer;
end;
var
MainWnd: TSDIMainWindow;
SB1,SB2:TAPIStatusbar;
Memo: TAPIMemo;
AR: array[0..3] of TEffRect;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure SB2Size(var Msg:TMessage);
var
r:TRect;
begin
GetEffectiveClientRect(MainWnd.Handle,@r,@AR[0]);
Memo.Dimension := SetDim(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
SB1 := CreateStatusBar(hWindow,true);
SB1.NumParts := 5;
SB2 := CreateStatusBar(hWindow,false);
SB2.NumParts := 3;
SB2.OnSize := SB2Size;
Memo := CreateMemo(hWindow,50,50,100,100);
AR[0].Mark := 1; AR[0].ID := 1;
AR[1].Mark := 1; AR[1].ID := SB1.ID;
AR[2].Mark := 1; AR[2].ID := SB2.ID;
AR[3].Mark := 0; AR[3].ID := 0;
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.EffectiveRec01.zip(16.767kB)
実行すると、右図のように上下にステータスバーが配置され、あいだに Memo コントロールが配置される。メインウィンドウのサイズを変更してもこれらのコントロールが正しく配置されることが確かめられる｡
コードを見てみよう｡ ここで考慮したいのは、二つのステータスバーである。関数の三番目の引数に設定する配列は少し変わった形をしている｡ ここでは、
type TEffRect = record Mark:integer; ID: integer; end;
のようなレコード型を定義し、これを要素とする配列を宣言している。
AR: array[0..3] of TEffRect;
そして、MainCreate( ) ハンドラでステータスバーのＩＤが確定した後、
AR[0].Mark := 1; AR[0].ID := 1; AR[1].Mark := 1; AR[1].ID := SB1.ID; AR[2].Mark := 1; AR[2].ID := SB2.ID; AR[3].Mark := 0; AR[3].ID := 0;
として初期化している｡ 配列の最初の要素は初期マーカであり、どちらのフィールドもゼロ以外を設定する。ここでは１を設定している。二番目以降の要素には、コントロールごとに Mark フィールドをゼロ以外にし、ＩＤフィールドには考慮したいコントロールのＩＤを設定する。最後の要素では、両方のフィールドにゼロを設定して終了マーカとしている｡ GetEffectiveClientRect( ) 関数は、この配列を使って、二番目のステータスバーの OnSize イベントハンドラの中で実行されている。
procedure SB2Size(var Msg:TMessage); var r:TRect; begin GetEffectiveClientRect(MainWnd.Handle,@r,@AR[0]); Memo.Dimension := SetDim(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top); end;
そして、得られた TRect レコードから、位置と幅と高さを計算して Memo の Dimension プロパティーに設置している｡
この関数を、メインウィンドウの WM_SIZE や一番目のステータスバーの OnSize イベントハンドラで実行しても期待した結果は得られない｡ 考えてみればこのことは当然である。GetEffectiveClientRect( ) は、実行されるその時点でのコントロールのサイズを計算する。したがって、期待したような結果を得るためには、その時点で考慮すべきコントロールのサイズが確定していなければならない｡ ちょっと、TSubClass について復習してみよう｡ ユーザがメインウィンドウのサイズを変更すると WM_SIZE メッセージがメインウィンドウのウィンドウ関数に送られる。しかし、TSubClass の派生クラスである TAPIStatusbar はこれをサブクラス化しているので、UtilClass.pas にある SubClassProc( ) が最初に受け取る。そして、その中であらためてメインウィンドウの本来のウィンドウ関数を呼び出して実行する｡ その後、このメッセージは Dispatcher オブジェクトに送られ、その DefaultHandler( ) から登録リストを参照して、登録順にメッセージを配送する。したがって、一番目のステータスバーが受け取り、自分を再配置する。次に二番目のステータスバーが受け取り自分を再配置する｡ ここでやっと GetEffectiveClientRect( ) 関数を呼び出すことができるわけである｡
ここでは前項の GetEffectiveClientRect( ) の機能をカプセル化したクラスを作成しよう｡ TSubClass から派生すると自動的に親ウィンドウの WM_SIZE メッセージを取得できるだろう｡ ただし、前項でも考慮したように、考慮に入れるコントロールより後にこのメッセージを受け取るためには、これらのコントロールより後にインスタンスを作成する。そうすれば自動的に WM_SIZE を受け取る順番が、これらのコントロールより後になるわけである｡
最初に CmCtrl.pas に TEffecRect クラスを作成する｡ 冒頭の宣言部に以下のレコード型を定義する。
TEffRect = record Mark:integer; ID: integer; end;
以下に TEffecRect クラスの宣言部を示す｡
//----------------- TEffecRect ------------------------------------- type TEffecRect = class(TSubClass) private FOnSize: TNotifyMessage; FIDArray: array[0..5] of TEffRect; FEffectiveRect:TRect; function GetItemID(i:integer):integer; procedure SetItemID(i,value:integer); function GetEffectiveDim:TRect; protected public constructor Create(hParent:HWND); override; procedure DefaultHandler(var Message);override; procedure ReCalc; property OnSize:TNotifyMessage read FOnSize write FOnSize; property ItemID[i:integer]:integer read GetItemID write SetItemID; property EffectiveDim:TRect read GetEffectiveDim; end;
OnSize イベントでこのクラスが WM_SIZE を受け取ったことをユーザに知らせている。このとき、EffectiveDim をそのままコントロールの Dimension に設定すると適正に配置する。計算に使われるステータスバーやツールバーなどのコントロールＩＤは、ItemID プロパティーで登録する｡ 配列の要素数は６個なので、開始マーカと終了マーカを除いて、インデックスが１から４までの最大４個のコントロールを登録できる。実装部を以下に示す｡
//----------------- TEffecRect -------------------------------------
constructor TEffecRect.Create(hParent:HWND);
begin
inherited Create(hParent);
Dispatcher.TrapMessage(WM_SIZE,self);
FIDArray[0].Mark := 1; FIDArray[0].ID := 1;
end;
procedure TEffecRect.DefaultHandler(var Message);
var
AMsg:TMessage;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_SIZE: begin
GetEffectiveClientRect(Parent,@FEffectiveRect,@FIDArray[0]);
AMsg.Msg := UINT(self);
if Assigned(FOnSize) then FOnSize(AMsg);
end;
end;
end;
procedure TEffecRect.ReCalc;
var
Msg:TMessage;
begin
Msg.Msg := WM_SIZE;
Dispatch(Msg);
end;
function TEffecRect.GetItemID(i:integer):integer;
begin
result := 0;
if (i<1) or (i>4) then exit;
result := FIDArray[i].ID;
end;
procedure TEffecRect.SetItemID(i,value:integer);
begin
if (i<1) or (i>4) then exit;
FIDArray[i].Mark := 1; FIDArray[i].ID := value;
end;
function TEffecRect.GetEffectiveDim:TRect;
var
r:TRect;
begin
r := FEffectiveRect;
result := SetDim(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
end;GetEffectiveClientRect( ) 関数は、DefaultHandler( ) で WM_SIZE を受け取ったときに呼び出されている。このとき取得した矩形領域を private 部の FEffectiveRect に格納している｡ EffetiveDim プロパティーの取得メソッド GetEffectiveDim ではこの FEffectiveRect から幅と高さを計算している。ステータスバーなどは、メインウィンドウのサイズ変更と関わりなくサイズを変更することがある｡ MinHeight プロパティーを設定したり、フォントを変更したときである｡ このとき再計算するために、TEffecRect には Recalc メソッドがある｡ これは、自分のパスカルオブジェクトに WM_SIZE を配送しているだけである｡
このクラスをテストするプログラムを EffectiveRect02.dpr につくる。以下に全リストを示す｡
program EffectiveRect02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas',
CmCtrl in 'CmCtrl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
SB1,SB2:TAPIStatusbar;
Memo: TAPIMemo;
ER:TEffecRect;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure ERSize(var Msg:TMessage);
begin
Memo.Dimension := ER.EffectiveDim;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
SB1 := CreateStatusBar(hWindow,true);
SB1.NumParts := 5;
SB2 := CreateStatusBar(hWindow,false);
SB2.NumParts := 3;
Memo := CreateMemo(hWindow,50,50,100,100);
ER := TEffecRect.Create(hWindow);
ER.ItemID[1] := SB1.ID;
ER.ItemID[2] := SB2.ID;
ER.OnSize := ERSize;
with MainWnd do begin
ClientWidth := 360;
ClientHeight := 260;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
SB2.MinHeight := 50;
ER.ReCalc;
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.EffectiveRec02.zip(16.898kB)
実行すると右図のように、前項と同様に動作する｡ Test! メニューを選ぶと下のステータスバーの高さが大きくなり、ReCalc メソッドを呼び出すことで適正に配置されるのが分かるだろう｡
最後に、再び注意するが、TEffecRect クラスのインスタンスは、考慮するコントロールの後に作成しなければならないことを忘れないようにしなければならない。
ステータスバーの利用例でよく見かけるのが、メニューの項目にマウスカーソルを持っていくと、そのメニュー項目を説明する一行のテキストを下のステータスバーに表示する、というものだ。これは「メニューヘルプ」と呼ばれる機能で、CommCtrl.pas には、この機能を実現する関数が定義されている｡
procedure MenuHelp(Msg: UINT;
wParam: WPARAM;
lParam: LPARAM;
hMainMenu: HMENU;
hInst: THandle;
hwndStatus: HWND;
lpwIDs: PUINT); stdcall;この関数は、メニュー関連メッセージである WM_MENUSELECT メッセージに同期して文字列リソースの中の文字列を hwndStatus で指定されるステータスバーに表示する。この関数は、文字列リソースを使うことが前提となっており、しかも、ポップアップメニュー項目にＩＤを設定できないことを仮定しており､ 現在カーソルが乗っているメニュー項目のＩＤと文字列リソースの番号の対応が非常にややこしくて、なかなか使いづらい。参考にした著書 の Petzold 本にその使用例が載っているが、本稿ではこの関数をこれ以上説明しない｡ そのかわりに、ほぼ同様の機能をコードで実現してみよう。そしてそのラッパークラスを作成しよう。
２１−７ メニューメッセージ のところで説明したようにメニューをマウスで選択すると WM_ENTERMENULOOP メッセージが発行されメニューループに入る。そして、メニューの選択が終わると WM_EXITMENULOOP が発行されてメニューループから抜ける。この間に、マウスカーソルがメニュー項目の上を移動するたびに WM_MENUSELECT メッセージが発行される。Delphi に付属する Win32.hlp ではこのメッセージは以下のようになっている｡
WM_MENUSELECT uItem = (UINT) LOWORD(wParam); // menu item or pop-up menu index fuFlags = (UINT) HIWORD(wParam); // menu flags hmenu = (HMENU) lParam; // handle of menu clicked
uItem には、そのメニュー項目がコマンドメニューであるならメニューＩＤが設定されている｡ ポップアップメニューのときは、その項目の位置を示すメニューインデックスが設定されている｡ そのときの親メニューは hmenu に設定されている｡ fuFlags には、以下の定数のうちの幾つかが設定されている。
MF_GRAYED = 1; MF_DISABLED = 2; MF_BITMAP = 4; MF_CHECKED = 8; MF_POPUP = $10; MF_HILITE = $80; MF_OWNERDRAW = $100; MF_SYSMENU = $2000; MF_MOUSESELECT = $8000;
これらの定数はビットフラグになっているので、コードでは容易に判別することができる｡ 本稿では 第２１章 メニューの研究 その１ でつくったメニュークラスを使ってメニューを作成すると、ポップアップメニュー項目にもＩＤを設定できるので、MF_POPUP フラグが立っている場合でもメニューＩＤと文字列の対応が一対一に付けられれば、この WM_MENUSELECT メッセージに同期して適切な説明文字列をステータスバーに表示することができるだろう。それでは早速試してみよう｡
以下に MenuHelp01.dpr の全リストを示す｡
program MenuHelp01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas',
CmCtrl in 'CmCtrl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
MMain: TAMainMenu;
PFile, PHelp, POption: TAPopupMenu;
SB: TAPIStatusbar;
IL:TIntegerList;
SA:TStringArray;
const
ID_EXIT = 200;
ID_TEST = 201;
ID_ABOUT = 202;
ID_OPTION1 = 203;
ID_OPTION2 = 204;
ID_SEP1 = 208;
ID_FILE = 300;
ID_HELP = 301;
ID_OPTION = 302;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure InitArray;
begin
IL.Add(SC_RESTORE); SA.Add('ウィンドウのサイズを元に戻します');
IL.Add(SC_MOVE); SA.Add('ウィンドウを移動します');
IL.Add(SC_SIZE); SA.Add('ウィンドウのサイズを変更します');
IL.Add(SC_MINIMIZE); SA.Add('ウィンドウを最小化します');
IL.Add(SC_MAXIMIZE); SA.Add('ウィンドウを最大化します');
IL.Add(SC_CLOSE); SA.Add('このウィンドウが閉じます');
IL.Add(ID_FILE); SA.Add('編集コマンドです');
IL.Add(ID_HELP); SA.Add('ヘルプ情報です');
IL.Add(ID_OPTION); SA.Add('オプションコマンドです');
IL.Add(ID_EXIT); SA.Add('このプログラムが終了します');
IL.Add(ID_TEST); SA.Add('テストコマンドを実行します');
IL.Add(ID_ABOUT); SA.Add('アバウトウィンドウを表示します');
IL.Add(ID_OPTION1); SA.Add('１番目のオプションコマンドです');
IL.Add(ID_OPTION2); SA.Add('２番目のオプションコマンドです');
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure MainMenuCommand(var Msg: TMessage);
begin
case Msg.WParamLo of
ID_OPTION1,ID_OPTION2:MessageBeep($FFFFFFFF);
end;
end;
procedure MakeMenu(hParent:HWND);
begin
MMain := MakeMainMenu(hParent,MainMenuCommand);
PFile := MakePopupMenu(hParent,ID_FILE,nil);
PFile.AppendString('E&xit',ID_EXIT);
PFile.AttachMenu(MMain,-1,'&File');
MMain.AppendString('&Test!',ID_TEST);
PHelp := MakePopupMenu(hParent,ID_HELP,nil);
PHelp.AppendString('&About..',ID_ABOUT);
PHelp.AppendSeparator(ID_SEP1);
PHelp.AttachMenu(MMain,-1,'&Help');
POption := MakePopupMenu(hParent,ID_OPTION,nil);
POption.AppendString('Option&1',ID_OPTION1);
POption.AppendString('Option&2',ID_OPTION2);
POption.AttachMenu(PHelp,-1,'&Option');
MMain.SetToParent;
end;
procedure MainMenuSelect(var Msg:TMessage);
var
i,ID:integer;
begin
if (Msg.WParamHi and MF_POPUP) <> 0 then
ID := MenuItemID(Msg.LParam,Msg.WParamLo)
else
ID := Msg.WParamLo;
if ID = 0 then exit;
i := IL.Search(ID);
if i <> -1 then
SB.SimpleText := SA[i];
end;
procedure MainEnterMenuLoop(var Msg:TMessage);
begin
SB.Simple := true;
end;
procedure MainExitMenuLoop(var Msg:TMessage);
begin
SB.Simple := false;
end;
procedure MainContextMenu(var Msg: TMessage);
begin
SB.Simple := true;
POption.EchoBack(POption.Track(Msg,MainWnd.Handle));
SB.Simple := false;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeMenu(hWindow);
SB := CreateStatusBar(hWindow,false);
SB.NumParts := 3;
SB.PartsWidth[0] := 200;
IL := TIntegerList.Create(0,0);
SA := TStringArray.Create;
InitArray;
with MainWnd do begin
Trap(WM_MENUSELECT,MainMenuSelect);
Trap(WM_ENTERMENULOOP,MainEnterMenuLoop);
Trap(WM_EXITMENULOOP,MainExitMenuLoop);
Trap(WM_CONTEXTMENU,MainContextMenu);
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
IL.Free;
SA.Free;
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.MenuHelp01.zip(17.803kB)
実行すると右図のようになる。ポップアップメニュー項目のときも適切に表示されることを確かめてほしい。また、ウィンドウメニューについてもメニューヘルプが表示される。さらに、クライアント領域でマウスを右クリックすると表示されるショートカットメニューの場合にも表示される。
コードを見てみよう。冒頭の定数定義では全てのメニュー項目のメニューＩＤを定義している。そして、MainCreate( ) ハンドラから呼び出される MakeMenu( ) ヘルパ関数によりメニューを作成している。MainCreate( ) では次にステータスバーを作成してから TIntegreList 型の変数 IL と TStringArray 型の変数 SA のインスタンスを作成し、これらを InitArray 手続きで初期化している｡
procedure InitArray;
begin
IL.Add(SC_RESTORE); SA.Add('ウィンドウのサイズを元に戻します');
IL.Add(SC_MOVE); SA.Add('ウィンドウを移動します');
IL.Add(SC_SIZE); SA.Add('ウィンドウのサイズを変更します');
IL.Add(SC_MINIMIZE); SA.Add('ウィンドウを最小化します');
IL.Add(SC_MAXIMIZE); SA.Add('ウィンドウを最大化します');
IL.Add(SC_CLOSE); SA.Add('このウィンドウが閉じます');
IL.Add(ID_FILE); SA.Add('編集コマンドです');
IL.Add(ID_HELP); SA.Add('ヘルプ情報です');
IL.Add(ID_OPTION); SA.Add('オプションコマンドです');
IL.Add(ID_EXIT); SA.Add('このプログラムが終了します');
IL.Add(ID_TEST); SA.Add('テストコマンドを実行します');
IL.Add(ID_ABOUT); SA.Add('アバウトウィンドウを表示します');
IL.Add(ID_OPTION1); SA.Add('１番目のオプションコマンドです');
IL.Add(ID_OPTION2); SA.Add('２番目のオプションコマンドです');
end;この手続きにより、メニューＩＤの値とそれに対応する表示文字列が、IL と SA の同じインデックスに格納されていることが分かるだろう｡ つまり、メニューＩＤの値から対応するメニューヘルプに表示する文字列を取得するには、IL のメソッドである Search( ) を使って、インデックスを取得し、そのインデックスをつかって SA の文字列を取得できるわけである｡ 上のリストのはじめの SC_XXX のＩＤの値については､ ２２−３ ウィンドウメニュー のところで説明した｡ メインウィンドウでは、以下のように、４つのメッセージを捕まえて処理している。
with MainWnd do begin
Trap(WM_MENUSELECT,MainMenuSelect);
Trap(WM_ENTERMENULOOP,MainEnterMenuLoop);
Trap(WM_EXITMENULOOP,MainExitMenuLoop);
Trap(WM_CONTEXTMENU,MainContextMenu);
ClientWidth := 360;
ClientHeight := 260;
Center;
end;最初にメニューが選択されると WM_ENTERMENULOOP メッセージが送られてくる。
procedure MainEnterMenuLoop(var Msg:TMessage); begin SB.Simple := true; end;
ここでは、ステータスバーを Simple モードにしているだけだ。メニュー項目の上にマウスカーソルがくると WM_MENUSELECT メッセージが次々に発行される。
procedure MainMenuSelect(var Msg:TMessage);
var
i,ID:integer;
begin
if (Msg.WParamHi and MF_POPUP) <> 0 then
ID := MenuItemID(Msg.LParam,Msg.WParamLo)
else
ID := Msg.WParamLo;
if ID = 0 then exit;
i := IL.Search(ID);
if i <> -1 then
SB.SimpleText := SA[i];
end;ここでは、ポップアップメニュー項目のときは ２２−３ ウィンドウメニュー のところで作成した MenuItemID( ) 関数を使ってＩＤを取得している｡ そして、上で説明したとおり IL の Search( ) メソッドを使ってインデックスを取得し、そのインデックスを使って、ステータスバーに文字列を設定している。右クリックによる WM_CONTEXTMENU メッセージに同期して、ショートカットメニューを表示する。
procedure MainContextMenu(var Msg: TMessage); begin SB.Simple := true; POption.EchoBack(POption.Track(Msg,MainWnd.Handle)); SB.Simple := false; end;
筆者の Windows95 のバージョンでは、このとき WM_ENTERMENULOOP も WM_EXITMENULOOP も送られてこないので、上のコードのようにショートカットメニューを表示する前後でスタータスバーの Simple モードの切り替えを行っている。
メニューループから抜け出ると WM_EXITMENULOOP が送られてくる。
procedure MainExitMenuLoop(var Msg:TMessage); begin SB.Simple := false; end;
ここではステータスバーをステータスモードにしている。
以上のように、本稿では全てのメニュー項目にＩＤを設定することにしているので、WM_MENUSELECT メッセージに同期してメニューＩＤの値を取得できれば、メニューヘルプに表示する文字列を取得するのは簡単である｡
前項のメニューヘルプの機能を実現したコードをまとめて、メニューヘルプを自動的に行うクラスを作成しよう｡ メインウィンドウに送られてくるメニューメッセージを捕まえるために TSubClass から派生すればよいだろう｡ さっそく取りかかることにしよう｡
最初に CmCtrl.pas に TMenuHelp クラスを作成しよう｡ 宣言部を以下に示す｡
//------------------ TMenuHelp ----------------------------------- TMenuHelp = class(TSubClass) private FhStatusBar: HWND; FID: TIntegerList; FSA: TStringArray; function GetNumList:integer; protected procedure InitArray; public constructor Create(hParent: HWND); override; destructor Destroy; override; procedure DefaultHandler(var Message);override; procedure AddList(mID:integer;sStr:string); property hStatusBar:HWND read FhStatusBar write FhStatusBar; property NumList:integer read GetNumList; end;
private 部の最初のフィールドは、ステータスバーのウィンドウハンドルを保持している。次の二つのフィールドは、前項で示したようにメニューＩＤのリストと、それに対応する文字列を保持している｡ public 部の AddList( ) メソッドでメニューＩＤと対応する文字列を追加する。hStatusBar プロパティーは、メニューヘルプを表示するステータスバーのウィンドウハンドルを取得・設定する。NumList プロパティーは、保持しているメニューＩＤ・文字列リストの数を知らせる。実装部を以下に示す｡
//------------------ TMenuHelp -----------------------------------
constructor TMenuHelp.Create(hParent: HWND);
begin
inherited Create(hParent);
FID := TIntegerList.Create(0,0);
FSA := TStringArray.Create;
InitArray;
Dispatcher.TrapMessage(WM_ENTERMENULOOP,self);
Dispatcher.TrapMessage(WM_MENUSELECT,self);
Dispatcher.TrapMessage(WM_EXITMENULOOP,self);
end;
destructor TMenuHelp.Destroy;
begin
FID.Free;
FSA.Free;
inherited Destroy;
end;
procedure TMenuHelp.DefaultHandler(var Message);
var
AMsg:TMessage;
i,ID:integer;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_ENTERMENULOOP:SendMessage(FhStatusBar,SB_SIMPLE,1,0);
WM_EXITMENULOOP:SendMessage(FhStatusBar,SB_SIMPLE,0,0);
WM_MENUSELECT:begin
if (AMsg.WParamHi and MF_POPUP) <> 0 then
ID := MenuItemID(AMsg.LParam,AMsg.WParamLo)
else
ID := AMsg.WParamLo;
if ID = 0 then exit;
i := FID.Search(ID);
if i <> -1 then
SendMessage(FhStatusBar,SB_SETTEXT,255,integer(PChar(FSA[i])));
end;
end;
end;
procedure TMenuHelp.InitArray;
begin
FID.Add(SC_RESTORE); FSA.Add('ウィンドウのサイズを元に戻します');
FID.Add(SC_MOVE); FSA.Add('ウィンドウを移動します');
FID.Add(SC_SIZE); FSA.Add('ウィンドウのサイズを変更します');
FID.Add(SC_MINIMIZE); FSA.Add('ウィンドウを最小化します');
FID.Add(SC_MAXIMIZE); FSA.Add('ウィンドウを最大化します');
FID.Add(SC_CLOSE); FSA.Add('このウィンドウが閉じます');
end;
procedure TMenuHelp.AddList(mID:integer;sStr:string);
begin
FID.Add(mID); FSA.Add(sStr);
end;
function TMenuHelp.GetNumList:integer;
begin
result := FID.Count;
end;コンストラクタでは、初期化処理のあとで Dispatcher の TrapMessage( ) を使って三つのメニュー関連メッセージをこのクラスのインスタンスに送ってくれるようにしている｡ ショートカットメニューについては、これまでと同じスキームで行う｡ InitArray メソッドでは、ウィンドウメニューのうちの幾つかをあらかじめ登録している。DefaultHandler( ) のコードについては、前項のメッセージ処理ハンドラと同じであるので説明しない｡ このクラスには公開されるイベントはない。
このクラスをテストする MenuHelp02.dpr の全リストを以下に示す。
program MenuHelp02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas',
CmCtrl in 'CmCtrl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
MMain: TAMainMenu;
PFile, PHelp, POption: TAPopupMenu;
SB: TAPIStatusbar;
MH:TMenuHelp;
const
ID_EXIT = 200;
ID_TEST = 201;
ID_ABOUT = 202;
ID_OPTION1 = 203;
ID_OPTION2 = 204;
ID_SEP1 = 208;
ID_FILE = 300;
ID_HELP = 301;
ID_OPTION = 302;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure InitMenuHelp;
begin
MH.AddList(ID_FILE,'編集コマンドです');
MH.AddList(ID_HELP,'ヘルプ情報です');
MH.AddList(ID_OPTION,'オプションコマンドです');
MH.AddList(ID_EXIT,'このプログラムが終了します');
MH.AddList(ID_TEST,'テストコマンドを実行します');
MH.AddList(ID_ABOUT,'アバウトウィンドウを表示します');
MH.AddList(ID_OPTION1,'１番目のオプションコマンドです');
MH.AddList(ID_OPTION2,'２番目のオプションコマンドです');
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure MainMenuCommand(var Msg: TMessage);
begin
case Msg.WParamLo of
ID_OPTION1,ID_OPTION2:MessageBeep($FFFFFFFF);
end;
end;
procedure MakeMenu(hParent:HWND);
begin
MMain := MakeMainMenu(hParent,MainMenuCommand);
PFile := MakePopupMenu(hParent,ID_FILE,nil);
PFile.AppendString('E&xit',ID_EXIT);
PFile.AttachMenu(MMain,-1,'&File');
MMain.AppendString('&Test!',ID_TEST);
PHelp := MakePopupMenu(hParent,ID_HELP,nil);
PHelp.AppendString('&About..',ID_ABOUT);
PHelp.AppendSeparator(ID_SEP1);
PHelp.AttachMenu(MMain,-1,'&Help');
POption := MakePopupMenu(hParent,ID_OPTION,nil);
POption.AppendString('Option&1',ID_OPTION1);
POption.AppendString('Option&2',ID_OPTION2);
POption.AttachMenu(PHelp,-1,'&Option');
MMain.SetToParent;
end;
procedure MainContextMenu(var Msg: TMessage);
begin
SB.Simple := true;
POption.EchoBack(POption.Track(Msg,MainWnd.Handle));
SB.Simple := false;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeMenu(hWindow);
SB := CreateStatusBar(hWindow,false);
SB.NumParts := 3;
SB.PartsWidth[0] := 200;
MH := TMenuHelp.Create(hWindow);
MH.hStatusBar := SB.Handle;
InitMenuHelp;
with MainWnd do begin
Trap(WM_CONTEXTMENU,MainContextMenu);
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.MenuHelp02.zip(17.829kB)
実行すると右図のようになる。前項のプログラムと全く同じ動作をする事を確かめてほしい
本章では、Win32 から導入されたコモンコントロールの入門編として、一般的な事項について調べた後、スタータスバーをコードでつくり、そのラッパークラスを作成した｡ スタータスバーやツールバーなどがある時、有効なクライアント領域を求める関数をテストし、そのラッパークラスを作成した｡ また、ステータスバーの応用例としてメニューヘルプの機能を調べ、その機能を包み込んだクラスを作成してテストした｡
本章以降、しばらくのあいだコモンコントロールのいくつかについて調べることにする｡
ここまでのプログラムファイル