フォーム間のイベントやりとり
解決フォームAの実行ボタンをクリックするとフォームBが表示します。
フォームAの主処理を数回繰り返すのですが、繰り返すたびにインターバル時間をおいてフォームBの中断ボタンを使用できるようにしようと思ってます。
ボタンが使える時間もフォームBでカウントダウンさせようおもってます。
現在問題なのが、フォームBが固まったような状態になりちゃんと表示されません。インターバル時間が終わって、フォームAの主処理に戻るとフォームBは表示されるようになります。
固まったような状態になるのはなぜなのでしょうか？
> 固まったような状態になるのはなぜなのでしょうか？
どのバージョンのVBで、どのようなコードを書いたときに、そのような状況に
なっているのかが説明されていないので、判断できないです…。
ＶＢ6.0です。
フォームＢ.show
while(フォームＢのカウントダウン時間が０以下になったら)
sleep(60000)
フォームＢカウントダウン時間書換え
wend
ループ中に画面が固まる？ボタン等が表示されない。
フォームの枠は表示されています。
> sleep(60000)
Sleep している間は、ウィンドウメッセージを処理できなくなりますので、
ウィンドウを持つアプリは、そのメインスレッドから Sleep API を
呼ぶべきでは無いとされています。
限定的にであれば、Sleep 呼び出しをごく短時間にして、DoEventsとあわせて
繰り返し呼び出すという対処方法もありますが、できれば、
http://msdn.microsoft.com/library/ja/jpdllpro/html/_win32_sleep.asp
にも書かれているように、MsgWaitForMultipleObjects API もしくは、
MsgWaitForMultipleObjectsEx を使った方が安全でしょう。
そうすれば、待機中にもメッセージ(再描画要求、マウスやキー入力等)を
DoEvents等で処理できますので。
=========================
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" _
(ByVal Count As Long, ByVal HandlesPointer As Long, _
ByVal WaitAll As Long, ByVal MilliSeconds As Long, _
ByVal WakeMask As Long) As Long
Public Sub Wait(ByVal msec As Long)
If msec <= 0 Then
msec = 1
End If
Dim Interval As Long
Dim tickBegin As Long
Interval = msec
tickBegin = GetTickCount()
Do
If MsgWaitForMultipleObjects(0, 0, 0, Interval, &HFF&) = 0 Then
DoEvents
End If
Interval = msec + tickBegin - GetTickCount()
Loop Until Interval < 0
End Sub
=========================
> インターバル時間をおいて
『フォームAの主処理』の内容にもよりますが、Sleep 関数にて「スレッドを中断させる」のではなく、
MsgWaitForMultipleObjects にて待機するようにするか、もしくは Timer コントロールを利用して、
「一定時間経過後に、フォームAの主処理を再開する」ような設計にしてみてはいかがでしょう。
> フォーム間のイベントやりとり
これを WithEvents 変数と RaiseEvent で処理すると、こんな感じでしょうか。
'==== Form1 : メイン処理 ===
Option Explicit
Private WithEvents cancelDialog As Form2
'★イベントを受け取る部分★
Private Sub cancelDialog_Feedback(ByVal canceled As Boolean)
Set cancelDialog = Nothing
If canceled Then
MsgBox "処理は中断されました。", vbExclamation
Else
Timer1.Enabled = True '処理の再開を促す
End If
End Sub
Private Sub Form_Load()
Timer1.Interval = 60 '短い時間
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
'長い処理
'result = MainProcedure(mPreviousData)
'mPreviousData = result
'中断ボタンを表示(5秒間でタイムアウト)
Set cancelDialog = New Form2
cancelDialog.SetInterval 5, Me
End Sub
'==== Form2 : 中断ボタン ===
Option Explicit
'★中断ボタンが押されたか、またはタイムアウトしたことを通知するイベント★
Public Event Feedback(ByVal canceled As Boolean)
Private canceled As Boolean
Private Limit As Date
Private Sub Form_Unload(Cancel As Integer)
'★フォームが閉じるときに、終了イベントを発生★
RaiseEvent Feedback(canceled)
End Sub
'中断ボタン画面を表示するためのメソッド
Friend Sub SetInterval(ByVal totalSecond As Integer, ByVal ownerForm As Form)
Limit = DateAdd("s", totalSecond, Now())
Load Me
Me.Show vbModeless, ownerForm
Timer1.Enabled = True
'カウントダウンの表示
UpdateCountdownTimer
End Sub
Private Sub Form_Load()
'Me.StartUpPosition = vbStartUpOwner
canceled = True
Timer1.Interval = 100
Timer1.Enabled = False
Command1.Caption = "中止"
Me.Width = Me.ScaleX(200, vbPixels, vbTwips)
Me.Height = Me.ScaleY(90, vbPixels, vbTwips)
Command1.Move 0, 0
End Sub
Private Sub Timer1_Timer()
UpdateCountdownTimer
End Sub
'カウントダウン用
Private Sub UpdateCountdownTimer()
Dim dt As Date
dt = Now()
Dim sec As Double
sec = DateDiff("s", dt, Limit)
If sec > 0 Then
Command1.Caption = Format(sec, "中止(0.0)")
Else
Command1.Caption = "再開"
Command1.Enabled = False
Timer1.Enabled = False
'タイムアウト：キャンセルされなかった。
canceled = False
Unload Me
End If
End Sub
Private Sub Command1_Click()
'キャンセルされた。
canceled = False
Unload Me
End Sub
最後の部分、間違ってました…。
>Private Sub Command1_Click()
> 'キャンセルされた。
canceled = True '★修正
> Unload Me
> End Sub
魔界の仮面弁士さんソースまでありがとうございました。
Sleepがいけなかったんですね。
勉強になりました。
| ツイート |  |