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
お礼
通貨型が悪いわけじゃなかったんですね。 ありがとうございます。早速試してみます。
補足
追加で質問させていただきます。 CopyMemoryを使用する場合、4の倍数の変数を使うとはString型などは使用できないということでしょうか？