Dim MyLeft As Long
Dim MyTop As Long
MyLeft = Screen.Width/15/2-320
MyTop = Screen.Height/15/2-240
'这个语句在你播放媒体后使用
mciExecute "put MyMCIDC window at " & MyLeft & " " & MyTop & " 640 480"

mciExecute "open C:\1.wmv TYPE MPEGVideo ALIAS MyMCIDC STYLE child PARENT " & Picture1.hWnd

'在窗体Form1中放2个命令按钮Command1、Command2，1个滑杆控件Slider1，1个图片框控件Picture1，Picture1和Slider1的宽度可以不一样，1个定时器控件Timer1
'再添加一个窗体Form2

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 Const WS_CHILD = &H40000000  '用于建立播放视频窗口的样式

Dim S As String, fName As String, sName As String

Function mciVideoStretch(MCIfile As String, formTV As Form) 'MCI视频图像缩放函数
       On Error Resume Next
       Dim strMCI As String
       strMCI = "put " & MCIfile & " window at 0 0 " & formTV.ScaleWidth & " " & formTV.ScaleHeight
       Call mciSendString(strMCI, vbNullString, 0, 0)
End Function


Private Sub Command1_Click()
        
         
        On Error Resume Next
        
        Form2.Visible = True
        
        fName = "E:\下载音乐\我和你（演唱者莎拉布菜曼刘欢）_北京2008年第29届奥运会主题歌高清视频720×576.avi"
        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)
        Call mciSendString("open " & Trim(sName) & " alias MEDIA parent " & Form2.hWnd & " style " & WS_CHILD & " WAIT", vbNullString, 256, 0)
        
        S = String(256, Chr(0))
        mciSendString "status MEDIA length", S, Len(S), 0
        Slider1.Max = Val(S) * 1000 / 25
        Slider1.Min = 0
        Slider1.TickFrequency = Int(Val(S) * 1000 / 75)
        Timer1.Enabled = True
        Picture1.BackColor = RGB(74, 74, 82)
        
        mciSendString "play MEDIA", vbNullString, 0, 0
        'Call mciVideoStretch("MEDIA", Form2)  '调用视频缩放函数
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
        Form2.Visible = False
        Form2.Left = (Screen.Width - Form2.Width) / 2
        Form2.Top = (Screen.Height - Form2.Height) / 2
        
        Form2.ScaleMode = 3 '这句非常非常重要，你把这句去掉，看有什么效果

End Sub

Private Sub Form_Unload(Cancel As Integer)
        Unload Form2
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
        Call mciVideoStretch("MEDIA", Form2)  '调用视频缩放函数
        S = String(256, Chr(0))
        mciSendString "status MEDIA position", S, Len(S), 0
        Slider1.Value = Val(S) * 1000 / 25 '当前播放时间进度，单位是毫秒
        
        '除以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