【视频播放闪烁问题】闪烁发生于设置播放位置时.比较郁闷,大家拉我一把吧....

Question

起因:    要做一个视频相关的应用,其视频为N多段具有相同开始与结束画面的小视频组成.
    程序根据界面上的选择来动态地组织视频文件.目前所有逻辑功能均正常,但是遇到一个软故障,伤透了脑筋.....具体情况就是,闪烁.由于需要动态组织视频,因此需要不断地设置播放位置,以使画面看起来是"连续"的.但是在设置的一瞬间的闪烁,是绝对不能出现的......不然那不就露馅了么?我做过的尝试:    一,使用MCI相关API播放,即mciSendString.    二,使用系统里的WMP控件播放,Windows Media Player.....    三,使用ActiveMovie control type library播放,引用C:\WINDOWS\system32\quartz.dll.无一例外,都会闪烁.然后使用SPY++观察了一下闪烁发生后的目标容器(一个PictureBox)里的播放窗口句柄,发现多了一个......经证实,每闪一次就多一个.....如图:闪烁,应该是切换显示目标时产生的瞬间黑帧.以上三种播放方式均如此.然后使用单独的播放器,无论是暴风,还是WMP,均无此现象.证明还是我的实现方式有问题.容器的AutoRedraw为True,窗体的AutoRedraw也是True,发现为True时出现闪烁的机率要低一点点,不知道是不是心理作用...我不明白:    一,为什么闪烁是随机发生的?
       有时闪,有时不闪.
       不闪的时候,播放半小时,都没问题,让我误以为解决了;闪的时候,半小时内会多出来八到十来个新句柄.    二,为什么独立的播放器就没有问题?比如同样是WMP,我在工程里使用控件,与WMP自己独立的区别在哪?    三,有没有办法让播放部分不新建窗口?这闪来闪去烦人啊!!大家拉我一把~~~~~~~~~- -#

Answer 1

把MCI与ActiveMovie control type library的类模块发上来:Option Explicit'文件播放类,只要装了解码器,就可播放大部分文件.
'需要引用ActiveMovie control type library,文件名:C:\WINDOWS\system32\quartz.dllDim pMC As FilgraphManager
Dim pVW As IVideoWindow
Dim pMP As IMediaPosition
Dim mFileName As String
Dim mObjPic As PictureBoxPublic Sub OpenFile(ByVal sFilename As String, ByRef objPic As PictureBox)
    '打开一个文件并处于暂停状态.
    On Error GoTo ErrHandle
    
    If sFilename = mFileName Then Exit Sub
    
    mFileName = sFilename
    Set mObjPic = objPic
    pMC.RenderFile mFileName
    
    On Error Resume Next
    
    Set pVW = pMC
    Set pMP = pMC
    
    pVW.WindowStyle = CLng(&H6000000)
    
    '设置图象区域大小
    pVW.Left = 0: pVW.top = 0
    pVW.Width = mObjPic.ScaleWidth
    pVW.Height = mObjPic.ScaleHeight
    
    pVW.Owner = mObjPic.hwnd
    
    Exit Sub
ErrHandle:
End SubPublic Function PlayFile()
    pMC.Run
End FunctionPublic Sub StopPlay()
    '停止播放
    pMC.Stop
End SubPublic Sub PausePlay()
    '暂停播放
    pMC.Pause
End SubPrivate Sub Class_Initialize()
    On Error Resume Next
    
    Set pMC = New FilgraphManager
    pMC.Stop
    pMC.RenderFile ""
End SubPrivate Sub Class_Terminate()
    Set pMP = Nothing
    Set pVW = Nothing
    Set pMC = Nothing
End SubPublic Property Get Position() As Single
    On Error Resume Next
    Position = pMP.CurrentPosition
End PropertyPublic Property Let Position(ByVal vNewValue As Single)
    pMP.CurrentPosition = vNewValue
End PropertyPublic Property Get FileName() As String
    FileName = mFileName
End PropertyPublic Property Let FileName(ByVal vNewValue As String)
    mFileName = vNewValue
End Property'以上代码为cPlayFile.cls第二个是MCI的:'----------------------------------------------------
Option Explicit
'--------------TrueZq 最新更新2001-01-12---------------------
'文件名： MMedia.cls
'说明： : 一个多媒体类,能播放Avi、Wave、Midi文件
'用法：
'Dim Multimedia As New Mmedia
'Multimedia.mmOpen "c:\test.wav"
'Multimedia.mmPlay
'！记住：在程序结束时，一定要用Set Multimedia=nothing释放资源！！！
'-----------------------------------------------------
' -=-=-=- 属性 -=-=-=-
' sFilename 当前的文件名
' nLength 文件长度（只读）
' nPosition 当前位置
' sStatus 当前状态（只读）
' bWait True/False.决定是否等待播放完
' -=-=-=- 方法 -=-=-=-=-
' mmOpen <Filename> 打开要播放的文件
' mmClose 关闭当前文件
' mmPause 暂停
' mmStop 停止 停止后可以跳到开始再次播放
' mmSeek <Position> Seeks to a position in the file
' mmPlay 播放
'--------------------------------------------------------------
Private sAlias As String '别名
'Private hWnd As Long
Private sFilename As String ' 当前的文件名
Private nLength As Single ' 文件长度Private nPosition As Single ' 当前位置
Private sStatus As String ' 当前状态
Private bWait As Boolean ' 决定是否等待播放完
Const WS_CHILD = &H40000000
'------------ API 声明 -------------
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 mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" ( _
     ByVal dwError As Long, _
     ByVal lpstrBuffer As String, _
     ByVal uLength As Long) As Long'Private Declare Function GetActiveWindow Lib "USER32" () As IntegerPrivate Function MCIGetErr(ByVal ErrCode As Long) As String
    Dim lRet As Long, Buff As String
    
    Buff = Space(260)
    lRet = mciGetErrorString(ErrCode, Buff, Len(Buff))
    MCIGetErr = Trim(Buff)
End FunctionPublic Sub OpenFile(ByVal sTheFile As String, Optional hwnd As Long = 0)
    '当sTheFile是一个Avi文件时，参数hWnd指定动画在哪里播放
    '若hWnd=0，则新开一个窗口播放动画。
    '如果听不到Midi音乐，请在Windows下用媒体播放器测试一下。
    '文件名不能带空格
    Dim nReturn As Long
    Dim sType As String '文件类型
    Static nNum As Integer
    
    Debug.Print "                                           hWnd = " & hwnd
    
    If sAlias <> "" Then '关闭开始打开的文件
        mmClose
    End If
    
    If (Dir(sTheFile) = "") Then '判断是否是一个存在的文件
        sFilename = "文件" & sTheFile & " 不存在！"
        Exit Sub
    Else
        sFilename = sTheFile
        ' nNum = nNum + 1
    End If
    ' Stop
    sAlias = sFilename '用文件名作别名，避免别名冲突！
    ' 判断文件类型
    Select Case UCase$(Right$(sTheFile, 3))
        Case "WAV"
            sType = "Waveaudio"
        Case "AVI", "MPG"
            sType = "AviVideo"
        Case "MID"
            sType = "Sequencer"
        Case Else
        ' 未知文件格式，退出。
        Exit Sub
    End Select
    
    If sType = "AviVideo" And hwnd > 0 Then
        Do
'            nReturn = mciSendString("open " & sTheFile & " ALIAS " & sAlias _
'                                    & " TYPE MPEGVideo parent " & hwnd & " style " & LTrim$(Str$(WS_CHILD)), 0&, 0, 0)
            nReturn = mciSendString("open " & sTheFile & " ALIAS " & sAlias _
                                    & " parent " & hwnd & " style " & LTrim$(Str$(WS_CHILD)), 0&, 0, 0)
            If nReturn <> 265 And nReturn <> 289 Then Exit Do
            OutputDebugString MCIGetErr(nReturn)
            
            nNum = nNum + 1
            sAlias = sAlias & nNum
        Loop
        If nReturn <> 0 Then
            MsgBox MCIGetErr(nReturn)
        End If
    Else
        nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _
                                & " TYPE " & sType, "", 0, 0)
    End If
End SubPublic Sub mmClose()
    '关闭当前打开的多媒体文件
    Dim nReturn As Long
    
    '如果没有文件打开，则退出
    If sAlias = "" Then Exit Sub
    
    nReturn = mciSendString("Close " & sAlias, "", 0, 0)
    sAlias = ""
    sFilename = ""
End SubPublic Sub PausePlay()
    '暂停
    Dim nReturn As Long
    
    If sAlias = "" Then
        Exit Sub
    ElseIf Status = "paused" Then '如果先前已经暂停了，则解除暂停
        PlayFile
    Else
        nReturn = mciSendString("Pause " & sAlias, "", 0, 0)
    End If
    'nPosition = Position
End SubPublic Sub PlayFile()
    '播放
    Dim nReturn As Long
    
    If sAlias = "" Then
        Exit Sub
    ElseIf Position = Length Then '如果已经到末尾
        mmSeek 0 '跳到开始处
    End If
    
    If bWait Then
        nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)
    Else
        nReturn = mciSendString("Play " & sAlias, "", 0, 0)
    End If
    Debug.Print "               nReturn = " & nReturn
End SubPublic Sub StopPlay()
    '停止
    '停止后跳到开始,以便再次播放
    Dim nReturn As Long
    
    If sAlias = "" Then Exit Sub
    
    nReturn = mciSendString("Stop " & sAlias, "", 0, 0)
    mmSeek 0 '跳到开始位置
End SubPublic Sub mmSeek(ByVal nPosition As Single)
    '跳到指定的位置,并且处于暂停状态
    '当nPosition的值>Length 或者nPosition<0时，将忽略这次操作
    Dim nReturn As Long
    
    nReturn = mciSendString("Set " & sAlias & " time format milliseconds", vbNullString, 0, 0)
    nReturn = mciSendString("Seek " & sAlias & " to " & nPosition * CSng(1000), "", 0, 0)
End SubProperty Get FileName() As String
    '方法Filename返回当前打开的文件名
    FileName = sFilename
End PropertyProperty Let FileName(ByVal sTheFile As String)
    '指定要播放的文件名，然后将它打开
    '对于需要指定容器的Avi文件，不要以这种方式打开。
    OpenFile sTheFile
End PropertyProperty Get Wait() As Boolean
    '读取属性Wait的值
    'Msgbox Multimedia.Wait
    Wait = bWait
End PropertyProperty Let Wait(bWaitValue As Boolean)
    '设置等待属性
    '用法：Multimedia.Wait=True
    bWait = bWaitValue
End PropertyProperty Get Length() As Single
    '获得长度值
    Dim nReturn As Long, nLength As Integer
    Dim sLength As String * 255
    
    If sAlias = "" Then
        Length = 0
        Exit Property
    End If
    nReturn = mciSendString("Set " & sAlias & " time format milliseconds", vbNullString, 0, 0)
    nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)
    nLength = InStr(sLength, Chr$(0))
    Length = Val(Left$(sLength, nLength - 1)) / 1000
End PropertyProperty Let Position(ByVal nPosition As Single)
    mmSeek nPosition
End PropertyProperty Get Position() As Single
    '获取当前位置
    Dim nReturn As Integer, nLength As Integer
    Dim sPosition As String * 255
    
    If sAlias = "" Then Exit Property
    
    nReturn = mciSendString("Set " & sAlias & " time format milliseconds", vbNullString, 0, 0)
  
    nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)
    nLength = InStr(sPosition, Chr$(0))
    Position = Val(Left$(sPosition, nLength - 1)) / 1000
End PropertyProperty Get Status() As String
    '当前打开文件的状态
    '有以下几种：playing paused stopped
    Dim nReturn As Integer, nLength As Integer
    Dim sStatus As String * 255
    
    If sAlias = "" Then Exit Property
    nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)
    
    nLength = InStr(sStatus, Chr$(0))
    Status = Left$(sStatus, nLength - 1)
End PropertyPublic Sub mmRestart()
    '从头开始播放
    Dim nReturn As Long
    
    If sAlias = "" Then Exit Sub
    
    mmSeek 0
    PlayFile
End SubPrivate Sub Class_Initialize()
    '类的初始化
    ' sAlias = "" '别名初值为空
End SubPrivate Sub Class_Terminate()
    '关闭打开的多媒体设备
    '当该类的对象所在的窗体（或模块）卸载时，自动调用该过程
    mmClose
End Sub'cMCI.cls

Answer 2

不断地设置播放位置是什么意思？
是拖动窗口移动位置？还是拖动窗口放大与缩小？另外，用quartz.dll播放视频文件时，ActiveMovie Window播放窗口是系统默认的播放窗口。我曾经想在每加载一个视频时把这个窗口关闭了，但无法关闭该窗口，如果你有自己应用播放窗口，这个窗口不会显示，只是一直存在，关闭视频文件时有时（很少时候）会出现瞬间的黑帧，就是因为那个默认窗口的原因。

Answer 3

mciSendString 播放用默认窗口还是自己指定窗口？
自己指定窗口不需要不停初始化，大概能避免闪烁。

Answer 4

以上两份代码的使用示例忘了发上来.......昨晚真的太困了....示例一,使用cMCI.cls完成视频播放:(示例中的Pic1为一PictureBox,内部坐标单位已经设置为象素.)dim objPlayVideo as New cMCIobjPlayVideo.OpenFile("xxxx.mpg",Pic1.hWnd)    '打开文件,并处于暂停状态objPlayVideo.Position=500       '设置播放位置为500秒示例二,使用cPlayVideo.cls完成视频播放:dim objPlayVideo as New cPlayVideoobjPlayVideo.OpenFile("xxxx.mpg",Pic1)    '打开文件,并处于暂停状态objPlayVideo.Position=500       '设置播放位置为500秒代码就上面两种,还一种是WMP的,就不贴了.我所说的情况是,不断地设置.Position属性,以使视频能以程序逻辑顺序播放.逻辑上都没有任何问题了,可是总出现偶尔黑帧,真烦人!连WMP控件在内,它们都是重建了播放窗口,每黑一次,多建立一个而且又是偶尔的,我郁闷~~~~~~~~~~~~~~~~~~到底独立播放器是如何实现的?

Answer 5

是设置播放进度....两种方式我都指定了一个图片框为播放目标,就是那黑帧整死我了....
自己指定窗体是指的哪种方式?是不是像我上面的那种给出一个句柄的方式?
这个...两份都不是我的原创.一个是从chenjl1031的BLOG里播放GIF的代码参考而来,封装一下而已;另一个直接就是复制的别人的,所以把版权保留了......忘了给出处,抱歉:http://blog.csdn.net/chenjl1031/archive/2008/05/04/2383674.aspx

Answer 6

你的第一段DSHOW播放的代码中，“动态组织视频”的相关代码在哪里？当你重新播放“动态组织”后的视频时是否初始化了FilgraphManager？不妨这样试一下： 1、     With pVW
        .AutoShow = True
        .WindowStyle = CLng(&H40000000)
        .Owner = mObjPic.hwnd
        .MessageDrain = mObjPic.hwnd'加上这句看看
     end with
 2、 或者可以考虑在适当的时候临时把视频窗口销毁：pVW.Owner=0，然后再.Owner = mObjPic.hwnd
 3、实在不行，调试的时候用pVW.visible=false/true来确定黑帧的来源（应该不是黑的，深棕的吧）顺便说一下，你发的代码里没有释放部分，是没发还是没写？

Answer 7

谢谢楼上的回答.所谓"动态组织",就是从一个视频时间表里读到特定的时间,再根据程序逻辑跳转到相应的视频的进度那里去播放.等效于不断地拖动播放进度条.....但播放软件无论怎么拖动都不会有黑帧.另外,黑帧基本上已经确认是播放组件新创建播放窗口时产生的....每黑的时候,使用SPY++都能看到多了一个播放窗口的句柄...这个很让人郁闷.

Answer 8

O,忘记说了，释放资源时别忘了pVW.Owner=0，不然要黑一下下的

Answer 9

还没玩过这东东呢，Mark..........

Answer 10

1、我在我的播放软件里测试了，怎么也没出现你说的现象
2\"确认是播放组件新创建播放窗口时产生的":
那基本确认是你创建窗口时没释放或释放以前的资源问题。很简单，释放的时候或新建之前pVW.Owner=0试试

Answer 11

视频释放部分：
....
  If Not (pVW Is Nothing) Then
    With pVW 
        .Visible = False
        .Owner = 0
        .MessageDrain = vbNull
    End With
  End If
  Set pVW = Nothing
.....

Answer 12

用quartz.dll播放，在关闭媒体文件时，左上角会出现黑帧。
但用MCI、WMP控件播放不会出现你说的情况。

Answer 13

不错：pVW.Owner=0 是关键！

Answer 14

1、拖动播放进度条，或者组织视频的时候不要停止Timer计时，这样图像会连续变化（动态地计算好时间就可以了）；
2、没必要用PictureBOX播放，直接用窗体播放，多一个图片框控件，多一个资源。

Answer 15

也许是这样!我马上试一下.因为我窗体上放了近两百个LABEL控件,还有十来个PICTUREBOX,以及十来个MAGEBOX.而单独把播放功能放在一个窗体时貌似没有闪的问题.......3Q先!!

Answer 16

设置播放位置要这样才行，在你的类模块中加一个属性（我试了一下不会闪）：'窗体上7个命令按钮，1个图片框控件
Option Explicit'Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long'定义DirectShow播放类
Dim PlayClass As cPlayFile'后退
Private Sub Command1_Click()
        Dim backCJL As Single
        'PlayClass.PausePlay
        backCJL = PlayClass.Position - 1
        If backCJL >= 0 Then
           PlayClass.Position = backCJL
        Else
           PlayClass.Position = 0
        End If
End Sub'前进
Private Sub Command2_Click()
        Dim forwordCJL As Single
        'PlayClass.PausePlay
        forwordCJL = PlayClass.Position + 1
        If forwordCJL <= PlayClass.Duration Then
           PlayClass.Position = forwordCJL
        Else
           PlayClass.Position = PlayClass.Duration
        End If
End Sub'暂停
Private Sub Command3_Click()
        PlayClass.PausePlay
End Sub'停止
Private Sub Command4_Click()
        PlayClass.StopPlay
End Sub'关闭窗体
Private Sub Command5_Click()
        Set PlayClass = Nothing
        Unload Me
End Sub
'打开文件
Private Sub Command6_Click()
        '打开文件
        PlayClass.OpenFile "E:\中国航天\中国航天员首次出舱活动.mpg", Picture1
End Sub'开始播放
Private Sub Command7_Click()
        PlayClass.PlayFile
End SubPrivate Sub Form_Load()
        Me.ScaleMode = 3
        Picture1.ScaleMode = 3
        Set PlayClass = New cPlayFile
        Command1.Caption = "后退"
        Command2.Caption = "前进"
        Command3.Caption = "暂停"
        Command4.Caption = "停止"
        Command5.Caption = "退出"
        Command6.Caption = "打开"
        Command7.Caption = "播放"
End Sub类模块：cPlayFile.cls
Option Explicit'文件播放类,只要装了解码器,就可播放大部分文件.
'需要引用ActiveMovie control type library,文件名:C:\WINDOWS\system32\quartz.dllDim pMC As FilgraphManager
Dim pVW As IVideoWindow
Dim pMP As IMediaPosition
Dim mFileName As String
Dim mObjPic As PictureBoxPublic Sub OpenFile(ByVal sFilename As String, ByRef objPic As PictureBox)
    '打开一个文件并处于暂停状态.
    On Error GoTo ErrHandle
    
    If sFilename = mFileName Then Exit Sub
    
    mFileName = sFilename
    Set mObjPic = objPic
    pMC.RenderFile mFileName
    
    On Error Resume Next
    
    Set pVW = pMC
    Set pMP = pMC
    
    pVW.WindowStyle = CLng(&H6000000)
    
    '设置图象区域大小
    pVW.Left = 0: pVW.Top = 0
    pVW.Width = mObjPic.ScaleWidth
    pVW.Height = mObjPic.ScaleHeight
    
    pVW.Owner = mObjPic.hWnd
    
    Exit Sub
ErrHandle:
End SubPublic Function PlayFile()
    pMC.Run
End FunctionPublic Sub StopPlay()
    '停止播放
    pMC.Stop
End SubPublic Sub PausePlay()
    '暂停播放
    pMC.Pause
End SubPrivate Sub Class_Initialize()
    On Error Resume Next
    
    Set pMC = New FilgraphManager
    pMC.Stop
    pMC.RenderFile ""
End SubPrivate Sub Class_Terminate()
    Set pMP = Nothing
    Set pVW = Nothing
    Set pMC = Nothing
End Sub
'持续时间
Public Property Get Duration() As Single
    On Error Resume Next
    Duration = pMP.Duration
End PropertyPublic Property Let Duration(ByVal vNewValue As Single)
    pMP.Duration = vNewValue
End Property
'位置
Public Property Get Position() As Single
    On Error Resume Next
    Position = pMP.CurrentPosition
End PropertyPublic Property Let Position(ByVal vNewValue As Single)
    pMP.CurrentPosition = vNewValue
End PropertyPublic Property Get FileName() As String
    FileName = mFileName
End PropertyPublic Property Let FileName(ByVal vNewValue As String)
    mFileName = vNewValue
End Property'以上代码为cPlayFile.cls