cdaudio.vb

这是一本用Visual Studio.NET进行多媒体编程的读物

Option Strict Off
Option Explicit On
Friend Class CDAudio
	Private Declare Function mciGetErrorString Lib "winmm.dll"  Alias "mciGetErrorStringA"(ByVal dwError As Integer, ByVal lpstrBuffer As String, ByVal uLength As Integer) As Integer
	Private Declare Function mciSendString Lib "winmm.dll"  Alias "mciSendStringA"(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
	
	Function StartPlay() As Object
		mciSendString("play cd", CStr(0), 0, 0)
	End Function
	
	Function SetTrack(ByRef Track As Short) As Object
		mciSendString("seek cd to " & Str(Track), CStr(0), 0, 0)
	End Function
	
	Function StopPlay() As Object
		mciSendString("stop cd wait", CStr(0), 0, 0)
	End Function
	
	Function PausePlay() As Object
		mciSendString("pause cd", CStr(0), 0, 0)
	End Function
	
	Function EjectCD() As Object
		mciSendString("set cd door open", CStr(0), 0, 0)
	End Function
	
	Function CloseCD() As Object
		mciSendString("set cd door closed", CStr(0), 0, 0)
	End Function
	
	Function UnloadAll() As Object
		mciSendString("close all", CStr(0), 0, 0)
	End Function
	
	Function SetCDPlayerReady() As Object
		mciSendString("open cdaudio alias cd wait shareable", CStr(0), 0, 0)
	End Function
	Function SetFormat_tmsf() As Object
		mciSendString("set cd time format tmsf wait", CStr(0), 0, 0)
	End Function
	
	Function SetFormat_milliseconds() As Object
		mciSendString("set cd time format milliseconds", CStr(0), 0, 0)
	End Function
	
	Function CheckCD() As Short
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(30)
		mciSendString("status cd media present", s.Value, Len(s.Value), 0)
		CheckCD = CShort(s.Value)
	End Function
	
	Function GetNumTracks() As Short
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(30)
		mciSendString("status cd number of tracks wait", s.Value, Len(s.Value), 0)
		GetNumTracks = CShort(Mid(s.Value, 1, 2))
	End Function
	
	Function GetCDLength() As String
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(30)
		mciSendString("status cd length wait", s.Value, Len(s.Value), 0)
		GetCDLength = s.Value
	End Function
	
	Function GetTrackLength(ByRef TrackNum As Short) As String
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(30)
		mciSendString("status cd length track " & TrackNum, s.Value, Len(s.Value), 0)
		GetTrackLength = s.Value
	End Function
	
	Sub GetCDPosition(ByRef Track As Short, ByRef Min As Short, ByRef Sec As Short)
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(30)
		mciSendString("status cd position", s.Value, Len(s.Value), 0)
		Track = CShort(Mid(s.Value, 1, 2))
		Min = CShort(Mid(s.Value, 4, 2))
		Sec = CShort(Mid(s.Value, 7, 2))
	End Sub
	
	Function CheckIfPlaying() As Short
		CheckIfPlaying = 0
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(30)
		mciSendString("status cd mode", s.Value, Len(s.Value), 0)
		If Mid(s.Value, 1, 7) = "playing" Then CheckIfPlaying = 1
	End Function
	
	Function SeekCDtoX(ByRef Track As Short) As Object
		StopPlay()
		SetTrack(Track)
		StartPlay()
	End Function
	
	Function ReadyDevice() As Object
		UnloadAll()
		SetCDPlayerReady()
		SetFormat_tmsf()
	End Function
	
	Function FastForward(ByRef Spd As Short) As Object
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(40)
		SetFormat_milliseconds()
		mciSendString("status cd position wait", s.Value, Len(s.Value), 0)
		CheckIfPlaying()
		If CheckIfPlaying = 1 Then
			mciSendString("play cd from " & CStr(CInt(s.Value) + Spd), CStr(0), 0, 0)
		Else
			mciSendString("seek cd to " & CStr(CInt(s.Value) + Spd), CStr(0), 0, 0)
		End If
		SetFormat_tmsf()
	End Function
	
	Function ReWind(ByRef Spd As Short) As Object
		Dim s As VB6.FixedLengthString = New VB6.FixedLengthString(40)
		SetFormat_milliseconds()
		mciSendString("status cd position wait", s.Value, Len(s.Value), 0)
		CheckIfPlaying()
		If CheckIfPlaying = 1 Then
			mciSendString("play cd from " & CStr(CInt(s.Value) - Spd), CStr(0), 0, 0)
		Else
			mciSendString("seek cd to " & CStr(CInt(s.Value) - Spd), CStr(0), 0, 0)
		End If
		SetFormat_tmsf()
	End Function
End Class