请高手帮忙修改一下程序 - VB6论坛

得分:0

主窗体中有两个command按钮。caption属性分别为“播放列表”“播放” 列表窗体中有一个command按钮和listbox 模块 Option Explicit Public frmList As Boolean 'Pole -Star '////////////////////////////////////////////////////////////////////////////////// 'm-Media 以下是用于处理流媒体的全局变量 Public m_dblRate As Double '多媒体流播放的速率，也既是每秒播放的帧数； Public m_bstrFileName As String '需要播放的流媒体文件名； Public m_dblRunLength As Double '播放的流媒体的持续时间，单位为秒； Public m_dblStartPosition As Double '待播放的流媒体文件的初始位置，以秒为单位； Public m_boolVideoRunning As Boolean '多媒体流正在播放的标志； Public m_objMediaControl As New FilgraphManager '定义一个FilgraphManager的新实例 Public m_objBasicAudio As IBasicAudio 'Basic 的音频对象，用来处理媒体流中的语音数据； Public m_objBasicVideo As IBasicVideo 'Basic的视频对象,用于处理媒体流中的语音数据； Public m_objVideoWindow As IVideoWindow '视频窗口对象； Public m_objFilgraphManager As FilgraphManager '媒体控制对象； Public m_objMediaPosition As IMediaPosition '媒体位置对象； '定义计算文件播放时间的时，分，秒的变量 Public HourLength As String, MinLength As String, SecLength As String '定义获取当前播放时间的变量（当前总时间，小时，分钟，秒） Public m_CurrentTime As Double, m_CurrentHour As String, m_CurrentMin As String, m_CurrentSec As String

'/////////////////////////////////////////////////////////////////////////////////////////// '播放媒体前的初始化过程 Public Sub Initialize() On Local Error Resume Next '停止时间控件 Form1.StarTimer.Enabled = False

'停止正在播放的视频文件 m_boolVideoRunning = False DoEvents If Not m_objFilgraphManager Is Nothing Then m_objFilgraphManager.Stop End If '清除视频窗口； If Not m_objVideoWindow Is Nothing Then m_objVideoWindow.Owner = 0 '设置m_objVideoWindow对象的拥有者为空； End If '清除与多媒体流相关的全局对象； If Not m_objBasicAudio Is Nothing Then Set m_objBasicAudio = Nothing If Not m_objBasicVideo Is Nothing Then Set m_objBasicVideo = Nothing If Not m_objFilgraphManager Is Nothing Then Set m_objFilgraphManager = Nothing If Not m_objVideoWindow Is Nothing Then Set m_objVideoWindow = Nothing If Not m_objMediaPosition Is Nothing Then Set m_objMediaPosition = Nothing Form1.StarTimer.Enabled = False Exit Sub ErrHandle: Err.Clear Exit Sub End Sub

'////////////////////////////////////////////////////////////////////////////////////////// '打开文件处理过程 Public Sub OpenFile() Dim nCount As Long On Local Error GoTo ErrHandle '选择打开文件的类型 Form1.ComDialog.Filter = "影视文件(*.mpg,*.dat,*.asf,*.avi,*.rm,*.rmvb,*wmv)|*.avi;*.mpg;*.dat;*.asf;*.rm;*.rmvb;*wmv;|音频文件(*.wav;*.mp3;*.mp2;*.rm)|*.wav;*.mp3;*.mp2;*.rm|所有文件(*.*)|*.*" '选择打开路径 ' Form1.ComDialog.InitDir = "C:\" '打开文件 Dim mydir As String, i As Integer '使用comdialog选择多项文件,其finename属性中,文件名之间是用空格隔开的. Form1.ComDialog.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer Form1.ComDialog.FileName = "" Form1.ComDialog.ShowOpen If Len(Form1.ComDialog.FileName) = 0 Then Exit Sub '如果什么都没有选择,直接退出 i = InStr(1, Form1.ComDialog.FileName, Chr(0)) '取得第一个空格的位置 If i = 0 Then '如果为0,说明没有空格,也就是只选择一个文件,直接加入listbox Form2.Lst1.AddItem Form1.ComDialog.FileName 'lst1是listbox Else mydir = Mid(Form1.ComDialog.FileName, 1, i) '取得第一个空格前的字符,也就是目录名 If Len(mydir) = 4 Then mydir = Left(mydir, 3) '如果只有四个字符,说明是在磁盘的根目录下,也就是c:\,这时候得把 \ 字符去掉 Do While i <> 0 '循环,直到没有匹配的空格 Form2.Lst1.AddItem Left(mydir, Len(mydir) - 1) & "\" & Mid(Form1.ComDialog.FileName, i + 1) ' Len(mydir) - 1)是为了把空格去掉,否则字符连接不成功,i+1是从空格之后开始取字符 i = InStr(i + 1, Form1.ComDialog.FileName, Chr(0)) '寻找下一个匹配的字符 Loop End If '播放器初始化,防止在播放媒体时打开 Call Initialize m_bstrFileName = Form1.ComDialog.FileName '显示正在播放的文件名 ' Form1.ComDialog.FileName = "" Form1.StarTimer.Enabled = True Set m_objFilgraphManager = New FilgraphManager '初始化一个滤波器图表(未实现) m_objFilgraphManager.RenderFile (m_bstrFileName) '装载流媒体文件； '设置Basic的音频对象，如语音的大小、平衡度等； Set m_objBasicAudio = m_objFilgraphManager '设置音频对象 ' m_objBasicAudio.Volume = Form1.slVolume.Value ' m_objBasicAudio.Balance = Form1.slBalance.Value '设置视频窗口对象，初始化位置后将其父窗口设置为窗口上的PictureBox对象； Set m_objVideoWindow = m_objFilgraphManager '设置视频窗口对象 m_objVideoWindow.WindowStyle = CLng(&H6000000) m_objVideoWindow.Top = 0 m_objVideoWindow.Left = 0 m_objVideoWindow.Width = frmPlayer.Width \ 15 m_objVideoWindow.Height = frmPlayer.Height \ 15 m_objVideoWindow.Owner = frmPlayer.hWnd '设置多媒体位置对象； Set m_objMediaPosition = m_objFilgraphManager

m_dblRunLength = Round(m_objMediaPosition.Duration, 2)

' 设置当前位置为起始位置； m_dblStartPosition = 0

Call PlayEvent Exit Sub ErrHandle: Err.Clear 'Resume Next Exit Sub End Sub '/////////////////////////////////////////////////////////////////////////////////////////

'///////////////////////////////////////////////////////////////////////////////////// Public Sub PlayEvent() '如果多媒体的当前位置不处在文件尾部，则对多媒体流的位置重新置位； If CLng(m_objMediaPosition.CurrentPosition) < CLng(m_dblStartPosition) Then m_objMediaPosition.CurrentPosition = m_dblStartPosition ElseIf CLng(m_objMediaPosition.CurrentPosition) = CLng(m_dblRunLength) Then m_objMediaPosition.CurrentPosition = m_dblStartPosition End If Call m_objFilgraphManager.Run '播放媒体文件 m_boolVideoRunning = True

Form1.StarTimer.Enabled = True Form1.StarTimer.Interval = 500 frmPlayer.picVideoWindow.Refresh End Sub

'//////////////////////////////////////////////////////////////////////////////// Public Sub StopEvent() On Local Error Resume Next '停止播放文件 m_objFilgraphManager.Stop m_boolVideoRunning = False ' 重新设置视频流的当前播放位置为起始位置； m_objMediaPosition.CurrentPosition = 0 End Sub 视频窗口代码 Option Explicit Private Enum CurrentForm MainForm VideoForm End Enum Private FontForm As CurrentForm Dim frmChange As Boolean

Private Sub Form_Resize() '设置播放控件picPlayWindow的大小与所在窗体大小一致 With frmPlayer.picVideoWindow .Left = 0 .Top = 0 .Height = frmPlayer.Height .Width = frmPlayer.Width End With If Not m_objVideoWindow Is Nothing Then With m_objVideoWindow .Left = 0 .Top = 0 .Height = frmPlayer.Height \ 15 .Width = frmPlayer.Width \ 15 .Owner = picVideoWindow.hWnd End With Else frmChange = True End If End Sub

Private Sub Form_Unload(Cancel As Integer) Call StopEvent Call Initialize Cancel = True End Sub

Private Sub picVideoWindow_Change() Call CheckCurrentForm End Sub

Private Sub picVideoWindow_Click() '检测当前活动窗体,并根据结果决定将哪一个窗体设为活动窗体 'Call CheckCurrentForm If FontForm = MainForm Then Me.Show FontForm = VideoForm ElseIf FontForm = VideoForm Then frmMain.Show FontForm = MainForm End If End Sub

'///////////////////////////////////////////////////////////////// '检测当前活动窗体 Private Sub CheckCurrentForm() If Screen.ActiveForm.Name = "frmMain" Then FontForm = MainForm ElseIf Screen.ActiveForm.Name = "frmPlayer" Then FontForm = VideoForm End If End Sub

Private Sub picVideoWindow_KeyPress(KeyAscii As Integer) If KeyAscii = 27 Then Me.WindowState = 0 End Sub 主窗体代码 Dim i As Integer

Private Sub command_Click() Form2.Show End Sub

Private Sub Command1_Click() Call OpenFile End Sub

Private Sub Form_Load() Load frmPlayer frmPlayer.Show End Sub

Private Sub Form_Unload(Cancel As Integer) frmPlayer.Hide Unload frmPlayer End Sub 列表窗体代码 Private Sub Command1_Click() Dim mydir As String, i As Integer '使用comdialog选择多项文件,其finename属性中,文件名之间是用空格隔开的. Form1.ComDialog.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer Form1.ComDialog.FileName = "" Form1.ComDialog.ShowOpen If Len(Form1.ComDialog.FileName) = 0 Then Exit Sub '如果什么都没有选择,直接退出 i = InStr(1, Form1.ComDialog.FileName, Chr(0)) '取得第一个空格的位置 If i = 0 Then '如果为0,说明没有空格,也就是只选择一个文件,直接加入listbox Lst1.AddItem Form1.ComDialog.FileName 'lst1是listbox Else mydir = Mid(Form1.ComDialog.FileName, 1, i) '取得第一个空格前的字符,也就是目录名 If Len(mydir) = 4 Then mydir = Left(mydir, 3) '如果只有四个字符,说明是在磁盘的根目录下,也就是c:\,这时候得把 \ 字符去掉 Do While i <> 0 '循环,直到没有匹配的空格 Lst1.AddItem Left(mydir, Len(mydir) - 1) & "\" & Mid(Form1.ComDialog.FileName, i + 1) ' Len(mydir) - 1)是为了把空格去掉,否则字符连接不成功,i+1是从空格之后开始取字符 i = InStr(i + 1, Form1.ComDialog.FileName, Chr(0)) '寻找下一个匹配的字符 Loop End If End Sub

Private Sub Form_Load() 'Lst1.AddItem Form1.ComDialog.FileName End Sub