| 投稿日 | ： 2004/09/25(Sat) 18:24 |
| 投稿者 | ： YAS |
| Ｅメール | ： yasunari@sakai.atnifty.com |
| ＵＲＬ | ： |
| タイトル | ： DirectShowでタイムシフト |
こんにちは。YASと申します。よろしくお願いします。
VB6.0でDirectShowとVideoControlを使ってDVカメラの画像をタイムシフトして
表示したいのですがうまくいきません。
以下のコードで，ファイルの記録まではうまくいきますが，そのファイルの再生ができません。
ご存知の方がいらっしゃいましたらご教授をお願いいたします。
Option Explicit
Dim mobjMCSink As FilgraphManager
Dim MSVidCtlSrc As MSVidCtl
'一時ファイルに録画する
Private Sub Form_Load()
Set mobjMCSink = New FilgraphManager
Dim objFGSink As IGraphBuilder
Set objFGSink = mobjMCSink
Dim objSBESink As New MSVidStreamBufferSink
Call objFGSink.AddFilter(objSBESink.SBESink, "SBESink")
objSBESink.SinkName = "c:\temp.avi"
Call RenderOutPin(mobjMCSink, AddFilter(mobjMCSink, "microsoft dv camera and vcr"))
objSBESink.NameSetLock
mobjMCSink.Run
End Sub
'一時ファイルを再生する
'参考:hhttp://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/DirectX9_c/directx/htm/usingthestreambufferinscript.asp
Private Sub Command1_Click()
Set MSVidCtlSrc = New MSVidCtl
Dim InputDev As IMSVidInputDevice
Dim objStreamBufferSource As IMSVidInputDevice
For Each InputDev In MSVidCtlSrc.InputsAvailable("{00000000-0000-0000-0000-000000000000}")
If InputDev.ClassID = "{AD8E510D-217F-409B-8076-29C5E73B98E8}" Then
MSVidCtlSrc.InputActive = InputDev
Set objStreamBufferSource = InputDev
End If
Next
objStreamBufferSource.FileName = "c:\temp.avi"
MSVidCtlSrc.Run
End Sub
Private Sub Form_Unload(Cancel As Integer)
mobjMCSink.Stop
MSVidCtlSrc.Stop
Set mobjMCSink = Nothing
Set MSVidCtlSrc = Nothing
End Sub
Private Function AddFilter(objMC As FilgraphManager, strFilterName As String) As IFilterInfo
Dim objRegFilter As IRegFilterInfo
Set AddFilter = Nothing
For Each objRegFilter In objMC.RegFilterCollection
If LCase(objRegFilter.Name) = LCase(strFilterName) Then
Call objRegFilter.Filter(AddFilter)
Exit For
End If
Next
Set objRegFilter = Nothing
End Function
Private Sub RenderOutPin(objMC As FilgraphManager, objFilter As IFilterInfo)
Dim objPin As IPinInfo
If objFilter Is Nothing Then Exit Sub
For Each objPin In objFilter.Pins
If objPin.Direction = 1 Then
Call objPin.Render
Exit For
End If
Next
Set objPin = Nothing
End Sub