リストボックス内を検索(APIを使って)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。 　　
リストボックス内を先頭一致検索・完全一致検索
　　 Option Explicit　　 'SampleNo=140　WindowsXP VB6.0(SP5) 2002．05.17

'指定のウィンドウにメッセージを送る(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 Form_Load()
'初期設定
　　List1.AddItem "かきくけこ"
　　List1.AddItem "あいうえお"
　　List1.AddItem "あいうえ"
　　List1.AddItem "あいうえおか"
　　List1.AddItem "さしすせそ"
　　List1.AddItem "たちつてと"
　　List1.AddItem "なにぬねの"
　　List1.AddItem "はひふへほ"
　　List1.AddItem "まみむめも"
End Sub


Private Sub Text1_Change()
'入力した文字列がリストボックス内に無いか完全一致検索を実施しあれば表示
　　Label3.Caption = List1.List(fLBSearch(List1, Text1.Text, 1))
End Sub


Private Sub Text2_Change()
'入力した文字列がリストボックス内に無いか前方一致検索を実施しあれば表示
　　Label4.Caption = List1.List(fLBSearch(List1, Text2.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 Command1_Click()
'入力した文字列がリストボックス内に無いか完全一致検索し、無ければ追加
　　Dim Ret As Integer
　　Ret = fLBSearch(List1, Text3.Text, 1)
　　If Ret = -1 Then
　　　　List1.AddItem Text3.Text　　'見つからなかったので追加
　　Else
　　　　MsgBox "すでに登録されています"
　　End If
End Sub
結構早くて、簡単なので使い道があれば便利かと思います。
　　　　




2002/05/25