frmmain.vb

一个简单的mp3播放器的源码

                setEnabled()
                'update the selected file text box with the file name, without the full path
                txtSoundTrack.Text = Path.GetFileName(ofdSound.FileName)
                'set global currentSoundTrack to hold the full path+filename
                currentSoundTrack = ofdSound.FileName
            End If
        End If
    End Sub

    'btnPlay_Click - fired when user clicks on the play button
    Private Sub btnPlay_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPlay.Click
        'start playing the track
        play_track()
        'disable play button and enable pause/stop buttons
        btnPause.Enabled = True
        btnStop.Enabled = True
        btnPlay.Enabled = False
        'set the progress bar max value to the length of the track divided by 1000 
        'divide by 1000 to avoid having a max value greater than what it can hold
        trackBar.Maximum = currentSoundLength / 1000
        trackBar.Minimum = 0
        'set the progress bar to 0
        trackBar.Value = 0
    End Sub

    'btnPause_Click - fired when user clicks on the pause button
    Private Sub btnPause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPause.Click
        'set the onPause boolean
        isOnPause = True
        'stop playing
        stop_track()
        'disable pause button
        btnPause.Enabled = False
        'other buttons still available
        btnStop.Enabled = True
        btnPlay.Enabled = True
    End Sub

    'btnStop_Click - fired when user clicks on the stop button
    Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
        'stop playing
        stop_track()
        'enable/disable buttons as if user had just selected a file
        setEnabled()
    End Sub

    'timSound_Tick - fired every 500ms to check current status of file
    'this is a workaround for a End_of_track event
    'a better solution would be to wrap the End_Callback from FMOD
    Private Sub timSound_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles timSound.Tick
        'set the uPausePosition to the current position in track
        uPausePosition = fmod_GetPosition(soundHandle)
        'convert to int [bad conversion ?]
        currentPosition = CInt(uPausePosition.ToString)
        'set the progress bar to the current position value divided by 1000
        trackBar.Value = CInt(currentPosition / 1000)
        'if the current position is greater or equal to the total length, then we have reached the end of the track
        If currentPosition >= currentSoundLength Then
            'disable timer, which means stop waiting for the end of the track
            timSound.Enabled = False
            'make sure it's really finished by calling stop_sound, just in case
            stop_track()
            'enable/disable buttons as if user had just selected a file
            setEnabled()
        End If
    End Sub

    'play_track - call to fmod functions to start playing
    Private Sub play_track()
        'initialize fmod with mixrate equal to 44.1kHz
        fmod_Init(44100, 16, 0)
        'create a handle to hold the track stream - REPLACE HERE fmod_getStream BY fmod_getStream_New TO TRY WITHOUT THE AddrOfPinnedObject BUG FIX !
        Dim soundStream As IntPtr = fmod_getStream(currentSoundTrack)
        'open the stream in Normal mode, which is combination of Mono sound, 16 bits, Signed
        soundHandle = fmod_Open(soundStream, &H10 Or &H20 Or &H100, 0, 0)
        'record the current length of track 
        currentSoundLength = fmod_GetLength(soundHandle)
        If isOnPause Then
            'if we are on pause, this means the user was previously playing
            'thus we have start the track where it has previously stopped
            'this position is in uPausePosition
            'so set the track's position to that
            fmod_SetPosition(soundHandle, uPausePosition)
            'and play from there
            fmod_Play(0, soundHandle)
            'unset the on pause bit
            isOnPause = False
        Else
            'if we are not on pause, this means it's a click on play after a file selection
            'so start playing immediately at start position
            fmod_Play(0, soundHandle)
        End If
        'start the timer to check for the end of the stream
        timSound.Enabled = True
    End Sub

    'stop_track - used to stop playing
    Private Sub stop_track()
        'check if the handle is still valid
        'if it's not, the track is probably already finished
        If soundHandle.ToInt32 > 0 Then
            'record the track's position, in case user has clicked on pause
            uPausePosition = fmod_GetPosition(soundHandle)
            'stop playing
            fmod_Stop(soundHandle)
            'release the ressources
            fmod_Close()
        End If
    End Sub

#Region " FMOD DLL calls "
    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Init", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_Init(ByVal mixrate As Integer, ByVal maxsoftwarechannels As Integer, ByVal flags As Integer) As Boolean
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Stream_GetLength", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_GetLength(ByVal fstream As IntPtr) As Integer
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Stream_GetPosition", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_GetPosition(ByVal fstream As IntPtr) As UInt32
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Stream_Open", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_Open(ByVal data As IntPtr, ByVal mode As Integer, ByVal offset As Integer, ByVal length As Integer) As IntPtr
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Stream_Play", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_Play(ByVal channel As Integer, ByVal fstream As IntPtr) As Integer
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Stream_SetPosition", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_SetPosition(ByVal fstream As IntPtr, ByVal position As UInt32) As Boolean
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Stream_Stop", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Function fmod_Stop(ByVal fstream As IntPtr) As Boolean
    End Function

    <DllImport("fmodce.dll", EntryPoint:="FSOUND_Close", SetLastError:=True, CharSet:=CharSet.Unicode, CallingConvention:=CallingConvention.Winapi)> _
    Public Shared Sub fmod_Close()
    End Sub

    Private Function fmod_getStream(ByVal filename As String) As IntPtr
        'thanks to mattias73 and lonifasiko for the help on this !
        Dim filenames As Byte() = Encoding.Default.GetBytes(filename & vbNullChar)
        Dim hfile As GCHandle = GCHandle.Alloc(filenames, GCHandleType.Pinned)
        'if the .NET CF version is 1.x, then we add 4 bytes to the address of the pinned object, 
        'because AddrOfPinnedObject returns the address of the object shifted of 4 bytes, which corresponds to the storage space of the pointer itself
        'the bug is only in CF 1.x so this bug-fix needs to be conditional
        If Environment.Version.Major = 1 Then
            fmod_getStream = New IntPtr(hfile.AddrOfPinnedObject().ToInt32 + 4)
        Else
            fmod_getStream = hfile.AddrOfPinnedObject()
        End If
        If hfile.IsAllocated Then
            hfile.Free()
        End If
        'End note :
        'The bug fix above is not a good bug-fix in fact, because although CF 2.0 doesn't have this problem anymore
        'it might be solved as well in later releases of CF 1.x (as service packs)
        'In this latter case, the code wouldn't work - SEE BELOW
    End Function

#Region " Sample from MS "
    'The code below is never called - it's only a sample of how to allocate the memory for the stream
    'without using the AddrOfPinnedObject
    'code from http://msdn.microsoft.com/smartclient/understanding/netcf/FAQ/default.aspx

    <DllImport("coredll.dll", SetLastError:=True)> _
     Public Shared Function LocalAlloc(ByVal uFlags As UInt32, ByVal uBytes As UInt32) As IntPtr
    End Function
    <DllImport("coredll.dll", SetLastError:=True)> _
    Public Shared Function LocalFree(ByVal hMem As IntPtr) As IntPtr
    End Function
    <DllImport("coredll.dll", SetLastError:=True)> _
    Public Shared Function LocalReAlloc(ByVal hMem As IntPtr, ByVal uBytes As UInt32, ByVal fuFlags As UInt32) As IntPtr
    End Function
    Public Const LMEM_FIXED As Integer = 0
    Public Const LMEM_MOVEABLE As Integer = 2
    Public Const LMEM_ZEROINIT As Integer = &H40
    Private Function fmod_getStream_New(ByVal filename As String) As IntPtr
        Dim filenames As Byte() = Encoding.Default.GetBytes(filename & vbNullChar)
        Dim p As IntPtr = LocalAlloc(Convert.ToUInt32(LMEM_FIXED Or LMEM_ZEROINIT), Convert.ToUInt32(filenames.Length))
        If Not p.Equals(IntPtr.Zero) Then
            Marshal.Copy(filenames, 0, p, filenames.Length)
            'else "out of memory" !
        End If
        fmod_getStream_New = p
    End Function

#End Region

#End Region

End Class