Code:
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private TheFileName As String
Private Function IsItPlaying() As Boolean
Static yn As String * 30
mciSendString "status MP3Play mode", yn, Len(yn), 0
IsItPlaying = (Mid$(yn, 1, 7) = "playing")
End Function
Private Function mp3Play(FileName As String)
Dim cmdToDo As String * 255
Dim dwReturn As Long
Dim ret As String * 128
Dim tmp As String * 255
Dim lenShort As Long
Dim ShortPathAndFie As String
If Dir(FileName) = "" Then
mmOpen = "Error with input file"
Exit Function
End If
lenShort = GetShortPathName(FileName, tmp, 255)
ShortPathAndFie = Left$(tmp, lenShort)
glo_hWnd = hwnd
cmdToDo = "open " & ShortPathAndFie & " type MPEGVideo Alias MP3Play"
dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)
If dwReturn <> 0 Then 'not success
mciGetErrorString dwReturn, ret, 128
mmOpen = ret
MsgBox ret, vbCritical
Exit Function
End If
mmOpen = "Success"
mciSendString "play MP3Play", 0, 0, 0
End Function
Private Function mp3Pause()
mciSendString "pause MP3Play", 0, 0, 0
End Function
Private Function mp3Unpause()
mciSendString "resume MP3Play", 0, 0, 0
End Function
Private Function mp3Stop() As String
mciSendString "stop MP3Play", 0, 0, 0
mciSendString "close MP3Play", 0, 0, 0
End Function
Private Function PositionInSec()
Static PIS As String * 30
mciSendString "set MP3Play time format milliseconds", 0, 0, 0
mciSendString "status MP3Play position", PIS, Len(PIS), 0
PositionInSec = Round(Mid$(PIS, 1, Len(PIS)) / 1000)
End Function
Private Function Position()
Static P As String * 30
mciSendString "set MP3Play time format milliseconds", 0, 0, 0
mciSendString "status MP3Play position", P, Len(P), 0
sec = Round(Mid$(P, 1, Len(P)) / 1000)
If sec < 60 Then Position = "0:" & Format(sec, "00")
If sec > 59 Then
mins = Int(sec / 60)
sec = sec - (mins * 60)
Position = Format(mins, "00") & ":" & Format(sec, "00")
End If
End Function
Private Function LengthInSec()
Static L As String * 30
mciSendString "set MP3Play time format milliseconds", 0, 0, 0
mciSendString "status MP3Play length", L, Len(s), 0
LengthInSec = Round(Val(Mid$(L, 1, Len(L))) / 1000) 'Round(CInt(Mid$(s, 1, Len(s))) / 1000)
End Function
Private Function Length()
Static L As String * 30
mciSendString "set MP3Play time format milliseconds", 0, 0, 0
mciSendString "status MP3Play length", L, Len(L), 0
sec = Round(Val(Mid$(L, 1, Len(L))) / 1000) 'Round(CInt(Mid$(l, 1, Len(l))) / 1000)
If sec < 60 Then Length = "0:" & Format(sec, "00")
If sec > 59 Then
mins = Int(sec / 60)
sec = sec - (mins * 60)
Length = Format(mins, "00") & ":" & Format(sec, "00")
End If
End Function
Private Function TimeRemaining() As String
RSecs = (LengthInSeconds) - (PositionInSec)
RMins = Int(RSecs / 60)
RSecs = Format((((RSecs / 60) - RMins) / 1.67), "0.00") * 100
If RSecs > 59 Then
RMins = RMins + 1
RSecs = 0#
Else: RMins = RMins
RSecs = RSecs
End If
If RSecs < 10 Then
TimeRemaining = RMins & ":0" & RSecs
Else: TimeRemaining = RMins & ":" & RSecs
End If
End Function
Private Function SeekTo(Second)
mciSendString "set MP3Play time format milliseconds", 0, 0, 0
If IsItPlaying = True Then mciSendString "play MP3Play from " & Second, 0, 0, 0
If IsItPlaying = False Then mciSendString "seek MP3Play to " & Second, 0, 0, 0
End Function
Private Function FastFoward(Second)
Second = (PositionInSec + Second) * 1000
mciSendString "set mpeg time format milliseconds", 0&, 0&, 0&
If IsItPlaying = True Then
mciSendString "play mpeg from " & Second, 0&, 0&, 0&
Else: mciSendString "seek mpeg from " & Second, 0&, 0&, 0&
End If
End Function
Private Function Rewind(Second)
Second = (PositionInSec - Second) * 1000
mciSendString "set mpeg time format milliseconds", 0&, 0&, 0&
If IsItPlaying = True Then
mciSendString "play mpeg from " & Second, 0&, 0&, 0&
Else: mciSendString "seek mpeg from " & Second, 0&, 0&, 0&
End If
End Function
Private Function SetVolume(Channel As String, VolumeValue As Long) As String
Dim cmdToDo As String * 128
Dim dwReturn As Long
Dim ret As String * 128
Dim VolumeV As Long
VolumeV = VolumeValue
If VolumeV < 0 Or VolumeV > 100 Then
SetVolume = "out of volume"
Exit Function
End If
VolumeV = VolumeV * 10
If LCase(Channel) = "left" Or LCase(Channel) = "right" Then
cmdToDo = "setaudio mpeg " & Channel & " Volume to " & VolumeV
Else
cmdToDo = "setaudio mpeg Volume to " & VolumeV
End If
dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)
If Not dwReturn = 0 Then 'not success
mciGetErrorString dwReturn, ret, 128 'Get the error
SetVolume = ret
Exit Function
End If
'Success
SetVolume = "Success"
End Function
Private Function Pitch(Value As Integer) As String
Dim dwReturn As Long
Dim ret As String * 128
Dim Pval As Long
Value = Value - 100
Pval = 1000 + Value
dwReturn = mciSendString("set mpeg speed " & Pval, 0&, 0&, 0&)
If Not dwReturn = 0 Then 'not success
mciGetErrorString dwReturn, ret, 128 'Get the error
Pitch = ret
Exit Function
End If
Pitch = "Success"
End Function
Reply With Quote