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

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

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

概要
UINT_PTR SetTimer(HWND hWnd, UINT_PTR nIDEvent, UINT uElapse, TIMERPROC lpTimerFunc)
機能 タイマーを設定
引数 hWnd タイマーに関連付けるウィンドウのハンドル HWND
(unsigned long)
nIDEvent タイマーID(任意の値)
(hWndにNULLを指定した場合は無視し、戻り値は新しいタイマーIDを返す)
UINT_PTR
(unsigned int)
uElapse タイマーの間隔
(1/1000秒単位)
UINT
(unsigned int)
lpTimerFunc タイマーのコールバック関数
(使用しない場合はNULLを指定)
TIMERPROC
戻り値 成功:タイマーID
失敗:0
UINT_PTR
(unsigned 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秒経過
タイマー解除


コメント
はじめまして
nori と言います
VBAでのタイマー処理を探してココに来ました。

PHPソースの国際化処理を組み込むのに膨大なソースコードを修正しないといけません。
修正箇所は人の目が基本ですが、修正方法はワンパターンです。
・修正前:Help me
・修正後:<?php _e('Help me','xxxx') ?>
昨日まで手作業で行っていましたが、もう疲れました。
そこで作業の効率化用の簡単なツールを作ることを決意。

クリップボードを監視して内容が変化した時に強制的に編集する。

ExcelとVB6に対しての気配りサンプル。
関心しました。

目的の処理が出来ました。
ありがとうございました。
  • nori
  • 2016/06/07 4:24 PM
コメントする








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