こんな質問がありました。
ループ処理が続いているとき、
何かキーを押せばループから抜け出せるようにしたい・・・
なので、いわばパニックボタン、緊急停止的な機能をもつプログラムを作ってみました。
親プログラムからループの処理を非同期に実行、
親側でキーが押されたことを検知したら、ループを中止する・・・そんなプログラムです。
ループを終了させるトリガーがキー入力だけではあまりにサミシイので
タイマーで終わらせる、ボタンで終わらせる機能をつけ足してみました。
これが起動時の画面・・・
[Stop] ボタンで停止するようにして [Start] ・・・
[Stop] ボタンを押して、停止した後・・・
◎ Any Key を選択しているなら、何かキーを押すと停止します。
Timer を選択しているなら、指定された秒数が経過したら停止します。
コードは次のとおり・・・
==========================================
Public Class frm_Main
' ---------------------------------------------------
' Async-Await can be used after .NET Framework 4.5
' UI can not change in Task process
' ---------------------------------------------------
#Region "=== Variables"
Private DoWhile As Boolean = True
Private BreakUpBy As String = ""
#End Region
#Region "=== Form: Load, RadioButton, etc."
' ---Form: Load
Private Sub frm_Main_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.ProgressBar1.Visible = False
Me.lbl_Elapse.Visible = False
Me.lbl_Msg.Visible = False
Me.txt_Seconds.Enabled = False
Me.btn_Stop.Enabled = False
End Sub
' ---⦿ RadioButton
Private Sub RadioButton_CheckedChanged(sender As Object, e As EventArgs) Handles _
rbt_AnyKey.CheckedChanged, rbt_Button.CheckedChanged, rbt_Timer.CheckedChanged
' ---
If (Me.rbt_AnyKey.Checked) Then
Me.txt_Seconds.Enabled = False
Me.BreakUpBy = "[Any Key]"
End If
If (Me.rbt_Button.Checked) Then
Me.txt_Seconds.Enabled = False
Me.BreakUpBy = "[Button]"
End If
If (Me.rbt_Timer.Checked) Then
Me.txt_Seconds.Enabled = True
Me.txt_Seconds.Select()
Me.BreakUpBy = "[Timer]"
End If
End Sub
' ---[Stop] ボタン
Private Sub btn_Stop_Click(sender As Object, e As EventArgs) Handles btn_Stop.Click
Call Me.prc_StopLoop()
End Sub
' --- Stop 処理(ボタン.PerformClick を行うため独立プロシージャとしている)
Private Sub prc_StopLoop()
Me.DoWhile = False
Me.ProgressBar1.Visible = False
Me.btn_Start.Enabled = True
Me.btn_Stop.Enabled = False
Me.grp_BreakUpBy.Enabled = True
Me.lbl_Msg.Text = "Broken up Loop by " & Me.BreakUpBy
Me.lbl_Msg.Visible = True
End Sub
' --- Seconds: only [0]-[9], [BackSpace] is OK
Private Sub txt_Seconds_KeyPress(sender As Object, e As KeyPressEventArgs) Handles txt_Seconds.KeyPress
If (e.KeyChar < "0"c Or e.KeyChar > "9"c) _
And (e.KeyChar <> vbBack) Then
e.Handled = True
End If
End Sub
#End Region
#Region "=== Async-Await: 非同期処理"
' ---[Start] ボタン
Private Async Sub btn_Start_Click(sender As Object, e As EventArgs) Handles btn_Start.Click
Call Me.prc_StartProcess()
' ---
Dim StartTime As DateTime = DateTime.Now
Dim tmSpan As TimeSpan
' --- ループ
Me.DoWhile = True
While Me.DoWhile = True
' ---▼ 非同期処理 ---
Dim myTask As Task = Task.Run _
(Sub()
LongOperation() ' --◀ 時間のかかる処理(この中で UI は変更できない)
End Sub)
Await myTask
' ---▲ 非同期処理 ---
tmSpan = DateTime.Now - StartTime
Debug.WriteLine("tmSpan.Seconds=" & tmSpan.Seconds)
If (Me.rbt_Timer.Checked) _
And (CInt(tmSpan.Seconds) >= CInt(Me.txt_Seconds.Text)) Then
Me.DoWhile = False
End If
' ---
Me.lbl_Elapse.Text = Format(tmSpan.Seconds, "#,0") & " sec. elapsed"
End While
' ---[Stop]ボタンクリックをシミュレート
Call Me.prc_StopLoop()
End Sub
' --- 時間のかかる処理(UI は変更できない)
Private Sub LongOperation()
Threading.Thread.Sleep(1000)
End Sub
' --- Form: PreviewKeyPress ★ループ中断
Private Sub frm_Main_PreviewKeyDown(sender As Object, e As PreviewKeyDownEventArgs) Handles MyBase.PreviewKeyDown
If (Me.rbt_AnyKey.Checked) Then
Me.DoWhile = False
End If
End Sub
' ---
Private Sub prc_StartProcess()
If (Me.rbt_Timer.Checked) And
(Me.txt_Seconds.Text = "" OrElse CInt(Me.txt_Seconds.Text) 「質疑応答 掲示板」で・・・
# ご質問にはできる限りお答えしています。
ただし、お名前(本名)を書いていただいた場合に限らせていただきます。
ここをクリックして、北窓舎のサイトにもお立ち寄りください・・・
ループ処理が続いているとき、
何かキーを押せばループから抜け出せるようにしたい・・・
なので、いわばパニックボタン、緊急停止的な機能をもつプログラムを作ってみました。
親プログラムからループの処理を非同期に実行、
親側でキーが押されたことを検知したら、ループを中止する・・・そんなプログラムです。
ループを終了させるトリガーがキー入力だけではあまりにサミシイので
タイマーで終わらせる、ボタンで終わらせる機能をつけ足してみました。
これが起動時の画面・・・
[Stop] ボタンで停止するようにして [Start] ・・・
[Stop] ボタンを押して、停止した後・・・
◎ Any Key を選択しているなら、何かキーを押すと停止します。
Timer を選択しているなら、指定された秒数が経過したら停止します。
コードは次のとおり・・・
==========================================
Public Class frm_Main
' ---------------------------------------------------
' Async-Await can be used after .NET Framework 4.5
' UI can not change in Task process
' ---------------------------------------------------
#Region "=== Variables"
Private DoWhile As Boolean = True
Private BreakUpBy As String = ""
#End Region
#Region "=== Form: Load, RadioButton, etc."
' ---Form: Load
Private Sub frm_Main_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.ProgressBar1.Visible = False
Me.lbl_Elapse.Visible = False
Me.lbl_Msg.Visible = False
Me.txt_Seconds.Enabled = False
Me.btn_Stop.Enabled = False
End Sub
' ---⦿ RadioButton
Private Sub RadioButton_CheckedChanged(sender As Object, e As EventArgs) Handles _
rbt_AnyKey.CheckedChanged, rbt_Button.CheckedChanged, rbt_Timer.CheckedChanged
' ---
If (Me.rbt_AnyKey.Checked) Then
Me.txt_Seconds.Enabled = False
Me.BreakUpBy = "[Any Key]"
End If
If (Me.rbt_Button.Checked) Then
Me.txt_Seconds.Enabled = False
Me.BreakUpBy = "[Button]"
End If
If (Me.rbt_Timer.Checked) Then
Me.txt_Seconds.Enabled = True
Me.txt_Seconds.Select()
Me.BreakUpBy = "[Timer]"
End If
End Sub
' ---[Stop] ボタン
Private Sub btn_Stop_Click(sender As Object, e As EventArgs) Handles btn_Stop.Click
Call Me.prc_StopLoop()
End Sub
' --- Stop 処理(ボタン.PerformClick を行うため独立プロシージャとしている)
Private Sub prc_StopLoop()
Me.DoWhile = False
Me.ProgressBar1.Visible = False
Me.btn_Start.Enabled = True
Me.btn_Stop.Enabled = False
Me.grp_BreakUpBy.Enabled = True
Me.lbl_Msg.Text = "Broken up Loop by " & Me.BreakUpBy
Me.lbl_Msg.Visible = True
End Sub
' --- Seconds: only [0]-[9], [BackSpace] is OK
Private Sub txt_Seconds_KeyPress(sender As Object, e As KeyPressEventArgs) Handles txt_Seconds.KeyPress
If (e.KeyChar < "0"c Or e.KeyChar > "9"c) _
And (e.KeyChar <> vbBack) Then
e.Handled = True
End If
End Sub
#End Region
#Region "=== Async-Await: 非同期処理"
' ---[Start] ボタン
Private Async Sub btn_Start_Click(sender As Object, e As EventArgs) Handles btn_Start.Click
Call Me.prc_StartProcess()
' ---
Dim StartTime As DateTime = DateTime.Now
Dim tmSpan As TimeSpan
' --- ループ
Me.DoWhile = True
While Me.DoWhile = True
' ---▼ 非同期処理 ---
Dim myTask As Task = Task.Run _
(Sub()
LongOperation() ' --◀ 時間のかかる処理(この中で UI は変更できない)
End Sub)
Await myTask
' ---▲ 非同期処理 ---
tmSpan = DateTime.Now - StartTime
Debug.WriteLine("tmSpan.Seconds=" & tmSpan.Seconds)
If (Me.rbt_Timer.Checked) _
And (CInt(tmSpan.Seconds) >= CInt(Me.txt_Seconds.Text)) Then
Me.DoWhile = False
End If
' ---
Me.lbl_Elapse.Text = Format(tmSpan.Seconds, "#,0") & " sec. elapsed"
End While
' ---[Stop]ボタンクリックをシミュレート
Call Me.prc_StopLoop()
End Sub
' --- 時間のかかる処理(UI は変更できない)
Private Sub LongOperation()
Threading.Thread.Sleep(1000)
End Sub
' --- Form: PreviewKeyPress ★ループ中断
Private Sub frm_Main_PreviewKeyDown(sender As Object, e As PreviewKeyDownEventArgs) Handles MyBase.PreviewKeyDown
If (Me.rbt_AnyKey.Checked) Then
Me.DoWhile = False
End If
End Sub
' ---
Private Sub prc_StartProcess()
If (Me.rbt_Timer.Checked) And
(Me.txt_Seconds.Text = "" OrElse CInt(Me.txt_Seconds.Text) 「質疑応答 掲示板」で・・・
# ご質問にはできる限りお答えしています。
ただし、お名前(本名)を書いていただいた場合に限らせていただきます。
ここをクリックして、北窓舎のサイトにもお立ち寄りください・・・