ab.com コミュニティ

コード: 全て選択

Class BACKGROUNDMUSIC
	Private
		mop As MCI_OPEN_PARMS
		mpp As MCI_PLAY_PARMS
		msp As MCI_SET_PARMS
		dwCallback As DWord
		bErr As DWord
	Public
		Sub ~BACKGROUNDMUSIC()
			Stop()
		End Sub
		Sub GetError(pszText As BytePtr, cchText As Long)
			mciGetErrorString(bErr, pszText, cchText)
		End Sub
		Sub Stop()
			'デバイスの停止
			bErr = mciSendCommand(mop.wDeviceID,MCI_STOP,MCI_WAIT,dwCallback)

			'デバイスのクローズ
			mciSendCommand(mop.wDeviceID,MCI_CLOSE,MCI_WAIT,dwCallback)
			mop.wDeviceID=0
		End Sub
		Sub Play(hCallBackWnd As HWND, filename As BytePtr, from As DWord)
			mpp.dwFrom = from
			If mop.wDeviceID Then Stop()

			mop.lpstrElementName = filename
			mop.dwCallback = hCallBackWnd
			mop.lpstrDeviceType = "MPEGVideo"
			bErr=mciSendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT or MCI_OPEN_TYPE,mop)

			msp.dwTimeFormat = MCI_FORMAT_MILLISECONDS
			mciSendCommand(mop.wDeviceID, MCI_SET, MCI_SET_TIME_FORMAT, msp)

			mpp.dwCallback = hCallBackWnd
			bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY,mpp)
		End Sub
		Sub Notify(flags As Long, DevID As Long)
			If flags = MCI_NOTIFY_SUCCESSFUL Then
				bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY or MCI_FROM,mpp)
			End If
		End Sub
End Class

コード: 全て選択

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

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

Dim BGM As BACKGROUNDMUSIC

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

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_Destroy()
	BGM.Stop()

	BGMTest_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	BGM.Play(hMainWnd, "チューリップ.mid", 0)
End Sub

Sub MainWnd_MciNotify(flags As Long, DevID As DWord)
	BGM.Notify(flags, DevID)
End Sub

コード: 全て選択

	Dim mpp As MCI_PLAY_PARMS,msp as MCI_SEEK_PARMS

	mciSendCommand(mop.wDeviceID,MCI_SEEK,MCI_SEEK_TO_START or MCI_WAIT,msp)
	mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY ,mpp)