２．API を使ってのリストボックスでよく使用するワンポイント設定集

１．リストボックス(ListBox)ですべての項目を選択状態にする、すべての選択状態を解除する ２．リストボックス(ListBox)の行の高さを設定する、行の高さを取得する ３．リストボックス(ListBox)内を先頭一致検索・完全一致検索する ４．リストボックス(ListBox)で重複しない項目だけを読み込み表示する ５．　 ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6) Option　：[Option Explicit] 参照設定：追加なし 使用 API：SendMessage その他　：このサンプルは、 Win32 APIを使用しておりますので、ある程度Win32 API が理解できる方がお使い下さい。 　　　　： Win32 API とは 　Win32 Application Programming Interfaces の略で、32bit プロセッサで動作する Windows 95 等、以降用に対応するアプリケーションの開発者のために、公開されている関数を指します。 尚、Visual Basic 2010 等の .NET 系のバージョンや VBA からも使用する事ができます。 　ここでは、略して Win32 API　とか　Win32 API 関数 とか表示スペースの関係から　API　と表記する場合があります。

１．リストボックス(ListBox)ですべての項目を選択状態にする、すべての選択状態を解除する

リストボックス(ListBox)には、データが表示されていて複数選択できるように設定されているものとし、その上で下記のコードを追加して下さい。 Option Explicit '指定のウィンドウにメッセージを送る(P750) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ 　　ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '複数選択リストボックスの指定の項目を選択(P828) Private Const LB_SETSEL = &H185 Private Sub Command1_Click() 　　Dim Ret As Long 　　'すべての項目を選択状態にする 　　Ret = SendMessage(List1.hWnd, LB_SETSEL, 1&, ByVal -1&) End Sub Private Sub Command2_Click() 　　Dim Ret As Long 　　'選択状態を解除する 　　Ret = SendMessage(List1.hWnd, LB_SETSEL, 0&, ByVal -1&) End Sub

２．リストボックス(ListBox)の行の高さを設定する、行の高さを取得する

リストボックス(ListBox)には、データが表示されているものとし、その上で下記のコードを追加して下さい。 Option Explicit '指定のウィンドウにメッセージを送る(P750) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ 　　ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '指定の項目の高さを取得する(P819) Private Const LB_GETITEMHEIGHT = &H1A1 '指定の項目の高さを設定する(P827) Private Const LB_SETITEMHEIGHT = &H1A0 Private Sub Command1_Click() 　　Dim Ret As Long 　　'現在の行の高さを求める 　　Ret = SendMessage(List1.hWnd, LB_GETITEMHEIGHT, 0&, ByVal 0&) 　　'行の高さを現在より10%高くする 　　Ret = SendMessage(List1.hWnd, LB_SETITEMHEIGHT, 0&, ByVal CLng(Ret * 1.1)) 　　List1.Refresh End Sub

３．リストボックス(ListBox)内を先頭一致検索・完全一致検索する

Option Explicit '指定のウィンドウにメッセージを送る(P750) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ 　　ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Private Const LB_FINDSTRING = &H18F　　　　 '先頭一致検索(P816) Private Const LB_FINDSTRINGEXACT = &H1A2　　'完全一致検索(P816) Private Sub Command1_Click() '入力した文字列がリストボックス内に無いか完全一致検索を実施しあれば表示 　　Label1.Caption = List1.List(fLBSearch(List1, Text1.Text, 1)) '入力した文字列がリストボックス内に無いか前方一致検索を実施しあれば表示 　　Label1.Caption = List1.List(fLBSearch(List1, Text1.Text, 0)) End Sub '================================================================= ' 指定の文字列がリストボックス内にあるか検索する関数 '　LBox　　　 :検索するリストボックス名 '　SearchStr　:検索する文字列 '　Exact　　　:検索方法　1<>前方一致検索　1=完全一致検索 '　fLBSearch　:戻り値　見つかった場合=インデックス それ以外 = -1 '================================================================== Private Function fLBSearch(LBox As ListBox, ByVal SearchStr As String, _ 　　　　　　　　　　　　Optional ByVal Exact As Integer = 0) As Integer 　　Dim Ret As Long 　　If Exact = 1 Then 　　　　Ret = SendMessage(LBox.hWnd, LB_FINDSTRINGEXACT, -1, SearchStr) 　　Else 　　　　Ret = SendMessage(LBox.hWnd, LB_FINDSTRING, -1, SearchStr) 　　End If 　　LBox.ListIndex = Ret 　　fLBSearch = Ret End Function 尚、部分一致検索をする場合は、下記のようにして検索して下さい。 Private Sub Command2_Click() 　　Dim i　 As Long 　　Dim Ret As Long 　　For i = 0 To List1.ListCount - 1 　　　　Ret = InStr(List1.List(i), Text1.Text) 　　　　If Ret <> 0 Then 　　　　　　MsgBox i & " 行で見つかりました" 　　　　End If 　　Next i End Sub

４．リストボックス(ListBox)で重複しない項目だけを読み込み表示する

Option Explicit '指定のウィンドウにメッセージを送る(P750) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ 　　ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Private Const LB_FINDSTRINGEXACT = &H1A2　　'完全一致検索(P816) Private Sub Command1_Click() 　　List1.Visible = False 　　List1.Clear 　　Dim intFileNo　 As Integer 　　Dim strTextLine As String 　　'使用可能なファイル番号を取得 　　intFileNo = FreeFile 　　'テキストファイルをオープン 　　Open "ListTest1.txt" For Input As #intFileNo 　　'ファイルの終端までループを繰り返します。 　　Do While Not EOF(intFileNo) 　　　　'1 行づつ変数に読み込みます。 　　　　Line Input #intFileNo, strTextLine 　　　　If SendMessage(List1.hWnd, LB_FINDSTRINGEXACT, -1, strTextLine) = -1 Then 　　　　　　List1.AddItem strTextLine 　　　　End If 　　Loop 　　'ファイルを閉じる 　　Close #intFileNo 　　List1.Visible = True End Sub 1万行で7秒程度の処理時間がかかりますので、行数が多いような場合は運用に工夫が必要です。

５．

６．

検索キーワード及びサンプルコードの別名(機能名)

リストボックスに関するサンプル集　ListBoxに関するサンプル集