| VB 源码 | VC 源码 | ASP源码 | JSP源码 | PHP源码 | CGI源码 | FLASH源码 | 素材模板 | C 源程序 | 站长工具 | 站长教程 |

VB技术

ASP技术
PHP技术
JSP技术
VB技术
.NET技术

本类阅读TOP10

·VB到底为我们做了什么?
·利用shell编程实现DOS风格的Linux命令行
·屏保程序模板化完整源代码
·用VB6实现中英文文本的私钥加密
·VB解决Unicode文本转换的问题
·用VB编写网络监控软件
·一组VB实用小程序
·新手必学:windows网络编程经典入门
·用VB编写定时关闭计算机的程序
·用VB制作屏幕保护程序

站内搜索

用MCI命令做一个播放器

  用MCI命令来实现多媒体的播放功能

  下面的内容几乎有播放器软件的各种功能,你只是引用这些函数就能做出一个播放器来

  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, lpdwVolume As Long) As Long

  Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

  Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

  Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

  Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

  Enum PlayTypeName
    File = 1
    CDAudio = 2
    VCD = 3
    RealPlay = 4
  End Enum
  Dim PlayType As PlayTypeName
  Enum AudioSource
    AudioStereo = 0 ' "stereo"
    AudioLeft = 1 '"left"
    AudioRight = 2 '"right"
  End Enum
  Dim hWndMusic As Long
  Dim prevWndproc As Long

  '=======================================================
  '打开MCI设备,urlStr为网址,传值代表成功与否
  '=======================================================
  Public Function OpenURL(urlStr As String, Optional hwnd As Long) As Boolean
    OpenMusic = False
    Dim MciCommand As String
    Dim DriverID As String

    CloseMusic
     'MCI命令
    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
  '=======================================================
  '打开MCI设备,FILENAME为文件名,传值代表成功与否
  '=======================================================
  Public Function OpenMusic(FileName As String, 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
    '获取短文件名
    GetShortPathName FileName, ShortPathName, 255
    RefShortName = Left(ShortPathName, InStr(1, ShortPathName, Chr(0)) - 1)
    'MCI命令
    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 Function
  Function 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
  '=======================================================
  '根据文件名,确定设备
  '=======================================================
  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"
     Case ".RM", "RAM", ".RA"
      GetDriverID = "RealPlayer"
     Case Else
      GetDriverID = "MPEGVideo"
     End Select
  End Function

  '======================================================
  '播放文件
  '======================================================
  Public Function PlayMusic() As Boolean
    Dim RefInt As Long
    PlayMusic = False
    RefInt = mciSendString("play NOWMUSIC", vbNull, 0, 0)
    If RefInt = 0 Then PlayMusic = True
  End Function

  '======================================================
  '获取媒体的长度
  '======================================================
  Public Function GetMusicLength() As Long
    Dim RefStr As String * 80
    mciSendString "status NOWMUSIC length", RefStr, 80, 0
    GetMusicLength = Val(RefStr)
  End Function

  '======================================================
  '获取当前播放进度
  '======================================================
  Public Function GetMusicPos() As Long
    Dim RefStr As String * 80
    mciSendString "status NOWMUSIC position", RefStr, 80, 0
    GetMusicPos = Val(RefStr)
  End Function

  '======================================================
  '获取媒体的当前进度
  '======================================================
  Public Function SetMusicPos(Position As Long) As Boolean
    Dim RefInt As Long
    SetMusicPos = False
    RefInt = mciSendString("seek NOWMUSIC to " & Position, vbNull, 0, 0)
    If RefInt = 0 Then SetMusicPos = True
  End Function

  '======================================================
  '暂停播放
  '======================================================
  Public Function PauseMusic() As Boolean
    Dim RefInt As Long
    PauseMusic = False
    RefInt = mciSendString("pause NOWMUSIC", vbNull, 0, 0)
    If RefInt = 0 Then PauseMusic = True
  End Function
  '======================================================
  '关闭媒体
  '======================================================
  Public Function CloseMusic() As Boolean
    Dim RefInt As Long
    CloseMusic = False
    RefInt = mciSendString("close NOWMUSIC", vbNull, 0, 0)
    If RefInt = 0 Then CloseMusic = True
  End 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 = True
  End Function

  '======================================================
  '全屏播放
  '======================================================
  Public Function PlayFullScreen() As Boolean
    Dim RefInt As Long
    PlayFullScreen = False
    RefInt = mciSendString("play NOWMUSIC fullscreen", vbNull, 0, 0)
    If RefInt = 0 Then PlayFullScreen = True
  End Function

  '=====================================================
  '设置声音大小
  '=====================================================
  Public Function SetVolume(Volume As Long) As Boolean
    Dim RefInt As Long
    SetVolume = False
    RefInt = mciSendString("setaudio NOWMUSIC volume to " & Volume, vbNull, 0, 0)
    If RefInt = 0 Then SetVolume = True
  End Function

  '=====================================================
  '设置播放速度
  '=====================================================
  Public Function SetSpeed(Speed As Long) As Boolean
    Dim RefInt As Long
    SetSpeed = False
    RefInt = mciSendString("set NOWMUSIC speed " & Speed, vbNull, 0, 0)
    If RefInt = 0 Then SetSpeed = True
  End Function

  '====================================================
  '静音True为静音,FALSE为取消静音
  '====================================================
  Public Function SetAudioOnOff(AudioOff As Boolean) As Boolean
    Dim RefInt As Long
    Dim OnOff As String
    SetAudioOff = False
    If AudioOff Then OnOff = "off" Else OnOff = "on"
    RefInt = mciSendString("setaudio NOWMUSIC " & OnOff, vbNull, 0, 0)
    If RefInt = 0 Then SetAudioOff = True
  End Function

  '====================================================
  '是否有画面True为有,FALSE为取消
  '====================================================
  Public Function SetWindowShow(WindowOff As Boolean) As Boolean
    Dim RefInt As Long
    Dim OnOff As String
    SetWindowShow = False
    If WindowOff Then OnOff = "show" Else OnOff = "hide"
    RefInt = mciSendString("window NOWMUSIC state " & OnOff, vbNull, 0, 0)
    If RefInt = 0 Then SetWindowShow = True
  End Function

  '====================================================
  '获得当前媒体的状态是不是在播放
  '====================================================
  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) = "播放" Then
      IsPlaying = True
    Else
      IsPlaying = False
    End If
  End Function

  '====================================================
  '获得播放窗口的handle
  '====================================================
  Public Function GetWindowHandle() As Long
    Dim RefStr As String * 160
    mciSendString "status NOWMUSIC window handle", RefStr, 80, 0
    GetWindowHandle = Val(RefStr)
  End Function

  '====================================================
  '获取DeviceID
  '====================================================
  Public Function GetDeviceID() As Long
    GetDeviceID = mciGetDeviceID("NOWMUSIC")
  End Function

  原作:thinkeasy




相关文章
  • 21个实用PHP代码
  • 精通PHP的十大要点
  • VB解决Unicode文本转换的问题
  • 一个基于WEB的QQ程序
  • 使用xmlhttp查询域名是否被注的小程序
  • 用VB6实现中英文文本的私钥加密
  • 一组VB实用小程序
  • 用VB编写异步多线程下载程序
  • 屏保程序模板化完整源代码
  • VB中实现窗体自动隐藏
  • 用VB编写网络监控软件
  • VB到底为我们做了什么?
  • 键盘幽灵VB版
  • 用VB编写定时关闭计算机的程序
  • 使用VB在WIN2000下截获IP数据包
  • VB中字符串中文的问题
  • 用VB制作屏幕保护程序
  • VB枚举主机IP
  • 用VB编写一个弹出菜单类
  • 自己的IE——用VB制作浏览器
  • 相关软件

  • VBScript编辑器源码  
  • 字体观察器FontViewer源码  
  • 自动壁纸更换器源码[第二部分]  
  • 自动壁纸更换器源码[第一部分]  
  • WINDOWS 3.0终端程序的C源码  
  • 一个取得 CPU 信息的程序源码  
  • 广告窗口终结者源码  
  • 下载整个网站程序ssnag与源码  
  • CGI邮件程序源码  
  • ISAPI留言簿源码  

  • 下载首页关于我们广告服务联系方式常见问题隐私声明法律条款本站声明下载帮助发布软件站点地图谷歌卫星地图