ab.com コミュニティ

スロットマシーンのプログラムを作ろうとして、ふと思ったのですが、例えば、始動ボタン(CommandButtonn1）を押すと、リールが回転するコードを書き、別のボタン（CommandButtonn2）を押すと、リールの指定角度（０度）の部分の番号がEditBox1に書き出されるというものを作りたいのですが、リール回転をWhile-Wend（無限ループ）で記述すると、Window上のほかのボタンが押せない状態になります。
イベント後のプログラム作動中ですからもっともなことなのですが、一つ目のボタンを押してプログラムが作動中に、別のボタンを押すことによって、その動作を中止させたり、そのときの指定変数の値を読み出すことはどのようにすればよいのでしょうか。

回転処理を別スレッドにすればいいです。
と回答したいところですが，少し前のDoEventsをループの中で呼び出せば、
メッセージが処理され、ウィンドウの操作が出来るようになります。

たとえば中止させたいときには私ならこうします。

まずフラグ用の変数を2つ用意します。
始めは共にFALSEにしておきます。
1つは回転中かどうかの判定用として回転が始まったらTRUEにし、終わったらFALSEにします。
もう1つは中止するかどうかのフラグで、回転中（先のフラグを使って判定します）に中止ボタンが押されたらTRUEにします。
回転のループでは脱出条件として後者のフラグを指定します。
そしてそのループから抜けるときには次回のことを考え、中止のフラグをFALSEに戻しておきます。

下記のような変更で　Main_Loop()　の無限ループを作成して

Sub Main_Loop()
　キーチェック（ボタン駆動）→回転・停止・滑り・選択処理へ
　リール回転・滑り・処理
　リール描画
　リールフラッシュ描画
　液晶演出描画
　バッファから表面に描画
　Sleep(1)　必要なら
End Sub

の処理をSubかFunctionで記述すれば良いのではないかとと思います。

'---------------------------
'  Window Message Loop
'---------------------------
Dim msgMain As MSG, iResult As Long
Do
     If PeekMessage(msgMain,0,0,0,PM_NOREMOVE) Then
            iResult=GetMessage(msgMain,0,0,0)
         If iResult=0 or iResult=-1 Then Exit Do
            TranslateMessage(msgMain)
             DispatchMessage(msgMain)
     Else
            Main_Loop()
     End If
Loop
ExitProcess(0)

既に二人の方が答えておりますので、
DoEventsによる処理形式？でとっくに解決済みかもしれませんが、
せっかくなので、イグトランスさんが言いかけてた のサンプルを載せてみます。
CreateThread()による並行処理はそのうち覚えようと
思っていたものなので、私自身の練習を兼ねて（＾＾；）。

RADを使っています。
ボタン（CommandButton1）を押すと0.1秒ごとにカウントアップを始め、
再びボタンを押すと、エディットボックス（EditBox1）に
そのときのカウント数を表示します。

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

Dim hSecondThread As Long 'スレッドハンドル
Dim nSec As Long '複数スレッドで共有する変数としての例。
Dim nFlag As Long 'スレッド動作のフラグ。
Dim lpCriticalSection As CRITICAL_SECTION '排他処理のための構造体
Dim tID As Dword 'スレッドIDを格納。

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As DWord, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function


'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	'排他処理のために、クリティカルの作成。
	InitializeCriticalSection( lpCriticalSection )
End Sub


Sub MainWnd_Destroy()

	'クリティカルセクションの破棄
	DeleteCriticalSection( lpCriticalSection )
	'平行動作のスレッドを破棄
	CloseHandle( hSecondThread )

	TestWnd_DestroyObjects()
	PostQuitMessage(0)
End Sub


Sub MainWnd_CommandButton1_Click()
	Dim nCount As Long
	Dim strBuf As String

	If( nFlag = FALSE )Then
		nSec = 0
		nFlag = TRUE

		'平行動作のスレッドを作成
		hSecondThread = CreateThread( ByVal NULL, NULL, AddressOf( CountUp ), NULL, NULL, VarPtr(tID) )

		SetWindowText( GetDlgItem( hMainWnd, CommandButton1 ), "今のカウントは？" )
	Else
		'複数スレッド間で共有する変数にアクセスする前に、排他処理。
		EnterCriticalSection( lpCriticalSection )
			nCount = nSec
		LeaveCriticalSection( lpCriticalSection )

		strBuf = Str$( nCount )
		SetWindowText( GetDlgItem( hMainWnd, EditBox1 ), strBuf )
	EndIf
End Sub


'平行スレッド＝平行動作で0.1秒ごとにカウントアップしてみる。
Sub CountUp()
	While( TRUE )
		Sleep 100
		'複数スレッド間で共有する変数にアクセスする前に、排他処理。
		EnterCriticalSection( lpCriticalSection )
			nSec = nSec + 1
		LeaveCriticalSection( lpCriticalSection )
	Wend
EndSub

このサンプルで言えば、Sub CountUp()の中で
While-Wend（無限ループ）を使っていますが、ボタンは押せます。

こんな感じで、リール回転の部分を別スレッドにする方法もあります、
っていう例でした。



蛇足。
DoEvents()って、Ver2.xのころの GetWndMsg＋While のスタイルと同類ですよね？
PeekMessage() は私は知らないのですが、今ヘルプを見た感じでは、
これも同様のスタイルに思えますが、あってますでしょうか？
個人的にはスレッドのスタイルの方が、バックグラウンドで好き放題に
処理を組めて好きなのですが、DoEvents()のスタイルの方が直感的で
分かりやすい気もしますね。どっちが良いのやら。
･･･好みの問題ですか（＾＾；）。

そうです。
ホントところは作者さまに聞いてみないと分かりませんが、十中八九GetWndMsgコマンド自体がGetMessage関数を呼んでいたものと思われます。
（開発された当時がまだAPIとの親和性が低かったためか）
ご推察通り同じようなものです。
一般的に使われるGetMesssageはメッセージがOSから送信されてくるまで待機するようになっていますが、PeekMessageはOSからメッセージが送られようが送られまいが待機状態とはなりません。
PeekMessageを使っているのはPeekMessageがメッセージがあればTRUEを返すという仕様のためWhileループで回し易いということと、PM_REMOVEメッセージでメッセージキューにたまっているメッセージをウィンドウに送信後すぐ破棄できるからです。

ちょっと専門的になりすぎましたね。（汗

個人的には絶対にスレッドをお勧めします。
理由は簡単で、スレッドがそういったバックグランド処理専用の機能だからです。DoEventsを使うのは刺身包丁があるのにお刺身を造るのに万能包丁を使うようなものです。

まぁ、万能包丁が便利ということも多々ありますが（笑

解答ありがとうございます。
なるほど。
すごく分かりやすい例えですね（＾＾）
φ（．　．）メモメモｗ

> >
> そうです。
> ホントところは作者さまに聞いてみないと分かりませんが、十中八九GetWndMsgコマンド自体がGetMessage関数を呼んでいたものと思われます。
> （開発された当時がまだAPIとの親和性が低かったためか）
>
> >
> ご推察通り同じようなものです。
> 一般的に使われるGetMesssageはメッセージがOSから送信されてくるまで待機するようになっていますが、PeekMessageはOSからメッセージが送られようが送られまいが待機状態とはなりません。
> PeekMessageを使っているのはPeekMessageがメッセージがあればTRUEを返すという仕様のためWhileループで回し易いということと、PM_REMOVEフラグでメッセージキューにたまっているメッセージをウィンドウに送信後すぐ破棄できるからです。
>
> ちょっと専門的になりすぎましたね。（汗
>
>
> >
> 個人的には絶対にスレッドをお勧めします。
> 理由は簡単で、スレッドがそういったバックグランド処理専用の機能だからです。DoEventsを使うのは刺身包丁があるのにお刺身を造るのに万能包丁を使うようなものです。
>
> まぁ、万能包丁が便利ということも多々ありますが（笑

すみません。上のゲストは私です。

何を血迷ったのか、編集しようとして引用返信してしまいました。


お詫びにメッセージスレッドとかコールバックスレッドと呼ばれるものを
ご紹介しておきます。

Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As *SECURITY_ATTRIBUTES, bManualReset As Long, bInitialState As Long, lpName As *Char) As HANDLE
Declare Function SetEvent Lib "kernel32" (hEvent As HANDLE) As Long
Declare Function ResetEvent Lib "kernel32" (hEvent As HANDLE) As Long

Sub MessageThreadProc(hEvent As HANDLE)
	/* スレッドメッセージキューの作成 */
	Dim msg As MSG
	Do
		PostThreadMessage(GetCurrentThreadId(),WM_USER,0,0)
		If PeekMessage(msg,NULL,WM_USER,WM_USER,PM_REMOVE)=TRUE Then Exit Do
		Sleep(0)
	Loop

	/* メインスレッドに準備の完了を通知 */
	If hEvent<>NULL Then SetEvent(hEvent)

	/* スレッドメッセージループ */
	While GetMessage(msg,0,0,0)>0
		Select Case msg.message
			Case WM_USER+1
				MessageBox(0,"テスト",0,0)
		End Select
	Wend
	/* メインスレッドに終了の完了を通知 */
	If hEvent<>NULL Then SetEvent(hEvent)

	/* メインスレッドの終了 */
	ExitThread(&HE0F)
End Sub

Class CMessageThread
Private
	m_hThread As HANDLE
	m_idThread As DWord
	m_hEvent As HANDLE
Public
	Sub CMessageThread()
		/* イベントを作成 */
		m_hEvent=CreateEvent(NULL,TRUE,FALSE,NULL)

		/* スレッドを作成 */
		m_hThread=CreateThread(ByVal NULL,0,AddressOf(MessageThreadProc),m_hEvent,0,VarPtr(m_idThread))

		/* スレッドメッセージキュー作成まで待機 */
		If m_hEvent<>NULL and m_hThread<>NULL Then WaitForSingleObject(m_hEvent,INFINITE)
	End Sub
	Sub ~CMessageThread()
		If m_hEvent<>NULL Then ResetEvent(m_hEvent)

		/* スレッドへ終了を通知 */
		SendMsg(WM_QUIT,0,0)

		/* スレッド終了まで待機 */
		If m_hEvent<>NULL and m_hThread<>NULL Then WaitForSingleObject(m_hEvent,INFINITE)

		/* ハンドルを破棄 */
		If m_hEvent<>NULL Then CloseHandle(m_hEvent)
		If m_hThread<>NULL Then CloseHandle(m_hThread)
	End Sub
	Function SendMsg(dwMsg As DWord, wParam As DWord, lParam As DWord) As Long
		/* スレッドにメッセージを送信 */
		SendMsg=PostThreadMessage(m_idThread,dwMsg,wParam,lParam)
	End Function
End Class

どんなものか分かりにくいと思いますが簡単に説明すると、スレッドとメッセージループを組み合わせて「いいとこ取り」しようというものです。

使い方は

Dim cmt As CMessageThread

オブジェクトを作成して

好きなタイミングで

cmt.SendMsg(WM_USER+1,0,0)

とメッセージをスレッドに送信してやればよいです。

メッセージはWM_USER+1以降であれば自由に追加することができます。
またGetMessage()の代わりにPeekMessage()を使って流動的に制御できます。


これは少し前にも紹介していたんですが、スレッド関数をクラス内に入れると
誤動作するようなので改良したものです。


私はこれを使ってよくMCIのサウンド・BGMエンジンを作成します。
時間があればそっちをコード掲示板の方に掲載します。

しばらく間をあけてしまい申し訳ありませんでした。
始めのお二方のﾚｽを読んでいるうちにまたたくさんのﾚｽをいただきありがとうございます。
すべてﾚｽを読みました上でちょっとしたらまた参ります。

イグトランス様
Uhsp様
ご回答いただきありがとうございます。
試しに簡単なことをやってみました。核心部は、掲載いただいたコードそのままです。
この状態で、コマンドボタン１をクリックすることにより、グローバル変数iをカウントさせ、コマンドボタン１上に結果を表示させ続け、
コマンドボタン２をクリックすると変数stpを切り替え、停止させることができるようになりました。
ただしここでは、ループを変数stpの変更によって止めているだけで、ご教示いただいたコード(Do～Loop)の部分の
GetMessageは生かしておりません。ヘルプでは、WM_QUIT メッセージを受けると0が返るとあるので、このメッセージが返ってきたかどうかの判断によって停止させるようですが、
コマンドボタン２をクリックした時にWM_QUIT メッセージをどのようなコマンド（関数）で送り出してよいのか分かりませんでした。
試しにSendMessage() でやってみたのですが、反応しませんでした。
どのような方法があるのでしょうか。以下のコードは、私が試してみたﾓﾉです。

グローバル変数
Dim i as Long
Dim stp as Byte '停止指示

Sub mainloop()
Dim buf as String

i=i+1
If i>10000 Then
i=i-10000
End If
buf=Str$(i) 'iをカウントアップする
SetDlgItemText(hMainWnd,CommandButton1,StrPtr(buf))
Sleep(100)
End Sub
'------------------------------------------------------
イベントプロシージャ
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
i=0 'メインウィンドウ作成時には、カウント０
End Sub

Sub MainWnd_CommandButton1_Click()
stp=0 'ボタン１を押すとスタート、停止指示は０
Do
If PeekMessage(msgMain,0,0,0,PM_NOREMOVE) Then
iResult=GetMessage(msgMain,0,0,0)
If iResult=0 or iResult=-1 Then Exit Do
TranslateMessage(msgMain)
DispatchMessage(msgMain)
Else
mainloop()
End If
Loop While stp=0 '停止指示が０の間は動作する、１になったら抜ける
End Sub

Sub MainWnd_CommandButton2_Click()
stp=1 '停止指示１を出す
End Sub

私を含め皆であれこれ言ったことがごちゃ混ぜになってしまったような感じがします。
これでどうでしょうか。

Sub MainWnd_CommandButton1_Click()
	stp = 0 'ボタン１を押すとスタート、停止指示は０
	Dim msg As MSG
	Do
		If PeekMessage(msg, 0, 0, 0, PM_REMOVE) Then
			If msg.message = WM_QUIT Then
				PostQuitMessage(msg.wParam) 'メインのメッセージループへ再送。
				Exit Do
			End If
			TranslateMessage(msg)
			DispatchMessage(msg)
		Else
			mainloop()
		End If
	Loop While stp = 0 '停止指示が０の間は動作する、１になったら抜ける
End Sub

　私もActiveBasicを学習中ですがHSPのように簡単に扱えないかと模索中で
検証用に安定回転の必要なスロゲーを作成しています参考になるかどうか
解りませんが一度ご覧下さい。

「実践コードモジュール→LOOK LIKE HSP?」の最後にURLが貼ってあります
DLした「Uabp3.lzh」を適当なフォルダに解凍し「Uhsp9999.abp」がその
コードですRADを使用していないので直接エディタで開いてコンパイルします。
：操作＝方向キー又はスペースキー
：メッセージループを加工して「Uhsp_Loop()」を無限ループ状態で
　コールしています。

：ボタン・画像の一部・キー・のクリックで直接コードを駆動するよりは
　フラグを立ててフラグによって制御を切り替える方が柔軟ではないかと
　思います。

　ButtonFlag[0] = 0 = 停止中
　ButtonFlag[0] = 1 = 回転中
　ButtonFlag[0] = 2 = 滑り中

　If ButtonFlag[0] = 1 Then ReelMove()
　If ButtonFlag[0]+Button[...] = 0 Then ReelMatchCheck()