【视频播放闪烁问题】闪烁发生于设置播放位置时.比较郁闷,大家拉我一把吧....
起因:
要做一个视频相关的应用,其视频为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自己独立的区别在哪?
三,有没有办法让播放部分不新建窗口?这闪来闪去烦人啊!!
大家拉我一把~~~~~~~~~- -#
[解决办法]
把MCI与ActiveMovie control type library的类模块发上来:
Option Explicit
'文件播放类,只要装了解码器,就可播放大部分文件.
'需要引用ActiveMovie control type library,文件名:C:\WINDOWS\system32\quartz.dll
Dim pMC As FilgraphManager
Dim pVW As IVideoWindow
Dim pMP As IMediaPosition
Dim mFileName As String
Dim mObjPic As PictureBox
Public 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 Sub
Public Function PlayFile()
pMC.Run
End Function
Public Sub StopPlay()
'停止播放
pMC.Stop
End Sub
Public Sub PausePlay()
'暂停播放
pMC.Pause
End Sub
Private Sub Class_Initialize()
On Error Resume Next
Set pMC = New FilgraphManager
pMC.Stop
pMC.RenderFile ""
End Sub
Private Sub Class_Terminate()
Set pMP = Nothing
Set pVW = Nothing
Set pMC = Nothing
End Sub
Public Property Get Position() As Single
On Error Resume Next
Position = pMP.CurrentPosition
End Property
Public Property Let Position(ByVal vNewValue As Single)
pMP.CurrentPosition = vNewValue
End Property
Public Property Get FileName() As String
FileName = mFileName
End Property
Public Property Let FileName(ByVal vNewValue As String)
mFileName = vNewValue
End Property
'以上代码为cPlayFile.cls
'----------------------------------------------------
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 Integer
Private 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 Function
Public 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 Sub
Public Sub mmClose()
'关闭当前打开的多媒体文件
Dim nReturn As Long
'如果没有文件打开，则退出
If sAlias = "" Then Exit Sub
nReturn = mciSendString("Close " & sAlias, "", 0, 0)
sAlias = ""
sFilename = ""
End Sub
Public 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 Sub
Public 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 Sub
Public Sub StopPlay()
'停止
'停止后跳到开始,以便再次播放
Dim nReturn As Long
If sAlias = "" Then Exit Sub
nReturn = mciSendString("Stop " & sAlias, "", 0, 0)
mmSeek 0 '跳到开始位置
End Sub
Public 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 Sub
Property Get FileName() As String
'方法Filename返回当前打开的文件名
FileName = sFilename
End Property
Property Let FileName(ByVal sTheFile As String)
'指定要播放的文件名，然后将它打开
'对于需要指定容器的Avi文件，不要以这种方式打开。
OpenFile sTheFile
End Property
Property Get Wait() As Boolean
'读取属性Wait的值
'Msgbox Multimedia.Wait
Wait = bWait
End Property
Property Let Wait(bWaitValue As Boolean)
'设置等待属性
'用法：Multimedia.Wait=True
bWait = bWaitValue
End Property
Property 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 Property
Property Let Position(ByVal nPosition As Single)
mmSeek nPosition
End Property
Property 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 Property
Property 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 Property
Public Sub mmRestart()
'从头开始播放
Dim nReturn As Long
If sAlias = "" Then Exit Sub
mmSeek 0
PlayFile
End Sub
Private Sub Class_Initialize()
'类的初始化
' sAlias = "" '别名初值为空
End Sub
Private Sub Class_Terminate()
'关闭打开的多媒体设备
'当该类的对象所在的窗体（或模块）卸载时，自动调用该过程
mmClose
End Sub
'cMCI.cls
