ab.com コミュニティ

次のコードで音楽を再生することはできるのですが停止ができません。どこに問題があるのでしょうか？

'-----呼び出し側-----
Dim Play As Sound '音楽再生用オブジェクト
Sub MainWnd_PlayButton_Click()
	Dim idThread As DWord 'スレッドID

	'新規スレッドで再生関数を呼び出す
	hThread=CreateThread(ByVal 0,0, AddressOf(Play.PlayCommand),0,0,VarPtr(idThread))
End Sub

Sub MainWnd_StopButton_Click()
	Play.StopCommand() '停止
End Sub
'------クラス側-----
Class Sound '音楽再生用クラス
Public
	Sub PlayCommand()
		Dim DevID As Long
    	Dim bErr As Long
    	Dim mpp As MCI_PLAY_PARMS
    	Dim buffer[MAX_PATH-1] As Byte
    	Dim dwCallback As DWord
		Dim itemStr As BytePtr
		Dim iniItem As BytePtr
		itemStr=calloc(255)
		iniItem=calloc(255)
		
    	'再生中の場合は停止させる
    	If mop.wDeviceID Then StopCommand()
	
    	'メディア ファイルのパスを設定します。
    	mop.lpstrElementName=buffer
		GetTreeCaretText(hAny,itemStr,255) '選択されているアイテム名の取得

    	If lstrcmp(ini,"0")<>0 Then 'iniファイルがデフォルト以外
	        lstrcpy(iniItem,ini) 'iniファイルの内容をコピー
			lstrcpy(mop.lpstrElementName,lstrcat(iniItem,itemStr)) '連結
		Else	'デフォルトのとき
			mop.lpstrElementName=ItemDir(itemStr) '連結
		End If

    	'メッセージ通知のためのウィンドウを指定
    	mop.dwCallback=hMainWnd As DWord

    	'MCIデバイスをオープン
    	bErr=mciSendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT,mop)
    	If bErr Then
        	'デバイスを閉じる
        	mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)
        	MessageBox(hMainWnd,"デバイスのオープンに失敗","エラー",MB_OK)
        	Exit Sub
    	End If

    	'再生
    	mpp.dwCallback=hMainWnd As DWord
    	bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY,mpp)
    	If bErr Then
        	'デバイスを閉じる
        	mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)
        	MessageBox(hMainWnd,"デバイスの再生に失敗","エラー",MB_OK)
			Exit Sub
    	End If

    	'停止ボタンを有効化する。
    	EnableWindow(GetDlgItem(hMainWnd,StopButton),1)
		free(itemStr)
		free(iniItem)
	End Sub

	Sub StopCommand()
		Dim DevID As Long
    	Dim bErr As Long
    	Dim dwCallback As DWord
    	'停止
    	bErr=mciSendCommand(mop.wDeviceID,MCI_STOP,MCI_WAIT,dwCallback)
    	If bErr Then
        	'デバイスを閉じる
        	mciSendCommand(mop.wDeviceID,MCI_CLOSE,MCI_WAIT,dwCallback)
        	MessageBox(hMainWnd,"デバイスの停止に失敗","エラー",MB_OK)
			'停止ボタンを無効にする
    		EnableWindow(GetDlgItem(hMainWnd,StopButton),0)
			Exit Sub
    	End If
	
    	'デバイスを閉じる
    	mciSendCommand(mop.wDeviceID,MCI_CLOSE,MCI_WAIT,dwCallback)
    	mop.wDeviceID=0

    	'停止ボタンを無効にする
		EnableWindow(GetDlgItem(hMainWnd,StopButton),0)
		CloseHandle(hThread) 'スレッドハンドルを閉じる
	End Sub
End Class

こんな感じに修正すると動くと思います。 [ここをクリックすると内容が表示されます]

コード: 全て選択

Class Sound '音楽再生用クラス
	DevID As Long
	dwCallback As DWord
Public
	Sub PlayCommand()
		Dim bErr As Long
		Dim mpp As MCI_PLAY_PARMS
		Dim buffer[MAX_PATH-1] As Byte
		Dim itemStr As BytePtr
		Dim iniItem As BytePtr
		itemStr=calloc(255)
		iniItem=calloc(255)
		
		'再生中の場合は停止させる
		If mop.wDeviceID Then StopCommand()
	
		'メディア ファイルのパスを設定します。
		mop.lpstrElementName=buffer
		GetTreeCaretText(hAny,itemStr,255) '選択されているアイテム名の取得

		If lstrcmp(ini,"0")<>0 Then 'iniファイルがデフォルト以外
			lstrcpy(iniItem,ini) 'iniファイルの内容をコピー
			lstrcpy(mop.lpstrElementName,lstrcat(iniItem,itemStr)) '連結
		Else	'デフォルトのとき
			mop.lpstrElementName=ItemDir(itemStr) '連結
		End If

		'メッセージ通知のためのウィンドウを指定
		mop.dwCallback = hMainWnd As DWord
		dwCallback = hMainWnd As DWord

		'MCIデバイスをオープン
		bErr=mciSendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT,mop)
		If bErr Then
			'デバイスを閉じる
			mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)
			MessageBox(hMainWnd,"デバイスのオープンに失敗","エラー",MB_OK)
			Exit Sub
		End If
		DevID = mop.wDeviceID

		'再生
		mpp.dwCallback=hMainWnd As DWord
		bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY,mpp)
		If bErr Then
			'デバイスを閉じる
			mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)
			MessageBox(hMainWnd,"デバイスの再生に失敗","エラー",MB_OK)
			Exit Sub
		End If

		'停止ボタンを有効化する。
		EnableWindow(GetDlgItem(hMainWnd,StopButton),1)
		free(itemStr)
		free(iniItem)
	End Sub

	Sub StopCommand()
		Dim bErr As Long

		'停止
		bErr=mciSendCommand(DevID,MCI_STOP,MCI_WAIT,dwCallback)
		If bErr Then
			'デバイスを閉じる
			mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)
			MessageBox(hMainWnd,"デバイスの停止に失敗","エラー",MB_OK)
			'停止ボタンを無効にする
			EnableWindow(GetDlgItem(hMainWnd,StopButton),0)
			Exit Sub
		End If
	
		'デバイスを閉じる
		mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)
		mop.wDeviceID=0

		'停止ボタンを無効にする
		EnableWindow(GetDlgItem(hMainWnd,StopButton),0)
		CloseHandle(hThread) 'スレッドハンドルを閉じる
	End Sub
End Class

> NoWestさん
試してみましたが停止できません。
また、最初のコードでのエラー情報では、「指定されたコマンドを自動的に開かれたデバイスで実行することはできません。」となっています。

別スレッドでの実行でなくそのまま呼び出したら、うまく動きました。ですが、別スレッドで実行したいので、別スレッドでの実行はどのようすれば良いのでしょうか？

> 別スレッドでの実行でなくそのまま呼び出したら、うまく動きました。ですが、別スレッドで実行したいので、別スレッドでの実行はどのようすれば良いのでしょうか？

ほぉ、あなたもこの妙なWindowsの仕様にはまっていましたか。

実は9X系のWindowsではあるスレッドで開かれたMCIデバイスを別のスレッドから操作可能なのですが、NT系のWindowsの場合、あるスレッドで開かれたMCIデバイスを別のスレッドから操作することはできない仕様になっています。

ですから、この問題を回避するためにはMCIデバイスを予め使いたいスレッド上で開く必要があります。

要するに、例えばMCI_STATUSなんぞで現在の再生位置リアルタイムに取得するスレッドを作成した場合、そのスレッドで内でMCIデバイスを開いておく必要があります。

デバイスは使いたいスレッドで開いてあるので問題はないのですが、停止のときに同じスレッドで停止用関数を呼び出す方法がわかりません。教えていただけないでしょうか。

> デバイスは使いたいスレッドで開いてあるので問題はないのですが、停止のときに同じスレッドで停止用関数を呼び出す方法がわかりません。教えていただけないでしょうか。

色々な実装法があると思いますが、
私の場合は、スレッドの別を考えなくてもよいスレッドセーフなmciSendCommandを作って使っています。

よかったら使ってください。

ソースはこちら [ここをクリックすると内容が表示されます]

コード: 全て選択

Const EVENT_ALL_ACCESS = &H001F0003

Const MCI_LAST = &HFFF

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

Type EXPARMS
	dwDeviceID As DWord
	pParam As VoidPtr
	dwReturn As DWord
End Type

Function MciThreadFunc() As Long
	Dim hEvent As HANDLE
	hEvent = OpenEvent(EVENT_ALL_ACCESS,FALSE,"MCI ENGNE EVENT")
	Dim msg As MSG
	Dim ep As *EXPARMS
	Do
		Select Case GetMessage(msg, 0, 0, 0)
			Case -1,0
				Exit Do
			Case Else
				If msg.message<>MCI_LAST Then
					ep = msg.lParam As *EXPARMS
					ep->dwReturn = mciSendCommand(ep->dwDeviceID, msg.message, msg.wParam, ByVal ep->pParam)
					SetEvent(hEvent)
				End If
		End Select
	Loop
	CloseHandle(hEvent)
	ExitThread(&HABCDEF)
End Function

Class CMciSafetySendCommand
	m_idThread As DWord
	m_hEvent As HANDLE
Public
	Sub CMciSafetySendCommand()
		m_hEvent = CreateEvent(NULL, TRUE, TRUE, "MCI ENGNE EVENT")
		CloseHandle(CreateThread(ByVal NULL, 0, AddressOf(MciThreadFunc), 0, 0, VarPtr(m_idThread)))
		While PostThreadMessage(m_idThread,&HFFF,0,0)
			Sleep(0)
		Wend
	End Sub
	Sub ~CMciSafetySendCommand()
		PostThreadMessage(m_idThread, WM_QUIT, 0, 0)
		CloseHandle(m_hEvent)
	End Sub
	Function SendCommand(dwDevID As DWord, dwMsg As DWord, dwCommand As DWord, ByRef Param As Any) As DWord
		Dim ep As *EXPARMS
		ep=malloc(SizeOf(EXPARMS))
		ep->dwDeviceID = dwDevID
		ep->pParam = VarPtr(Param)
		ResetEvent(m_hEvent)
		PostThreadMessage(m_idThread, dwMsg, dwCommand, ep As Long)
		WaitForSingleObject(m_hEvent,INFINITE)
		SendCommand = ep->dwReturn
		free(ep)
	End Function
Public
End Class

~使い方~
グローバル領域にでも

コード: 全て選択

Dim mci As MciSafetySendCommand

として

コード: 全て選択

Dim mop As MCI_OPEN_PARMS
mop.dwCallback=hMainWnd As DWord
mop.lpstrElementName="sound1.wav"
mci.SendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT,mop)

ってな感じで普段通りのmciSendCommandとして使えます。

仕組みは簡単で全てのMCIコマンドが同一スレッド上で実行されるようにカプセル化しているだけです。

mciSendCommandをmci.SendCommmandに変えたところエラーはでなくなりましたが、今度は再生ができません。ボタンを押しても音がでずMciNotifyイベントが起こりません。

まず、最初にソースに記述ミスがあったことを謝ります。

SendCommmand → SendCommandと直してください。

あと、ついでにSendCommandで戻り値を取得できるように改良しました。

> mciSendCommandをmci.SendCommmandに変えたところエラーはでなくなりましたが、今度は再生ができません。ボタンを押しても音がでずMciNotifyイベントが起こりません。

MciNotifyイベントを発生するにはMCIコマンドにMCI_NOTIFYが追加されていなければなりませんよ。

コード: 全て選択

Dim mpp As MCI_PLAY_PARMS
mpp.dwCallback=hMainWnd
mci.SendCommand(mop.dwDeviceID,MCI_PLAY,MCI_NOTIFY,mpp)

できました。ちなみに再生されない原因はただIDの指定を忘れただけでした。NoWestさんありがとうございました。

ab.com コミュニティ

音楽再生

音楽再生

Re: 音楽再生

原因

Re: 原因