'--------------------------------------
' コールバックすることによって
' 似たような処理をする関数を
' 複数作らなくてもよいことになり、
' 修正するのはコールバックされる関数のみ
' ということになります。
' Event,RaiseEventでも
' 同じようなことができますが、
' 呼び出される関数が限定されます。
'--------------------------------------

'フォームをロードしました
Private Sub Form_Load()
    'コンボボックスにアイテムを追加します
    Combo1.AddItem "MyFind_Callback1"
    Combo1.AddItem "MyFind_Callback2"
    Combo1.ListIndex = 0
End Sub

'検索ボタンをクリックしました
Private Sub Command1_Click()
    
    '検索ボタンの入力を無効にします
    Command1.Enabled = False
    
    'コールバックされる関数を指定して
    '検索を開始します
    List1.Clear
    MyFind Me, Combo1.Text, "MyFind_Looping", Text1.Text, Text2.Text
    Label1.Caption = ""
    
    '検索ボタンの入力を有効にします
    Command1.Enabled = True
    
End Sub

'コールバックする関数です
Sub MyFind(objCallModule As Object, ByVal strFindCall As String, ByVal strLoopingCall As String, ByVal strText As String, ByVal strFindItem As String)
    Dim lngInstr    As Long
    Dim lngStart    As Long
    Dim strItem     As String
    Dim cleArgs     As New Collection
    Dim lngFindItemLen As Long
    
    '検索開始位置と
    '検索対象文字列のサイズを代入します
    lngStart = 1
    lngFindItemLen = Len(strFindItem)
    Do
        
        
        'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
        ' 動作確認をするために待機処理をします
        ' 通常使用の際は、この部分は消して下さい
        'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
        Dim j As Long
        For j = 1 To 5000: DoEvents: Next
        'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
        
        
        'ループするつど
        '指定した関数を呼び出します
        CallByName objCallModule, strLoopingCall, VbMethod
        
        '文字列を検索します
        lngInstr = InStr(lngStart, strText, strFindItem, vbTextCompare)
        If lngInstr > 0 Then
            
            '次の検索位置を代入します
            lngStart = lngInstr + lngFindItemLen
            
            '検索した文字列を格納します
            strItem = Mid(strText, lngInstr, lngFindItemLen)
            
            'パラメータをセットします
            Set cleArgs = Nothing 'コレクションクリア
            cleArgs.Add lngInstr, "FIND_POS"
            cleArgs.Add strItem, "ITEM"
            
            '指定された関数に飛びます
            CallByName objCallModule, strFindCall, VbMethod, cleArgs
        End If
        
        '検索が終ったらループを抜けます
        If lngStart <= 0 Or lngStart > Len(strText) Then Exit Do
        
    Loop Until lngInstr <= 0
    
End Sub

'テキストボックスを選択状態にします
Sub MyFind_Callback1(cleArgs As Collection)
    'コレクションクラスに入っている引数を展開して
    'テキストボックスの文字列を選択します
    Text1.SelStart = cleArgs.Item("FIND_POS") - 1
    Text1.SelLength = Len(cleArgs.Item("ITEM"))
End Sub

'リストボックスにアイテムを追加します
Sub MyFind_Callback2(cleArgs As Collection)
    'リストボックスに追加します
    List1.AddItem cleArgs.Item("ITEM")
End Sub

' "検索中..." をアニメーションします
Sub MyFind_Looping()
    Static s_OldSecond  As Integer
    Static s_DotCount   As Integer
    Dim lngNowSecond    As Integer
    
    '1秒おきに . をアニメーションします
    lngNowSecond = Second(Time)
    If Not (lngNowSecond = s_OldSecond) Then
        s_OldSecond = lngNowSecond
        ' . が3つ以上のときは、カウントをリセットします
        If s_DotCount >= 3 Then
            s_DotCount = 0
        Else
            s_DotCount = s_DotCount + 1
        End If
        Label1.Caption = "検索中" & String(s_DotCount, ".")
        Label1.Refresh
    End If
        
End Sub