質問、意見はこちらに |
|
|
VB6のタイマー
今まではVB.NETでタイマーのコードを書いてきたが、ほぼ同じ動作のタイマーを
VB6で作成してみた。
VB6は基本的にマルチスレッドが使用できない為、シングルスレッドで作成してあります。
ループでタイマーを作動させ、DoEventsでほかの操作を可能にしています。
VB.NETと比較すると、VB6の方はタイマーを書き込むラベルがチラチラします、
原因は良くわからないのですが、多分実行速度の違いではないかと思われます。
VB6で作ったストップウォッチのコード
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
'状態を表す定数
Const sSTOP As Integer = 0
Const sSTART As Integer = 1
Const sLAP As Integer = 2
Dim States As Integer
Dim StartTime As Long
'秒を保持します
Dim Second As Integer
Private Sub Form_Load()
States = 0
Second = 0
StartTimer.Enabled = True
End Sub
Private Sub StartTimer_Timer()
'ループはタイマーから呼び出します
StartTimer.Enabled = False
LoopTimer
End Sub
Private Sub ButLap_Click()
States = sLAP
ButStart.Enabled = True
ButStop.Enabled = True
ButLap.Enabled = False
End Sub
Private Sub ButStart_Click()
'Stopから押されてか又はLapから押されたかによって処理を変える
Select Case (States)
Case sSTOP 'Stopから押された
States = sSTART 'ステートを変える
ButStart.Enabled = False 'ボタンのEnableを変える
ButStop.Enabled = True
ButLap.Enabled = True
StartTime = timeGetTime
Case sLAP 'Lapから押された
States = sSTART
ButStart.Enabled = False
ButStop.Enabled = True
ButLap.Enabled = True
End Select
PicDot.Visible = False 'Lap時のドットの表示を非表示に
End Sub
Private Sub ButStop_Click()
'Lapから停止時には最後の時間を書き込む
If States = sLAP Then
LblTimer.Caption = GetLapTime
End If
ButStart.Enabled = True
ButStop.Enabled = False
ButLap.Enabled = False
States = sSTOP
'ドット表示を非表示に
PicDot.Visible = False
End Sub
Private Sub LoopTimer()
Dim strTime As String
Static bstrTime As String
Do
'時間を取得
strTime = Time
'時間を2桁に変更
If Len(Time) = 7 Then
strTime = "0" & strTime
End If
If bstrTime <> strTime Then
'時間表示
LblTime.Caption = strTime
bstrTime = strTime
If States = sLAP Then
PicDot.Visible = Not PicDot.Visible
End If
End If
'スタート状態なら
If States = sSTART Then
LblTimer.Caption = GetLapTime
End If
DoEvents '書き込み
Sleep (1) 'CPUの負荷低減
Loop
End Sub
Private Function GetLapTime() As String
Dim strTime As String
Dim intMillsec As Integer 'ミリ秒
Dim intSec As Integer '秒
Dim intMinute As Integer '分
Dim intHour As Integer '時間
Dim lngTime As Long
'スタートからの時間を取得
lngTime = timeGetTime - StartTime
'ミリ秒の取得
intMillsec = lngTime Mod 1000
lngTime = (lngTime \ 1000) 'm秒
'秒の取得
intSec = lngTime Mod 60 '
lngTime = lngTime \ 60 '秒
'分の取得
intMinute = lngTime Mod 60
lngTime = lngTime \ 60 '分
'時間の取得
intHour = lngTime Mod 24
'表示文字を作成
strTime = Format(intHour, "00") & ":" & _
Format(intMinute, "00") & ":" & _
Format(intSec, "00") & ":" & _
Format(intMillsec, "000")
GetLapTime = strTime
End Function
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
|