【VB6・VBAメモ】WindowsAPI:KillTimer関数

このAPIはSetTimerで設定したタイマーを解除する際に使用します。
SetTimerでタイマー開始したら、KillTimerでのタイマー終了処理を忘れないように気を付けましょう。

タイマー処理はコールバック関数とウィンドウプロシージャで処理する方法がありますが、
個人的にはウィンドウプロシージャをC++以外で使用すると後始末が面倒なので(間違えるとWindowsごとフリーズする恐れがある)
コールバック関数を使用することをお勧めします。
※サンプルコードの使用は自己責任でお願いしいます。

概要
BOOL KillTimer(HWND hWnd, UINT_PTR uIDEvent)
機能 タイマーを破棄
引数 hWnd タイマーに関連付けるウィンドウのハンドル HWND
(unsigned long)
uIDEvent 破棄するタイマーのID UINT_PTR
(unsigned int)
戻り値 成功:0以外の値
失敗:0
BOOL
(int)
使用例(1):5秒間隔で処理を実行(コールバック関数使用)

コールバック関数を使用した場合のサンプルコードです。
ウィンドウハンドルを指定する場合は、任意のタイマーIDを指定することができます。
タイマーとコールバック関数が1対1の場合は、
コールバック関数内のタイマーIDの判別処理はなくても大丈夫かと思います。

'Windows API宣言'
Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
                    ByVal nIDEvent As Long, _
                    ByVal uElapse As Long, _
                    ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
                    ByVal nIDEvent As Long) As Long

'定数定義'
Private Const MY_TIMER_ID      As Long = 100001   'タイマーID(任意値)'
Private Const MY_TIMER_MSEC     As Long = 5000       '5秒間隔'

'変数定義'
Private prCnt          As Long   '処理回数'

'サンプル処理開始'
Sub Sample1()
    prCnt = 0
    
    'ウィンドウハンドルを取得'
    Dim hWnd As Long
    hWnd = Application.hWnd     'Excelの場合'
    'hWnd = Form1.hWnd'        'VB6フォームの場合'
    
    'タイマー設定'
    Debug.Print "タイマー設定"
    Call SetTimer(hWnd, MY_TIMER_ID, MY_TIMER_MSEC, AddressOf TimerProc)
End Sub

'タイマーコールバック関数'
Private Function TimerProc(ByVal hWnd As Long, ByVal msg As Long, _
                           ByVal wp As Long, ByVal lp As Long) As Long
    Select Case wp
    Case MY_TIMER_ID
        'タイマー処理'
        
        prCnt = prCnt + 1
        
        Dim time As Long
        time = (MY_TIMER_MSEC * prCnt) / 1000
        
        Dim str As String
        str = Space(3 - Len(CStr(time))) & CStr(time) & "秒経過"
        Debug.Print str
        
        '5回まで処理'
        If prCnt > 5 Then
            'タイマー解除'
            Call KillTimer(hWnd, MY_TIMER_ID)
            Debug.Print "タイマー解除"
        End If
    End Select
End Function
【出力結果】
タイマーセット
  5秒経過
 10秒経過
 15秒経過
 20秒経過
 25秒経過
 30秒経過
タイマー解除
使用例(2):5秒間隔で処理を実行(コールバック関数使用・ウィンドウハンドル未指定)

ウィンドウハンドルなしでコールバック関数を使用した場合のサンプルコードです。
ウィンドウハンドルを未指定とする場合はタイマーIDは自動で生成されます。

'Windows API宣言'
Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
                    ByVal nIDEvent As Long, _
                    ByVal uElapse As Long, _
                    ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
                    ByVal nIDEvent As Long) As Long

'定数定義'
Private Const MY_TIMER_MSEC     As Long = 5000       '5秒間隔'

'変数定義'
Private prCnt          As Long   '処理回数'
Private prTimerID      As Long   'タイマーID'

'サンプル処理開始'
Sub Sample2()
    prCnt = 0
    
    'タイマー設定'
    Debug.Print "タイマー設定"
    prTimerID = SetTimer(0, 0, MY_TIMER_MSEC, AddressOf TimerProc)
End Sub

'タイマーコールバック関数'
Private Function TimerProc(ByVal hWnd As Long, ByVal msg As Long, _
                           ByVal wp As Long, ByVal lp As Long) As Long
    Select Case wp
    Case prTimerID
        'タイマー処理'
        
        prCnt = prCnt + 1
        
        Dim time As Long
        time = (MY_TIMER_MSEC * prCnt) / 1000
        
        Dim str As String
        str = Space(3 - Len(CStr(time))) & CStr(time) & "秒経過"
        Debug.Print str
        
        '5回まで処理'
        If prCnt > 5 Then
            'タイマー解除'
            Call KillTimer(0, prTimerID)
            Debug.Print "タイマー解除"
        End If
    End Select
End Function
【出力結果】
タイマーセット
  5秒経過
 10秒経過
 15秒経過
 20秒経過
 25秒経過
 30秒経過
タイマー解除
使用例(3):5秒間隔で処理を実行(ウィンドウプロシージャ使用)

ウィンドウプロシージャを使用した場合のサンプルコードです。
タイマー解除処理以外にウィンドウプロシージャの復元処理が必要となるので注意してください。

'API宣言'
Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
                    ByVal nIDEvent As Long, _
                    ByVal uElapse As Long, _
                    ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
                    ByVal nIDEvent As Long) As Long

Declare Function CallWindowProc Lib "user32" _
          Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                                   ByVal hWnd As Long, ByVal Msg As Long, _
                                   ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" _
          Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
                                  ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC       As Long = (-4)       'ウィンドウプロシージャ書換'
Private Const WM_TIMER          As Long = &H113   'タイマーメッセージ'

'定数定義'
Private Const MY_TIMER_ID      As Long = 100001   'タイマーID(任意値)'
Private Const MY_TIMER_MSEC     As Long = 5000       '5秒間隔'

'変数定義'
Private prCnt        As Long   '処理回数'
Private prOrgWndProc As Long   '旧ウィンドウプロシージャ'

'サンプル処理開始'
Sub Sample3()
    prCnt = 0
    
    'ウィンドウハンドルを取得'
    Dim hWnd As Long
    hWnd = Application.hWnd     'Excelの場合'
    'hWnd = Form1.hWnd'         'VB6フォームの場合'

    'ウィンドウプロシージャを取得'
    prOrgWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
    
    'タイマー設定'
    Debug.Print "タイマー設定"
    Call SetTimer(hWnd, MY_TIMER_ID, MY_TIMER_MSEC, 0)
End Sub

'ウィンドウプロシージャ'
Private Function WndProc(ByVal hWnd As Long, ByVal msg As Long, _
                         ByVal wp As Long, ByVal lp As Long) As Long
On Error GoTo ERR_HANDLER
    Select Case msg
    Case WM_TIMER
        Select Case wp
        Case MY_TIMER_ID
            'タイマー処理'
            
            prCnt = prCnt + 1
            
            Dim time As Long
            time = (MY_TIMER_MSEC * prCnt) / 1000
            
            Dim str As String
            str = Space(3 - Len(CStr(time))) & CStr(time) & "秒経過"
            Debug.Print str
            
            '5回まで処理'
            If prCnt > 5 Then
                'タイマー解除'
                Call KillTimer(hWnd, MY_TIMER_ID)
                Debug.Print "タイマー解除"
                
                'ウィンドウプロシージャを元に戻す(これを忘れると危険)'
                Call SetWindowLong(hWnd, GWL_WNDPROC, prOrgWndProc)
            End If
        End Select
    End Select
ERR_HANDLER:
    '元のメッセージを処理(これを忘れると危険)'
    WndProc = CallWindowProc(prOrgWndProc, hWnd, msg, wp, lp)
End Function
【出力結果】
タイマーセット
  5秒経過
 10秒経過
 15秒経過
 20秒経過
 25秒経過
 30秒経過
タイマー解除


コメント
コメントする








    
この記事のトラックバックURL
トラックバック