Visual Basic - le falta algo a este kodigo

Life is soft - evento anual de software empresarial
 
Vista:

le falta algo a este kodigo

Publicado por scorpionhack (120 intervenciones) el 10/11/2005 19:40:26
Buenas kiero k el reproductor k tengo abajo reproduzca videos de internet metiendo la url, pero he exo un monton de intentos y no lo knsigo, aver si alguien me puede ayudar y sabe k tengo k añadirle al kodigo, le estaria muy agradecido.
GRACIAS

formulario:
Dim Paused
Const NormalWidth = 5280
Private Sub Command1_Click()
CommonDialog1.ShowOpen
Path_t.Text = CommonDialog1.FileName
End Sub
Private Sub Form_Load()
Me.Width = NormalWidth
End Sub

Private Sub FullScreen_c_Click()
End Sub

Private Sub Play_But_Click()
If Paused Then ' Check if paused
ActiveMovieControl.PlayActiveMovie
Else
DontMaintainRatio = (Ratio_c.Value = 0)
RunFullScreen = (FullScreen_c.Value = 1)
ActiveMovieControl.RunVideoContent Path_t.Text, DontMaintainRatio, RunFullScreen
End If
End Sub
Private Sub Stop_But_Click() ' Stop
' Setting flag
Paused = False

ActiveMovieControl.StopActiveMovie
End Sub

Private Sub Pause_But_Click()

Paused = True

ActiveMovieControl.PauseActiveMovie
End Sub

Private Sub Volume_s_Click()
ActiveMovieControl.SetActiveMovieVolume Volume_s.Value
End Sub

Private Sub Balance_s_Click()
ActiveMovieControl.SetActiveMovieBalance Balance_s.Value
End Sub


Private Sub RefreshTimer_Timer()
If ActiveMovieControl.VideoRunning Then
Length_l.Caption = "Length: " & ActiveMovieControl.GetVideoLength
CurrentPos_l.Caption = "Current Pos: " & ActiveMovieControl.GetVideoPos
End If
End Sub

Private Sub StateTimer_Timer()
ActiveMovieControl.ActiveMovieTimerEvent
End Sub


Public Sub VideoFinishedEvent()
CurrentPos_l.Caption = "Video Finished!"
End Sub

Modulo:

Option Explicit
Option Base 0
Option Compare Text

Private m_dblRate As Double 'Rate in Frames Per Second
Private m_bstrFileName As String 'Loaded Filename
Private m_dblRunLength As Double 'Duration in seconds
Private m_dblStartPosition As Double 'Start position in seconds
Public m_boolVideoRunning As Boolean 'Flag used to trigger clock

Private dblPosition As Double ' Current Play position

Private m_objBasicAudio As IBasicAudio
Private m_objBasicVideo As IBasicVideo
Private m_objMediaEvent As IMediaEvent
Private m_objVideoWindow As IVideoWindow
Private m_objMediaControl As IMediaControl
Private m_objMediaPosition As IMediaPosition



Sub RunVideoContent(ByVal path As String, Optional ByVal DontMaintainRatio As Boolean, Optional ByVal FullScreen As Boolean)
Dim nCount As Long
Dim sScale As Double
Dim topMod As Long
On Local Error GoTo ErrLine
UnloadActiveMovieControl


m_bstrFileName = path


Set m_objMediaControl = New FilgraphManager
Call m_objMediaControl.RenderFile(m_bstrFileName)

Set m_objBasicAudio = m_objMediaControl
m_objBasicAudio.Volume = 0
m_objBasicAudio.Balance = 0

Set m_objVideoWindow = m_objMediaControl
m_objVideoWindow.WindowStyle = CLng(&H6000000)
m_objVideoWindow.Left = 0
sScale = m_objVideoWindow.Height / m_objVideoWindow.Width

m_objVideoWindow.Width = Video_ActiveMovie.Video.Width
If Not (DontMaintainRatio) Then
m_objVideoWindow.Height = Video_ActiveMovie.Video.Width * sScale
topMod = (Video_ActiveMovie.Video.Height - m_objVideoWindow.Height) / 2
Else
m_objVideoWindow.Height = Video_ActiveMovie.Video.Height
End If
m_objVideoWindow.Top = topMod
' Setting FullScreen Mode
m_objVideoWindow.FullScreenMode = FullScreen
m_objVideoWindow.Owner = Video_ActiveMovie.Video.hWnd

Set m_objMediaEvent = m_objMediaControl
Set m_objMediaPosition = m_objMediaControl

m_objMediaPosition.Rate = 1 ' Normal play rate
m_dblRate = m_objMediaPosition.Rate
m_dblRunLength = Round(m_objMediaPosition.Duration, 2)
m_dblStartPosition = 0

PlayActiveMovie
Exit Sub

ErrLine:
Err.Clear
Resume Next
End Sub

Sub UnloadActiveMovieControl()
On Local Error GoTo ErrLine

m_boolVideoRunning = False
DoEvents

If Not m_objMediaControl Is Nothing Then
m_objMediaControl.Stop
End If

If Not m_objVideoWindow Is Nothing Then
m_objVideoWindow.Left = Screen.Width * 8
m_objVideoWindow.Height = Screen.Height * 8
m_objVideoWindow.Owner = 0 'sets the Owner to NULL
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_objMediaControl Is Nothing Then Set m_objMediaControl = Nothing
If Not m_objVideoWindow Is Nothing Then Set m_objVideoWindow = Nothing
If Not m_objMediaPosition Is Nothing Then Set m_objMediaPosition = Nothing
Exit Sub

ErrLine:
Err.Clear
End Sub



Sub PlayActiveMovie()
On Local Error GoTo errHandle



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

m_boolVideoRunning = True
Call m_objMediaControl.Run


Exit Sub
errHandle:
Err.Clear
Resume Next

End Sub

Sub PauseActiveMovie()
On Local Error GoTo errHandle

If Not (m_boolVideoRunning) Then Exit Sub
Call m_objMediaControl.Pause
m_boolVideoRunning = False

Exit Sub
errHandle:
Err.Clear
'logerror
End Sub

Sub StopActiveMovie()
On Local Error GoTo errHandle
If Not (m_boolVideoRunning) Then Exit Sub
Call m_objMediaControl.Stop
m_boolVideoRunning = False
m_objMediaPosition.CurrentPosition = 0

Exit Sub
errHandle:
Err.Clear

End Sub


Sub SetActiveMovieBalance(ByVal Value As Long)
On Local Error GoTo ErrLine
'Set the balance using the slider
If Not m_objMediaControl Is Nothing Then _
m_objBasicAudio.Balance = Value
Exit Sub
ErrLine:
Err.Clear
End Sub

Sub SetActiveMovieVolume(ByVal Value As Long)
On Local Error GoTo ErrLine

'Set the volume using the slider
If Not m_objMediaControl Is Nothing Then _
m_objBasicAudio.Volume = Value
Exit Sub

ErrLine:
Err.Clear
End Sub

Function GetVideoLength() As Double
GetVideoLength = m_dblRunLength
End Function

Function GetVideoPos() As Double
dblPosition = m_objMediaPosition.CurrentPosition
GetVideoPos = dblPosition
End Function

Function VideoRunning() As Boolean
VideoRunning = m_boolVideoRunning
End Function

Public Sub ActiveMovieTimerEvent()
Dim nReturnCode As Long

On Local Error GoTo errHandle

If m_boolVideoRunning = True Then

Call m_objMediaEvent.WaitForCompletion(100, nReturnCode)


If nReturnCode = 0 Then ' Playing

'get the current position for display
dblPosition = m_objMediaPosition.CurrentPosition

Else
m_boolVideoRunning = False
Video_ActiveMovie.VideoFinishedEvent
End If
End If
Exit Sub
errHandle:
Err.Clear
Resume Next
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder