转载请注明出处。VB演示源码下载地址：http://download.csdn.net/source/315615

'PictureBox控件作播放时间进度条演示，不会闪烁，并且和Slider控件同步。
'在窗体Form1中放2个命令按钮Command1、Command2，1个滑杆控件Slider1，1个图片框控件Picture1，Picture1和Slider1的宽度可以不一样，1个定时器控件Timer1

Option Explicit
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 GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Sub Command1_Click()
        Dim S As String, fName As String, sName As String
        
        On Error Resume Next
        fName = "E:\下载歌曲\你最近还好吗_she.wma"
        S = String(LenB(fName), Chr(0))
        GetShortPathName fName, S, Len(S)
        sName = Left(S, InStr(S, Chr(0)) - 1)

        mciSendString "stop MEDIA", vbNullString, 0, 0
        mciSendString "close MEDIA", vbNullString, 0, 0
       
        Call mciSendString("open " & Trim(sName) & " alias MEDIA", vbNullString, 256, 0)

       
        S = String(256, Chr(0))
        mciSendString "status MEDIA length", S, Len(S), 0
        Slider1.Max = Val(S)
        Slider1.Min = 0
        Slider1.TickFrequency = Int(Val(S) / 3)
        Timer1.Enabled = True
        Picture1.BackColor = RGB(74, 74, 82)
       
        mciSendString "play MEDIA", vbNullString, 0, 0

End Sub

Private Sub Command2_Click()
        On Error Resume Next
        Timer1.Enabled = False
        mciSendString "pause MEDIA", vbNullString, 0, 0
        mciSendString "stop MEDIA", vbNullString, 0, 0
        mciSendString "close MEDIA", vbNullString, 0, 0
End Sub

Private Sub Form_Load()
        Form1.BackColor = &H0&
        Command1.Caption = "播放音乐"
        Command2.Caption = "停止播放"
        Picture1.BackColor = &HC0C000
        Picture1.FillColor = &H0&
        Picture1.ForeColor = &H80000008
        Picture1.Height = 65 '图片框的高度
        Timer1.Interval = 100
        Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
        Dim S As String '记录当前时间
        Dim cjlS1 As Long, cjlS2 As Long
        Dim cjlDB As Double
        On Error Resume Next
        S = String(256, Chr(0))
        mciSendString "status MEDIA position", S, Len(S), 0
        Slider1.Value = Val(S) '当前播放时间进度，单位是毫秒
        Debug.Print " Slider1.Value=" & Slider1.Value
       
        '除以1000全都化成秒
        cjlS1 = (Slider1.Value / 1000) * Int(Picture1.Width / (Slider1.Max / 1000)) '基本值
        cjlDB = (Picture1.Width / (Slider1.Max / 1000)) - Int(Picture1.Width / (Slider1.Max / 1000))
        cjlS2 = Int((Slider1.Value / 1000) * (cjlDB)) '误差
        Picture1.Line (0, 0)-(cjlS1 + cjlS2, Picture1.Height), RGB(157, 217, 253), BF '播放时间进度显示器
End Sub 

发表于 @ 2007年12月24日 14:39:00|评论(loading...)|编辑