てなわけで、暇つぶしにWindos APIのタイマーを使ってみたサンプルです。
waitTime関数はただ時間を待つだけです。loopTest関数はひたすら無限ループします。
まぁ、次回以降のおもちゃを作るための準備なんですが。。。
例によって、動作保証はしませんが、ソースコードはご自由にお使いください。
Option Explicit
'--------------------------------------------------
' APIの宣言
'--------------------------------------------------
'DWORD timeGetTime( VOID);
Public Declare PtrSafe Function timeGetTime Lib "WINMM.DLL" () As Long
'SHORT GetAsyncKeyState( int vKey);
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Long
Public Const VK_ENTER As Integer = 13
Public Const VK_ESC As Integer = 27
Public Const VK_SPACE As Integer = 32
Public Const VK_LEFT As Integer = 37
Public Const VK_UP As Integer = 38
Public Const VK_RIGHT As Integer = 39
Public Const VK_DOWN As Integer = 40
'VOID Sleep( DWORD dwMilliseconds);
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'BOOL sndPlaySound( LPCSTR lpszSound, UINT fuSound);
Public Declare PtrSafe Function sndPlaySound Lib "WINMM.DLL" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Const SND_SYNC = &H0
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_LOOP = &H8
Public Const SND_NOSTOP = &H10
'--------------------------------------------------
Public Sub timerTest()
waitTime (3000)
MsgBox "waited 3 sec"
End Sub
Public Sub clear()
Sheet1.Cells.Delete
End Sub
Public Function waitTime(timeToWait As Integer)
Dim timeNext As Long
timeNext = timeGetTime() + timeToWait
'----- ループ -----
Do While timeGetTime() < timeNext
'Sheet1.Cells(1, 1).Select
DoEvents
Loop
'------------------
End Function
Public Function playSound(SoundName As String)
Dim wFlags As Long
wFlags = SND_ASYNC Or SND_NODEFAULT
playSound = sndPlaySound(SoundName, wFlags)
End Function
Public Sub loopTest()
Dim timeNext As Long
Dim loopFlag As Boolean
timeNext = timeGetTime
loopFlag = True
'----- メインループ -----
Do While loopFlag = True
If timeNext < timeGetTime Then
'----- ESC Keyで終了 -----
If GetAsyncKeyState(VK_ESC) <> 0 Then
loopFlag = False
End If
'-------------------------
timeNext = timeNext + 100
End If
'-------------------------
Sheet1.Cells(1, 1).Select
DoEvents
Loop
'------------------------
End Sub
0 件のコメント:
コメントを投稿