DirectShow関係

DirectShow関係

６．カメラ映像のスナップショット(VB)

ライブ動画を表示し、任意のタイミングでスナップショット（静止画）を取得する方法を説明します。

ライブ動画の任意のフレームのイメージを取得するにはいくつもの方法がありますが、

　・SampleGrabberフィルタを使用する
　　（正確にはISampleGrabberインターフェースのGetCurrentBufferメソッドを使用する）

　・IBasicVideoインターフェースのGetCurrentImageメソッドを使用する

の２方法が一般的かと思います。
（「４．オリジナルフィルタの作成」で作成したMoFilterのように　独自のフィルタを使う方法もありでしょう）

どっちもフィルタが持っているイメージを取得するという点では同じなんですが、
下記のような違いがあります。

方法	長所	短所
SampleGrabber	・グラフ内の任意の場所に入れられる。・メディアタイプを指定できる。　(イメージ形式を指定できる) ・イメージを取得したときにグラフを停止させたり、　コールバックさせることができる。	・VBから使うのは難しい。　っていうか手段が用意されてない(^^;
IBasicVideo	・VBからでも比較的容易に使用できる。・画面に出力される画像が取得できる。	・環境によっては使用できない。・グラフ内の任意位置で使用することができない。・描画を待っているイメージのみが取得できる。

IBasicVideoが使用できないのはハードウェアで描画する場合になりますが、
Video Mixing Rendererが使われる環境(WindowsXP)では問題ありません。

VBのみで行うならば必然的にIBasicVideoを使う方法になるでしょう。(^^;;
IBasicVideoインターフェースは前の章でもすでに使っていますが、
ビデオストリームのサイズを取得したり、出力するときの矩形を指定したりできます。
そしてGetCurrentImageメソッドで現在のイメージを取得できます。

では具体的なコードで説明致します。

Option Explicit
 

      


      'カメラのフィルタ名


      Private Const CAMERA_FILTER_NAME$ = "STV0680 Camera"     'Che-es! SPYZ
 

      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$)
 

      


      　　'カメラの出力ピンを取得


      　　Dim camerapin As QuartzTypeLib.IPinInfo
 

      　　cameraflt.FindPin CAMERA_OUTPUTPIN_NAME$, camerapin
 

      


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


      　　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
 

      　　Set vw = mGrp
 

      　　vw.WindowStyle = &H40000000 'WS_CHILD
 

      　　vw.SetWindowPosition 0, 0, vx, vy
 

      　　vw.Owner = Me.hWnd
 

      


      　　'ビデオウィンドウへのメッセージをフォームで受け取るようにする


      　　vw.MessageDrain = 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
 

      


      


      'ダブルクリック時


      Private Sub Form_DblClick()
 

      


      　　'ビデオの情報を取得


      　　Dim bv As QuartzTypeLib.IBasicVideo
 

      　　Dim vx As Long, vy As Long
 

      　　Set bv = mGrp
 

      　　bv.GetVideoSize vx, vy
 

      


      　　'グラフを一時停止させる


      　　mGrp.Pause


      


      　　'ビットマップ読み込み


      　　Dim sz As Long
 

      　　Dim img() As Long
 

      　　sz = vx * vy + 10
 

      　　ReDim img(sz - 1)
 

      　　bv.GetCurrentImage sz * 4, img(0)
 

      


      　　'グラフを再開させる


      　　mGrp.Run


      


      　　'形式のチェック


      　　If (img(0) <> 40) Or (img(3) <> &H200001) Then
 

      　　　　MsgBox "未サポートの形式です。"
 

      　　　　Exit Sub
 

      　　End If
 

      


      　　'取得したイメージを別ウィンドウに表示する


      　　ViewImage img(), vx, vy
 

      


      End Sub
 

      


      


      '取得したイメージを別ウィンドウに表示する


      Private Sub ViewImage(ByRef Image() As Long, ByVal Width As Long, ByVal Height As Long)
 

      


      　　'表示するウィンドウの準備


      　　Dim frm As Form2
 

      　　Set frm = New Form2
 

      　　Load frm
 

      　　With frm
 

      　　　　.AutoRedraw = True
 

      　　　　Dim winx&, winy&
 

      　　　　.ScaleMode = vbTwips
 

      　　　　winx = .Width - .ScaleWidth
 

      　　　　winy = .Height - .ScaleHeight
 

      　　　　.Width = winx + Width * Screen.TwipsPerPixelX
 

      　　　　.Height = winy + Height * Screen.TwipsPerPixelY
 

      　　　　.ScaleMode = vbPixels
 

      　　End With
 

      


      　　'描画


      　　Dim x As Long, y As Long
 

      　　Dim col As Long, rr As Long, gg As Long, bb As Long
 

      　　Dim pp As Long
 

      　　pp = 10
 

      　　For y = 0 To Height - 1
 

      　　　　For x = 0 To Width - 1
 

      　　　　　　col = Image(pp)
 

      　　　　　　bb = col And 255&
 

      　　　　　　gg = (col \ 256&) And 255&
 

      　　　　　　rr = (col \ 65536) And 255&
 

      　　　　　　col = RGB(rr, gg, bb)
 

      　　　　　　frm.PSet (x, Height - y), col
 

      　　　　　　pp = pp + 1
 

      　　　　Next


      　　Next


      


      　　'フォームの表示


      　　frm.Show


      


      End Sub

フォームは２つ必要になります。名前はForm1とForm2です。
必要なプロパティはコード内で指定していますので
新規プロジェクトを作成したらフォームをひとつ追加するだけでOKです。
（上のコードをForm1のコードにコピーしてください）

実行させるとカメラのライブ画像が表示されます。
ここぞというときにライブ画像をダブルクリックすると、
別ウィンドウにそのときのイメージが表示されます。
このサンプルでは行っていませんが、
別ウィンドウに表示した後SavePicture等で静止画映像を保存できます。

なおWindowsXPで画面モードが３２ビットカラーの環境でしかテストしていません。
他の環境では動作しない可能性もあります。

サンプルプログラムはここからダウンロードできます。

例によって順に説明します。

Option Explicit
 

      


      'カメラのフィルタ名


      Private Const CAMERA_FILTER_NAME$ = "STV0680 Camera"     'Che-es! SPYZ
 

      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$)
 

      


      　　    'カメラの出力ピンを取得


      　　    Dim camerapin As QuartzTypeLib.IPinInfo
 

      　　    cameraflt.FindPin CAMERA_OUTPUTPIN_NAME$, camerapin
 

      


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


      　　    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
 

      　　    Set vw = mGrp
 

      　　    vw.WindowStyle = &H40000000 'WS_CHILD
 

      　　    vw.SetWindowPosition 0, 0, vx, vy
 

      　　    vw.Owner = Me.hWnd
 

      


      　　    'ビデオウィンドウへのメッセージをフォームで受け取るようにする


      　　    vw.MessageDrain = 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

フォームロード時にグラフを生成し、フォームでライブ画像を表示させます。
青色の部分以外は「２．ライブ動画の再生」と同じなので説明は割愛させて頂きます。




      　　    'ビデオウィンドウへのメッセージをフォームで受け取るようにする


      　　    vw.MessageDrain = Me.hWnd

この部分は、動画をダブルクリックした場合、イベントとして取得できるようにするためのものです。
フォーム上にビデオレンダラのウィンドウを持たせることで動画をフォーム内で再生させていますが、
このままでは動画上でのマウス操作などはレンダラのウィンドウが処理(無視)してしまい、
フォーム等でイベントが発生しません。
MessageDrainにフォームのウィンドウハンドルを指定することで
ビデオレンダラウィンドウに送られたウィンドウメッセージがフォームに送られるようになります。
これによりビデオウィンドウ上でのマウス操作などがフォーム上でのマウス操作とすることができる訳です。
要するに動画上でダブルクリックするとフォームのDblClickイベントが発生するようになるということです。

スナップを指示する操作は別途ボタン等を用意してもよかったんですが、
こういう方法もあるよってことと、
ボタン位置やサイズを動画サイズに合わせ調整するのが面倒だったので
今回はこの方法をとりました。

で、動画をダブルクリックするとForm_DblClickイベントが発生します。

'ダブルクリック時


      Private Sub Form_DblClick()
 

      


      　　    'ビデオの情報を取得


      　　    Dim bv As QuartzTypeLib.IBasicVideo
 

      　　    Dim vx As Long, vy As Long
 

      　　    Set bv = mGrp
 

      　　    bv.GetVideoSize vx, vy
 

      


      　　    'グラフを一時停止させる


      　　    mGrp.Pause


      


      　　    'ビットマップ読み込み


      　　    Dim sz As Long
 

      　　    Dim img() As Long
 

      　　    sz = vx * vy + 10
 

      　　    ReDim img(sz - 1)
 

      　　    bv.GetCurrentImage sz * 4, img(0)
 

      


      　　    'グラフを再開させる


      　　    mGrp.Run


      


      　　    '形式のチェック


      　　    If (img(0) <> 40) Or (img(3) <> &H200001) Then
 

      　　　　        MsgBox "未サポートの形式です。"
 

      　　　　        Exit Sub
 

      　　    End If
 

      


      　　    '取得したイメージを別ウィンドウに表示する


      　　    ViewImage img(), vx, vy
 

      


      End Sub

DblClickイベントプロシジャ内ではビットマップイメージを取得して別ウィンドウに表示しています。

'ダブルクリック時


      Private Sub Form_DblClick()
 

      


      　　    'ビデオの情報を取得


      　　    Dim bv As QuartzTypeLib.IBasicVideo
 

      　　    Dim vx As Long, vy As Long
 

      　　    Set bv = mGrp
 

      　　    bv.GetVideoSize vx, vy

IBasicVideoインターフェース経由で動画のサイズを取得しています。




      　　    'グラフを一時停止させる


      　　    mGrp.Pause

GetCurrentImageメソッドでイメージを取得するためにいったんグラフをポーズ状態にしています。
ヘルプによるとビデオレンダラがVMRの場合(WindowsXP)は不要だそうです。




      　　    'ビットマップ読み込み


      　　    Dim sz As Long
 

      　　    Dim img() As Long
 

      　　    sz = vx * vy + 10
 

      　　    ReDim img(sz - 1)
 

      　　    bv.GetCurrentImage sz * 4, img(0)

イメージを取得するための領域(Long型の配列)を確保し、GetCurrentImageメソッドでビットマップイメージを取得します。
サイズはビデオサイズから決定しています。Long型(4バイト)でのサイズは以下のようになります。
　　必要サイズ　＝　横ピクセル数　×　縦ピクセル数　＋　１０
「+１０」の部分はビットマップ情報が入るためのサイズになります。
GetCurrentImageメソッドの第１引数はバイト数ということなので「配列のサイズ×４」で指定します。
また第２引数は参照で渡す必要があるので配列の先頭要素を指定します。
（配列の先頭ポインタを渡すということです。）

これでLong型の配列に画像情報が入ります。
画像情報のフォーマットについては後で説明します。




      　　'グラフを再開させる


      　　mGrp.Run

イメージを取得したらポーズしていたグラフを再開させます。




      　　    '形式のチェック


      　　    If (img(0) <> 40) Or (img(3) <> &H200001) Then
 

      　　　　        MsgBox "未サポートの形式です。"
 

      　　　　        Exit Sub
 

      　　    End If

取得した画像情報の形式をチェックしています。かなりいい加減です（＾＾；




      　　    '取得したイメージを別ウィンドウに表示する


      　　    ViewImage img(), vx, vy
 

      


      End Sub

'取得したイメージを別ウィンドウに表示する


      Private Sub ViewImage(ByRef Image() As Long, ByVal Width As Long, ByVal Height As Long)
 

      


      　　    '表示するウィンドウの準備


      　　    Dim frm As Form2
 

      　　    Set frm = New Form2
 

      　　    Load frm
 

      　　    With frm
 

      　　　　        .AutoRedraw = True
 

      　　　　        Dim winx&, winy&
 

      　　　　        .ScaleMode = vbTwips
 

      　　　　        winx = .Width - .ScaleWidth
 

      　　　　        winy = .Height - .ScaleHeight
 

      　　　　        .Width = winx + Width * Screen.TwipsPerPixelX
 

      　　　　        .Height = winy + Height * Screen.TwipsPerPixelY
 

      　　　　        .ScaleMode = vbPixels
 

      　　    End With
 

      


      　　    '描画


      　　    Dim x As Long, y As Long
 

      　　    Dim col As Long, rr As Long, gg As Long, bb As Long
 

      　　    Dim pp As Long
 

      　　    pp = 10
 

      　　    For y = 0 To Height - 1
 

      　　　　        For x = 0 To Width - 1
 

      　　　　　　            col = Image(pp)
 

      　　　　　　            bb = col And 255&
 

      　　　　　　            gg = (col \ 256&) And 255&
 

      　　　　　　            rr = (col \ 65536) And 255&
 

      　　　　　　            col = RGB(rr, gg, bb)
 

      　　　　　　            frm.PSet (x, Height - y), col
 

      　　　　　　            pp = pp + 1
 

      　　　　        Next


      　　    Next


      


      　　    'フォームの表示


      　　    frm.Show


      


      End Sub

最後にイメージを別フォームに描画してそのフォームを表示させています。

GetCurrentImageメソッドで取得した画像データは下記のようなデータ構造になります。

ビットマップ情報

Height-1行目のピクセル情報

Height-2行目のピクセル情報

0行目のピクセル情報

配列　　: 実際のデータ例 : 内容
 

      img( 0) : 00000028       : ビットマップ情報のサイズ(バイト)
 

      img( 1) : 00000140       : 横ピクセル数(Width)
 

      img( 2) : 000000F0       : 縦ピクセル数(Height)
 

      img( 3) : 00200001       : ビット深度とプレーン数
 

      img( 4) : 00000000       : 


      img( 5) : 0004B000       : 


      img( 6) : 00000000       : 


      img( 7) : 00000000       : 


      img( 8) : 00000000       : 


      img( 9) : 00000000       : 


      img(10) : 0096A9AC       : 位置(0,Height-1)の色
 

      img(11) : 00A0B4BD       : 位置(1,Height-1)の色
 

      img(12) : 00A9B4C6       : 位置(2,Height-1)の色
 

      :


      img(??) : ????????       : 位置(Width-1,Height-1)の色
 

      img(??) : ????????       : 位置(1,Height-2)の色
 

      img(??) : ????????       : 位置(2,Height-2)の色
 

      :


      img(??) : ????????       : 位置(0,0)の色
 

      img(??) : ????????       : 位置(1,0)の色
 

      :


      img(??) : ????????       : 位置(Width-1,0)の色

先頭にビットマップの情報があり、その後に各ピクセルの色情報が入ります。

ピクセル情報は配列の要素10からになります。（先頭の&H28=40バイト後。40/4=10ということです）
注意しなければならないのは画像の最も下のラインから格納されているということと、
各ピクセルの色は(RGB関数で取得できる)RRGGBB形式ではなくBBGGRR形式であるということです。
このため描画時にはちょっと面倒な変換を行っています。

本当はビットマップ情報部を見てそれにあわせた描画をすべきですが、
このサンプルでは描画しやすいこのフォーマットのみをサポートするように形式チェックを行っています(^^;;;
なおViewImage関数内では一ピクセル毎にPSetで描画していますが、
APIを使えば高速で一気に描画することも可能です。

以上でVBからライブ画像のスナップショットを取得することができます。
環境依存なところもあるのは簡便してください。
どんな環境でも動作させるのはDirectShowでは難しいんです。
(いろんなハードを共通の手段で使えるようにするための物ではあるんですが、
必ずサポートしていなければならない機能以外は
サポートしているかを問い合わせてそれに合わせて処理する必要があるんです。
この確認処理ってのがしゃれにならないほど大変なんですよねー）

カメラソースではなく動画ファイルをソースにすれば、
動画ファイル中のスナップショットも同様に取得することができます。
ただし動画ファイル中のイメージを取得するならば
MediaDetオブジェクトを使う方が楽かもしれません。
（DirectX8のVC用ヘルプにVBのサンプルコードがあります。）

DirectX9ではIBasicVideo2というインターフェースもVBから使えます。
が、このIBasicVideo2インターフェースのGetCurrentImageメソッドはサポート外となっています。
実際につかってみるとイメージは取得できるんですが、
メモリが開放されないみたいですね。
連続で取得してると使用済みメモリ量がずんずん増えていきます。

上に戻る