tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル Re^7: USBカメラ
投稿日: 2009/02/27(Fri) 10:29
投稿者かっけ
'カメラのフィルタ名
Private Const CAMERA_FILTER_NAME$ = "USB ビデオ デバイス"
Private Const CAMERA_OUTPUTPIN_NAME$ = "~Capture"

'フィルタグラフマネージャ
Private mGrp As QuartzTypeLib.FilgraphManager

Private Sub Form_Load()

  'グラフマネージャの作成
  Set mGrp = New QuartzTypeLib.FilgraphManager

  'グラフにキャプチャ(カメラ)フィルタを追加する
  Dim cameraflt As QuartzTypeLib.IFilterInfo
  Set cameraflt = AddFilter(mGrp, CAMERA_FILTER_NAME$)
  If cameraflt Is Nothing Then
    MsgBox "カメラ'" + CAMERA_FILTER_NAME + "'が見つかりません。" + vbCrLf + "カメラの名前を確認してください。"
    Exit Sub
  End If

  'グラフにビデオレンダラフィルタを追加する
  AddFilter mGrp, "Video Renderer"

  'カメラの出力ピンを取得
  Dim camerapin As QuartzTypeLib.IPinInfo
  Dim pp As QuartsTypeLib.IPinInfo

    For Each pp In cameraFlt.Pins
        If pp.Direction = 1 Then
            Set camerapin = pp
            Exit For
        End If
    Next

  'カメラの出力ピンからフィルタを接続し、グラフを構築する
  camerapin.Render

  'ビデオサイズ(縦横)を取得
  Dim bv As QuartzTypeLib.IBasicVideo
  Dim vx&, vy&
  Set bv = mGrp
  bv.GetVideoSize vx, vy

  'ビデオサイズに合わせてウィンドウを調整
  Dim winx&, winy& 'ウィンドウの縁サイズ
  Me.ScaleMode = vbTwips
  winx = Me.Width - Me.ScaleWidth
  winy = Me.Height - Me.ScaleHeight
  Me.Width = winx + vx * Screen.TwipsPerPixelX
  Me.Height = winy + vy * Screen.TwipsPerPixelY

  'ウィンドウ内で動画を再生させる
  Dim vw As QuartzTypeLib.IVideoWindow
    Dim L As Long, T As Long, W As Long, H As Long
  Set vw = mGrp
  vw.WindowStyle = &H40000000 'WS_CHILD

    L = 1035: T = 5670: W = 1995: H=1485
    vw.SetWindowPosition L / 15, T / 15, W / 15, H / 15
  vw.Owner = Me.hWnd

  '再生
  mGrp.Run

End Sub



'レジストリに登録されているフィルタをグラフに追加する
Public Function AddFilter(ByRef Grp As QuartzTypeLib.FilgraphManager, ByVal FilterName$) As IFilterInfo
 Dim regflt As QuartzTypeLib.IRegFilterInfo
 For Each regflt In Grp.RegFilterCollection
  If regflt.Name = FilterName$ Then
   regflt.Filter AddFilter
  Exit Function
 End If
 Next
End Function

こんな感じです。

VB6.0 SP3 です。

よろしくお願いいたします。

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。