前の章へ
| 総目次へ
| 次の章へ 
｜リストボックスコントロールは、ＶＣＬの TListBox に相当するものだ。その機能についての説明は不要だろう。 ボタンコントロールと同様、そのウィンドウ関数のソースコードは見ることはできない。しかし、本稿でこれまでに作ってきたプログラムやクラスとは比較にならないほど大きな「アプリケーション」プログラムであることは間違いない。 これをゼロから実装するコードを書く気は起こらないほどだ。 この章では、 リストボックスコントロールのラッパークラスを作り、このコントロールの使い方を調べよう。
| 第８章 リストボックス |
| ８−１ リストボックスを作ってみる |
| ８−２ 文字列リストの保持とソート |
| ８−３ リストボックスのラッパークラス |
| ８−４ 複数項目選択可能なリストボックス |
| ８−５ まとめ |
前の章へ
| 総目次へ
| 次の章へ ｜リストボックスコントロールは CreateWindowEx( ) の第二パラメータであるクラス名に 'LISTBOX'を指定してつくられる子ウィンドウである。 そのウィンドウスタイルに指定できるいくつかの定数が Windows.pas に定義されている。
const
{ Listbox Styles }
LBS_NOTIFY = 1; // クリックやダブルクリックを親に通知する
LBS_SORT = 2; // 項目の文字列をソートする
LBS_NOREDRAW = 4; // 再描画の一次停止。WM_SETREDRAW で解除できる
LBS_MULTIPLESEL = 8; // 一度に複数の項目を選択できる
LBS_OWNERDRAWFIXED = $10; // 項目の高さが一定のオーナー描画
LBS_OWNERDRAWVARIABLE = $20; // 項目の高さが一定ではないオーナー描画
LBS_HASSTRINGS = $40; // 文字列リストを保持する
LBS_USETABSTOPS = $80; // タブの展開をする
LBS_NOINTEGRALHEIGHT = $100; // 指定通りの高さで作る（項目の高さの整数倍にはしない）
LBS_MULTICOLUMN = $200; // 複数列のリストを表示する。水平スクロールをする
LBS_WANTKEYBOARDINPUT = $400; // フォーカスがあるときキー入力を親に通知する
LBS_EXTENDEDSEL = $800; // シフトキーなどを使って一度に複数の項目を選択できる
LBS_DISABLENOSCROLL = $1000; // リストが少ないとき使用不可のスクロールバーを表示する
LBS_NODATA = $2000; // データを保持しない。 オーナー描画に使う
LBS_NOSEL = $4000; // 項目を選択できない
LBS_STANDARD = (LBS_NOTIFY or LBS_SORT or WS_VSCROLL or WS_BORDER);これだけ多いと何を選択してよいか迷うところだ。そこで、ＲＡＤ環境で TListBox を一つ Form1 にドロップして、UtilFunc.pas にある WindowInfo( ) 関数を使ってスタイルを調べてみると $54010141 の値が得られた。 これは、
デフォルトスタイル が $54010141 WS_CHILD = $40000000 WS_VISIBLE = $10000000 WS_CLIPSIBLINGS = $4000000 WS_TABSTOP = $10000 LBS_NOINTEGRALHEIGHT = $100 LBS_HASSTRINGS = $40 LBS_NOTIFY = 1
と分解できる。 さらに、MultiSelect プロパティーを True にすると LBS_EXTENDEDSEL(=$800）が加わる。また、Sorted を true にし、TabWidth を設定すると、LBS_USETABSTOPS と LBS_SORT が加わる。 これで大体の組み合わせが理解できるだろう。 なお、WindowInfo( ) 関数を使って調べてみた拡張スタイルには、WS_EX_CLIENTEDGE = $200 が指定されていた。
リストボックスを作成したら、これに文字列を追加・挿入・削除したくなるだろう。 ＶＣＬの TListBox では TStrings 型の Items プロパティーのメソッドとして実現されていた。 ボタンコントロールと同様に、リストボックスと対話するには SendMessage( ) ＡＰＩを使う。リストボックスに送るメッセージは Messages.pas に以下のように定義されている。
{ Listbox messages }
const
LB_ADDSTRING = $0180; // 項目文字列を追加する
LB_INSERTSTRING = $0181; // 項目文字列を挿入する
LB_DELETESTRING = $0182; // 項目文字列を削除する
LB_SELITEMRANGEEX = $0183; // 連続した項目を複数選択する
LB_RESETCONTENT = $0184; // 全項目を削除する
LB_SETSEL = $0185; // 複数項目選択可能なときに特定の項目を選択する
LB_SETCURSEL = $0186; // 単項目だけ選択可能なときに特定の項目を選択する
LB_GETSEL = $0187; // 特定の項目が選択されているかどうかを知る
LB_GETCURSEL = $0188; // 現在選択中の項目のインデックスを知る
LB_GETTEXT = $0189; // 特定の項目の文字列を取得する
LB_GETTEXTLEN = $018A; // 特定の項目の文字列の長さを取得する
LB_GETCOUNT = $018B; // 現在の項目数を取得する
LB_SELECTSTRING = $018C; // 特定文字列項目を検索して選択状態にする
LB_DIR = $018D; // ファイルやドライブのリストを表示する
LB_GETTOPINDEX = $018E; // 現在見えている項目の最初の項目のインデックスを取得する
LB_FINDSTRING = $018F; // 特定の文字列を含む最初の項目の検索
LB_GETSELCOUNT = $0190; // 複数項目選択可能なときに選択項目数を取得する
LB_GETSELITEMS = $0191; // 複数項目選択可能なときに選択項目に関連づけられた
// 整数値の配列を取得する
LB_SETTABSTOPS = $0192; // タブストップの数と位置の設定
LB_GETHORIZONTALEXTENT = $0193; // 水平スクロール可能範囲の取得
LB_SETHORIZONTALEXTENT = $0194; // 水平スクロール可能範囲の設定
LB_SETCOLUMNWIDTH = $0195; // 複数列のリストの列幅を設定する
LB_ADDFILE = $0196; // ファイルリストにファイル名を追加する
LB_SETTOPINDEX = $0197; // 特定項目を可視領域の最初の項目にするためにスクロールする
LB_GETITEMRECT = $0198; // リスト表示領域の境界矩形を取得
LB_GETITEMDATA = $0199; // 特定項目に関連付けられた整数値を取得
LB_SETITEMDATA = $019A; // 特定項目に関連付けられた整数値を設定
LB_SELITEMRANGE = $019B; // 複数項目選択可能なときに選択項目の範囲を設定
LB_SETANCHORINDEX = $019C; // 複数項目選択可能なときに最初の選択項目（アンカー）を設定
LB_GETANCHORINDEX = $019D; // 複数項目選択可能なときに最初の選択項目（アンカー）を取得
LB_SETCARETINDEX = $019E; // フォーカス矩形を表示する項目インデックスを設定
LB_GETCARETINDEX = $019F; // フォーカス矩形を表示している項目インデックスを取得
LB_SETITEMHEIGHT = $01A0; // 項目の高さの設定
LB_GETITEMHEIGHT = $01A1; // 項目の高さの取得
LB_FINDSTRINGEXACT = $01A2; // 特定の文字列と同一な最初の項目の検索
LB_SETLOCALE = $01A5; // ロケールの設定
LB_GETLOCALE = $01A6; // ロケールの取得
LB_SETCOUNT = $01A7; // LBS_NODATA スタイルのときの項目数の設定
LB_INITSTORAGE = $01A8; // 予めメモり容量を割り当てる
LB_ITEMFROMPOINT = $01A9; // 特定位置の再近接項目の取得
LB_MSGMAX = 432; // 最初の三つが文字列の追加・挿入・削除をするものだ。例えば、 LB_ADDSTRING をつかって文字列 'ABCdef'を追加するには
s := 'ABCdef'; index := SendMessage(hListBox,LB_ADDSTRING,0,LPARAM(PChar(s)));
とすればよい。戻り値には追加された文字列のリストボックスにおけるゼロから始まる位置を示すインデックスが返される。 これらの情報は、Delphi 付属の Win32.hlp で上記のメッセージをキーワードにして検索すると見つかる。 LB_ADDSTRING の場合は、
LB_ADDSTRING wParam = 0; // not used; must be zero lParam = (LPARAM) (LPCTSTR) lpsz; // address of string to add
となっている。 リストボックスの重要な機能の一つには、複数項目からマウスのクリックや矢印キーによる特定項目の選択機能がある。ＶＣＬでは OnClick イベントとして公開されているが、コントロールではボタンと同じように WM_COMMAND メッセージを親のウィンドウ関数に送ることで通知する。 以下に Win32.hlp から WM_COMMAND メッセージの定義を再掲する。
WM_COMMAND wNotifyCode = HIWORD(wParam); // notification code wID = LOWORD(wParam); // item, control, or accelerator identifier hwndCtl = (HWND) lParam; // handle of control
このうちリストボックスコントロールが通知する wNotifyCode = HIWORD(wParam) は、Messages.pas に定義されている。
{ Listbox Notification Codes }
const
LBN_ERRSPACE = (-2); // メモリの割り当てに失敗した
LBN_SELCHANGE = 1; // 選択状態が変更された
LBN_DBLCLK = 2; // 項目がダブルクリックされた
LBN_SELCANCEL = 3; // ユーザが選択をキャンセルした
LBN_SETFOCUS = 4; // キーボードフォーカスを受け取った
LBN_KILLFOCUS = 5; // キーボードフォーカスを失ったLBN_ERRSPACE は、文字列を追加しようとしてもメモリを確保できなかった場合に送られてくる。これらの通知メッセージは LBS_NOTIFY スタイルが指定されているときだけ通知される。 選択状態が変化するとリストボックスは LBN_SELCHANGE を通知してくる。ウィンドウ関数ではこの通知を WM_COMMAND メッセージを通じて受け取ったら、 リストボックスに LB_GETCURSEL を送り、選択された項目のインデックスを得る。 つぎに、このインデックスを使って LB_GETTEXT を送って、文字列を手に入れる。これらの一連の操作は少し複雑だが、 小さな関数かクラスのメソッドやプロパティーのアクセスメソッドにまとめてしまえば選択項目へのアクセスは簡単だ。
以上のような断片的知識だけでは少々頼りないが、とにかくいろいろ試してみるためにはコントロールを実際に作ってみるのが早道だ。 ここでは、ＶＣＬの TListBox のデフォルトスタイルをもとにしたスタイルを指定してリストボックスコントロールを作ってみよう。
以下に ListBox01.dpr の全リストを示す。
program ListBox01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
hListBox: HWND;
L1: TAPILabel;
BkCLR,TxtColor: COLORREF;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
function AddString(s: string):integer;
begin
result := SendMessage(hListBox,LB_ADDSTRING,0,LPARAM(PChar(s)));
end;
function InsertString(index: integer;s: string):integer;
begin
result := SendMessage(hListBox,LB_INSERTSTRING,WPARAM(index),
LPARAM(PChar(S)));
end;
function DeleteString(index: integer):integer;
begin
result := SendMessage(hListBox,LB_DELETESTRING,WPARAM(index),0);
end;
procedure ResetContent;
begin
SendMessage(hListBox,LB_RESETCONTENT, 0, 0);
end;
function GetSelText: string;
var
index,len: integer;
s: string;
PC:PChar;
begin
index := SendMessage(hListBox,LB_GETCURSEL,0,0);
len := SendMessage(hListBox,LB_GETTEXTLEN,WPARAM(index),0);
GetMem(PC,len+1); // +1 for null-terminator
SendMessage(hListBox,LB_GETTEXT,WParam(index),LParam(PC));
SetString(s,PC,len);
FreeMem(PC);
result := AIntToStr(index)+' : '+s;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,250,280);
CenterWindow(hWindow);
BkCLR := clrWhite;
TxtColor := clrBlack;
L1 := CreateLabel(hWindow,10,10,220,34,'');
L1.Margin := 8;
hListBox := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX',
'MyListBox',
$54010141 or WS_VSCROLL or LBS_USETABSTOPS,
10,60,220,150,
hWindow,500,hInstance,nil);
AddString('ABC123');
AddString('あかさたな');
AddString('123&&&5%%'+#9+'Tab');
AddString('柿食えば鐘が鳴るなり');
AddString('This is the last line.');
end;
procedure OnTest(hWindow: HWND);
begin
InsertString(2,'これは挿入項目です');
BkCLR := RGB(255,245,215);
TxtColor := clrGreen;
InvalidateRect(hListBox,nil,true);
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
if (Msg.LParam = LPARAM(hListBox)) then // ListBox Command
case Msg.WParamHi of
LBN_SELCHANGE: L1.Text := GetSelText;
end;
end;
procedure OnCtlColorListBox(var Msg: TMessage);
begin
if Msg.LParam <> LPARAM(hListBox) then exit;
SetBkColor(Msg.WParam,BkCLR);
SetTextColor(Msg.WParam,TxtColor);
Msg.Result := CreateSolidBrush(BkCLR);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_CTLCOLORLISTBOX --------------------------
WM_CTLCOLORLISTBOX: begin
OnCtlColorListBox(AMsg);
result := AMsg.Result;
end;
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.
ListBox01.zip(14.721kB)
実行時の様子を右図に示す。Test! メニューを選択すると新しい文字列が３行目に挿入されるとともに背景と文字の色が変更される。表示領域より多くの文字列が追加されると自動的に垂直スクロールバーが現れる。 WS_VSCROLL スタイルを指定しているからである。 マウスで文字列をクリックすると選択文字列がラベルにインデックスとともに表示される。 また LBS_USETABSTOPS スタイルを指定しているのでタブ(#9)が展開されることも確認できる。
OnCreate( ) ハンドラでは、上記で取得したＶＣＬの TListbox のデフォルトスタイル $54010141 に WS_VSCROLL と LBS_USETABSTOPS を加えたリストボックスを作成している。拡張スタイルにはＶＣＬと同じ WS_EX_CLIENTEDGE を指定して、枠部分を３Ｄ的に表示している。 この指定をゼロにしたときのリストボックスは、ＶＣＬの使用に慣れた人には奇異な感じがするだろう。 リストボックスを作成したあとに、適当な文字列を追加している。リストボックスに送ることができるメッセージを幾つかのヘルパ関数にまとめて Object Event Handlers のところに実装している。 これらは、文字列の追加・挿入・削除と全内容のクリア、および選択文字列の取得のために用いられる。 GetSelText 関数では、上記の説明のように、選択されている文字列のインデックスを取得し、それを使って文字列の長さを取得してバッファの長さを設定し、それから LB_GETTEXT メッセージを送って選択文字列を取得している。
function GetSelText: string; var index,len: integer; s: string; PC:PChar; begin index := SendMessage(hListBox,LB_GETCURSEL,0,0); len := SendMessage(hListBox,LB_GETTEXTLEN,WPARAM(index),0); GetMem(PC,len+1); // +1 for null-terminator SendMessage(hListBox,LB_GETTEXT,WParam(index),LParam(PC)); SetString(s,PC,len); FreeMem(PC); result := AIntToStr(index)+' : '+s; end;
選択状態が変化したときの WM_COMMAND メッセージをトラップするために OnCommand( ) ハンドラに以下のコードを挿入している。
if (LParam = LPARAM(hListBox)) then
case HIWORD(WParam) of
LBN_SELCHANGE: L1.Text := GetSelText;
end;ここでは、コントロールのハンドルの値がリストボックスのそれであることを確認してから、通知が LBN_SELCHANGE である時、ラベルに選択項目のインデックスと文字列を表示している。 OnTest( ) ハンドラでは上から３番目の位置に項目を挿入し、リストボックスの背景色と文字色を変更している。
procedure OnTest(hWindow: HWND); begin InsertString(2,'これは挿入項目です'); BkCLR := RGB(255,245,215); TxtColor := clrGreen; InvalidateRect(hListBox,nil,true); end;
ここでは文字列を挿入する InsertString( ) をテストしている。 ここのコードを入れ替えて、いろいろなメッセージを送ってみてほしい。リストボックスの背景色と文字色を変更するために、 メインウィンドウのウィンドウ関数では WM_CTLCOLORLISTBOX メッセージを捕捉している。
//------------- WM_CTLCOLORLISTBOX --------------------------
WM_CTLCOLORLISTBOX: begin
OnCtlColorListBox(AMsg);
result := AMsg.Result;
end;ここでは、OnCtlColorListBox( ) ハンドラを呼び出し、結果をシステムに戻している。
procedure OnCtlColorListBox(var Msg: TMessage); begin if Msg.LParam <> LPARAM(hListBox) then exit; SetBkColor(Msg.WParam,BkCLR); SetTextColor(Msg.WParam,TxtColor); Msg.Result := CreateSolidBrush(BkCLR); end;
Win32.hlp によると、このメッセージは
WM_CTLCOLORLISTBOX hdcLB = (HDC) wParam; // handle of list box display context hwndLB = (HWND) lParam; // handle of list box
と定義され、 リストボックスが描画されるときに親ウィンドウに送られる。このメッセージの処理ハンドラでは、wParam のデバイスコンテキストハンドルを使って、背景色と文字色を変更できる。 戻り値には、 背景色を定義するブラシのハンドルを設定する。
この節で示したように、リストボックスコントロールは CreateWindowEx( ) ＡＰＩで簡単に作ることができる。 このコントロールの操作は、SendMessage( ) ＡＰＩを使って LB_XXX のメッセージを送ることで遠隔操作する。 ボタンコントロールに較べればリストボックスはかなり複雑なウィンドウであり、送られるメッセージの種類も多いが基本的には同じである。 これらのメッセージの送出手続きは、クラスのメソッドやプロパティーのアクセスメソッドに対応していることに気づくだろう。 リストボックスのような複雑なコントロールであるほど、ラッパークラスの存在は、その重要性が大きいことが分かるだろう。
リストボックスコントロールの各項目には３２ビットの整数値を格納できる。したがって、単なる整数値はもちろん、 任意のサイズのレコードのポインタやオブジェクト参照のリストも保持できる。 これらの値のアクセスメッセージは LB_GETITEMDATA と LB_SETITEMDATA である。明らかに追加・挿入・削除に対応するものはないので、まず適当な文字列で領域を確保してから設定・取得されるものであることが分かる。 この節で作ったプログラムの OnTest( ) ハンドラのコードを変更して、このことも確認してほしい。ちなみに、ＶＣＬでは TCustomListBox に protected メソッドとして GetItemData と SetItemData があるが、これを継承した TListBox でもこれらのメソッドは公開されていない。
Delphi のＶＣＬには、TStrings や TStringList などの文字列のリストを保持するクラスがある。 リストボックス自体も文字列を保持するので、ＶＣＬでは文字列の追加や挿入などの操作はこれらのクラスのメソッドを使って実現している。 リストボックスを使ううちに、リストボックスが保持している文字列リストに対応するようなクラスがあれば便利であることに気づく。 幅と高さをゼロにして目に見えないリストボックスをカプセル化すると、このようなクラスを作成することができる。 また、前節のヘルパ関数 GetSelText( )で示したように、任意の文字列は PChar 型の変数に、GetMem( ) を使って保持することができる。 PChar は文字列へのポインタであるから、integer 型に型キャストできる。したがって、文字列リストは整数配列で保持できることになる。 すでに４−５節で TIntegerList クラスを作成しているので、データとして PChar 型の変数を保持するようにして文字列リストを保持する TStringArray クラスを作成しよう。 このクラスは、次節以降でリストボックスコントロールをカプセル化するときに使われる。
文字列リストを保持する TStringArray クラスをつくってテストするプログラムを作成する。
最初に UtilClass.pas に TStringArray クラスを作成しよう。宣言部を以下に示す。
//----------------- TStringArray ------------------------------------- TStringArray = class(TObject) private PCharArray : TIntegerList; FCount: integer; function GetItems(index:integer): string; procedure SetItem(index: integer;value:string); function GetCount: integer; protected public constructor Create; virtual; destructor Destroy; override; property Items[i:integer]:string read GetItems write SetItem;default; property Count: integer read GetCount; procedure Add(value:string); procedure Clear; procedure Delete(index: integer); procedure Insert(index: integer; value: string); function Search(s:string):integer; procedure Exchange(i,j: integer); procedure Sort; end; function APICompareString(S1,S2: string): integer; procedure StringQuickSort(SS: TStringArray;l,r: Integer);
このクラスは、TObject から直接派生している。 文字列リストを保持する TIntegerList クラスのインスタンスは、private 部の PCharArray である。このリストに対して、項目を参照・設定する Items プロパティーと項目数を表す Count プロパティー、項目の追加（Add）、削除（Delete)、挿入 (Insert）、検索（Search）、交換（Exchange）、ソート（Sort）のメソッドがある。 最後の二つの外部関数は、ソートを実行するためのものだ。実装部を以下に示す。
//----------------- TStringArray -------------------------------------
constructor TStringArray.Create;
begin
PCharArray := TIntegerList.Create($10,$10);
FCount := -1;
end;
destructor TStringArray.Destroy;
var
i: integer;
begin
if FCount <> -1 then
for i := 0 to FCount do FreeMem(PChar(PCharArray[i]));
PCharArray.Free;
end;
procedure TStringArray.Add(value:string);
var
PC: PChar;
begin
Inc(FCount);
GetMem(PC,Length(value)+1);
lstrcpy(PC,PChar(value));
PCharArray.Add(integer(PC));
end;
function TStringArray.GetItems(index:integer): string;
var
PC: PChar;
begin
if (index > FCount) or (index < 0) then begin
result := 'index error';
exit;
end;
PC := PChar(PCharArray[index]);
SetString(result,PC,lstrlen(PC));
end;
procedure TStringArray.SetItem(index: integer;value:string);
var
PC: PChar;
begin
if (index > FCount) or (index < 0) then exit;
GetMem(PC,Length(value)+1);
lstrcpy(PC,PChar(value));
FreeMem(PChar(PCharArray[index]));
PCharArray[index] := integer(PC);
end;
procedure TStringArray.Clear;
var
i: integer;
begin
if FCount = -1 then exit;
for i := 0 to FCount do FreeMem(PChar(PCharArray[i]));
PCharArray.Clear;
FCount := -1;
end;
procedure TStringArray.Delete(index: integer);
begin
if (index > FCount) or (index < 0) then Exit;
FreeMem(PChar(PCharArray[index]));
PCharArray.Delete(index);
Dec(FCount);
end;
procedure TStringArray.Insert(index: integer; value: string);
var
PC: PChar;
begin
if (index > FCount) or (index < 0) then Exit;
GetMem(PC,Length(value)+1);
lstrcpy(PC,PChar(value));
PCharArray.Insert(index,integer(PC));
Inc(FCount);
end;
function TStringArray.Search(s:string):integer;
var
i: integer;
begin
i := -1;
Repeat
Inc(i);
Until (Items[i] = s) or ( i>FCount );
if i > FCount then
Result := -1
else
Result := i;
end;
function TStringArray.GetCount: integer;
begin
result := FCount+1;
end;
procedure TStringArray.Exchange(i,j: integer);
var
s: string;
begin
s := Items[i];
Items[i] := Items[j];
Items[j] := s;
end;
procedure TStringArray.Sort;
begin
StringQuickSort(self,0,Count-1);
end;
function APICompareString(S1,S2: string): integer;
begin
result := CompareString(LOCALE_SYSTEM_DEFAULT,0,
PChar(S1),-1,PChar(S2),-1) - 2;
end;
procedure StringQuickSort(SS: TStringArray;l,r: integer);
var
i,j: integer;
sP: string;
begin
repeat
i := l;
j := r;
sP := SS[(l+r) div 2];
repeat
while APICompareString(SS[i],sP) < 0 do inc(i);
while APICompareString(SS[j],sP) > 0 do dec(j);
if i <= j then begin
SS.Exchange(i,j);
inc(i);
dec(j);
end;
until i > j;
if l < j then StringQuickSort(SS,l,j);
l := i;
until i >= r;
end;コンストラクタで PCharArray を作成し、デストラクタで保持しているメモリを解放してから PCharArray も廃棄している。 Add メソッドを見てみよう。
procedure TStringArray.Add(value:string); var PC: PChar; begin Inc(FCount); GetMem(PC,Length(value)+1); lstrcpy(PC,PChar(value)); PCharArray.Add(integer(PC)); end;
ここでは、項目数をインクレメントしてから GetMem( )でメモリを確保し、lstrcpy( ) ＡＰＩを使って文字列をコピーしたあとでそのポインタを整数型にキャストして PCharArray に追加している。
function lstrcpy(lpString1,
lpString2: PChar): PChar; stdcall;このＡＰＩは、PChar型の lpString2 を、同じく PChar 型の lpString1 にコピーする。項目を取得する Items プロパティーの read アクセスメソッドである GetItems( ）を見てみよう。
function TStringArray.GetItems(index:integer): string;
var
PC: PChar;
begin
if (index > FCount) or (index < 0) then begin
result := 'index error';
exit;
end;
PC := PChar(PCharArray[index]);
SetString(result,PC,lstrlen(PC));
end;ここでは、インデックスの範囲チェックをしたあとで PCharArray の項目（整数型）を PChar 型にキャストし、SetString で string 型にコピーしている。 PChar 文字配列の長さを取得するために lstrlen( ) ＡＰＩを使っている。
function lstrlen(lpString: PChar): Integer; stdcall;
項目のソートは、外部関数 StringQuickSort( ) をつかって、クイックソートによって行っている。 このアルゴリズムについてはここでは説明しない。 ソート操作は、文字列に順番を付けることであるから、順番を決める何らかの基準が必要になる。 ここでは、文字列同士の比較をして順番付けするために APICompareString( ) 関数の中で CompareString( ) ＡＰＩを使っている。
function CompareString(Locale: LCID;
dwCmpFlags: DWORD;
lpString1: PChar;
cchCount1: Integer;
lpString2: PChar;
cchCount2: Integer): Integer; stdcall;第一パラメータは、ユーザの国と使用言語を識別するロケール識別子である。（LCID = DWORD）ロケールについては本稿で説明しないが、 ここではこのパラメータに LOCALE_SYSTEM_DEFAULT を指定しておけばよい。第二パラメータは、比較の仕方を指定する。 ゼロを指定するとデフォルトの順番付けを行う。 以下の組み合わせが指定できる。
const NORM_IGNORECASE = 1; // 大文字と小文字を区別しない NORM_IGNORENONSPACE = 2; // 非スペース文字を無視する NORM_IGNORESYMBOLS = 4; // 記号を無視する NORM_IGNOREKANATYPE = $10000; // ひらがなとカタカナを区別しない NORM_IGNOREWIDTH = $20000; // ANSI と UNICODE を区別しない
第三パラメータ以降は、比較する二つの文字列とその長さを指定する。 長さに -1 を指定すると #0 で終わる文字列とみなされ、長さは自動的に計算される。CompareString( ) は、lpString1 ＜ lpString2 のときは１を、等しいときは２を、lpString1 ＞ lpString2 のときは３を戻す。ここでは、戻り値から２を引いてクイックソートに用いている。
以上で TStringArray クラスが完成したので、これをテストするプログラムを TestStringArray.dpr につくろう。以下に全リストを示す。
program TestStringArray;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
hLB1,hLB2: HWND;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
function AddString(hListBox:HWND;s:string):integer;
begin
result := SendMessage(hListBox,LB_ADDSTRING,0,LPARAM(PChar(s)));
end;
function GetCount(hListBox:HWND):integer;
begin
result := SendMessage(hListBox,LB_GETCOUNT,0,0);
end;
function GetText(hListBox:HWND;index: integer):string;
var
len: integer;
PC:PChar;
begin
len := SendMessage(hListBox,LB_GETTEXTLEN,WPARAM(index),0);
GetMem(PC,len+1); // +1 for null-terminator
SendMessage(hListBox,LB_GETTEXT,WParam(index),LParam(PC));
SetString(result,PC,len);
FreeMem(PC);
end;
procedure ResetContent(hListBox:HWND);
begin
SendMessage(hListBox,LB_RESETCONTENT, 0, 0);
end;
function GetSelText(hListBox:HWND): string;
var
index: integer;
s: string;
begin
index := SendMessage(hListBox,LB_GETCURSEL,0,0);
s := GetText(hListBox,index);
result := AIntToStr(index)+' : '+s;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,270,280);
CenterWindow(hWindow);
hLB1 := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX',
'MyListBox',
$54010141 or WS_VSCROLL or LBS_USETABSTOPS,
10,10,100,200,
hWindow,500,hInstance,nil);
AddString(hLB1,'雨');
AddString(hLB1,'あめ');
AddString(hLB1,'飴');
AddString(hLB1,'アメ');
AddString(hLB1,'A1');
AddString(hLB1,'abc');
AddString(hLB1,'a12');
AddString(hLB1,'ABC');
AddString(hLB1,'987');
AddString(hLB1,'123');
hLB2 := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX',
'MyListBox',
$54010141 or WS_VSCROLL or LBS_USETABSTOPS,
140,10,100,200,
hWindow,500,hInstance,nil);
end;
procedure OnTest(hWindow: HWND);
var
SA: TStringArray;
i,Count: integer;
begin
SA := TStringArray.Create;
Count := GetCount(hLB1);
for i := 0 to Count-1 do SA.Add(GetText(hLB1,i));
SA.Sort;
ResetContent(hLB2);
for i := 0 to Count-1 do AddString(hLB2,SA[i]);
SA.Free;
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
if (Msg.LParam = LPARAM(hLB1)) then // ListBox Command
case Msg.WParamHi of
LBN_SELCHANGE: begin
ResetContent(hLB2);
AddString(hLB2,GetSelText(hLB1));
end;
end;
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.TestStringArray.zip(13.541kB)
実行して Test! メニューを選択したときの様子を右図に示す。 左のリストが右のリストボックスにソートしてコピーされる。OnCreate( ) ハンドラでは、ハンドルが hLB1 と hLB2 の二つのリストボックスを CreateWindowEx( ) で作っている。 hLB1 には、９個の文字列が追加される。この項目をクリックすると hLB2 にその項目の内容がインデックスとともに表示される。
OnTest( ) ハンドラを見てみよう。
procedure OnTest(hWindow: HWND); var SA: TStringArray; i,Count: integer; begin SA := TStringArray.Create; Count := GetCount(hLB1); for i := 0 to Count-1 do SA.Add(GetText(hLB1,i)); SA.Sort; ResetContent(hLB2); for i := 0 to Count-1 do AddString(hLB2,SA[i]); SA.Free; end;
ここでは、TStringArray のインスタンス SA をつくり、hLB1 のすべての文字列をコピーしている。 そして、ソートを実行したのち、hLB2 にコピーしている。 最後に、SA を廃棄している。 ここでは、TStringArray のすべてのメソッドをテストしていないが、それについては読者に任せたい。 SA.Sort のコードをコメントアウトして実行すると文字列がそのまま hLB2 にコピーされる。
リストボックスコントロールのラッパークラスを設計するとき困ったことが一つある。 それは、項目をソートするかどうかを決める LBS_SORT スタイルや、複数の項目の選択を許すかどうかを決める LBS_EXTENDEDSEL スタイルなどの コントロールの性質を決める重要なウィンドウスタイルが、ウィンドウ作成時のみの指定が有効であり、作成後に SetWindowLong( ) ＡＰＩを使って設定しても機能に反映されないことだ。 ＶＣＬの TListBox は、一つのクラスでリストボックスのほぼ全ての機能をカプセル化することに成功している。 このことは、オブジェクトインスペクタで設定されたプロパティーを実行時に参照できるので当然のように思われるが、コードで ListBox1.Sorted := true; とすると直ぐに反映されるというのは見事だ。ウィンドウ関数を完全にサブクラス化しているか、プロパティーの設定変更に伴ってウィンドウオブジェクトを作成し直しているかのどちらかだろうと想像できる。
８−１節で見てきたように単選択リストボックスと多選択可能リストボックスでは、項目の参照や設定に使用できるメッセージがお互いに異なっている部分がある。 ここでは、両方に共通なメソッドやプロパティーを装備した TAPIListBoxBase クラスを TAPIControl から派生してつくる。そして、その TAPIListBoxBase クラスから派生しての両方のリストボックスをカプセル化したクラスを作成することにしよう。 LBS_SORT スタイルを持ったリストボックスのラッパークラスは作成しないかわりに、前節でつくった TStringArray の Sort メソッドを利用して、ユーザが望むときにはいつでもソートできるようなメソッドを装備しよう。
まず APIControl.pas に TAPIListBoxBase クラスを宣言する。
//---------- APIListBoxBase ---------------------------------------------- TAPIListBoxBase = class(TAPIControl) private FColor: COLORREF; FTxtColor: COLORREF; FRedraw: Boolean; FOnDoubleClick: TNotifyMessage; FOnSelChange: TNotifyMessage; function GetString(index:integer): string; procedure SetString(index: integer; value: string); function GetCount: integer; function GetTopIndex: integer; procedure SetTopIndex(value: integer); function GetItemData(index: integer):integer; procedure SetItemData(index,value: integer); procedure SetColor(value: COLORREF); procedure SetTxtColor(value: COLORREF); procedure SetRedraw(value: Boolean); protected procedure Initialize; override; public procedure DefaultHandler(var Message); override; function AddString(value: string):integer; function DeleteString(index: integer):integer; function InsertString(index: integer; value:string):integer; procedure Clear; function FindString(StartIndex:integer; s: string):integer; procedure DoSort; property ItemString[index:integer]: string read GetString write SetString;default; property Count: integer read GetCount; property TopIndex: integer read GetTopIndex write SetTopIndex; property ItemData[index:integer]: integer read GetItemData write SetItemData; property Color: COLORREF read FColor write SetColor; property TextColor: COLORREF read FTxtColor write SetTxtColor; property Redraw: Boolean read FRedraw write SetRedraw; property OnDoubleClick: TNotifyMessage read FOnDoubleClick write FOnDoubleClick; property OnSelChange: TNotifyMessage read FOnSelChange write FOnSelChange; end;
TAPIListBoxBase は、リストボックスコントロールのラッパークラスの上位クラスとして設計されている。 文字列の追加・挿入・削除・全消去・検索・ソートをするメソッドと、特定のインデックスの項目の文字列を設定・取得する ItemString プロパティー、項目数を表す Count プロパティー、垂直スクロールをして表示項目の領域を制御する TopIndex プロパティー、項目に関連づけられる整数値の設定・取得をする ItemData プロパティー などがある。 Redraw プロパティーはデフォルトでは true であり、項目数や選択状態が変更されるたびに再描画する。多数の項目を追加したり、 項目をソートするときなどは、いちいち再描画しないようにこのプロパティーを false にしてから、追加やソートを実行し、最後に true にして一度だけ再描画すると、見た目も処理スピード向上する。イベントとして、OnSelChange と OnDoubleClick が公開されている。 つぎに実装部に実装コードを書く。
//---------- APIListBoxBase ----------------------------------------------
procedure TAPIListBoxBase.Initialize;
begin
inherited Initialize;
FColor := clrWhite;
FTxtColor := clrBlack;
FRedraw := true;
Dispatcher.TrapMessage(WM_CTLCOLORLISTBOX,self);
end;
procedure TAPIListBoxBase.DefaultHandler(var Message);
var
AMsg: TMessage;
begin
AMsg := TMessage(Message);
case AMsg.Msg of
WM_COMMAND: begin
if (AMsg.LParam <> LPARAM(FHandle)) then exit;
if AMsg.WParamHi = WORD(LBN_ERRSPACE) then
MessageBox(Parent,'ListBox Error Space','Warning',MB_OK);
AMsg.Msg := UINT(self); // Sender
case AMsg.WParamHi of
LBN_SELCHANGE: if Assigned(FOnSelChange) then OnSelChange(AMsg);
LBN_DBLCLK: if Assigned(FOnDoubleClick) then OnDoubleClick(AMsg);
end; // case
end;
WM_CTLCOLORLISTBOX: if AMsg.LParam = LPARAM(FHandle) then begin
SetBkColor(AMsg.WParam,FColor);
SetTextColor(AMsg.WParam,FTxtColor);
TMessage(Message).Result := CreateSolidBrush(FColor);
end;
end; // case
end;
function TAPIListBoxBase.AddString(value: string):integer;
begin
Result := SendMessage(FHandle,LB_ADDSTRING, 0, Integer(PChar(value)));
end;
function TAPIListBoxBase.DeleteString(index: integer):integer;
begin
Result := SendMessage(FHandle,LB_DELETESTRING,WParam(index),0);
end;
function TAPIListBoxBase.InsertString(index: integer; value:string):integer;
begin
Result := SendMessage(FHandle,LB_INSERTSTRING,WParam(index),
lParam(PChar(value)));
end;
procedure TAPIListBoxBase.Clear;
begin
SendMessage(FHandle,LB_RESETCONTENT, 0, 0);
end;
function TAPIListBoxBase.GetString(index:integer): string;
var
len: integer;
PC:PChar;
begin
if (index > Count-1) or (index < 0) then Exit;
len := SendMessage(FHandle,LB_GETTEXTLEN,WPARAM(index),0);
GetMem(PC,len+1); // +1 for null-terminator
SendMessage(FHandle,LB_GETTEXT,WParam(index),LParam(PC));
System.SetString(result,PC,len);
FreeMem(PC);
end;
procedure TAPIListBoxBase.SetString(index: integer; value: string);
begin
if (index > Count-1) or (index < 0) then Exit;
DeleteString(index);
InsertString(index,value);
end;
function TAPIListBoxBase.FindString(StartIndex:integer; s: string):integer;
begin
Result := SendMessage(FHandle,LB_FINDSTRING,StartIndex,LPARAM(PChar(s)))
end;
procedure TAPIListBoxBase.DoSort;
var
SA: TStringArray;
i,IC: integer;
begin
SA := TStringArray.Create;
IC := Count;
for i := 0 to IC-1 do SA.Add(ItemString[i]);
Clear;
SA.Sort;
Redraw := false;
for i := 0 to IC-1 do AddString(SA[i]);
SA.Free;
Redraw := true;
end;
function TAPIListBoxBase.GetCount: integer;
begin
result := SendMessage(FHandle,LB_GETCOUNT,0,0);
end;
function TAPIListBoxBase.GetTopIndex: integer;
begin
result := SendMessage(FHandle,LB_GETTOPINDEX,0,0);
end;
procedure TAPIListBoxBase.SetTopIndex(value: integer);
begin
SendMessage(FHandle,LB_SETTOPINDEX,WParam(value),0);
end;
function TAPIListBoxBase.GetItemData(index: integer):integer;
begin
Result := SendMessage(FHandle,LB_GETITEMDATA,index,0);
end;
procedure TAPIListBoxBase.SetItemData(index,value: integer);
begin
SendMessage(FHandle,LB_SETITEMDATA,index,value);
end;
procedure TAPIListBoxBase.SetColor(value: COLORREF);
begin
FColor := value;
InvalidateRect(FHandle,nil,true);
end;
procedure TAPIListBoxBase.SetTxtColor(value: COLORREF);
begin
FTxtColor := value;
InvalidateRect(FHandle,nil,true);
end;
procedure TAPIListBoxBase.SetRedraw(value: Boolean);
begin
if value then begin
SendMessage(FHandle,WM_SETREDRAW,1,0);
InvalidateRect(FHandle,nil,true);
end else
SendMessage(FHandle,WM_SETREDRAW,0,0);
FRedraw := value;
end;少しだけ実装コードを調べよう。 Initialize メソッドでは、背景色とテキスト色を制御するために Dispatcher に WM_CTLCOLORLISTBOX メッセージを送ってくれるよう依頼している。 DefaultHandler では、WM_COMMAND と WM_CTLCOLORLISTBOX だけを処理している。 このコードは、単選択か複数選択可能かによらないのでこのベースクラスに設けた。 ソートを実行する DoSort メソッドを見てみよう。
procedure TAPIListBoxBase.DoSort; var SA: TStringArray; i,IC: integer; begin SA := TStringArray.Create; IC := Count; for i := 0 to IC-1 do SA.Add(ItemString[i]); Clear; SA.Sort; Redraw := false; for i := 0 to IC-1 do AddString(SA[i]); SA.Free; Redraw := true; end;
ここでは前節で作った TStringArray クラスのインスタンスをつくり、その Sort メソッドを使って文字列リストをソートしている。 追加メソッド AddString( ) の実行の前後で Redraw プロパティーを操作してちらつきをなくしている。 SetRedraw アクセスメソッドでは、WM_SETREDRAW メッセージを送って、リストボックスコントロールの Redraw フラグを制御している。 再描画の有無を設定するには、 このコントロールに WM_SETREDRAW メッセージを送る。
WM_SETREDRAW wParam = (WPARAM) fRedraw; // state of redraw flag lParam = 0; // not used; must be zero
Redraw フラグをセットするには、wParam にゼロ以外の数値を指定する。再描画可能にしたら、InvalidateRect( ) を実行して強制的に再描画する。 その他のメソッドは、前節まででコードで使ってきたので容易に理解できるだろう。
TAPIListBoxBase クラスが出来たので、これから派生して単選択のみ可能な TAPIListBox クラスを作成しよう。宣言部を以下に示す。
//---------- APIListBox ---------------------------------------------- TAPIListBox = class(TAPIListBoxBase) private procedure SetSelIndex(value: Integer); function GetSelIndex: integer; function GetSelString: string; protected procedure APICreateParams(var Params: TAPICreateParams); override; public property SelIndex: integer read GetSelIndex write SetSelIndex; property SelText: string read GetSelString; end;
単選択のみと複数選択可能なリストボックスコントロールの違いは、 項目の内容の設定と取得、選択状態の設定と取得に関するメッセージだけなので、TAPIistBoxBase の派生クラスはこの違うところだけを実装すればよい。 単選択のみ可能なリストボックス TAPIListBox では、ウィンドウスタイルを設定する APICreateParams( ) をオーバーライドし、選択項目のインデックスと文字列を設定・取得するプロパティーだけが追加されている。実装部を以下に示す。
//---------- APIListBox ----------------------------------------------
procedure TAPIListBox.APICreateParams(var Params: TAPICreateParams);
begin
with Params do begin
Caption := 'APIListBox';
Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
WS_CLIPSIBLINGS or WS_VSCROLL or LBS_NOINTEGRALHEIGHT or
LBS_USETABSTOPS or LBS_HASSTRINGS or LBS_NOTIFY;
ExStyle := WS_EX_CLIENTEDGE;
X := 50;
Y := 50;
Width := 150;
Height := 32;
WinClassName := 'LISTBOX';
end;
end;
procedure TAPIListBox.SetSelIndex(value: Integer);
begin
SendMessage(FHandle,LB_SETCURSEL,WParam(value),0);
end;
function TAPIListBox.GetSelIndex: integer;
begin
Result := Integer(SendMessage(FHandle,LB_GETCURSEL,0,0));
end;
function TAPIListBox.GetSelString: string;
begin
Result := ItemString[SelIndex];
end;ここで使っている LB_GETCURSEL と LB_SETCURSEL メッセージは８−１節で示したように、単選択のみ可能なリストボックスコントロールにだけ使うことができる。 これでこのクラスが完成したので、このクラスのインスタンスを作る関数を作ろう。 宣言部は、
function CreateListBox(hParent: HWND; x,y,cx,cy: integer;
sOnSelChange:TNotifyMessage): TAPIListBox;とし、実装部は
function CreateListBox(hParent: HWND; x,y,cx,cy: integer;
sOnSelChange:TNotifyMessage): TAPIListBox;
begin
result := TAPIListBox.Create(hParent);
with result do begin
Dimension := SetDim(x,y,cx,cy);
OnSelChange := sOnSelChange;
end;
end;とする。
TAPIListBox をテストするプログラムを ListBox02.dpr に書こう。 以下に全リストを示す。
program ListBox02;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1, LB2: TAPIListBox;
L1: TAPILabel;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg:TMessage);
begin
LB2.AddString(LB1.SelText);
LB2.TopIndex := LB2.Count -5;
end;
procedure LB1DoubleClick(var Msg:TMessage);
begin
L1.Text := LB1.SelText;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,480,270);
CenterWindow(hWindow);
L1 := CreateLabel(hWindow,10,10,220,34,'');
L1.Margin := 6;
LB1 := CreateListBox(hWindow,10,60,220,150,LB1SelChange);
with LB1 do begin
AddString('ABC123');
AddString('あかさたな');
AddString('123&&&5%%'+#9+'Tab');
AddString('柿食えば鐘が鳴るなり');
AddString('This is the last line.');
OnDoubleClick := LB1DoubleClick;
end;
LB2 := CreateListBox(hWindow,240,10,220,200,nil);
end;
procedure OnTest(hWindow: HWND);
var
s: string;
begin
{s := '柿';
L1.Text := LB1[LB1.FindString(0,s)];}
{LB1.ItemData[2] := 1234567;
L1.Text := AIntToStr(LB1.ItemData[2]);}
LB1.InsertString(3,'挿入された文です');
LB1.Color := RGB(255,255,230);
LB1.TextColor := clrGreen;
LB2.Clear;
//LB1.DoSort;
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.ListBox02.zip(15.793kB)
実行すると、右図のようになる。 LB１の選択項目をマウスや矢印キーなどで変更すると、新しく選択された項目の文字列が LB2 に追加される。 LB1 をダブルクリックすると、その文字列がラベルに表示される。 OnTest( ) ハンドラにいろいろなコードを書いて、プロパティーやメソッドをテストしてほしい。
複数項目の同時選択ができる TAPIMSListBox クラスを TAPIListBoxBase から派生して作る。 ウィンドウスタイルの変更は、APICreateParams( ) を override するだけだ。 しかし、複数選択可能の場合は、選択された項目にアクセスするために幾つかのプロパティーを追加しなければならない。
最初に APIControl.pas に TAPIMSListBox クラスをつくろう。宣言部を以下に示す。
//---------- APIMSListBox ---------------------------------------------- TAPIMSListBox = class(TAPIListBoxBase) private function GetSelected(index: integer):Boolean; procedure SetSelected(index: integer; value: Boolean); function GetSelCount: integer; function GetCaretIndex: integer; procedure SetCaretIndex(index:integer); function GetCaretText: string; protected procedure APICreateParams(var Params: TAPICreateParams); override; public property Selected[index:integer]: Boolean read GetSelected write SetSelected; property SelCount: integer read GetSelCount; property CaretIndex: integer read GetCaretIndex write SetCaretIndex; property CaretText: string read GetCaretText; end;
複数の項目が選択されているとき、選択項目の内容を取得・設定するために Selected プロパティーがある。 インデックスを指定して読みとると、true が返ってきたらその項目が選択されている事を示している。 逆に、true を設定するとその項目を選択状態にする。SelCount プロパティーは、選択項目の数を取得する。 CaretIndex プロパティーは、フォーカス矩形のある項目の取得・設定を行う。 特に、ダブルクリックされたときの項目のインデックスを取得し、CaretText でその項目の文字列を取得するのに使われる。 実装部を以下に示す。
//---------- APIMSListBox ----------------------------------------------
procedure TAPIMSListBox.APICreateParams(var Params: TAPICreateParams);
begin
with Params do begin
Caption := 'APIMSListBox';
Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
WS_CLIPSIBLINGS or WS_VSCROLL or LBS_NOINTEGRALHEIGHT or
LBS_USETABSTOPS or LBS_HASSTRINGS or LBS_NOTIFY or
LBS_EXTENDEDSEL;
ExStyle := WS_EX_CLIENTEDGE;
X := 50;
Y := 50;
Width := 150;
Height := 32;
WinClassName := 'LISTBOX';
end;
end;
function TAPIMSListBox.GetSelCount: integer;
begin
result := SendMessage(FHandle,LB_GETSELCOUNT,0,0);
end;
function TAPIMSListBox.GetSelected(index: integer):Boolean;
begin
if SendMessage(FHandle,LB_GETSEL,wParam(index),0) > 0 then
result := true
else
result := false;
end;
procedure TAPIMSListBox.SetSelected(index: integer; value: Boolean);
begin
SendMessage(FHandle,LB_SETSEL,WPARAM(value),LPARAM(index));
end;
function TAPIMSListBox.GetCaretIndex: integer;
begin
result := SendMessage(FHandle,LB_GETCARETINDEX,0,0);
end;
procedure TAPIMSListBox.SetCaretIndex(index:integer);
begin
SendMessage(FHandle,LB_GETCARETINDEX,WPARAM(index),1);
end;
function TAPIMSListBox.GetCaretText: string;
begin
Result := ItemString[CaretIndex];
end;実装部のコードについては説明の必要はないだろう。最後に、このクラスのインスタンスを作る関数を作ろう。 宣言部は、
function CreateMSListBox(hParent: HWND; x,y,cx,cy: integer;
sOnSelChange:TNotifyMessage): TAPIMSListBox;であり、実装部は、
function CreateMSListBox(hParent: HWND; x,y,cx,cy: integer;
sOnSelChange:TNotifyMessage): TAPIMSListBox;
begin
result := TAPIMSListBox.Create(hParent);
with result do begin
Dimension := SetDim(x,y,cx,cy);
OnSelChange := sOnSelChange;
end;
end;となる。 このクラスをテストするプログラムを ListBox03.dpr に作る。 以下に全リストを示す。
program ListBox03;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
Clr: COLORREF;
LB1, LB2: TAPIMSListBox;
L1: TAPILabel;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg:TMessage);
var
i: integer;
begin
LB2.Clear;
for i := 0 to LB1.Count-1 do
if LB1.Selected[i] then LB2.AddString(LB1[i]);
end;
procedure LB1DoubleClick(var Msg:TMessage);
begin
L1.Text := LB1.CaretText;
end;
//------------------------------------------------------------
// Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := Msg.Msg;
Clr := clrBtnFace;
MakeInitMenu(hWindow);
ChangeWindowSize(hWindow,480,270);
CenterWindow(hWindow);
L1 := CreateLabel(hWindow,10,10,220,34,'');
L1.Margin := 6;
LB1 := CreateMSListBox(hWindow,10,60,220,150,LB1SelChange);
with LB1 do begin
AddString('ABC123');
AddString('あかさたな');
AddString('123&&&5%%'+#9+'Tab');
AddString('柿食えば鐘が鳴るなり');
AddString('This is the last line.');
OnDoubleClick := LB1DoubleClick;
end;
LB2 := CreateMSListBox(hWindow,240,10,220,200,nil);
end;
procedure OnTest(hWindow: HWND);
begin
LB2.DoSort;
LB2.Color := RGB(230,230,255);
end;
procedure OnCommand(var Msg: TMessage);
begin
InitMenuCommand(Msg,OnTest);
end;
procedure OnEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;
procedure OnDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): LRESULT; stdcall;
var
AMsg: TMessage;
begin
Result := 0;
AMsg.Msg := hWindow;
AMsg.WParam := WParam;
AMsg.LParam := LParam;
AMsg.Result := 0;
case Msg of
//------------- WM_CREATE -----------------------------------
WM_CREATE: OnCreate(AMsg);
//------------- WM_COMMAND ----------------------------------
WM_COMMAND: OnCommand(AMsg);
//------------- WM_ERASEBKGND -------------------------------
WM_ERASEBKGND: begin
OnEraseBkgnd(AMsg);
result := AMsg.Result;
end;
//------------- WM_DESTROY ----------------------------------
WM_DESTROY: OnDestroy(AMsg);
//-------- そのほかのメッセージの処理 ------
else begin
result := DefWindowProc( hWindow, Msg, wParam, lParam );
end;
end; // case
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MakeMainWindow(@MainWndProc);
Halt(MessageLoopNormal);
end.ListBox03.zip(16.514kB)
実行時の様子を右図に示す。 左のリストボックスの項目を CTRL キーや SHIFT キーとマウスを使って複数個選択すると、選択状態が変更されるたびに右側のリストボックスに選択項目の全リストが表示される。
LB1SelChange( ) を見てみよう。
procedure LB1SelChange(var Msg:TMessage);
var
i: integer;
begin
LB2.Clear;
for i := 0 to LB1.Count-1 do
if LB1.Selected[i] then LB2.AddString(LB1[i]);
end;選択状態の項目の内容を一度に取得するメッセージはないので、このコードのように Selected プロパティーが true の項目だけ拾い出すことによって、選択項目の内容のリストを取得する。複数選択された状態でも、ダブルクリックでクリックされた項目がラベルに表示される。 LB1DoubleClick( ) を持て見よう。
procedure LB1DoubleClick(var Msg:TMessage); begin L1.Text := LB1.CaretText; end;
このように複数選択可能なリストボックスでは、選択状態の有無にかかわらず、フォーカス矩形のある項目の内容を取得するのに CaretText プロパティーを用いる。 Test! メニューでは、右側のリストボックスの項目をソートし、背景を薄い水色に変更している。
本章では、ボタンよりかなり複雑なコントロールであるリストボックスについて、まず ＶＣＬの TListBox のクラス属性を参考にして、コードで作成することから始めた。 そして、リストボックスが親ウィンドウに送るメッセージやリストボックスが理解できるメッセージを調べ、実際にそれらを試してみた。 つぎに、リストボックスが保持する文字列リストに対応するクラス TStringArray を作成した。 このクラスをつかって、単選択リストボックスと多選択リストボックスのラッパークラスを作成し、テストした。
次章では、 本章で作成したリストボックスをつかって小さいアプリケーションを作ってみる。
ここまでのプログラムファイル