AVIファイルの特定フレームをBMPで保存するには…？ (ID:85863)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 > イメージを表示せずにBMPなどで特定のフレームを保存する http://www.mapletown.net/~nekora/soft/howto/avi.html 第２章 ＡＶＩファイルからビットマップを取り出す のサンプルを参考にして、VB6で作ってみました（時間が空いたんで）。 Formに、Picture1, Command1, Command2の各コントロールを貼って下さい。 '// フォームモジュール Option Explicit Private Sub Command1_Click() Dim szAviFile As String Dim iFrame As Long Dim szBmpFile As String szAviFile = "AVIファイルのフルパス名" iFrame = 0 szBmpFile = App.Path & "\test.bmp" If (Dir(szBmpFile) <> "") Then Kill szBmpFile Call AviToBmp(szAviFile, iFrame, szBmpFile) End Sub Private Sub Command2_Click() On Error Resume Next Picture1.Picture = LoadPicture(App.Path & "\test.bmp") End Sub '// 標準モジュール Option Explicit Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Const BI_RGB As Long = 0 Private Const AVIERR_OK As Long = 0 Private Declare Sub AVIFileInit Lib "avifil32.dll" () Private Declare Sub AVIFileExit Lib "avifil32.dll" () Private Declare Function AVIFileOpen Lib "avifil32.dll" _ (ByRef ppfile As Long, ByVal szFile As String, _ ByVal uMode As Long, ByVal pclsidHandler As Long) As Long Private Const OF_READ As Long = &H0 Private Const OF_SHARE_DENY_NONE As Long = &H40 Private Declare Function AVIFileRelease Lib "avifil32.dll" _ (ByVal pfile As Long) As Long Private Declare Function AVIFileGetStream Lib "avifil32.dll" _ (ByVal pfile As Long, ByRef ppaviStream As Long, _ ByVal fccType As Long, ByVal lParam As Long) As Long Private Const streamtypeVIDEO As Long = 1935960438 Private Declare Function AVIStreamRelease Lib "avifil32.dll" _ (ByVal pavi As Long) As Long Private Declare Function AVIStreamGetFrameOpen Lib "avifil32.dll" _ (ByVal pAviStream As Long, ByRef bih As Any) As Long Private Declare Function AVIStreamGetFrame Lib "avifil32.dll" _ (ByVal pGetFrameObj As Long, ByVal lPos As Long) As Long Private Declare Function AVIStreamGetFrameClose Lib "avifil32.dll" _ (ByVal pGetFrameObj As Long) As Long Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _ (ByRef dest As Any, ByRef src As Any, ByVal dwLen As Long) Public Function AviToBmp(ByVal szAviFile As String, _ ByVal iFrame As Long, _ ByVal szBmpFile As String) As Long Dim pbmih As Long ' LPBITMAPINFOHEADER Dim pavi As Long ' PAVIFILE Dim pstm As Long ' PAVISTREAM Dim pfrm As Long ' PGETFRAME Call AVIFileInit If (AVIFileOpen(pavi, szAviFile, OF_READ Or _ OF_SHARE_DENY_NONE, 0) <> 0) Then GoTo ErrOut If (AVIFileGetStream(pavi, pstm, 0, 0) <> 0) Then GoTo ErrOut pfrm = AVIStreamGetFrameOpen(pstm, ByVal 0&) If (pfrm = 0) Then GoTo ErrOut pbmih = AVIStreamGetFrame(pfrm, iFrame) If (pbmih = 0) Then GoTo ErrOut Call BmpSave(szBmpFile, pbmih) AviToBmp = 1 ErrOut: If (pfrm <> 0) Then Call AVIStreamGetFrameClose(pfrm) If (pstm <> 0) Then Call AVIStreamRelease(pstm) If (pavi <> 0) Then Call AVIFileRelease(pavi) Call AVIFileExit End Function Private Sub BmpSave(ByVal fname As String, pbmih As Long) Dim bmih As BITMAPINFOHEADER Dim s As Long, x As Long, y As Long Dim bmfh As BITMAPFILEHEADER Dim bbmih() As Byte Dim fn As Integer Call MoveMemory(bmih, ByVal pbmih, Len(bmih)) x = bmih.biWidth y = Abs(bmih.biHeight) bmfh.bfType = &H4D42 bmfh.bfReserved1 = 0 bmfh.bfReserved2 = 0 If (bmih.biClrUsed = 0) Then Select Case (bmih.biBitCount) Case 1: bmfh.bfOffBits = 8 Case 4: bmfh.bfOffBits = 64 Case 8: bmfh.bfOffBits = 1024 Case 24: bmfh.bfOffBits = 0 Case 16, 32: bmfh.bfOffBits = IIf(bmih.biCompression = BI_RGB, 12, 0) End Select Else bmfh.bfOffBits = bmih.biClrUsed * 4 End If bmfh.bfOffBits = bmfh.bfOffBits + Len(bmfh) + Len(bmih) If (bmih.biSizeImage = 0) Then Select Case (bmih.biBitCount) Case 1: s = (x + 7) \ 8 Case 4: s = (x + 1) \ 2 Case 8: s = x Case 16: s = x * 2 Case 24: s = x * 3 Case 32: s = x * 4 End Select bmfh.bfSize = bmfh.bfOffBits + ((s + 3) \ 4) * 4 * y Else bmfh.bfSize = bmfh.bfOffBits + bmih.biSizeImage End If ReDim bbmih(0 To bmfh.bfSize - Len(bmfh) - 1) Call MoveMemory(bbmih(0), ByVal pbmih, bmfh.bfSize - Len(bmfh)) On Error Resume Next fn = FreeFile Open fname For Binary As #fn Put #fn, , bmfh Put #fn, , bbmih() Close #fn Erase bbmih() End Sub