ab.com コミュニティ

コード: 全て選択

Dim lpCriticalSection As CRITICAL_SECTION 'グローバル変数として定義
InitializeCriticalSection( lpCriticalSection )

コード: 全て選択

EnterCriticalSection( lpCriticalSection )

コード: 全て選択

LeaveCriticalSection( lpCriticalSection )

コード: 全て選択

DeleteCriticalSection( lpCriticalSection )

コード: 全て選択

Dim BGM As *BACKGROUNDMUSIC '音楽再生用のクラスを示すポインタ

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
'ウィンドウ作成時にグローバルオブジェクトを作成
	BGM=New BACKGROUNDMUSIC()
End Sub

Sub MainWnd_Destroy()
'ウィンドウ破棄時にグローバルオブジェクトを破棄
	Delete BGM
End Sub

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Const MM_MCICONTROL	= (WM_APP+1)

Type MCICONTROL
	dwMciID As DWord
	uMsg As DWord
	fdwCommand As DWord
	lpParam As VoidPtr
End Type

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

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

	Select Case dwMsg
	Case WM_CREATE
		CreateThread(ByVal NULL, 0, AddressOf(SubThread), NULL, 0, VarPtr(tid))
	Case MM_MCICONTROL
		pmc = lParam
		mciSendCommand(pmc->dwMciID, pmc->uMsg, pmc->fdwCommand, ByVal pmc->lpParam)
	Case MM_MCINOTIFY
		' MM_MCINOTIFYの処理
	End Select
	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
	Dim mcic As MCICONTROL

Sub mciSendCommand2(dwMciID As DWord, uMsg As DWord, fdwCommand As DWord, lpParam As VoidPtr)

	mcic.dwMciID	= dwMciID
	mcic.uMsg		= uMsg
	mcic.fdwCommand	= fdwCommand
	mcic.lpParam	= lpParam

	SendMessage(hMainWnd, MM_MCICONTROL, 0, VarPtr(mcic))
End Sub

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

Sub MainWnd_Destroy()
	Music_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub SubThread()
	Dim mop As MCI_OPEN_PARMS
	Dim mpp As MCI_PLAY_PARMS

	Sleep(5000)
	
	mop.lpstrDeviceType  = MCI_DEVTYPE_SEQUENCER
	mop.lpstrElementName = "battle.mid"
	mciSendCommand2(NULL, MCI_OPEN, MCI_WAIT or MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID or MCI_OPEN_ELEMENT, VarPtr(mop))

	mpp.dwCallback = hMainWnd
	mciSendCommand2(mop.wDeviceID, MCI_PLAY, MCI_NOTIFY, VarPtr(mpp))

	Sleep(10000)
	
	mciSendCommand2(mop.wDeviceID, MCI_STOP, MCI_WAIT, NULL)
	mciSendCommand2(mop.wDeviceID, MCI_CLOSE, MCI_WAIT, NULL)

	SendMessage(hMainWnd, WM_CLOSE, 0, 0)
End Sub

コード: 全て選択

Class BACKGROUNDMUSIC
	Private
		mop As MCI_OPEN_PARMS
		mpp As MCI_PLAY_PARMS
		msp As MCI_SET_PARMS
		dwCallback As DWord
		bErr As DWord
		' mciSendMessage と MCIControl 用
		mfilename As BytePtr
		mfrom As DWord
		mhCallBackWnd
	Public
		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
			bErr=mciSendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT,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
		Function mciSendMessage(hCallBackWnd As HWND, msg As DWord, filename As BytePtr, from As DWord) As Long
			mfilename = filename
			mfrom = from
			mhCallBackWnd = hCallBackWnd
			mciSendMessage = SendMessage(hCallBackWnd, MM_MCICONTROL, msg, 0)
		End Function
		Sub MCIControl(msg As DWord)
			'"msg" は wParam
			Select Case msg
				Case BGM_PLAY
					Play(mhCallBackWnd, mfilename, mfrom)
				Case BGM_STOP
					Stop()
			End Select
		End Sub
End Class