AVIから映像を1/60フィールドごとにBMP形式で保存する
BY jaroau / DATE 2010-05-19 07:29:07 / ID 419 / VIEW 1
AVIから映像を1/60フィールドごとにBMP形式で保存する
こんにちは。他の質問掲示板にも載せていますが、たくさん
の方から情報を頂くため、こちらにも投稿させて頂きます。

現在、VB.net(2008)でAVIファイルから映像を1/60フィールドごとに
BMP形式で保存するソフトを作成しています。以前、VB6.0で
同様のソフトを作っていましたが、Vista以降、ソフトがうまく
作動しなくなったので、VB2008での作成を始めました。
いろいろなサイトを検索して、vb2008でAVIから1/30ごとの映像を
BMP形式で取り出すところまではできましたが、どうしてもvb2008で
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
Dim pAVIStream As Long
Dim pGetFrameObj As Long
Dim pDIB As Long
Dim bmpIH As BITMAPINFOHEADER

AVIFileInit
AVIFileOpen pAVIFile, strAVIFileName, OF_READ, 0&
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

pGetFrameObj = AVIStreamGetFrameOpen(pAVIStream, bmpIH)
pDIB = AVIStreamGetFrame(pGetFrameObj, lngAVIFrameNo)

GetPackedDIBPointer pDIB
SeparateDIB intSeparateType
PutToBMPFile strBMPFileName

ErrorOut:
AVIStreamGetFrameClose pGetFrameObj
AVIStreamRelease pAVIStream
AVIFileRelease pAVIFile
AVIFileExit

wdt(d) = bmpIH.biWidth
hgt(d) = bmpIH.biHeight
End Sub



Public Function AVIFrameMax(strAVIFileName As String) As Long
Dim pAVIFile As Long
Dim pAVIStream As Long

Call AVIFileInit
Call AVIFileOpen(pAVIFile, strAVIFileName, OF_READ, 0&)
Call AVIFileGetStream(pAVIFile, pAVIStream, streamtypeVIDEO, 0)
AVIFrameMax = AVIStreamLength(pAVIStream) - 1
Call AVIStreamRelease(pAVIStream)
Call AVIFileRelease(pAVIFile)
Call AVIFileExit
End Function



Private Sub GetPackedDIBPointer(ByRef pDIB As Long)
Call CopyMemory(ByVal VarPtr(m_BmpIH.biSize), ByVal pDIB, Len(m_BmpIH))
ReDim m_memBits(0 To m_BmpIH.biSizeImage - 1)
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 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



Private Sub SeparateDIB(ByVal intSeparateType As Integer)
Dim j As Long
Dim k As Long
Dim l As Long

Select Case intSeparateType
Case 0
For j = 0 To m_BmpIH.biHeight - 2 Step 2
k = j * m_BmpIH.biWidth * 3
l = (j + 1) * m_BmpIH.biWidth * 3
Call CopyMemory(m_memBits(l), m_memBits(k), Len(m_memBits(k)) * m_BmpIH.biWidth * 3)
Next
Case 1
For j = 1 To m_BmpIH.biHeight - 2 Step 2
k = j * m_BmpIH.biWidth * 3
l = (j + 1) * m_BmpIH.biWidth * 3
Call CopyMemory(m_memBits(l), m_memBits(k), Len(m_memBits(k)) * m_BmpIH.biWidth * 3)
Next
End Select
End Sub