前の章へ| 総目次へ
| 次の章へ 
｜前章の最後の節で少しふれたが、VCL のコンポーネントでも標準スクロールバーを表示するものはたくさんある。TListBox、TMemo、TRichEdit、TTreeView、TListView、TStringGrid、TScrollBox、などのコントロールのほか、TForm も標準スクロールバーを表示する。どれも非常によく使用されるコンポーネントである。標準スクロールバーは、システムが全面的にサポートしている入力専用ＵＩであり、各コントロールは、スクロールメッセージをウィンドウ関数で受け取って、そのコントロール特有のスクロール処理をする。そこにユーザが介在する必要はないが、それでも、コードでスクロールを制御したり、スクロールのときのタイミングがほしいときがあるだろう。ところが、VCL ではスクロールに関するイベントもスクロールを制御するメソッドもほとんどない。この章では、標準スクロールバーを通してユーザがコントロールに送るメッセージを調べることからはじめ、スクロールに関する一般論を列挙して、それをコードで制御する方法を試してみよう。そして、いくつかのコントロールについて、各々のコントロール特有のスクロール動作を調べてみよう。これは、API のところの 第１４章 スクロールバー と重複している部分も多いが、各コントロールに特有のスクロール動作に特に注目してみることにする。
| 第３章 コントロールのメッセージ処理（その２） |
| ３−１ スクロールメッセージを調べる |
| ３−２ コードでスクロールさせる |
| ３−３ 標準スクロールバーを調べる |
| ３−４ TMemo のスクロールメッセージ |
| ３−５ TMemo をコードでスクロールする |
| ３−６ コントロール間のスクロールの同期 |
| ３−７ まとめ |
前の章へ| 総目次へ
| 次の章へ ｜前章の最後の節ではフォームについてスクロールメッセージを調べた。ここでは、もっとも汎用的なウィンドウの例として TScrollBox のスクロールメッセージを調べよう。スクロールメッセージ自体は、どのウィンドウに対しても同じであるのでどのコントロールでも共通である。重複するが WM_VSCROLL と WM_HSCROLL メッセージは Messages.pas で以下のように定義されている。
WM_HSCROLL = $0114; WM_VSCROLL = $0115;
これらの内容は API のヘルプによれば
WM_VSCROLL nScrollCode = (int) LOWORD(wParam); // scroll bar value nPos = (short int) HIWORD(wParam); // scroll box position hwndScrollBar = (HWND) lParam; // handle of scroll bar WM_HSCROLL nScrollCode = (int) LOWORD(wParam); // scroll bar value nPos = (short int) HIWORD(wParam); // scroll box position hwndScrollBar = (HWND) lParam; // handle of scroll bar
となっている。ｗParam の下位ワードには、どのようなスクロール動作が起こったのかを識別する nScrollCode が入っている。Windows.pas には以下のような宣言がある。
{ Scroll Bar Commands }
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;
この節では、どのようなときにこの nScrollCode が送られてくるのかを詳しく調べてみる。wParam の上位ワードには、nScrollCode が SB_THUMBTRACK と SB_THUMBPOSITION のときには、スクロールバーのつまみ (Thumb) の位置が入っている。それ以外のときはゼロが入っている。lParam には、標準スクロールバーの場合はゼロが入っている。それではさっそく調べてみよう。右図のように Memo1 と ScrollBox1 とその中に Label1 を配置する。
そして、以下のようにコードを書く。
List 1
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Label1: TLabel;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
OriginalProc:TWndMethod;
procedure SubclassProc(var Msg:TMessage);
procedure ScrollBox1VScroll(var Msg:TWMScroll);
procedure ScrollBox1HScroll(var Msg:TWMScroll);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.ScrollBars := ssVertical;
Label1.Left := 1000;
Label1.Top := 1000;
OriginalProc := ScrollBox1.WindowProc;
ScrollBox1.WindowProc := SubclassProc;
end;
procedure TForm1.ScrollBox1HScroll(var Msg: TWMScroll);
var
s:string;
begin
inherited;
case Msg.ScrollCode of
SB_LINELEFT :s := 'LINELEFT';
SB_LINERIGHT :s := 'LINERIGHT';
SB_PAGELEFT :s := 'PAGELEFT';
SB_PAGERIGHT :s := 'PAGERIGHT';
SB_THUMBPOSITION :s := 'THUMBPOSITION';
SB_THUMBTRACK :s := 'THUMBTRACK';
SB_LEFT :s := 'LEFT';
SB_RIGHT :s := 'RIGHT';
SB_ENDSCROLL :s := 'ENDSCROLL';
else
s := 'UNKNOWN';
end;
Memo1.Lines.Add(Format('%s : Pos = %d',[s,Msg.Pos]));
end;
procedure TForm1.ScrollBox1VScroll(var Msg: TWMScroll);
var
s:string;
begin
inherited;
case Msg.ScrollCode of
SB_LINEUP :s := 'LINEUP';
SB_LINEDOWN :s := 'LINEDOWN';
SB_PAGEUP :s := 'PAGEUP';
SB_PAGEDOWN :s := 'PAGEDOWN';
SB_THUMBPOSITION :s := 'THUMBPOSITION';
SB_THUMBTRACK :s := 'THUMBTRACK';
SB_TOP :s := 'TOP';
SB_BOTTOM :s := 'BOTTOM';
SB_ENDSCROLL :s := 'ENDSCROLL';
else
s := 'UNKNOWN';
end;
Memo1.Lines.Add(Format('%s : Pos = %d',[s,Msg.Pos]));
end;
procedure TForm1.SubclassProc(var Msg: TMessage);
begin
OriginalProc(Msg);
case Msg.Msg of
WM_VSCROLL:ScrollBox1VScroll(TWMScroll(Msg));
WM_HSCROLL:ScrollBox1HScroll(TWMScroll(Msg));
end;
end;
end.
まず、FormCreate では、Memo1 に垂直スクロールバーを表示するようにし、Label1 の位置を変更して ScrollBox1 がスクロールバーを表示するようにする。それから、ScrollBox1 を前章でやったように「サブクラス化」する。
procedure TForm1.FormCreate(Sender: TObject); begin Memo1.ScrollBars := ssVertical; Label1.Left := 1000; Label1.Top := 1000; OriginalProc := ScrollBox1.WindowProc; ScrollBox1.WindowProc := SubclassProc; end;
そして、入れ替えた WindowProc では、まずもとのそれを実行してから WM_VSCROLL と WM_HSCROLL メッセージを捕まえて処理関数に渡している。
procedure TForm1.SubclassProc(var Msg: TMessage);
begin
OriginalProc(Msg);
case Msg.Msg of
WM_VSCROLL:ScrollBox1VScroll(TWMScroll(Msg));
WM_HSCROLL:ScrollBox1HScroll(TWMScroll(Msg));
end;
end;
それぞれの処理関数では、Msg.ScrollCode で分岐して Memo1 にその内容を表示する。それでは具体的にやってみよう。
まず最初に、スクロールバーの上下左右に表示される三角印のボタンを押してみよう。垂直スクロールバーの場合は、下向きと上向きを一回ずつ押すと右図のようになるだろう。このように、三角印のボタンを押すと Msg.ScrollCode が SB_LINEXXXX となっているメッセージが送られてきて、つぎに SB_ENDSCROLL が送られてきて、その結果最小のスクロール処理が行われる。
つぎに、つまみと三角印ボタンの間のシャフトの部分をクリックすると右図のようになって、表示されている領域の次の領域が見えるようにスクロールされる。このスクロール動作は、Msg.ScrollCode が SB_PAGEXXX に対応して行われる。最後に SB_ENDSCROLL が送られてくる。
最後につまみをマウスでドラグして任意の位置にもっていってみよう。右図のように、ドラグ中は複数の SB_THUMBTRACK が送られ、マウスを離すと SB_THUMBPOSITION が一回だけ送られ、最後に SB_ENDSCROLL が送られてくる。確かにヘルプにあったとおり、SB_THUMBTRACK と SB_THUMBPOSITION のときは Pos の値が有効になっているのが分かるだろう。
以上のように、ユーザが標準スクロールバーを使ってスクロール動作をするとき、WM_VSCROLL または WM_HSCROLL メッセージが対象となるコントロールのウィンドウ関数に送られ、それに応答してウィンドウ関数がスクロール動作をしているのが分かっただろう。もし、上記のメッセージを捕まえてスクロールイベントとして公開するときは、Msg.ScrollCode が SB_ENDSCROLL のときだけで十分であることも分かった。
つけたしだが、筆者の環境では、上記のプログラム実行中にマウスホイールを最小の単位で動かすと、右図のように WM_VSCROLL が送られてきて、SB_LINEUP または SB_LINEDOWN と SB_ENDSCROLL のペアが３回続けて送られてくる。したがってこの場合もイベントに応答できるが、SB_ENDSCROLL が３回送られてくるので３回イベントが起こることになる。
ここ で議論した結果、筆者のアダプタを介して PS/2 端子に接続している USB マウスの場合、上記のように、本来 WM_MOUSEWHEEL が送られてくるところが、WM_VSCROLL の置き換わっていることが判明した。TScrollBox をマウスホイールでスクロールするためには、OnMouseWheel OnMouseWheelDown OnMouseWheelUp イベントに明示的にコードを書かないといけないようである。
前節では、ユーザが標準スクロールバーを操作するとどんなメッセージがコントロールに届くかを調べた。コントロールのウィンドウ関数はこれらのメッセージに従ってスクロール処理をしているわけである。したがって、スクロールバーを操作するかわりに、コードでそれと同じメッセージをコントロールに送ってやれば、ウィンドウ関数が応答してスクロール処理をしてくれるはずである。この節では、このことを具体的に試してみよう。
試すためのプログラムは右図のようにして前節と同じである。違いは Button1 から Button4 までの４つのボタンが追加されているだけである。この OnClick イベントハンドラにコードを書いて、ScrollBox1 にメッセージを送ってスクロール処理をさせてみよう。
前節のプログラムに追加した部分を以下に示す。
List 2
procedure ScrollLineDown(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_LINEDOWN,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollLineUp(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_LINEUP,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollLineRight(WC:TWinControl); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_LINERIGHT,0),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollLineLeft(WC:TWinControl); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_LINELEFT,0),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollPageDown(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_PAGEDOWN,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollPageUp(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_PAGEUP,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollPageRight(WC:TWinControl); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_PAGERIGHT,0),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollPageLeft(WC:TWinControl); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_PAGELEFT,0),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure TForm1.Button1Click(Sender: TObject); begin ScrollLineDown(ScrollBox1); ScrollLineRight(ScrollBox1); end; procedure TForm1.Button2Click(Sender: TObject); begin ScrollLineUp(ScrollBox1); ScrollLineLeft(ScrollBox1); end; procedure TForm1.Button3Click(Sender: TObject); begin ScrollPageDown(ScrollBox1); ScrollPageRight(ScrollBox1); end; procedure TForm1.Button4Click(Sender: TObject); begin ScrollPageUp(ScrollBox1); ScrollPageLeft(ScrollBox1); end;
ここでは、コードでスクロールさせるために SB_LINEXXX と SB_PAGEXXX に相当するスクロールメッセージを TWinControl に送るために８個の関数を作成した。そして、ボタンの OnClick イベントハンドラでそれを試している。右図のように、各関数は期待通りに動作することが確かめられる。
関数は、前節で調べたメッセージと全くおなじメッセージを送っている。
procedure ScrollLineDown(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_LINEDOWN,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end;
このように、WM_VSCROLL メッセージで wParam の下位ワードに nScrollCode を設定して TWinCotrol の Perform() メソッドでウィンドウ関数に送っている。もちろん、SendMessage() API を使っても同じことができる。スクロールメッセージの最後は、必ず SB_ENDSCROLL コードを送るようにすると、スクロールバー操作からのメッセージと互換性がある動作を期待することができる。以下同様である。
もうすこし別な関数もつくってみよう。
List 3
procedure ScrollVPos(WC:TWinControl;Pos:integer); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_THUMBPOSITION,Pos),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollHPos(WC:TWinControl;Pos:integer); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_THUMBPOSITION,Pos),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollBottom(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_BOTTOM,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollTop(WC:TWinControl); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_TOP,0),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollRight(WC:TWinControl); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_RIGHT,0),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollLeft(WC:TWinControl); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_LEFT,0),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure TForm1.Button1Click(Sender: TObject); begin ScrollVPos(ScrollBox1,500); ScrollHPos(ScrollBox1,500); end; procedure TForm1.Button2Click(Sender: TObject); begin ScrollVPos(ScrollBox1,0); ScrollHPos(ScrollBox1,0); end; procedure TForm1.Button3Click(Sender: TObject); begin ScrollBottom(ScrollBox1); ScrollRight(ScrollBox1); end; procedure TForm1.Button4Click(Sender: TObject); begin ScrollTop(ScrollBox1); ScrollLeft(ScrollBox1); end;
ここでは、任意の位置にスクロールさせるのと、スクロール範囲の最初と最後にコードでスクロールする関数を試している。実行時の様子は右図のようになる。
前節でつまみをマウスでドラグしたときのメッセージを参考にして、任意の位置にスクロールする関数を作ってみた。
procedure ScrollVPos(WC:TWinControl;Pos:integer); begin WC.Perform(WM_VSCROLL,MakeWParam(SB_THUMBPOSITION,Pos),0); WC.Perform(WM_VSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end; procedure ScrollHPos(WC:TWinControl;Pos:integer); begin WC.Perform(WM_HSCROLL,MakeWParam(SB_THUMBPOSITION,Pos),0); WC.Perform(WM_HSCROLL,MakeWParam(SB_ENDSCROLL,0),0); end;
いろいろ試してみると、SB_THUMBTRACK 部分のメッセージは必要なく、SB_THUMBPOSITION と SB_ENDSCROLL だけで十分なようである。また、スクロール範囲の末尾にスクロールするには SB_BOTTOM または SB_RIGHT を、先頭にスクロールするためには SB_TOP または SB_LEFT のコードを送ればよいことも確認できただろう。
以上でコードでスクロールするための一般論は終わるが、各コントロールには、そのコントロール特有のスクロールメッセージがあることもあるので、その場合はそちらを優先して使った方がよいだろう。詳細は、後に個別のコントロールを扱うときに調べよう。重要なことは、ここで例としてあげた TScrollBox に限らず以上で調べたスクロールメッセージやここでつくった関数は標準スクロールバーを表示するどのコントロールでも有効であることを知っておくことである。スクロールメッセージ処理自体の仕組みは、どのコントロールも同じだからである。
標準スクロールバーのつまみの位置やサイズ、スクロール範囲などを取得する関数をつくろう。テストプログラムは前節のものと全く同じである。それではさっそくとりかかる。使うのは以下の API である。
function GetScrollInfo(hWnd: HWND;
BarFlag: Integer;
var ScrollInfo: TScrollInfo): BOOL; stdcall;
第一パラメータの hWnd には、標準スクロールバーを表示しているコントロールのウィンドウハンドルを設定する。第二パラメータ BarFlag には、垂直スクロールバーのときは SB_VERT を、水平スクロールバーのときは SB_HORZ を設定する。第三パラメータは以下のようなレコード型の変数を設定する。情報はこのレコード型の変数に設定されて戻される。
type
tagSCROLLINFO = packed record
cbSize: UINT;
fMask: UINT;
nMin: Integer;
nMax: Integer;
nPage: UINT;
nPos: Integer;
nTrackPos: Integer;
end;
PScrollInfo = ^TScrollInfo;
TScrollInfo = tagSCROLLINFO;
cbSize には、このレコード型のサイズを SizeOf() で設定する。fMask には取得したい情報の以下のようなフラグの組み合わせを設定する。
const SIF_RANGE = 1; // スクロール範囲 nMin と nMax が有効 SIF_PAGE = 2; // つまみのサイズ nPage が有効 SIF_POS = 4; // つまみの位置 nPos が有効 SIF_TRACKPOS = $10; // つまみをドラグ（トラック）中のときの位置 nTrackPos が有効 SIF_ALL = (SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS);
これらの任意の組み合わせを or で設定する。したがって、一度に全部の情報を取得することもできる。ここでは、この API をラップして単機能化した関数を作成する。以下にテストコードを示す。
List 4
function GetThumbPosV(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_POS;
if GetScrollInfo(WC.Handle,SB_VERT,SI) then
result := SI.nPos
else
result := -1;
end;
function GetThumbPosH(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_POS;
if GetScrollInfo(WC.Handle,SB_HORZ,SI) then
result := SI.nPos
else
result := -1;
end;
function GetThumbSizeV(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_PAGE;
if GetScrollInfo(WC.Handle,SB_VERT,SI) then
result := SI.nPage
else
result := -1;
end;
function GetThumbSizeH(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_PAGE;
if GetScrollInfo(WC.Handle,SB_HORZ,SI) then
result := SI.nPage
else
result := -1;
end;
function GetRangeMinV(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_RANGE;
if GetScrollInfo(WC.Handle,SB_VERT,SI) then
result := SI.nMin
else
result := -1;
end;
function GetRangeMaxV(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_RANGE;
if GetScrollInfo(WC.Handle,SB_VERT,SI) then
result := SI.nMax
else
result := -1;
end;
function GetRangeMinH(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_RANGE;
if GetScrollInfo(WC.Handle,SB_HORZ,SI) then
result := SI.nMin
else
result := -1;
end;
function GetRangeMaxH(WC:TWinControl):integer;
var
SI:TScrollInfo;
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_RANGE;
if GetScrollInfo(WC.Handle,SB_HORZ,SI) then
result := SI.nMax
else
result := -1;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add('');
Memo1.Lines.Add('VPage = '+IntToStr(GetThumbSizeV(ScrollBox1)));
Memo1.Lines.Add('VMin = '+IntToStr(GetRangeMinV(ScrollBox1)));
Memo1.Lines.Add('VMax = '+IntToStr(GetRangeMaxV(ScrollBox1)));
Memo1.Lines.Add('VPos = '+IntToStr(GetThumbPosV(ScrollBox1)));
Memo1.Lines.Add('');
Memo1.Lines.Add('HPage = '+IntToStr(GetThumbSizeH(ScrollBox1)));
Memo1.Lines.Add('HMin = '+IntToStr(GetRangeMinH(ScrollBox1)));
Memo1.Lines.Add('HMax = '+IntToStr(GetRangeMaxH(ScrollBox1)));
Memo1.Lines.Add('HPos = '+IntToStr(GetThumbPosH(ScrollBox1)));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.Add('');
Memo1.Lines.Add('VPos = '+IntToStr(GetThumbPosV(ScrollBox1)));
Memo1.Lines.Add('HPos = '+IntToStr(GetThumbPosH(ScrollBox1)));
end;
実行時の様子を右図にしめす。Button1 をクリックすると、つまみのサイズとスクロール範囲、つまみの位置を Memo1 に表示する。図は筆者の環境のものだが、Label1 を (1000,1000) に配置しているが、フォントの大きさなどによって Label1 の大きさも変わるので、別の環境では少々ちがった値を示すかもしれない。
次に、垂直、水平ともにつまみをドラグして最大になるようにしてから Button2 をクリックしてみると、筆者の環境では Memo1 に以下のように表示される。
VPos = 839 HPos = 784
これから、次のことが一般に成り立つ。
スクロール可能な最大の位置 = Max - Min − Page(つまみのサイズ) + 1;
この関係式は重要である。一般に、つまみのサイズはゼロではないので、実際にスクロール可能なつまみの位置は Max の値より小さいのである。
最後に、標準スクロールバーが表示されているかどうか判断する関数をつくろう。標準スクロールバーの垂直の幅と水平の高さは、システムにより決められており、以下の API の返値で取得できる。
GetSystemMetrics(SM_CXVSCROLL); GetSystemMetrics(SM_CYHSCROLL);
また、標準スクロールバーが表示されると自動的にクライアント領域がその分だけ小さくなる。このことを利用して関数をつくろう。以下にそのコードを示す。
List 5
function IsVScrollShown(WC:TWinControl):Boolean;
begin
result := (WC.Width-WC.ClientWidth) >= GetSystemMetrics(SM_CXVSCROLL);
end;
function IsHScrollShown(WC:TWinControl):Boolean;
begin
result := (WC.Height-WC.ClientHeight) >= GetSystemMetrics(SM_CYHSCROLL);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if IsVScrollShown(ScrollBox1) then
Memo1.Lines.Add('VScroll is Shown')
else
Memo1.Lines.Add('VScroll is not Shown');
if IsHScrollShown(ScrollBox1) then
Memo1.Lines.Add('HScroll is Shown')
else
Memo1.Lines.Add('HScroll is not Shown');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Label1.Left := 10;
Label1.Top := 10;
end;
実行してすぐに Button3 を押し、それから Button4 をおして Label1 の位置を変更してスクロールバーを消し、それから Button3 を再び押すと右図のようになる。
ここまで作ってきた標準スクロールバーに関する関数をユニットファイルにまとめたものを以下にリンクしておく。標準スクロールバーを表示するコンポーネントから派生して、スクロールイベントやメソッドやプロパティーを装備したコンポーネントを作るときに、これらのコードが参考になるだろう。
個別のコントロールのスクロール動作を調べる最初の例として TMemo から始めることにしよう。TMemo がつくるコントロールは Win32 の標準コントロールである複数行 EDIT コントロールである。前節までの TScrollBox のような汎用ウィンドウとは違って、コントロールはそれ特有の動作を実現するために、制御メッセージや通知メッセージが定義されている。スクロールについても、TMemo に特有の制御メッセージや通知メッセージがある。ここでは最初に、ユーザの操作にしたがって発生するスクロールメッセージを捕まえて解析してみよう。右図のように Memo1 と Memo2 を配置する。Memo1 はモニタ用である。Memo2 を操作したときのメッセージを Memo2 をサブクラス化して捕まえよう。コントロールは入力フォーカスを持つことができるので、標準スクロールバーをマウスで操作したときだけでなく、キー入力によってもスクロールが起こる。これが TMemo に特有のスクロール動作となっている。
以下にテストコードを示す。
List 6
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
Memo2Proc:TWndMethod;
procedure Memo2SuclassProc(var Msg:TMessage);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
Memo1.ScrollBars := ssVertical;
Memo2.ScrollBars := ssVertical;
Memo2.Clear;
for i := 0 to 100 do Memo2.Lines.Add(Format('%.3d',[i]));
Memo2Proc := Memo2.WindowProc;
Memo2.WindowProc := Memo2SuclassProc;
end;
function IsKeyPressed(virtualkey:integer):Boolean;
begin
result := (GetAsyncKeyState(virtualkey) and $8000) <> 0;
end;
procedure TForm1.Memo2SuclassProc(var Msg: TMessage);
var
s:string;
begin
Memo2Proc(Msg);
case Msg.Msg of
WM_VSCROLL:begin
case Msg.WParamLo of
SB_LINEUP :s := 'LINEUP';
SB_LINEDOWN :s := 'LINEDOWN';
SB_PAGEUP :s := 'PAGEUP';
SB_PAGEDOWN :s := 'PAGEDOWN';
SB_THUMBPOSITION:s := 'THUMBPOSITION';
SB_THUMBTRACK :s := 'THUMBTRACK';
SB_TOP :s := 'TOP';
SB_BOTTOM :s := 'BOTTOM';
SB_ENDSCROLL :s := 'ENDSCROLL';
else
s := 'N/A message';
end;
s := s+' Pos : '+IntToStr(Msg.WParamHi);
Memo1.Lines.Add(s);
end;
CN_COMMAND:
if Msg.WParamHi = EN_VSCROLL then begin
if IsKeyPressed(VK_UP) then Memo1.Lines.Add('UP')
else
if IsKeyPressed(VK_DOWN) then Memo1.Lines.Add('DOWN')
else
if IsKeyPressed(VK_RIGHT) then Memo1.Lines.Add('RIGHT')
else
if IsKeyPressed(VK_LEFT) then Memo1.Lines.Add('LEFT')
else
if IsKeyPressed(VK_HOME) then Memo1.Lines.Add('HOME')
else
if IsKeyPressed(VK_END) then Memo1.Lines.Add('END')
else
if IsKeyPressed(VK_RETURN) then Memo1.Lines.Add('RETURN');
end;
end;
end;
end.
実行時の様子を右図に示した。いろいろ試してみると分かるが、標準スクロールバーをマウスで操作したときの WM_VSCROLL メッセージの内容は、前節までで取り扱った TScrollBox の場合と全く同じである。
TMemo 特有の動作としては、四つの矢印キーを押したときにスクロールが起こることと、Ctrl+Home や Ctrl+End によるスクロール、および表示領域の最下行でリターンキーで改行したときである。これらは、スクロールバーと無関係に TMemo の作るコントロールのウィンドウ関数が独自に解釈してスクロール処理をしているので WM_VSCROLL メッセージは送られてこない。しかし、前章で調べたように WM_COMMAND を通して親ウィンドウに EN_VSCROLL 通知メッセージを送る。VCL では親ウィンドウは TMemo にこれを CN_COMMAND として送り返す。Memo2 のサブクラスウィンドウプロシージャではこれを捕まえている。
EN_VSCROLL idEditCtrl = (int) LOWORD(wParam); // identifier of edit control hwndEditCtrl = (HWND) lParam; // handle of edit control
このように、ｗParam にも lParam にも、この通知メッセージの原因となったスクロール処理がどのキー入力によるものか情報をもっていない。したがって、ここではこの通知が届いた瞬間にどのキーが押されているかを調べることによって、どのようなスクロール動作が起こったのか判断している。キーの押し下げ状態を取得するために GetAsyncKeyState() API をラップした以下のような関数を使っている。
function IsKeyPressed(virtualkey:integer):Boolean; begin result := (GetAsyncKeyState(virtualkey) and $8000) <> 0; end;
このようにして、WM_VSCROLL メッセージと CN_COMMAND を通じた EN_VSCROLL 通知メッセージを捕まえるとスクロール処理に関するタイミングをすべて知ることができる。ここでは垂直スクロールについてだけを調べたが水平スクロールについてもほぼ同様である。
TMemo をコードでスクロールさせよう。３−３節の最後のところでリンクされている ScrollControl.txt を新たに作ったユニットのコードエディタに貼り付けて、ScrollControl.pas として保存し、あらたにプロジェクトに加えてください。前節のプログラムにボタンを七つ追加して、右図のようにしてください。
uses 節に ScrollControl を加え、各ボタンの OnClick イベントハンドラを以下のようにする。
List 7
procedure TForm1.Button1Click(Sender: TObject); begin ScrollLineDown(Memo2); end; procedure TForm1.Button2Click(Sender: TObject); begin ScrollLineUp(Memo2); end; procedure TForm1.Button3Click(Sender: TObject); begin ScrollPageDown(Memo2); end; procedure TForm1.Button4Click(Sender: TObject); begin ScrollPageUp(Memo2); end; procedure TForm1.Button5Click(Sender: TObject); begin ScrollBottom(Memo2); end; procedure TForm1.Button6Click(Sender: TObject); begin ScrollTop(Memo2); end; procedure TForm1.Button7Click(Sender: TObject); begin ScrollVPos(Memo2,50); end;
すべてのハンドラが期待通りの動作をすることが確かめられただろう。特に、ScrollVPos 関数はこの場合便利である。なぜならば、TMemo の場合、最小のスクロールは行単位で行われるため、任意の行を表示領域の最上行にするためにこの関数を使えるのである。つまり、垂直スクロールバーのつまみの位置と、そのとき表示されている領域の最上行の行インデックスは一致しているのである。このように、WM_VSCROLL を送ってスクロールさせるのは、だいたいすべてのコントロールでうまくいく。これはメッセージを受け取るウィンドウ関数がスクロールバーを操作した結果なのか、コードで送られたのか区別できないからである。
つぎに TMemo 特有の制御メッセージを送ってスクロールさせてみよう。あらたに EM_SCROLL と EM_SCROLLCARET をサブクラス関数で捕まえる必要があるので以下のように追加する。
List 8
procedure TForm1.Memo2SuclassProc(var Msg: TMessage);
var
s:string;
begin
Memo2Proc(Msg);
case Msg.Msg of
WM_VSCROLL:begin
case Msg.WParamLo of
SB_LINEUP :s := 'LINEUP';
SB_LINEDOWN :s := 'LINEDOWN';
SB_PAGEUP :s := 'PAGEUP';
SB_PAGEDOWN :s := 'PAGEDOWN';
SB_THUMBPOSITION:s := 'THUMBPOSITION';
SB_THUMBTRACK :s := 'THUMBTRACK';
SB_TOP :s := 'TOP';
SB_BOTTOM :s := 'BOTTOM';
SB_ENDSCROLL :s := 'ENDSCROLL';
else
s := 'N/A message';
end;
s := s+' Pos : '+IntToStr(Msg.WParamHi);
Memo1.Lines.Add(s);
end;
CN_COMMAND:
if Msg.WParamHi = EN_VSCROLL then begin
if IsKeyPressed(VK_UP) then Memo1.Lines.Add('UP')
else
if IsKeyPressed(VK_DOWN) then Memo1.Lines.Add('DOWN')
else
if IsKeyPressed(VK_RIGHT) then Memo1.Lines.Add('RIGHT')
else
if IsKeyPressed(VK_LEFT) then Memo1.Lines.Add('LEFT')
else
if IsKeyPressed(VK_HOME) then Memo1.Lines.Add('HOME')
else
if IsKeyPressed(VK_END) then Memo1.Lines.Add('END')
else
if IsKeyPressed(VK_RETURN) then Memo1.Lines.Add('RETURN');
end;
EM_SCROLL: begin
case Msg.WParam of
SB_LINEUP :s := 'LINEUP';
SB_LINEDOWN :s := 'LINEDOWN';
SB_PAGEUP :s := 'PAGEUP';
SB_PAGEDOWN :s := 'PAGEDOWN';
SB_TOP :s := 'TOP';
SB_BOTTOM :s := 'BOTTOM';
end;
Memo1.Lines.Add(s);
end;
EM_SCROLLCARET:Memo1.Lines.Add('SCROLLCARET');
end;
end;
そして、ボタンのイベントハンドラを以下のようにする。
List 9
procedure TForm1.Button1Click(Sender: TObject); begin Memo2.Perform(EM_SCROLL,SB_LINEDOWN,0); end; procedure TForm1.Button2Click(Sender: TObject); begin Memo2.Perform(EM_SCROLL,SB_LINEUP,0); end; procedure TForm1.Button3Click(Sender: TObject); begin Memo2.Perform(EM_SCROLL,SB_PAGEDOWN,0); end; procedure TForm1.Button4Click(Sender: TObject); begin Memo2.Perform(EM_SCROLL,SB_PAGEUP,0); end; procedure TForm1.Button5Click(Sender: TObject); begin Memo2.Perform(EM_SCROLL,SB_BOTTOM,0); end; procedure TForm1.Button6Click(Sender: TObject); begin Memo2.Perform(EM_SCROLL,SB_TOP,0); end; procedure TForm1.Button7Click(Sender: TObject); var LineIndex:integer; begin LineIndex := Memo2.Perform(EM_LINEINDEX,55,0); Memo2.SelStart := LineIndex; Memo2.Perform(EM_SCROLLCARET,0,0); end;
実行時の様子を右図に示した。このように TMemo に対して送られた EM_SCROLL メッセージはちょうど対応する WM_VSCROLL メッセージと全く同じ動作をする。EM_SCROLL は WM_VSCROLL のラッパーであると見なせるだろう。しかし、EM_SCROLL の方がパラメータの設定の仕方が簡単にできるようになっている。EM_SCROLLCARET は独特のスクロール動作をする。送られる直前の位置から、最小のスクロールでキャレットがある行が表示領域に入るようにスクロールするのである。したがって、上から下へスクロールするような場合は、キャレットが最下行にくる。逆に下から上へスクロールするときは最上行にくる。はじめから表示行にキャレットがある場合はなにもしない。ここでは、５５行目の最初の文字のところへキャレットをもっていってから EM_SCROLLCARET を送っている。
最後にスクロールに関連するメッセージとして EM_GETFIRSTVISIBLELINE を試してみよう。これは、現在の表示領域の最上行の行インデックスを与える。これは垂直スクロールバーのつまみの位置と一致している。以下のようにして確認できる。
List 10
procedure TForm1.Button1Click(Sender: TObject);
var
LineNo:integer;
begin
LineNo := Memo2.Perform(EM_GETFIRSTVISIBLELINE,0,0);
Memo1.Lines.Add('FirstVisibleLine = '+IntToStr(LineNo));
Memo1.Lines.Add('ThumbPosV = '+IntToStr(GetThumbPosV(Memo2)));
end;
各自試してみてほしい。
どのような要求があるのか想像できないが、二つの同等なコントロール間でスクロール動作を同期させたい、という質問が BBS などでかなり頻繁にあるようです。この節では、前節までのスクロール処理について調べたことをもとにして、二つの TMemo の一方のスクロール動作が他方のスクロール動作に同期するようにしてみよう。前節までに分かったことは、TMemo では標準スクロールバーをユーザがマウスで操作した場合に加えて、キー入力によるスクロール、またメッセージによるスクロールが起こることである。捕まえなければならないメッセージは全部で四つである。WM_VSCROLL と CN_COMMAND、EM_SCROLL、EM_SCROLLCARET である。
右図のようにまったく同じ TMemo を二つ配置して以下のコードを試してみよう。
List 11
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
Memo2Proc:TWndMethod;
procedure Memo2SuclassProc(var Msg:TMessage);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
ScrollControl;
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
Memo1.ScrollBars := ssVertical;
Memo2.ScrollBars := ssVertical;
Memo1.Clear;
for i := 0 to 100 do Memo1.Lines.Add(Format('%.3d',[i]));
Memo2.Clear;
for i := 0 to 100 do Memo2.Lines.Add(Format('%.3d',[i]));
Memo2Proc := Memo2.WindowProc;
Memo2.WindowProc := Memo2SuclassProc;
end;
procedure TForm1.Memo2SuclassProc(var Msg: TMessage);
var
Pos:integer;
begin
Memo2Proc(Msg);
case Msg.Msg of
WM_VSCROLL:
case Msg.WParamLo of
SB_THUMBTRACK :Memo1.Dispatch(Msg);
SB_ENDSCROLL :begin
Pos := GetThumbPosV(Memo2);
ScrollVPos(Memo1,Pos);
end;
end;
CN_COMMAND:
if Msg.WParamHi = EN_VSCROLL then begin
Pos := GetThumbPosV(Memo2);
ScrollVPos(Memo1,Pos);
end;
EM_SCROLL,EM_SCROLLCARET: begin
Pos := GetThumbPosV(Memo2);
ScrollVPos(Memo1,Pos);
end;
end;
end;
end.
実行時の様子を右図に示した。Memo2 のスクロール動作に Memo1 が追随することが確かめられる。ここでは試していないが EM_SCROLL などのメッセージを Memo2 に送ってスクロールさせたときも完全に同期する。Memo2SuclassProc() を見ればわかるように、WM_VSCROLL の nScrollCode が SB_THUMBTRACK のときは、Memo1.Dispatch() で転送している。あとは、スクロール動作が一段落してから、Memo2 のつまみの位置を取得して、ScrollVPos() により Memo1 にそのつまみの位置にスクロールさせている。
本章では、コントロールのメッセージ処理のうち VCL ではほとんど無視されているスクロールメッセージについて、まず汎用ウィンドウの標準スクロールバーの例として TScrollBox のスクロールメッセージについて調べ、それらをラップした関数ユニット ScrollControl.pas を作成した。それをもとにして、次に、コントロールの例として TMemo についてやや詳細に調べた。標準スクロールバーの操作のほかに、キー入力やメッセージによるスクロール動作もあることが分かった。最後に、それをつかって、二つの TMemo 間のスクロール動作を同期させることができた。次の段階は、これらのスクロール動作をイベントとしたり、コードでスクロールするためのメソッドやスクロール範囲やつまみのサイズ・位置を取得／設定するためのプロパティーを備えた派生コンポーネントを作成することだろう。しかし、それは読者にお任せする。本章でしめしたコードを参考にすると簡単に実装できるだろう。のこりのコントロールのスクロール動作については章をあらためて公表する予定である。