前の章へ
| 総目次へ
| 次の章へ 
｜スクロールバーは、これまでのコントロールでもリストボックスやエディットやコンボボックスで部品としてつかわれていた。コントロールの部品としてのスクロールバーは標準スクロールバーと呼ばれている｡ また汎用のウィンドウにも、WS_HSCROLL や WS_VSCROLL のスタイルを指定すると標準スクロールバーを付けて作成することができる｡ 標準スクロールバーは、ＶＣＬの TForm や TScrollBox の部品として使われている TControlScrollBar に相当する｡ 標準スクロールバーとは別に､ 独立した子ウィンドウとしてのスクロールバーコントロールを作ることもできる｡ これは、ＶＣＬ の TScrollBar に相当し、これまでのコントロールと同じように CreateWindow( ) のクラス名として 'SCROLLBAR' を指定して作られる｡ 標準スクロールバーはスクロールバーコントロールとは違って、大きさや位置を指定できなかったり、キーボード入力フォーカスを受け取らないなどの相違点があるが、両者には制御方法やメッセージの種類などの共通する部分も多い｡ この章では､ 標準スクロールバーの使い方を調べることから始め、最終的に両方のスクロールバーのラッパークラスを作ることにしよう｡
| 第１４章 スクロールバー |
| １４−１ 標準スクロールバー |
| １４−２ 標準スクロールバーの制御 |
| １４−３ 標準スクロールバーのラッパークラス |
| １４−４ スクロールバーコントロール |
| １４−５ スクロールバーコントロールクラス |
| １４−６ Colors プログラム |
| １４−７ まとめ |
前の章へ
| 総目次へ
| 次の章へ ｜標準スクロールバーは、独立した子ウィンドウではなく、これまでにもリストボックスや複数行エディットに用いられていたように、ウィンドウの部品として作成される｡ ウィンドウスタイルに WS_HSCROLL や WS_VSCROLL を加えるとウィンドウ作成時に同時作成される｡ これらのウィンドウスタイルを持たないウィンドウにも、後から追加作成することができる。この節では､ 標準スクロールバーを追加作成して、どのように制御するのかを調べよう。
ウィンドウに標準スクロールバーを追加するには、ShowScrollBar( ) を使う｡
function ShowScrollBar(hWnd: HWND;
wBar: Integer;
bShow: BOOL): BOOL; stdcall;hWnd には取り付けるウィンドウのハンドルを、wBar パラメータには､
SB_HORZ = 0; // 標準水平スクロールバーを指定する SB_VERT = 1; // 標準垂直スクロールバーを指定する SB_CTL = 2; // スクロールバーコントロールを指定する SB_BOTH = 3; // 標準スクロールバーの水平・垂直両方
のうちの一つを指定する｡ bShow に true を指定すると可視になる｡ このＡＰＩ は、その名前のとおり標準スクロールバーの可視性も制御する。
標準スクロールバーやスクロールバーコントロールは、これまでのコントロールと違い、親ウィンドウに WM_COMMAND を送らない。そのかわり､ ユーザーがスクロールバーを操作すると WM_HSCROLL か WM_VSCROLL メッセージを送る。Delphi に付属する Win32.hlp でこれらのメッセージを見てみると以下のようになる｡
WM_HSCROLL nScrollCode = (int) LOWORD(wParam); // scroll bar value nPos = (short int) HIWORD(wParam); // scroll box position hwndScrollBar = (HWND) lParam; // handle of scroll bar WM_VSCROLL nScrollCode = (int) LOWORD(wParam); // scroll bar value nPos = (short int) HIWORD(wParam); // scroll box position hwndScrollBar = (HWND) lParam; // handle of scroll bar
両メッセージの hwndScrollBar には、コントロールのときはそのウィンドウハンドル、標準スクロールバーのときはゼロが入っている｡ nPos はこのメッセージが送られた時点でのスクロールボックス（つまみ）の位置が入っている。nScrollCode には、このメッセージを送出した以下のようなユーザーの操作の種類が入っている。
SB_LINEUP = 0; SB_LINELEFT = 0; SB_LINEDOWN = 1; SB_LINERIGHT = 1; SB_PAGEUP = 2; SB_PAGELEFT = 2; SB_PAGEDOWN = 3; SB_PAGERIGHT = 3; SB_THUMBPOSITION = 4; SB_THUMBTRACK = 5; SB_TOP = 6; SB_LEFT = 6; SB_BOTTOM = 7; SB_RIGHT = 7; SB_ENDSCROLL = 8;
スクロールバーの左右端または上下端には三角矢印の付いたボタンがあるが、マウスでこれらのボタンを押すと少しだけ「つまみ」が矢印の方向の動くことは知っているだろう｡ この動作は、上記の SB_LINEXXX に相当する。また、「つまみ」と矢印ボタンの間のバーの部分をクリックすると大きな単位でその方向に動く。この動作が SB_PAGEXXX に相当する｡ マウスを押し続けると SB_LINEXXX や SB_PAGEXXX の通知コードを含む一連のメッセージが送出されるが､ ユーザーがマウスボタンを離すと SB_ENDSCROLL 通知が送られてくる｡ さらにユーザーは「つまみ」をドラグすることもできる。このとき、一連の SB_THUMBTRACK コードを含むメッセージが送られる｡ ドラグを中止するためにマウスボタンを離すと SB_THUMBPOSITION の通知が送られてくる｡ SB_TOP、SB_LEFT、SB_BOTTOM、SB_RIGHT の通知はキーボード入力フォーカスをもつコントロールだけが送ることができる｡
これで、スクロールバーが親コントロールに送るメッセージについては分かった｡ リストボックスなどのコントロールの部品として使われている標準スクロールバーのメッセージ処理は､親ウィンドウであるそのコントロールのウィンドウ関数で処理されるので、プログラマが介入しなくても期待通りの動作をする。しかし、汎用ウィンドウの標準スクロールバーやスクロールバーコントロールは、上記の通知コードを含む WM_HSCROLL や WM_VSCROLL メッセージを処理するコードを書かなくては､ ユーザーは「つまみ」を好きな位置に持ってゆくこともできないのだ。ここまでの知識を試してみよう｡
以下に SScrollBar01.dpr の全リストを示す｡
program SScrollBar01;
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;
Pnl: TAPIPanel;
Btn: TAPIButton;
L1,L2: TAPILabel;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure MainScroll(var Msg:TMessage);
var
nPos,nBar: integer;
hWindow: HWND;
begin
if Msg.LParam <> 0 then exit;
hWindow := MainWnd.Handle;
if Msg.Msg = WM_HSCROLL then nBar:= SB_HORZ else nBar := SB_VERT;
nPos := GetScrollPos(hWindow,nBar);
case Msg.WParamLo of
SB_LINEDOWN: SetScrollPos(hWindow,nBar,nPos+2,true);
SB_LINEUP: SetScrollPos(hWindow,nBar,nPos-2,true);
SB_PAGEDOWN: SetScrollPos(hWindow,nBar,nPos+20,true);
SB_PAGEUP: SetScrollPos(hWindow,nBar,nPos-20,true);
SB_THUMBPOSITION,SB_THUMBTRACK:
SetScrollPos(hWindow,nBar,Msg.WParamHi,true);
end;
if nBar = SB_HORZ then
L2.Text := AIntToStr(GetScrollPos(hWindow,SB_HORZ))
else
L1.Text := AIntToStr(GetScrollPos(hWindow,SB_VERT));
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
Pnl := CreatePanel(hWindow,10,10,200,200);
Pnl.InnerEdge := esSunken;
Btn := CreateButton(Pnl.Handle,30,30,100,100,'Button',nil);
L1 := CreateLabel(hWindow,270,100,60,27,'L1');
L1.TextAlign := DT_RIGHT;
L2 := CreateLabel(hWindow,120,230,60,27,'L2');
L2.TextAlign := DT_RIGHT;
with MainWnd do begin
ClientWidth := 360;
ClientHeight := 280;
Trap(WM_HSCROLL,MainScroll);
Trap(WM_VSCROLL,MainScroll);
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
ShowScrollbar(MainWnd.Handle,SB_BOTH,true);
ShowScrollbar(Pnl.Handle,SB_BOTH,true);
ShowScrollbar(Btn.Handle,SB_BOTH,true);
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.
SScrollBar01.zip(16.134kB)
実行すると、パネルとその上にボタンが作成される。またラベルも二つ作成される｡ Test! メニューをクリックすると、メインウィンドウとパネルとボタンに標準スクロールバーが設置される。このときの様子を右図に示す｡ 最初にボタンやパネルに付けられたスクロールバーを動かしてみよう｡ つまみをドラグしても、ゴムひもを引っ張るみたいにまたもとの位置に戻ってしまうだろう｡ スクロールバーのつまみの位置を制御するためには､ 上記の通知メッセージを処理して、明示的にコードで位置を確定する必要があるのだ｡ これに対し、メッセージを処理しているメインウィンドウに付けられたスクロールバーは、正常に動作し、つまみの位置がラベルに示される｡ 標準スクロールバーのデフォルトのスクロール範囲が０から１００までであることが確かめられる。
コードを見てみよう｡ OnTest( ) ハンドラでは ShowScrollbar( ) を三回使ってメインウィンドウとパネルとボタンに標準スクロールバーを設置している｡ ボタンにスクロールバーを付けても無意味であるが、どんなウィンドウでも設置できることを示したかっただけである｡ 注目すべきは､ 標準スクロールバーの設置の前後で各ウィンドウの物理的サイズは変化せず、クライアント領域がスクロールバーの分だけ自動的に小さくなる事である｡ ボタンやパネルの輪郭からもクライアント領域の変化を見ることができる｡ このように、標準スクロールバーは簡単に設置でき、しかもクライアント領域の変化が自動的に行われるので、用途によってはスクロールバーコントロールより便利である｡ 標準スクロールバーの垂直バーの横幅や水平バーの高さはシステムにより決まっていて､ GetSystemMetrics( ) ＡＰＩを使って得られる｡
function GetSystemMetrics(nIndex: Integer): Integer; stdcall;
この関数の唯一のパラメータに
const
{ GetSystemMetrics() codes }
SM_CXVSCROLL = 2;
SM_CYHSCROLL = 3;を指定すれば、望みの値が返される｡ メインウィンドウでは、Trap( ) メソッドを使って WM_HSCROLL と WM_VSCROLL メッセージを捕捉し、MainScroll( ) ハンドラで処理している｡
procedure MainScroll(var Msg:TMessage);
var
nPos,nBar: integer;
hWindow: HWND;
begin
if Msg.LParam <> 0 then exit;
hWindow := MainWnd.Handle;
if Msg.Msg = WM_HSCROLL then nBar:= SB_HORZ else nBar := SB_VERT;
nPos := GetScrollPos(hWindow,nBar);
case Msg.WParamLo of
SB_LINEDOWN: SetScrollPos(hWindow,nBar,nPos+2,true);
SB_LINEUP: SetScrollPos(hWindow,nBar,nPos-2,true);
SB_PAGEDOWN: SetScrollPos(hWindow,nBar,nPos+20,true);
SB_PAGEUP: SetScrollPos(hWindow,nBar,nPos-20,true);
SB_THUMBPOSITION,SB_THUMBTRACK:
SetScrollPos(hWindow,nBar,Msg.WParamHi,true);
end;
if nBar = SB_HORZ then
L2.Text := AIntToStr(GetScrollPos(hWindow,SB_HORZ))
else
L1.Text := AIntToStr(GetScrollPos(hWindow,SB_VERT));
end;ここでは、メッセージの LParam がゼロであることを確かめて、標準スクロールバーからのメッセージであることを確認している｡ その後、現在のつまみの位置を GetScrollPos( ) ＡＰＩ で取得している｡
function GetScrollPos(hWnd: HWND;
nBar: Integer): Integer; stdcall;hWnd には、スクロールバーコントロールのときはそのハンドルを、標準スクロールバーのときはそのウィンドウのハンドルを、nBar には上記の ShowScrollBar( ) のときの wBar と同じものを指定する｡ この関数の戻り値が現在のつまみの位置である｡ そして、大きな変化では２０単位、小さな単位では２単位だけ位置をずらしてから、つまみを SetScrollPos( ) で設定している｡
function SetScrollPos(hWnd: HWND;
nBar,
nPos: Integer;
bRedraw: BOOL): Integer; stdcall;bRedraw フラグを true に設定すると表示が更新される｡ SB_THUMBPOSITION と SB_THUMBTRACK のときは、そのときのつまみの位置をそのまま設定している｡ 以上のように､ スクロールバーは単なる入力部品であって、ユーザーがスクロールバーを使って入力した結果を反映するために､ 具体的に何をスクロールするのかということはプログラマに任されている｡ スクロールバーの処理コードが難しいという声をよく聞くが、難しいのはスクロールバー自身ではなく、何かをスクロールする処理の実装が難しいのだ｡ ここで見たように、スクロールバー自体は､ 比較的単純な入力装置である｡
前節で表示した標準スクロールバーの制御方法をもう少し調べよう｡ SetScrollRange( ) は、スクロール領域の範囲を指定する。
function SetScrollRange(hWnd: HWND;
nBar,
nMinPos,
nMaxPos: Integer;
bRedraw: BOOL): BOOL; stdcall;hWnd には、コントロールのウィンドウハンドル、標準スクロールバーの場合は親ウィンドウのハンドルを指定する。nBar には、
SB_HORZ = 0; //標準水平スクロールバーを指定する SB_VERT = 1; //標準垂直スクロールバーを指定する SB_CTL = 2; //スクロールバーコントロールを指定する
のうちの一つを指定する。nMinPos と nMaxPos はスクロール範囲の最小・最大値を指定する。bRedraw には、指定変更後に再描画するときは true を指定する｡ なお､標準スクロールバーのデフォルトのスクロール範囲は前節で見たようにゼロから100までである。GetScrollRange( ) は、現在設定されているスクロール領域を取得する。
function GetScrollRange(hWnd: HWND;
nBar: Integer;
var lpMinPos,
lpMaxPos: Integer): BOOL; stdcall;これらのパラメータは、取得範囲を変数渡しすることを除いて、対応する SetScrollRange( )と同じだ｡ 「つまみ」の位置を設定する SetScrollPos( ) ついては、前節で取り上げた。
スクロールバーを使用可・使用不可にするには EnableScrollBar( ) を使う｡
function EnableScrollBar(hWnd: HWND;
wSBflags,
wArrows: UINT): BOOL; stdcall;wSBflags には、
SB_HORZ = 0; //標準水平スクロールバーを指定する SB_VERT = 1; //標準垂直スクロールバーを指定する SB_CTL = 2; //スクロールバーコントロールを指定する SB_BOTH = 3; //標準スクロールバーの水平・垂直両方
のうちの一つを指定する。wArrows には、以下のうちの一つを指定する。
const
{ EnableScrollBar() flags }
ESB_ENABLE_BOTH = 0;
ESB_DISABLE_BOTH = 3;
ESB_DISABLE_LEFT = 1;
ESB_DISABLE_RIGHT = 2;
ESB_DISABLE_UP = 1;
ESB_DISABLE_DOWN = 2;
ESB_DISABLE_LTUP = ESB_DISABLE_LEFT;
ESB_DISABLE_RTDN = ESB_DISABLE_RIGHT;ESB_ENABLE_BOTH と ESB_DISABLE_BOTH 以外は､ どちらか一方向だけ有効･無効にするものだが、この指定によっても無効の方もドラグできたりするので、片方だけの指定はあまり意味が無い｡
より高機能なＡＰＩとして SetScrollInfo( ) と GetScrollInfo( ) がある。
function SetScrollInfo(hWnd: HWND;
BarFlag: Integer;
const ScrollInfo: TScrollInfo;
Redraw: BOOL): Integer; stdcall;
function GetScrollInfo(hWnd: HWND;
BarFlag: Integer;
var ScrollInfo: TScrollInfo): BOOL; stdcall;hWnd には、コントロールのウィンドウハンドル、標準スクロールバーの場合は親ウィンドウのハンドルを指定する。 BarFlag には、以下のものの一つを指定する。
SB_HORZ = 0; //標準水平スクロールバーを指定する SB_VERT = 1; //標準垂直スクロールバーを指定する SB_CTL = 2; //スクロールバーコントロールを指定する
TScrollInfo レコードの定義は以下のようである｡
type
TScrollInfo = packed record
cbSize: UINT; //このレコードのバイトサイズ
fMask: UINT; //取得・設定する値を指定するマスクフラグ
nMin: Integer; //スクロール領域の最小値
nMax: Integer; //スクロール領域の最大値
nPage: UINT; //サム（つまみ）のサイズ
nPos: Integer; //サムの位置
nTrackPos: Integer; //ドラグ中のサムの位置
end;fMask フィールドに指定できる値は､ 以下のものの組み合わせである｡
SIF_RANGE = 1; //スクロール範囲を取得・設定する。nMin と nMax が有効。 SIF_PAGE = 2; //サム（つまみ）の大きさを取得・設定する。nPage が有効。 SIF_POS = 4; //サムの位置を取得・設定する。nPos が有効｡ SIF_DISABLENOSCROLL = 8; //使用禁止を設定する。 SIF_TRACKPOS = $10; //ドラグ中のサム位置を取得する。nTrackPos が有効。 SIF_ALL = (SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS);
SetScrollInfo( ) の Redraw には、設定後に再描画するときは true を指定する。この戻り値は、設定前のサム位置である｡ fMask に指定したフラグによって、対応するフィールドのみ設定・参照する｡ ただし、cbSize フィールドの設定は必須である｡ つまみの大きさは、全スクロール領域に対して現在の表示領域の大きさを反映するように設定する｡
これらの関数を試してみよう。
以下に SScrollBar02.dpr の全リストを示す｡
program SScrollBar02;
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;
fShow: Boolean;
L1,L2: TAPILabel;
LB1: TAPIListBox;
Btn1,Btn2,Btn3,Btn4,Btn5: TAPISpeedBtn;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure MainScroll(var Msg:TMessage);
var
nPos,nBar: integer;
hWindow: HWND;
begin
if Msg.LParam <> 0 then exit;
hWindow := MainWnd.Handle;
if Msg.Msg = WM_HSCROLL then nBar:= SB_HORZ else nBar := SB_VERT;
nPos := GetScrollPos(hWindow,nBar);
case Msg.WParamLo of
SB_LINEDOWN: SetScrollPos(hWindow,nBar,nPos+2,true);
SB_LINEUP: SetScrollPos(hWindow,nBar,nPos-2,true);
SB_PAGEDOWN: SetScrollPos(hWindow,nBar,nPos+20,true);
SB_PAGEUP: SetScrollPos(hWindow,nBar,nPos-20,true);
SB_THUMBPOSITION,SB_THUMBTRACK:
SetScrollPos(hWindow,nBar,Msg.WParamHi,true);
end;
if nBar = SB_HORZ then
L2.Text := AIntToStr(GetScrollPos(hWindow,SB_HORZ))
else
L1.Text := AIntToStr(GetScrollPos(hWindow,SB_VERT));
end;
procedure GetInfoClick(var AMsg: TMessage);
var
si: TScrollInfo;
begin
si.cbSize := SizeOf(si);
si.fMask := SIF_ALL;
GetScrollInfo(MainWnd.Handle,SB_VERT,si);
LB1.Clear;
LB1.AddString('--- Vertical ---');
LB1.AddString(' nMin : '+AIntToStr(si.nMin));
LB1.AddString(' nMax : '+AIntToStr(si.nMax));
LB1.AddString(' nPage : '+AIntToStr(si.nPage));
LB1.AddString(' nPos : '+AIntToStr(si.nPos));
LB1.AddString('nTrackPos : '+AIntToStr(si.nTrackPos));
GetScrollInfo(MainWnd.Handle,SB_HORZ,si);
LB1.AddString(' ');
LB1.AddString('--- Horizontal ---');
LB1.AddString(' nMin : '+AIntToStr(si.nMin));
LB1.AddString(' nMax : '+AIntToStr(si.nMax));
LB1.AddString(' nPage : '+AIntToStr(si.nPage));
LB1.AddString(' nPos : '+AIntToStr(si.nPos));
LB1.AddString('nTrackPos : '+AIntToStr(si.nTrackPos));
end;
procedure EnableClick(var AMsg: TMessage);
begin
if not EnableScrollBar(MainWnd.Handle,SB_BOTH,ESB_DISABLE_BOTH) then
EnableScrollBar(MainWnd.Handle,SB_BOTH,ESB_ENABLE_BOTH);
end;
procedure ShowClick(var AMsg: TMessage);
begin
if fShow then
ShowScrollBar(MainWnd.Handle,SB_BOTH,false)
else
ShowScrollBar(MainWnd.Handle,SB_BOTH,true);
fShow := not fShow;
end;
procedure ClientRectClick(var AMsg: TMessage);
var
r: TRect;
DC: HDC;
SX,SY: integer;
begin
GetClientRect(MainWnd.Handle,r);
LB1.Clear;
LB1.AddString('ClientWidth : '+AIntToStr(r.Right));
LB1.AddString('ClientHeight : '+AIntToStr(r.Bottom));
SX := GetSystemMetrics(SM_CXVSCROLL);
SY := GetSystemMetrics(SM_CYHSCROLL);
LB1.AddString(' ');
LB1.AddString('SX : '+AIntToStr(SX));
LB1.AddString('SY : '+AIntToStr(SY));
InflateRect(r,-5,-5);
DC := GetDC(MainWnd.Handle);
FrameRect(DC,r,GetStockObject(BLACK_BRUSH));
ReleaseDC(MainWnd.Handle,DC);
end;
procedure SetScrollClick(var AMsg: TMessage);
var
si: TScrollInfo;
begin
si.cbSize := SizeOf(si);
si.fMask:= SIF_RANGE or SIF_PAGE or SIF_POS;
si.nMin := 0;
si.nMax := 300;
si.nPage := 50;
si.nPos := 123;
SetScrollInfo(MainWnd.Handle,SB_VERT,si,true);
SetScrollInfo(MainWnd.Handle,SB_HORZ,si,true);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
L1 := Createlabel(hWindow,10,10,100,25,'');
L2 := Createlabel(hWindow,120,10,100,25,'');
LB1 := CreateListBox(hWindow,10,50,210,270,nil);
Btn1 := CreateSpeedBtn(hWindow,240,10,100,40,'GetInfo',GetInfoClick);
Btn2 := CreateSpeedBtn(hWindow,240,60,100,40,'Enable',EnableClick);
Btn3 := CreateSpeedBtn(hWindow,240,110,100,40,'Show',ShowClick);
fShow := true;
Btn4 := CreateSpeedBtn(hWindow,240,160,100,40,'ClientRect',ClientRectClick);
Btn5 := CreateSpeedBtn(hWindow,350,10,100,40,'SetScroll',SetScrollClick);
ShowScrollbar(MainWnd.Handle,SB_BOTH,true);
with MainWnd do begin
ClientWidth := 470;
ClientHeight := 330;
Trap(WM_HSCROLL,MainScroll);
Trap(WM_VSCROLL,MainScroll);
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.SScrollBar02.zip(17.306kB)
以上で完成である｡ コンパイルして実行すると図のようになる｡クライアント領域の右端と下端に標準スクロールバーが作られている｡ また、クライアント領域には、ラベルが３つとリストボックスが１つ、スピードボタンが５つ作られている｡
標準スクロールバーは、MainCreate( ) ハンドラで ShowScrollbar( ) を実行して設置されている｡ 最初に、'GetInfo' ボタンを押すとリストボックスにスクロールバーの情報が表示され、デフォルトのスクロール範囲は､ 大きさに関係なく 0 から 100 に設定されているのを確かめることができる。スクロールバーを操作して「つまみ」の位置を変更するとラベルに現在の位置が表示される｡ スクロールメッセージの処理は、前節のプログラムと同じである｡ 'Enable' ボタンを押すと、両方のスクロールバーの使用可・使用不可がトグルする｡ 使用不可のときに、'GetInfo' を押すと、一部の情報が正しく取得されないことが分かる｡ 'Show' ボタンを押すと、スクロールバーの可視・不可視が交互に切り替わる｡ 'ClientRect' ボタンを押すと、GetClientRect( ) を使ってクライアント領域の幅と高さを取得し、リストボックスに表示される｡ スクロールバーが可視の場合と不可視の場合とでは、GetClientRect( ) で得られる大きさはスクロールボックスの分だけ正しく増減して幅と高さを返してくれることが分かるだろう｡ 可視の場合と不可視の場合とで得られる値の差は、垂直スクロールバーの幅と水平スクロールバーの高さに相当し､ ClientRectClick( ) ハンドラで示したように GetSystemMetrics( ) で標準スクロールバーの幅と高さを取得した値と一致していることが確かめられる｡ 'SetScroll' ボタンを押すと、SetScrollClick( ) ハンドラが実行され、スクロール範囲・つまみのサイズと位置が SetScrollInfo( ) で変更される｡ つぎに 'GetInfo' ボタンをおして、この設定の内容を見ることができる｡
標準スクロールバーは、任意の位置に配置できないことやサイズを変更できないこと、キー入力フォーカスを受け取れないことなどの不便があるが、ウィンドウのサイズを変更しても自動的に右端・下端に張り付くことや可視性の変更によっても GetClientRect( ) が正しくクライアント領域を返すこと、そして何より簡単に作成できることなどのメリットが大きいため、独立した子ウィンドウであるスクロールバーコントロールより頻繁に使われることになるだろう｡ このため、前節で調べたようになまのＡＰＩを使って標準スクロールバーを制御することはできるが、ラッパークラスを作成すればより簡単に制御することができるだろう｡ この節では､ 標準スクロールバーのラッパークラスを作成してテストするプログラムを作ろう｡
標準スクロールバーは、ShowScrollBar( ) を実行して汎用ウィンドウに設置することができる｡ これは、独立した子ウィンドウではない。つまり、これまでに作成したコントロールのラッパークラスと異なり､ このラッパークラスは対応するウィンドウオブジェクトを持たない。したがって、TAPIControl から派生して作ることは適当ではない。しかし、少なくともウィンドウに送られてくる WM_VSCROLL と WM_HSCROLL のメッセージは捕捉しなければならない｡ ここでは、標準垂直スクロールバーのラッパークラス TAPISVScroll は、TSubClass から直接派生することにより、上記のメッセージを捕捉しよう｡ 水平スクロールバーのラッパークラス TAPISHScroll は、TAPISVScroll から派生することにしよう｡ 対応するウィンドウオブジェクトを持たないという意味で､ TGDIObject の派生クラスに似ているので、GDIObject.pas に作成することにする｡
最初に GDIObject.pas に二つのラッパークラスを作成しよう。宣言部は以下のようになる｡
//---------- TAPISVScroll ------------------------------------------- TAPISVScroll = class(TSubClass) private FOnChange: TNotifyMessage; FVorH: integer; FLargeChange: integer; FSmallChange: integer; FEnable: Boolean; FVisible: Boolean; function GetMin: integer; procedure SetMin(AMin: integer); function GetMax: integer; procedure SetMax(AMax: integer); function GetPos: integer; procedure SetPos(APos: integer); function GetThumbSize: integer; procedure SetThumbSize(ASize: integer); procedure SetEnable(value: Boolean); procedure SetVisible(value: Boolean); protected procedure Initialize; virtual; public constructor Create(hParent: HWND); override; procedure DefaultHandler(var Message); override; property Min: integer read GetMin write SetMin; property Max: integer read GetMax write SetMax; property Pos: integer read GetPos write SetPos; property LargeChange: integer read FLargeChange write FLargeChange; property SmallChange: integer read FSmallChange write FSmallChange; property ThumbSize: integer read GetThumbSize write SetThumbSize; property Enable: Boolean read FEnable write SetEnable; property Visible: Boolean read FVisible write SetVisible; property OnChange: TNotifyMessage read FOnChange write FOnChange; end; //---------- TAPISHScroll ------------------------------------------- TAPISHScroll = class(TAPISVScroll) protected procedure Initialize; override; end;
実装部を以下に示す｡
//---------- TAPISVScroll -------------------------------------------
constructor TAPISVScroll.Create(hParent: HWND);
begin
inherited Create(hParent);
Initialize;
if IsWindow(hParent) then
if FVorH = SB_VERT then
Dispatcher.TrapMessage(WM_VSCROLL,self)
else
Dispatcher.TrapMessage(WM_HSCROLL,self);
FLargeChange := 10;
FSmallChange := 1;
FEnable := true;
FVisible := true;
ShowScrollBar(hParent,FVorH,true);
end;
procedure TAPISVScroll.Initialize;
begin
FVorH := SB_VERT;
end;
procedure TAPISVScroll.DefaultHandler(var Message);
var
AMsg: TMessage;
Pos,FSC,FLC: integer;
begin
AMsg := TMessage(message);
if AMsg.LParam <> 0 then exit;
FSC := FSmallChange;
FLC := FLargeChange;
case AMsg.Msg of
WM_VSCROLL,WM_HSCROLL: begin
Pos := GetScrollPos(Parent,FVorH); ;
case AMsg.WParamLo of
SB_LINEDOWN: SetScrollPos(Parent,FVorH,Pos+FSC,true);
SB_LINEUP: SetScrollPos(Parent,FVorH,Pos-FSC,true);
SB_PAGEDOWN: SetScrollPos(Parent,FVorH,Pos+FLC,true);
SB_PAGEUP: SetScrollPos(Parent,FVorH,Pos-FLC,true);
SB_THUMBPOSITION,SB_THUMBTRACK:
SetScrollPos(Parent,FVorH,AMsg.WParamHi,true);
end;
if Assigned(FOnChange) then begin
AMsg.Msg := UINT(self); // Sender
OnChange(AMsg);
end;
end;
end;
end;
function TAPISVScroll.GetMin: integer;
var
AMax: integer;
begin
GetScrollRange(Parent,FVorH,result,AMax);
end;
procedure TAPISVScroll.SetMin(AMin: integer);
begin
SetScrollRange(Parent,FVorH,AMin,Max,true);
end;
function TAPISVScroll.GetMax: integer;
var
AMin: integer;
begin
GetScrollRange(Parent,FVorH,AMin,result);
end;
procedure TAPISVScroll.SetMax(AMax: integer);
begin
SetScrollRange(Parent,FVorH,Min,AMax,true);
end;
function TAPISVScroll.GetPos: integer;
begin
result := GetScrollPos(Parent,FVorH);
end;
procedure TAPISVScroll.SetPos(APos: integer);
var
AMsg: TMessage;
begin
SetScrollPos(Parent,FVorH,APos,true);
AMsg.Msg := WM_VSCROLL;
AMsg.LParam := 0;
AMsg.WParamLo := SB_ENDSCROLL;
Dispatch(AMsg);
end;
function TAPISVScroll.GetThumbSize: integer;
var
si: TScrollInfo;
begin
si.cbSize := SizeOf(si);
si.fMask:= SIF_PAGE;
GetScrollInfo(Parent,FVorH,si);
result := si.nPage;
end;
procedure TAPISVScroll.SetThumbSize(ASize: integer);
var
si: TScrollInfo;
AMsg: TMessage;
begin
si.cbSize := SizeOf(si);
si.fMask:= SIF_PAGE;
si.nPage := ASize;
SetScrollInfo(Parent,FVorH,si,true);
AMsg.Msg := WM_VSCROLL;
AMsg.LParam := 0;
AMsg.WParamLo := SB_ENDSCROLL;
Dispatch(AMsg);
end;
procedure TAPISVScroll.SetEnable(value: Boolean);
begin
if value then
EnableScrollBar(Parent,FVorH,ESB_ENABLE_BOTH)
else
EnableScrollBar(Parent,FVorH,ESB_DISABLE_BOTH);
FEnable := value;
end;
procedure TAPISVScroll.SetVisible(value: Boolean);
begin
if (FVisible <> value) then begin
ShowScrollBar(Parent,FVorH,value);
FVisible := value;
end;
end;
//---------- TAPISHScroll -------------------------------------------
procedure TAPISHScroll.Initialize;
begin
FVorH := SB_HORZ;
end;以上で標準スクロールバーの二つのラッパークラスは完成である。コードを見てみよう｡
TAPISVScroll のコンストラクタ Create( ) では、継承メソッドを呼び出したのち、Initialize メソッドを呼び出して自分が垂直スクロールバーであることを示す SB_VERT を FVorH フィールドに格納している｡ 次に、親ウィンドウが有効であることを確かめてから、WM_VSCROLL または WM_HSCROLL メッセージを送ってくれるように Dispatcher に依頼している｡ その後、プロパティーの初期値を設定してから ShowScrollBar( ) を実行して実際に標準スクロールバーを設置している｡
オーバーライドした DefaultHandler( ) では、これらのメッセージの通知コードにより場合分けし、「つまみ」の位置を適切に設定する｡ ここのコードは､ 前節のメッセージ処理ハンドラとほぼ同じなので理解しやすいだろう｡ 「つまみ」の位置を設定した後、OnChange イベントハンドラを呼び出す｡
スクロール範囲、「つまみ」の位置とサイズ、使用可・不可、可視性、移動量の大きさなどの設定・取得は、対応するプロパティーをアクセスすることで可能にしている。 アクセスメソッドのコードは、前節までに説明したＡＰＩを使っているので、簡単に理解できるだろう｡ 水平スクロールバーのラッパークラスは、TAPISVScroll を継承して Initialize メソッドをオーバーライドし、FVorH フィールドに SB_HORZ を格納しているだけである｡
これらのクラスをテストするプログラムを SScrollBar03.dpr に書く｡ 以下に全リストを示す｡
program SScrollBar03;
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;
SVScroll: TAPISVScroll;
SHScroll: TAPISHScroll;
L1,L2: TAPILabel;
LB1: TAPIListBox;
Btn1,Btn2,Btn3,Btn4: TAPISpeedBtn;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure SVScrollChange(var AMsg: TMessage);
begin
L1.Text := 'VPos = '+ AIntToStr(SVScroll.Pos);
end;
procedure SHScrollChange(var AMsg: TMessage);
begin
L2.Text := 'HPos = '+ AIntToStr(SHScroll.Pos);
end;
procedure GetInfoClick(var AMsg: TMessage);
var
S: TAPISVSCroll;
begin
LB1.Clear;
S := SVSCroll;
LB1.AddString('--- Vertical ---');
LB1.AddString(' nMin : '+AIntToStr(S.Min));
LB1.AddString(' nMax : '+AIntToStr(S.Max));
LB1.AddString(' nPage : '+AIntToStr(S.ThumbSize));
LB1.AddString(' nPos : '+AIntToStr(S.Pos));
LB1.AddString('LargeChange : '+AIntToStr(S.LargeChange));
LB1.AddString('SmallChange : '+AIntToStr(S.SmallChange));
S := SHScroll;
LB1.AddString('--- Horizontal ---');
LB1.AddString(' nMin : '+AIntToStr(S.Min));
LB1.AddString(' nMax : '+AIntToStr(S.Max));
LB1.AddString(' nPage : '+AIntToStr(S.ThumbSize));
LB1.AddString(' nPos : '+AIntToStr(S.Pos));
LB1.AddString('LargeChange : '+AIntToStr(S.LargeChange));
LB1.AddString('SmallChange : '+AIntToStr(S.SmallChange));
end;
procedure EnableClick(var AMsg: TMessage);
begin
SVScroll.Enable := not SVScroll.Enable;
SHScroll.Enable := not SHScroll.Enable;
end;
procedure ShowClick(var AMsg: TMessage);
begin
SVScroll.Visible := not SVScroll.Visible;
SHScroll.Visible := not SHScroll.Visible;
end;
procedure SetScrollClick(var AMsg: TMessage);
begin
with SHScroll do begin
Min := 120;
Max := 330;
Pos := 230;
ThumbSize := 31;
LargeChange := 15;
SmallChange := 2;
end;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
L1 := CreateLabel(hWindow,10,10,100,25,'');
L2 := CreateLabel(hWindow,120,10,100,25,'');
LB1 := CreateListBox(hWindow,10,50,210,270,nil);
Btn1 := CreateSpeedBtn(hWindow,240,10,100,40,'GetInfo',GetInfoClick);
Btn2 := CreateSpeedBtn(hWindow,240,60,100,40,'Enable',EnableClick);
Btn3 := CreateSpeedBtn(hWindow,240,110,100,40,'Show',ShowClick);
Btn4 := CreateSpeedBtn(hWindow,350,10,100,40,'SetScroll',SetScrollClick);
SVScroll := TAPISVScroll.Create(hWindow);
SVScroll.OnChange := SVScrollChange;
SHScroll := TAPISHScroll.Create(hWindow);
SHScroll.OnChange := SHScrollChange;
with MainWnd do begin
ClientWidth := 480;
ClientHeight := 350;
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.SScrollBar03.zip(17.536kB)
以上で完成である。実行すると、右図のようになる｡ 前節のプログラムとほぼ同じ機能であるが メインウィンドウのウィンドウ関数ではスクロール関係のメッセージを捕捉していないこと､ イベントハンドラでは､ ラッパークラスのプロパティーを参照しているのでコードが分かり易く簡単になっていることが分かるだろう。
本節で作成したクラスは、そのインスタンスが対応するウィンドウオブジェクトを生成せず、すでに別の方法で生成したウィンドウオブジェクトの一部の機能を制御するＡＰＩを包み込んだものであるといえる｡ このクラスは、それ自体は不可視であるが制御の対象となる標準スクロールバーは可視であり､ その意味で TGDIObject の派生クラスとも異なっている。 もっぱら制御する機能だけを包み込んだクラスであると見れば､ ＶＣＬの THandleStream クラスと類似している。
スクロールバーコントロールは、標準スクロールバーとは異なり、任意の位置へ任意のサイズで配置できる定義済みの子ウィンドウである｡ またキーボード入力フォーカスを受け取ることができることも大きな違いだ｡ ユーザーからの連続した数値入力のための手段として使うことができるが、Win32 にはこのような使用法に特化したトラックバーコントロールがあるので、スクロールバーコントロールの使用方法は限定的なものになった｡ このコントロールは、他のコントロールと同じように CreateWindow( ) のクラス名に 'SCROLLBAR' を設定して作られる｡ スタイルの設定には以下の定数の幾つかを指定できる｡
{ Scroll Bar Styles }
SBS_HORZ = 0;
SBS_VERT = 1;
SBS_TOPALIGN = 2;
SBS_LEFTALIGN = 2;
SBS_BOTTOMALIGN = 4;
SBS_RIGHTALIGN = 4;
SBS_SIZEBOXTOPLEFTALIGN = 2;
SBS_SIZEBOXBOTTOMRIGHTALIGN = 4;
SBS_SIZEBOX = 8;
SBS_SIZEGRIP = $10;ちなみにＶＣＬの TScrollBar クラスのデフォルトのスタイルは ＄54010000 である。分解すると
デフォルトスタイルが $54010000 WS_CHILD = $40000000 WS_VISIBLE = $10000000 WS_CLIPSIBLINGS = $4000000 WS_TABSTOP = $10000 SBS_HORZ = 0
である。これにならうと水平スクロールバーには SBS_HORZ を、垂直スクロールバーには SBS_VERT を追加するだけで良さそうだ｡ スクロールバーコントロールが認識するメッセージは、Messages.pas に以下のように定義されている｡
const
{ Scroll bar messages }
SBM_SETPOS = 224;
SBM_GETPOS = 225;
SBM_SETRANGE = 226;
SBM_SETRANGEREDRAW = 230;
SBM_GETRANGE = 227;
SBM_ENABLE_ARROWS = 228;
SBM_SETSCROLLINFO = 233;
SBM_GETSCROLLINFO = 234;これらのメッセージを SendMessage( ) で送ってもスクロールバーコントロールを制御することができるが、12-1 節で説明したＡＰＩを使った方が便利である｡ 例えば、
SBM_SETPOS wParam = (WPARAM) nPos; // new position of scroll box lParam = (LPARAM) (BOOL) fRedraw; // redraw flag
を使って、「つまみ」の位置を設定するのに
SendMessage(hVScroll,SBM_SETPOS,50,1);
とするより、
SetScrollPos(hVScroll,SB_CTL,50,true);
とする方が意味が分かりやすいだろう｡ ここでは以後 SBM_ メッセージを使わずに､ 前節までに説明したＡＰＩを使うことにしよう｡ それでは早速、コードでスクロールバーを作ってテストするプログラムを作ろう｡
ScrollBar01.dpr の全リストを以下に示す｡
program ScrollBar01;
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;
fShow: Boolean = true;
L1,L2: TAPILabel;
Btn1,Btn2,Btn3,Btn4: TAPISpeedBtn;
hVScroll, hHScroll: HWND;
VColor: COLORREF = 0;
HColor: COLORREF = 0;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure MakeScrollBar;
var
si: TScrollInfo;
begin
hVScroll := CreateWindow('SCROLLBAR',' ',
$54010001,
280,10,40,260,
MainWnd.Handle,123,hInstance,nil);
SetScrollRange(hVScroll,SB_CTL,0,100,true);
hHScroll := CreateWindow('SCROLLBAR',' ',
$54010000,
10,270,260,40,
MainWnd.Handle,124,hInstance,nil);
SetScrollRange(hHScroll,SB_CTL,0,100,true);
si.cbSize := SizeOf(si);
si.fMask:= SIF_RANGE or SIF_PAGE or SIF_POS;
si.nMin := 0;
si.nMax := 300;
si.nPage := 46;
si.nPos := 123;
SetScrollInfo(hVScroll,SB_CTL,si,true);
SetScrollInfo(hHScroll,SB_CTL,si,true);
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure EnableClick(var AMsg: TMessage);
begin
if not EnableScrollBar(hVScroll,SB_CTL,ESB_DISABLE_BOTH) then
EnableScrollBar(hVScroll,SB_CTL,ESB_ENABLE_BOTH);
if not EnableScrollBar(hHScroll,SB_CTL,ESB_DISABLE_BOTH) then
EnableScrollBar(hHScroll,SB_CTL,ESB_ENABLE_BOTH);
end;
procedure ShowClick(var AMsg: TMessage);
begin
if fShow then begin
ShowScrollBar(hVScroll,SB_CTL,false);
ShowScrollBar(hHScroll,SB_CTL,false);
end else begin
ShowScrollBar(hVScroll,SB_CTL,true);
ShowScrollBar(hHScroll,SB_CTL,true);
end;
fShow := not fShow;
end;
procedure SetColorClick(var AMsg: TMessage);
begin
VColor := clrRed; InvalidateRect(hVScroll,nil,true);
HColor := clrGreen; InvalidateRect(hHScroll,nil,true);
end;
procedure ResetColorClick(var AMsg: TMessage);
begin
VColor := 0; InvalidateRect(hVScroll,nil,true);
HColor := 0; InvalidateRect(hHScroll,nil,true);
end;
procedure MainScroll(var Msg: TMessage);
var
nPos: integer;
AMin,AMax: integer;
begin
if Msg.LParam = 0 then Exit;
nPos := GetScrollPos(Msg.LParam,SB_CTL);
case Msg.WParamLo of
SB_LINEDOWN: SetScrollPos(Msg.LParam,SB_CTL,nPos+2,true);
SB_LINEUP: SetScrollPos(Msg.LParam,SB_CTL,nPos-2,true);
SB_PAGEDOWN: SetScrollPos(Msg.LParam,SB_CTL,nPos+20,true);
SB_PAGEUP: SetScrollPos(Msg.LParam,SB_CTL,nPos-20,true);
SB_THUMBPOSITION,SB_THUMBTRACK:
SetScrollPos(Msg.LParam,SB_CTL,Msg.WParamHi,true);
SB_TOP:begin
GetScrollRange(Msg.LParam,SB_CTL,AMin,AMax);
SetScrollPos(Msg.LParam,SB_CTL,AMin,true);
end;
SB_BOTTOM:begin
GetScrollRange(Msg.LParam,SB_CTL,AMin,AMax);
SetScrollPos(Msg.LParam,SB_CTL,AMax,true);
end;
end;
if Msg.Msg = WM_VSCROLL then
L1.Text := 'VPos = '+ AIntToStr(GetScrollPos(Msg.LParam,SB_CTL))
else
L2.Text := 'HPos = '+ AIntToStr(GetScrollPos(Msg.LParam,SB_CTL));
end;
procedure MainColorScrollBar(var Msg:TMessage);
begin
if Msg.LParam = LPARAM(hVScroll) then
if VColor <> 0 then Msg.Result := CreateSolidBrush(VColor);
if Msg.LParam = LPARAM(hHScroll) then
if HColor <> 0 then Msg.Result := CreateSolidBrush(HColor);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
MakeScrollBar;
L1 := CreateLabel(hWindow,10,10,100,25,'');
L2 := CreateLabel(hWindow,120,10,100,25,'');
Btn1 := CreateSpeedBtn(hWindow,20,50,100,40,'Enable',EnableClick);
Btn2 := CreateSpeedBtn(hWindow,20,100,100,40,'Show',ShowClick);
Btn3 := CreateSpeedBtn(hWindow,20,150,100,40,'SetColor',SetColorClick);
Btn4 := CreateSpeedBtn(hWindow,20,200,100,40,'ResetColor',ResetColorClick);
with MainWnd do begin
ClientWidth := 330;
ClientHeight := 320;
Trap(WM_VSCROLL,MainScroll);
Trap(WM_HSCROLL,MainScroll);
Trap(WM_CTLCOLORSCROLLBAR,MainColorScrollBar);
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.ScrollBar01.zip(15.921kB)
以上で完成だ｡ 実行すると右図のようになる｡ コードを見てみよう｡ MainCreate( ) ハンドラから呼び出される MakeScrollBar では､ CreateWindow( ) を使って、二つのスクロールバーコントロールを作成している｡ 標準スクロールバーとは異なり、スクロールバーコントロールではデフォルトのスクロール範囲はゼロからゼロとなっているので作成直後に SetScrollRange( ) を使ってスクロール範囲を設定している｡ その後、SetScrollInfo( )で範囲とサムの位置と大きさを設定し直している｡ この設定では､ スクロール範囲はゼロから 300-46+1＝255 までである。メインウィンドウの Trap( )で WM_VSCROLL と WM_HSCROLL と WM_CTLCOLORSCROLLBAR を捕捉して、各ハンドラを呼び出している｡ コントロールはキーボード入力フォーカスを受け取れるので、スクロールバーの場合はサム（つまみ）の部分が点滅し、キーボード入力を受け付けるため、これらのハンドラでは SB_TOP と SB_BOTTOM の通知コードも処理している｡このときキーボードから矢印キーや [ Page Up ] キーや [ Page Down ] キー、[ End ] キー、[ Home ] キーの入力に応答することを見ることができる｡ 是非、試してほしい。 このコードも含め､ 各スピードボタンの OnClick 処理ハンドラのコードは、前節までの標準スクロールバーの場合と同じだ｡ ただし、SB_HORZ または SB_VERT と指定していたところを SB_CTL に変更し、親ウィンドウのハンドルの代わりにコントロールのウィンドウハンドルを指定することだけが相違点である｡ WM_CTLCOLORSCROLLBAR メッセージの処理では､ バー部分の色を設定することができる｡
前節でテストしたスクロールバーコントロールのラッパークラスを作ろう｡ 既に標準スクロールバーのラッパークラスを作成したので、コード自体は似たようなものになることが予想できるだろう｡ これまでに作ってきたプッシュボタンやリストボックス・エディットなどのラッパークラスと同じように、TAPIControl から派生することで、自分自身のウィンドウ関数のサブクラス化や、親ウィンドウに送られる WM_HSCROLL と WM_VSCROLL メッセージを捕捉する仕組みが自動的に組み込まれる｡ まず水平スクロールバーコントロールのラッパークラス TAPIHScroll を TAPIControl から派生し、垂直スクロールバーコントロールのクラス TAPIVScroll をそれから派生する事にしよう｡
スクロールバーコントロールのラッパークラスを作成し、テストするプログラムを作る｡
最初に APIControl.pas に TAPIHScroll と TAPIVScroll クラスを作成しよう｡
宣言部を以下に示す｡
//--------- APIHScroll -------------------------------------------- TAPIHScroll = class(TAPIControl) private FLargeChange: integer; FSmallChange: integer; FColor: COLORREF; FOnChange: TNotifyMessage; FOnTrack: TNotifyMessage; function GetMin:integer; procedure SetMin(value:integer); function GetMax:integer; procedure SetMax(value:integer); function GetPosition: integer; procedure SetPosition(value: integer); function GetThumbSize: integer; procedure SetThumbSize(ASize: integer); procedure SetColor(value: COLORREF); protected procedure APICreateParams(var Params: TAPICreateParams); override; procedure Initialize; override; public procedure DefaultHandler(var Message); override; property Min: integer read GetMin write SetMin; property Max: integer read GetMax write SetMax; property Position: integer read GetPosition write SetPosition; property LargeChange: integer read FLargeChange write FLargeChange; property SmallChange: integer read FSmallChange write FSmallChange; property ThumbSize: integer read GetThumbSize write SetThumbSize; property Color: COLORREF read FColor write SetColor; property OnChange: TNotifyMessage read FOnChange write FOnChange; property OnTrack: TNotifyMessage read FOnTrack write FOnTrack; end; //--------- APIVScroll -------------------------------------------- TAPIVScroll = class(TAPIHScroll) protected procedure APICreateParams(var Params: TAPICreateParams); override; end;
実装部を以下に示す｡
//--------- APIHScroll --------------------------------------------
procedure TAPIHScroll.Initialize;
begin
inherited Initialize;
SetScrollrange(FHandle,SB_CTL,0,100,true);;// default range 0-100
FLargeChange := 10;
FSmallChange := 1;
Dispatcher.TrapMessage(WM_HSCROLL,self);
Dispatcher.TrapMessage(WM_VSCROLL,self);
Dispatcher.TrapMessage(WM_CTLCOLORSCROLLBAR,self);
end;
procedure TAPIHScroll.APICreateParams(var Params: TAPICreateParams);
begin
with Params do begin
Caption := '';
Style := $54010000;
ExStyle := 0;
X := 50;
Y := 50;
Width := 150;
Height := 32;
WinClassName := 'SCROLLBAR';
end;
end;
procedure TAPIHScroll.DefaultHandler(var Message);
var
AMsg: TMessage;
ScrPos: integer;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_HSCROLL,WM_VSCROLL: begin
if (AMsg.LParam <> LPARAM(FHandle)) then exit;
ScrPos := GetScrollPos(FHandle,SB_CTL);
case AMsg.WParamLo of
SB_THUMBPOSITION: begin
SetScrollPos(FHandle,SB_CTL,AMsg.WParamHi,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_LINERIGHT: begin
SetScrollPos(FHandle,SB_CTL,ScrPos+FSmallChange,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_LINELEFT: begin
SetScrollPos(FHandle,SB_CTL,ScrPos-FSmallChange,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_PAGERIGHT: begin
SetScrollPos(FHandle,SB_CTL,ScrPos+FLargeChange,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_PAGELEFT: begin
SetScrollPos(FHandle,SB_CTL,ScrPos-FLargeChange,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_THUMBTRACK: begin
SetScrollPos(FHandle,SB_CTL,AMsg.WParamHi,true);
if Assigned(FOnTrack) then OnTrack(AMsg);
end;
SB_LEFT: begin
SetScrollPos(FHandle,SB_CTL,Min,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_RIGHT: begin
SetScrollPos(FHandle,SB_CTL,Max,true);
if Assigned(FOnChange) then OnChange(AMsg);
end;
SB_ENDSCROLL: if Assigned(FOnChange) then OnChange(AMsg);
end; // case
end;
WM_CTLCOLORSCROLLBAR: if AMsg.LParam = LPARAM(FHandle) then
if FColor <> 0 then TMessage(Message).Result := CreateSolidBrush(FColor);
end;
end;
function TAPIHScroll.GetMin:integer;
var
AMax:integer;
begin
GetScrollRange(FHandle,SB_CTL,result,AMax);
end;
procedure TAPIHScroll.SetMin(value:integer);
begin
SetScrollrange(FHandle,SB_CTL,value,Max,true);
end;
function TAPIHScroll.GetMax:integer;
var
AMin:integer;
begin
GetScrollRange(FHandle,SB_CTL,AMin,result);
end;
procedure TAPIHScroll.SetMax(value:integer);
begin
SetScrollrange(FHandle,SB_CTL,Min,value,true);
end;
function TAPIHScroll.GetPosition: integer;
begin
result := GetScrollPos(FHandle,SB_CTL);
end;
procedure TAPIHScroll.SetPosition(value: integer);
var
AMsg: TMessage;
begin
with AMsg do begin
Msg := WM_HSCROLL;
WParamHi := value;
Result := 0;
LParam := FHandle;
WParamLo := SB_THUMBPOSITION;
end;
Dispatch(AMsg);
end;
function TAPIHScroll.GetThumbSize: integer;
var
si: TScrollInfo;
begin
si.cbSize := SizeOf(si);
si.fMask:= SIF_PAGE;
GetScrollInfo(FHandle,SB_CTL,si);
result := si.nPage;
end;
procedure TAPIHScroll.SetThumbSize(ASize: integer);
var
si: TScrollInfo;
begin
si.cbSize := SizeOf(si);
si.fMask:= SIF_PAGE;
si.nPage := ASize;
SetScrollInfo(FHandle,SB_CTL,si,true);
end;
procedure TAPIHScroll.SetColor(value: COLORREF);
begin
if FColor <> value then begin
FColor := value;
InvalidateRect(FHandle,nil,true);
end;
end;
//--------- APIVScroll --------------------------------------------
procedure TAPIVScroll.APICreateParams(var Params: TAPICreateParams);
begin
inherited APICreateParams(Params);
with Params do begin
Style := $54010001;
end;
end;これで完成である｡ コードを調べよう｡ TAPIHScroll では、APICreateParams( ) をオーバーライドして、クラス名を 'SCROLLBAR' に設定し､ ウィンドウスタイルにＶＣＬの TScrollBar クラスのスタイルと同じ ＄54010000 を設定して子ウィンドウを作成する｡ コンストラクタから最後に呼び出される Initialize メソッドもオーバーライドして、デフォルトのスクロール範囲を 0-100 、LargeChange を 10 、 SmallChange を 1 に設定している｡ スクロールバーメッセージを DefaultHandler( ) で処理して、イベントハンドラを呼び出している｡ SB_LEFT と SB_RIGHT 通知コードは、前節で処理した SB_TOP と SB_BOTTOM と同じものである｡ 各プロパティーのアクセスメソッドのコードは、前節のコードや標準スクロールバーのラッパークラスを作った時とほぼ同じである。TAPIVScroll は TAPIHScroll から派生して、オーバーライドした APICreateParams( ) で ウィンドウスタイルを垂直スクロールバーにしているだけだ｡
次に、インスタンス作成関数を APIContorl.pas に作ろう。宣言部は、
function CreateHScroll(hParent: HWND; x,y,cx,cy: integer;
sOnTrackChange:TNotifyMessage): TAPIHScroll;
function CreateVScroll(hParent: HWND; x,y,cx,cy: integer;
sOnTrackChange:TNotifyMessage): TAPIVScroll;であり、実装部は、以下のようになる。
function CreateHScroll(hParent: HWND; x,y,cx,cy: integer;
sOnTrackChange:TNotifyMessage): TAPIHScroll;
begin
result := TAPIHScroll.Create(hParent);
with result do begin
Dimension := SetDim(x,y,cx,cy);
OnChange := sOnTrackChange;
OnTrack := sOnTrackChange;
end;
end;
function CreateVScroll(hParent: HWND; x,y,cx,cy: integer;
sOnTrackChange:TNotifyMessage): TAPIVScroll;
begin
result := TAPIVScroll.Create(hParent);
with result do begin
Dimension := SetDim(x,y,cx,cy);
OnChange := sOnTrackChange;
OnTrack := sOnTrackChange;
end;
end;作成したスクロールバーコントロールのラッパークラスをテストするプログラムを ScrollBar02.dpr に書こう｡ 以下に全リストを示す｡
program ScrollBar02;
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;
L1,L2: TAPILabel;
Btn1,Btn2,Btn3,Btn4: TAPISpeedBtn;
VScroll: TAPIVScroll;
HScroll: TAPIHScroll;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure VScrollChange(var AMsg: TMessage);
begin
L1.Text := 'VPos = '+ AIntToStr(VScroll.Position);
end;
procedure HScrollChange(var AMsg: TMessage);
begin
L2.Text := 'HPos = '+ AIntToStr(HScroll.Position);
end;
procedure EnableClick(var AMsg: TMessage);
begin
VScroll.Enable := not VScroll.Enable;
HScroll.Enable := not HScroll.Enable;
end;
procedure ShowClick(var AMsg: TMessage);
begin
VScroll.Visible := not VScroll.Visible;
HScroll.Visible := not HScroll.Visible;
end;
procedure SetColorClick(var AMsg: TMessage);
begin
VScroll.Color := clrRed; InvalidateRect(VScroll.Handle,nil,true);
HScroll.Color := clrGreen; InvalidateRect(HScroll.Handle,nil,true);
end;
procedure ResetColorClick(var AMsg: TMessage);
begin
VScroll.Color := 0; InvalidateRect(VScroll.Handle,nil,true);
HScroll.Color := 0; InvalidateRect(HScroll.Handle,nil,true);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
VScroll := CreateVScroll(hWindow,280,10,40,260,VScrollChange);
with VScroll do begin
Max := 300;
LargeChange := 20;
ThumbSize := 46;
end;
HScroll := CreateHScroll(hWindow,10,270,260,40,HScrollChange);
with HScroll do begin
Max := 300;
LargeChange := 20;
ThumbSize := 46;
end;
L1 := CreateLabel(hWindow,10,10,100,25,'');
L2 := CreateLabel(hWindow,120,10,100,25,'');
Btn1 := CreateSpeedBtn(hWindow,20,50,100,40,'Enable',EnableClick);
Btn2 := CreateSpeedBtn(hWindow,20,100,100,40,'Show',ShowClick);
Btn3 := CreateSpeedBtn(hWindow,20,150,100,40,'SetColor',SetColorClick);
Btn4 := CreateSpeedBtn(hWindow,20,200,100,40,'ResetColor',ResetColorClick);
with MainWnd do begin
ClientWidth := 330;
ClientHeight := 320;
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.Scrollbar02.zip(16.897kB)
以上で完成である｡ 実行すると右図のようになる｡ これは、ほとんど前節のコードでスクロールバーコントロールを作ったときと同じ動作をする｡ しかし、ラッパークラスを作成したおかげでメインウィンドウ関数でのメッセージ処理がなくなり、さらにボタンを押したときの処理コードが非常に簡単になっていることが理解できるだろう｡
スクロールバーコントロールの使用例として、右図のように色を指定する数値入力部品としての例を示す｡ 前にも述べたように、Win32 の色指定の変数の標準の型は COLORREF であり、単なる３２ビットの整数である｡ RGB( ) 関数を使えば、赤・緑・青の各明度を 0-255 の段階で指定できる｡ 三つの水平スクロールバーコントロールを使って、この三原色の明度を指定するのがこのプログラムのただ一つの機能である｡ 結果の色は下の正方形のラベルの背景色として表示される｡ このラベルの右側には、三つのエディットに、それぞれ RGB( )関数と COLORREF 型と ＨＴＭＬの色指定方式のテキスト表示があり、その横のスピードボタンを押すとクリップボード経由でコードエディタなどに貼り付けることができる｡ 似たようなプログラムをＣ言語でつくり、その著書に示した Petzolt 氏に敬意を表して Colors プログラムと呼ぶことにしよう｡ ここでは、前節までに作ったラッパークラスを使用するので、コードは原著のものより大幅に簡単化することができる｡ それでは早速作ることにしよう｡
以下に、Colors.dpr の全リストを示す｡
program Colors;
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;
SBH1,SBH2,SBH3: TAPIHScroll;
L1,L2,L3,L4: TAPILabel;
Btn1,Btn2,Btn3: TAPISpeedBtn;
Ed1,Ed2,Ed3: TAPIEdit;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure DisplayColor;
var
r,g,b: integer;
begin
r := SBH1.Position;
g := SBH2.Position;
b := SBH3.Position;
L4.Color := RGB(r,g,b);
Ed1.Text := 'RGB('+AIntToStr(r)+','+AIntToStr(g)+','+AIntToStr(b)+')';
Ed2.Text := '$'+AIntToHex(b,2)+AIntToHex(g,2)+AIntToHex(r,2);
Ed3.Text := '#'+AIntToHex(r,2)+AIntToHex(g,2)+AIntToHex(b,2);
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure SBH1Change(var Msg:TMessage);
begin
L1.Text := AIntToStr(SBH1.Position);
DisplayColor;
end;
procedure SBH2Change(var Msg:TMessage);
begin
L2.Text := AIntToStr(SBH2.Position);
DisplayColor;
end;
procedure SBH3Change(var Msg:TMessage);
begin
L3.Text := AIntToStr(SBH3.Position);
DisplayColor;
end;
procedure Btn1Click(var Msg:TMessage);
begin
Ed1.SelectAll;
Ed1.Copy;
end;
procedure Btn2Click(var Msg:TMessage);
begin
Ed2.SelectAll;
Ed2.Copy;
end;
procedure Btn3Click(var Msg:TMessage);
begin
Ed3.SelectAll;
Ed3.Copy;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
SBH1 := CreateHScroll(hWindow,10,10,350,30,SBH1Change);
with SBH1 do begin
Color := clrRed;
Max := 300;
ThumbSize := 46;
end;
SBH2 := CreateHScroll(hWindow,10,50,350,30,SBH2Change);
with SBH2 do begin
Color := clrGreen;
Max := 300;
ThumbSize := 46;
end;
SBH3 := CreateHScroll(hWindow,10,90,350,30,SBH3Change);
with SBH3 do begin
Color := clrBlue;
Max := 300;
ThumbSize := 46;
end;
L1 := CreateLabel(hWindow,370,12,50,24,'0');
L1.TextAlign := DT_CENTER;
L2 := CreateLabel(hWindow,370,52,50,24,'0');
L2.TextAlign := DT_CENTER;
L3 := CreateLabel(hWindow,370,92,50,24,'0');
L3.TextAlign := DT_CENTER;
L4 := CreateLabel(hWindow,10,130,160,160,'');
with L4 do begin
Color := clrBlack;
DrawFrame := true;
end;
Ed1 := CreateEdit(hWindow,180,170,150,30,'RGB(0,0,0)',nil);
Ed2 := CreateEdit(hWindow,180,210,150,30,'$000000',nil);
Ed3 := CreateEdit(hWindow,180,250,150,30,'#000000',nil);
Btn1 := CreateSpeedBtn(hWindow,340,170,80,30,'Copy',Btn1Click);
Btn2 := CreateSpeedBtn(hWindow,340,210,80,30,'Copy',Btn2Click);
Btn3 := CreateSpeedBtn(hWindow,340,250,80,30,'Copy',Btn3Click);
with MainWnd do begin
ClientWidth := 430;
ClientHeight := 300;
Center;
end;
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;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.Colors.zip(17.239kB)以上で完成である。スクロールバーのつまみを動かすと正方形の領域の色が連続的に変化するのが確かめられる｡ 対応する明度は、右の三つのラベルに値が表示される｡ コードを見てみよう｡
MainCreate( ) ハンドラでは､ 三つの水平スクロールバーコントロールと四つのラベル、三つのエディットコントロール、三つのスピードボタンを作成している｡ 四つ目のテキストを持たない正方形のラベルは、作成した色の表示に用いられる｡ 各スクロールバーのイベントハンドラでは､ つまみの位置を対応するラベルに表示してから、大きなラベルの背景色を設定し、エディットに対応する色のテキストを設定している。Copy ボタンを押すとエディットのメソッドを使ってそれらのテキストがクリップボードにコピーされる。
本章では､ 汎用ウィンドウの右側と下方に表示される標準スクロールバーと、スクロールバーコントロールの作成や表示、制御方法などを調べた。まず、コードで作成・表示し、ＡＰＩ関数で制御する方法を調べた｡ 次に、それぞれのラッパークラスを作成し、テストした｡ 最後に、色の入力を補助する Colors プログラムを作成した｡
スクロールバーそのものの作成や制御方法は、他のコントロールと比較しても比較的簡単である事が分かっただろう。難しいのは、スクロールバーのメッセージにしたがって何をどのようにしてスクロールするのか、とういう点である。本章では､ この点については具体例を挙げて説明していないが、後の章で、幾つかの例を示すことにする｡
ここまでのプログラムファイル