'Use the MCI command to realize the contents of the multimedia play function', almost all the features of the player software, you just quote these functions can make a player "
Public 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
Public Declare Function MciGetDeviceID LIB "Winmm.dll" Alias "MciGetDeviceIDA" (Byval LPSTRNAME AS STRING) AS Long
Public Declare Function WaveoutGetVolume LIB "Winmm.dll" (Byval UdeviceID As Long) As long
Public Declare Function GetWindowlong Lib "User32" Alias "getWindowlonga" (Byval Nindex as long) As long
Public Declare Function CallWindowProc LIB "User32" Alias "CallWindowProca" (Byval Hwndfunc As Long, Byval Hwnd As Long, Byval Msg As Long, Byval WParam As Long) As long
Public Declare Function SetWindowlong Lib "User32" Alias "SetWindowlonga" (Byval Nindex As Long, Byval Dwnewlong As Long) As long
Public Declare Function GetshortPathname Lib "kernel32" Alias "getshortpathnamea" (byval lpszlongpath as string, Byval Cchbuffer as long) As long
Enum PlayTypeName File = 1 CDAudio = 2 VCD = 3 RealPlay = 4End EnumDim PlayType As PlayTypeNameEnum AudioSource AudioStereo = 0 ' "stereo" AudioLeft = 1' "left" AudioRight = 2 ' "right" End EnumDim hWndMusic As LongDim prevWndproc As Long
'==================================================== ====== 'Open the MCI device, URLSTR is the URL, the pass value represents success or no' ============================ ===================================== DriverID As String CloseMusic 'MCI command DriverID = GetDriverID (urlStr) If DriverID = "RealPlayer" Then PlayType = RealPlay Exit Function End If MciCommand = "open" & urlStr & "type" & DriverID & "alias NOWMUSIC"
If DriverID = "AVIVideo" Or DriverID = "MPEGVideo" Or DriverID = "MPEGVideo2" Then If hwnd <> 0 Then MciCommand = MciCommand "parent" & hwnd & "style child" hWndMusic = GetWindowHandle prevWndproc = GetWindowLong (hWndMusic, -4 ) SetWindowLong hWndMusic, -4, AddressOf WndProc Else MciCommand = MciCommand "style overlapped" End If End If RefInt = mciSendString (MciCommand, vbNull, 0, 0) mciSendString "set NOWMUSIC time format milliseconds", vbNullString, 0, 0 If RefInt = 0 Then OpenMusic = TRUE
End function '=============================================== ======== 'Open the MCI device, filename is the file name, the pass value represents success or no' ========================= ============================== pl, OPTIONAL HWND As long, Optional HWnd As long, as boolean openmusic = false Dim Shortpathname As String * 255 Dim RefShortName As String Dim RefInt As Long Dim MciCommand As String Dim DriverID As String CloseMusic 'Get short filename GetShortPathName fileName, ShortPathName, 255 RefShortName = Left (ShortPathName, InStr (1, ShortPathName, Chr (0)) - 1) 'MCI command DriverID = GetDriverID (RefShortName) If DriverID = "RealPlayer" Then PlayType = RealPlay Exit Function End If MciCommand = "open" & RefShortName & "type" & DriverID & "alias NOWMUSIC"
If DriverID = "AVIVideo" Or DriverID = "MPEGVideo" Or DriverID = "MPEGVideo2" Then If hwnd <> 0 Then MciCommand = MciCommand "parent" & hwnd & "style child" hWndMusic = GetWindowHandle prevWndproc = GetWindowLong (hWndMusic, -4 ) SetWindowLong hWndMusic, -4, AddressOf WndProc Else MciCommand = MciCommand "style overlapped" End If End If RefInt = mciSendString (MciCommand, vbNull, 0, 0) mciSendString "set NOWMUSIC time format milliseconds", vbNullString, 0, 0 If RefInt = 0 Then OpenMusic = TRUE
End FunctionFunction WndProc (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If Msg = & H202 Then MsgBox "OK" End If WndProc = CallWindowProc (prevWndproc, hwnd, Msg, wParam, lParam ) End function '================================================================================================================================================================================= ========== According to the file name, determine the device '================================= ====================== Public Function GetDriverId (ff as string) AS STRING SELECT CASE UCASE (Right (FF, 3)) Case "MID", "RMI "," Idi "getDriverid =" sequencer "Case" WAV "getDriverid =" Waveaudio "Case" ASF "," ASX "," IVF "," LSF "," LSX "," P2V "," WAX "," WVX " "," .Wm "," wma "," wmx "," wmp "getDriverid =" MPEGVIDEO2 "." .Rm "," ram "," .ra "getDriverid =" realplayer "Case Else getDriverid =" mpegvideo "End SelectEnd Function
'==================================================== ===== 'Play file' =========================================== ============= Public function playmusic () AS Boolean Dim Refint As long playmusic = false refint = mcIndstring ("Play nowMusic", vbnull, 0, 0) if refint = 0 THEN PLAYMUSIC = TrueEnd Function '================================================ ====== 'Get the length of the media' ======================================= ================ Public function getMusiclength () As long Dim Refstr AS String * 80 mciSendstring "Status nowmusic length", refstr, 80, 0 getMusicLength = Val (refstr) end function
'==================================================== ===== 'Get the current playback progress' ======================================= =============== Public function getMusicpos () As long Dim Refstr AS String * 80 mcIndstring "status nowmusic position", refstr, 80, 0 getmusicpos = val (refstr) end function '= ============================================================================================================================================================================================================= === 'Get the current progress of the media' ======================================== ============== Public function setmusicpos (position as long) AS Boolean Dim Refint As long setmusicpos = false refint = mcIndstring ("Seek nowmusic to" & position, vbnull, 0, 0) IF Refint = 0 THEN SETMUSICPOS = TrueEnd Function
'==================================================== ===== 'Suspension play' ========================================= ============= Public function pausemusic () AS Boolean Dim Refint As long pausemusic = false refint = mcIndstring ("pause nowmusic", vbnull, 0, 0) if refint = 0 THEN PAUSEMUSIC = TrueEnd Function '================================================ ====== 'Close Media' ======================================== ============== Public function closemusic () AS Boolean Dim Refint As long closemusic = false refint = mcIndstring ("Close Nowmusic", Vbnull, 0, 0) if refint = 0 Then Closemusic = TrueEnd Function '======================================
================ ============================ ========================= Public Function setaudiosource (Saudiosource As Audiosource) AS Boolean Dim Refint As Long Dim Strsource AS String Select Case Saudiosource Case 1: Strsource = "left" Case 2: strSource = "right" Case 0: strSource = "stereo" End Select SetAudioSource = False RefInt = mciSendString ( "setaudio NOWMUSIC source to" & strSource, vbNull, 0, 0) If RefInt = 0 Then SetAudioSource = TrueEnd function '=============================================== ======== 'full screen play' ====================================== ================ Public function playfulscreen () AS Boolean Dim Refint As long playfullscreen = false refint = McISendstring ("Play nowMusic Fullscreen", VBnull, 0, 0) if refint = 0 Then Playfullscreen = TrueEnd Function
'==================================================== ==== 'Set the sound size' ========================================== ============ Public Function setVolume (Volume as long) as boolean Dim Refint As long setvolume = false refint = mcIndstring ("setaudio nowmusic volume to" & volute, vbnull, 0, 0) if Refint = 0 THEN SETVOLUME = TrueEnd Function '========================================== =========== 'Set the play speed' =================================== =================== Public function setspeed (speted as long) AS Boolean Dim Refint As long setspeed = false refint = mcIndstring ("Set NowMusic Speed" & Speed, VBnull, 0, 0) if refint = 0 THEN setSpeed = TrueEnd Function
'==================================================== === 'Mute True is mute, false is canceled' ==================================== ================ Public function setaudioonoff (Audioff as boolean) AS Boolean Dim Refint As Long Dim onoff as string setaudioff = false ife = "OFF" Else Onoff = "ON "Refint = McISendstring (" setaudio nowmusic "& onoff, vbnull, 0, 0) if refint = 0 Then setAudiooff = trueEnd Function
'==================================================== === 'Is there a screen true, false is canceled' ================================== ================= Public Function setWindowshow (Windowoff as boolean) AS Boolean Dim Refint As long Dim onoff as string setWindowshow = false if windowoff dam = "show" else onoff = " Hide "refint = mcIndstring (" Window Nowmusic State "& onoff, Vbnull, 0, 0) if refint = 0 THEN SETWINDOWSHOW = TrueEnd Function
'==================================================== === 'The status of the current media is playing' ===================================== ================ Public function isplaying () AS Boolean Dim SL AS STRING * 255 MCISENDSTRING "STATUS NOWMUSIC MODE", SL, LEN (SL), 0 IF Left (SL, 7 = "playing" or left (sl, 2) = "Play" THEN ISPLAYING = true Else isplaying = false end ifend function '====================== ===============================11 get the handle '================================================================================================================================================================================================================================ ================================================ public function getWindowhandle () AS Long Dim Refstr As string * 160 mciSendstring "Status nowmusic window handle", refstr, 80, 0 getWindowhandle = VAL (refstr) end function
