|
マルチスレッドのストップウオッチ VB2005
|
VB2005のコード
VB2005のコード
Public Class FomStopwatch
'状態を表す定数
Const sSTOP As Integer = 0
Const sSTART As Integer = 1
Const sLAP As Integer = 2
'上の３つ状態を保持します
Dim States As Integer = 0
'秒を保持します
Dim Second As Integer = 0
'スレッドの宣言
Dim TimerThread As System.Threading.Thread
'現在の時刻の表示と、タイマーの表示に使用されるデリゲート
Delegate Sub dlgSetString(ByVal lbl As Object, ByVal text As String)
'ラップ時のドットの表示非表示に使用されます
Delegate Sub dlgGene()
'ストップウオッチクラス
Dim MyStopWatch As System.Diagnostics.Stopwatch = New System.Diagnostics.Stopwatch()
Private Sub ForStopwatch_Load(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MyBase.Load
TimerThread = New System.Threading.Thread(AddressOf DoWork)
TimerThread.Start()
End Sub
'スタートボタン押下
Private Sub ButStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButStart.Click
'Stopから押されてか又はLapから押されたかによって処理を変える
Select Case (States)
Case sSTOP 'Stopから押された
MyStopWatch.Reset() 'ストップウオッチを初期化
MyStopWatch.Start() 'ストップウオッチのスタート
States = sSTART 'ステートを変える
ButStart.Enabled = False 'ボタンのEnableを変える
ButStop.Enabled = True
ButLap.Enabled = True
Case sLAP 'Lapから押された
MyStopWatch.Start()
States = sSTART
ButStart.Enabled = False
ButStop.Enabled = True
ButLap.Enabled = True
End Select
PicDot.Visible = False 'Lap時のドットの表示を非表示に
End Sub
'Lapボタンが押された
Private Sub ButLap_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButLap.Click
States = sLAP
ButStart.Enabled = True
ButStop.Enabled = True
ButLap.Enabled = False
End Sub
'ストップボタンが押された
Private Sub ButStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButStop.Click
MyStopWatch.Stop() ' ストップウオッチの停止
'Lapから停止時には最後の時間を書き込む
If States = sLAP Then
LblTimer.Text = String.Format("{00:00:00:00:000}", MyStopWatch.ElapsedMilliseconds)
End If
ButStart.Enabled = True
ButStop.Enabled = False
ButLap.Enabled = False
States = sSTOP
'ドット表示を非表示に
PicDot.Visible = False
End Sub
'デリゲートで別スレッドから呼ばれてラベルに現在の時間又は
'ストップウオッチの時間を表示する
Private Sub ShowTime(ByVal sender As Object, ByVal strTime As String)
Dim lbl As Label = DirectCast(sender, Label) 'objectをLabelにキャストする
lbl.Text = strTime
End Sub
'Lapの場合一秒ごとに別スレッドからデリゲートに呼ばれ
'ドットの表示非表示を行なう
Private Sub ChangePicColor()
PicDot.Visible = Not PicDot.Visible
End Sub
'別スレッド上で行なわれる処理
Private Sub DoWork()
'スレッドが停止状態でなければ
While (True)
'1msecのウエイト、CPUの使用率を下げる
System.Threading.Thread.Sleep(1)
Try
If Second <> DateTime.Now.Second Then
'時間を文字列に直す
Dim strTime As String = String.Format("{0:00}", DateTime.Now.Hour) _
+ ":" + String.Format("{0:00}", DateTime.Now.Minute) _
+ ":" + String.Format("{0:00}", DateTime.Now.Second) + ":" _
+ String.Format("{0:000}", DateTime.Now.Millisecond)
'匿名デリゲートで現在の時間をラベルに表示する
Me.Invoke(New dlgSetString(AddressOf ShowTime), New Object() {LblTime, strTime})
If States = sLAP Then
'匿名デリゲートでドットの表示非表示情報を渡す
Me.Invoke(New dlgGene(AddressOf ChangePicColor), New Object() {})
End If
'秒の保持
Second = DateTime.Now.Second
End If
'ストップウオッチが動作していたら時間を表示する
If States = sSTART Then
'ストッップウオッチの時間を文字に直す
Dim eTime As String = String.Format("{00:00:00:00:000}", MyStopWatch.ElapsedMilliseconds)
'匿名デリゲートで時間を渡す
Me.Invoke(New dlgSetString(AddressOf ShowTime), New Object() {LblTimer, eTime})
'Dim SetString As dlgSetString = New dlgSetString(AddressOf ShowTime)
'Me.Invoke(SetString, LblTimer, eTime)
End If
Catch
'このエラーはフォームを閉じたときに発生します
End Try
End While
End Sub
Private Sub FomStopwatch_FormClosing(ByVal sender As System.Object, _
ByVal e As System.Windows.Forms.FormClosingEventArgs) _
Handles MyBase.FormClosing
TimerThread.Abort()
End Sub
End Class
サンプルコードのダウンロード