【Class Library】

'//クラス内のグローバル変数//
'オブジェクトサイズなど
Private pgb_Obje As Object    '対象オブジェクト
Private pgb_Width As Long     'プログレスバーの幅
Private pgb_Height As Long    'プログレスバーの高さ
Private pgb_MaxValue As Long  'プログレスバーに設定された最大値
Private pgb_Style As Boolean  'プログレスバーが横方向か縦方向か
Private pgb_Type As Boolean   '進行が左→右、上→下であるかどうか
Private pgb_BackColor As Long 'プログレスバーの背景色
Private pgb_Count As Long     'プログレスバーの幅と高さに同じ
Private graCount As Long      '進行したカウント

'---------------------------------
'グラデーションパターンのための変数
'終了値と変化値の指定を終了値のみにして、
'変化値 = (終了値 - 変化値) / (pgb_Count)
'のようにした方が、コードも簡略化され高速化できます。
'ただ、グラデーションが自動化されるので、少し面白くないかも
Private pgb_r1 As Single
Private pgb_g1 As Single
Private pgb_b1 As Single
'r,g,b値の終了値
Private pgb_r2 As Single
Private pgb_g2 As Single
Private pgb_b2 As Single
'r,g,b値の1カウントごとの変化値
Private pgb_rm As Single
Private pgb_gm As Single
Private pgb_bm As Single
 '描画するR,G,B値(1文字の変数とは・・・、いつもの事ながら非常識かな。(^^))
Private r As Single, g As Single, b As Single

'General セクション内の変数
Dim cpb As New CPgbar 'プログレスバークラス
Dim rfname As String
Dim stopflag As Boolean '処理の中止を制御

'General セクション内のプロシージャ
'===========================================================
'GetSearchWordCount  指定されたファイル中に指定された文字列が
'                    いくつあるかを求める(パターン・マッチング)
'---------引数----------------------------------------------
'fname        ファイル名
'TargetWord   検索する文字列
'CompareType  比較タイプ(0-大文字と小文字を区別する,1-区別しない)
'---------戻り値--------------------------------------------
'fname中のTargetWordの数を返す
'===========================================================
Private Function GetSearchWordCount(ByVal fname As String, _
                        ByVal TargetWord As String, _
                        ByVal CompareType As Long, _
                        ByVal labelobje As Object) As Long

    Dim InputFileNumber As Integer '読み込むファイル番号
    Dim tempStr As String          '検索先文章1行の格納先
    Dim SearchPoint As Long        '1行中の検索位置
    Dim wCount As Long             '見つかった文字列数
    Dim ret As Long                'InStr関数の戻り値
    Dim fl As Long                 'ファイルの長さ
    Dim sl As Long                 'ファイルの読み込み位置
    
    wCount = 0&                    'ヒットした文字数の初期化
    InputFileNumber = FreeFile(0)
    stopflag = False               '中止をしない
    fl = FileLen(fname)            'ファイルの大きさ(Byte)を得る
    sl = 0&
    
    cpb.PgbMaxValue = fl           '最大値＝ファイルの大きさの指定
    
    'ファイルを開く
    Open fname For Input Access Read As #InputFileNumber

        'ファイルの終端まで
        Do While EOF(InputFileNumber) = False
            '処理を中止せよ
            If stopflag = True Then Exit Do
            '1行ずつ読み込む(通常、CrLfを探すことはない)
            Line Input #InputFileNumber, tempStr
            '検索開始位置の初期化
            SearchPoint = 1&
            'その行中に文字列が何個あるか探す
            Do
                '検索
                ret = InStr(SearchPoint, tempStr, TargetWord, CompareType)
                
                '戻り値が 0 であればループを抜ける
                '(tempStr <> NULL,TargetWord <> NULL
                ' Len(TargetWord) <> 0 というのが前提です。)
                'もしNULLを指定すると無限ループに陥ります。
                If ret = 0 Then Exit Do
                '文字列のヒット
                wCount = wCount + 1&
                '次の検索位置へ
                SearchPoint = ret + Len(TargetWord)
            Loop
            'ファイルの読み込み位置を加算していく
            sl = sl + LenB(StrConv(tempStr, vbFromUnicode)) + 2
            'ラベル・・・に現在の処理状況を表示する
            labelobje.Caption = cpb.DrawPgb(sl) & "%"
            '制御を返す
            DoEvents
        Loop
    
    Close #InputFileNumber
    '見つかった文字の数を返す
    GetSearchWordCount = wCount

End Function

Private Sub SearchStop()
    stopflag = True
End Sub

'イベントプロシージャ
Private Sub Form_Load()
    Command2.Enabled = False
    Command3.Enabled = False
    cpb.SetObject = Form1.Picture1
End Sub

Private Sub Command1_Click()
    
    If Right$(App.Path, 1) = "\" Then
        rfname = App.Path & "Pgbar.frm"
    Else
        rfname = App.Path & "\" & "Pgbar.frm"
    End If
    Label3.Caption = rfname
    Command2.Enabled = True
    
End Sub

Private Sub Command2_Click()

    Dim ret As Long
    If Text1.Text = "" Then Exit Sub
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = True
    
    cpb.SetObject = Form1.Picture1
    
    If Check1.Value = 1 Then
        ret = GetSearchWordCount(rfname, Text1.Text, 0, Label4)
    Else
        ret = GetSearchWordCount(rfname, Text1.Text, 1, Label4)
    End If
    MsgBox CStr(ret) & "個見つかりました", vbInformation
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = False
    Picture1.Cls
    Label4.Caption = "0%"
    
End Sub

Private Sub Command3_Click()
    Call SearchStop
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = False
End Sub