|
分類:[VB.NET/VB2005 以降]
こんにちは。
現在、VB.net(2008)でAVIﾌｧｲﾙから映像を1/60ﾌｨｰﾙﾄﾞごとに
BMP形式で保存するｿﾌﾄを作成しています。以前、VB6.0で
同様のｿﾌﾄを作っていましたが、Vista以降、ｿﾌﾄがうまく
作動しなくなったので、VB.netでの作成を始めました。
いろいろなｻｲﾄを検索して、AVIから1/30ごとの映像をBMP形式で
取り出すところまではできましたが、どうしても1/30から1/60に
分割するところがうまくできません（下記VB6.0のｿｰｽ中の
ﾌﾟﾛｼｼﾞｬｰ「SeparateDIB」）。
そこで、みなさまのお知恵をお借りしたいと思い、投稿させて
頂きました。
下記、VB6.0のｿｰｽです。
Public Sub AVI_to_BMP(ByVal strAVIFileName As String, ByVal strBMPFileName As String, ByVal lngAVIFrameNo As Long, ByVal intSeparateType As Integer)
Dim pAVIFile As Long 'AVIファイルのインターフェースアドレス(pPAVIFile)
Dim pAVIStream As Long 'ビデオストリームのインターフェースアドレス(pPAVIStream)
Dim pGetFrameObj As Long 'AVIStreamGetFrameで使用するFetFrameオブジェクト
Dim pDIB As Long 'パックDIB
Dim bmpIH As BITMAPINFOHEADER 'ビットマップ情報ヘッダー
'AVIFileライブラリを開く
AVIFileInit
'AVIファイルのインターフェースアドレス獲得(pPAVIFile)
AVIFileOpen pAVIFile, strAVIFileName, OF_READ, 0&
'ビデオストリームのインターフェースアドレス獲得(pPAVIStream)
AVIFileGetStream pAVIFile, pAVIStream, streamtypeVIDEO, 0
'ビットマップ情報ヘッダー
With bmpIH
.biSize = 40
.biWidth = 0
.biHeight = 0
.biPlanes = 1
.biBitCount = 24
.biCompression = 0
.biSizeImage = 0
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
.biClrUsed = 0
.biClrImportant = 0
End With
'ビデオストリームからビデオフレームを解凍する準備をする
' (AVIStreamGetFrameで使用するGetFrameオブジェクトが返る)
'bmpIHの戻り値あり->.biWidthと.biHeight
pGetFrameObj = AVIStreamGetFrameOpen(pAVIStream, bmpIH) '必ず24bit DIBS
'圧縮解除されたビデオフレームのアドレスを取得する／パックDIBとして返る
pDIB = AVIStreamGetFrame(pGetFrameObj, lngAVIFrameNo)
GetPackedDIBPointer pDIB 'パックDIB展開
SeparateDIB intSeparateType '1/30->1/60分離
PutToBMPFile strBMPFileName 'BMPFileName保存
ErrorOut:
'GetFrameのリソースとインターフェースを開放する
AVIStreamGetFrameClose pGetFrameObj
'ビデオストリームを閉じる
AVIStreamRelease pAVIStream
'ファイルを閉じる
AVIFileRelease pAVIFile
'AVIFileライブラリを閉じる
AVIFileExit
End Sub
Private Sub GetPackedDIBPointer(ByRef pDIB As Long)
'BMP情報ヘッダー獲得 VarPtr(value)|バリアブルポインター|変数のアドレスを長整数型(long)で返す
Call CopyMemory(ByVal VarPtr(m_BmpIH.biSize), ByVal pDIB, Len(m_BmpIH))
'BMPサイズイメージを再定義<<< 720*480や640*480の画像へ変更したときに有効
ReDim m_memBits(0 To m_BmpIH.biSizeImage - 1)
'BMP変数へ一気にコピー
Call CopyMemory(m_memBits(0), ByVal pDIB + 40, m_BmpIH.biSizeImage)
'ファイルヘッダー部
With m_BmpFH
.bftype = "BM"
.bfSize = 55 + m_BmpIH.biSizeImage
.bfReserved1 = 0&
.bfReserved2 = 0&
.bfOffBits = 54
End With
End Sub
Private Sub SeparateDIB(ByVal intSeparateType As Integer)
Dim j As Long
Dim k As Long
Dim l As Long
' ﾌｨｰﾙﾄﾞの分離
Select Case intSeparateType
Case 0
'後の1/60は偶数行：偶数行を次の奇数行にコピー
For j = 0 To m_BmpIH.biHeight - 2 Step 2
k = j * m_BmpIH.biWidth * 3 'Org
l = (j + 1) * m_BmpIH.biWidth * 3 'Dest
Call CopyMemory(m_memBits(l), m_memBits(k), Len(m_memBits(k)) * m_BmpIH.biWidth * 3)
Next
Case 1
'先の1/60は奇数行：奇数行を次の偶数行にコピー
For j = 1 To m_BmpIH.biHeight - 2 Step 2
k = j * m_BmpIH.biWidth * 3 'Org
l = (j + 1) * m_BmpIH.biWidth * 3 'Dest
Call CopyMemory(m_memBits(l), m_memBits(k), Len(m_memBits(k)) * m_BmpIH.biWidth * 3)
Next
End Select
End Sub
Private Sub PutToBMPFile(ByVal strFileName As String)
Dim intFileNumber As Integer
intFileNumber = FreeFile()
Open strFileName For Binary As intFileNumber
Put intFileNumber, 1, m_BmpFH
Put intFileNumber, Len(m_BmpFH) + 1, m_BmpIH
Put intFileNumber, , m_memBits
Close intFileNumber
End Sub
現在は、一旦1/30のBMPで落として、その後、System.Drawing.Bitmap.Clone、
System.Drawing.Graphics.FromImageを使って、走査線の
偶数行（もしくは奇数行）を次の奇数行（もしくは偶数行）
にコピーして、1/60の映像を抽出してますが、処理速度が
遅すぎて、実用的ではありません。
ｿﾌﾄの使用方法としては、BMP形式で保存したﾌｧｲﾙをﾌｫｰﾑ上の
picture boxに表示させようとしているですが、わざわざBMP
で落とさず（処理速度を高めるために）、直接ﾒﾓﾘから表示
できる方法があれば、合わせてお教え頂ければ幸いです。
どうかよろしくお願い致します。
|
