|
|
|
In my previous 2 articles Part-1 (Opening and Closing AVI file) and Part-2 (Working with AVI Streams) you learned that how to open and close AVI file and Stream we also learned how to get basic information of AVI file and Streams. In this article we will have real fun with AVI and GDI APIs. This step by step tutorial will teach you how to grab frames from AVI and save as BMP file. Saving frame as BMP file requires basic understanding of BMP file format. If you are not familier with BMP file format then please check my article Working with Bitmap and DIB.
To make resusable piece of code I have wrapped my logic and declares in a class called clsAviFrames This class has the following public members.
Properties
- Filename : Full path of loaded AVI file, by setting this property class will initialize avi file.
- FrameCount : Number of frames in loaded AVI file
- FrameDuration : Dration of each frame in miliseconds
- BitsPerPixel : Color-depth of frame (Bits/Pixel)
- Width : Actual width of frame
- Height : Actual Height of frame
- Name : Name of loaded AVI file this might be some description.
- Compression : Compression type
- StreamHandler : Preferred data handler for the stream.
- StreamType : Type of the data contained in the stream (i.e. Audio, Video, Text or MIDI)
Sub/Function
- DrawFrame : Draw a specified frame to a specified DC.
- SaveFrameBMP : Save a specified frame as BMP file
Lets start step by step implementation on our clsAviFrames class.
Lets start with declaration. |
Click here to copy the following block | Option Explicit
Private m_sFileName As String Private m_pAS As Long Private m_pGF As Long Private m_hDrawDib As Long Private m_lFrames As Long Private m_lFrameDuration As Long Private m_tBMIH As BITMAPINFOHEADER Private m_tBMIHBlank As BITMAPINFOHEADER Private m_tBMI256 As BITMAPINFO256 Private m_tAVI As AVI_STREAM_INFO
Private Const ERR_BASE As Long = vbObjectError + 1024 + 77561 Private Const STREAM_TYPE_VIDEO = &H73646976
Const DIB_RGB_COLORS As Long = 0 Const DIB_PAL_COLORS As Long = 1
Const BI_RGB As Long = 0 Const BI_RLE8 As Long = 1
Const OF_CREATE = &H1000 Const OF_EXIST = &H4000 Const OF_READ = &H0 Const OF_READWRITE = &H2 Const OF_SHARE_DENY_READ = &H30 Const OF_SHARE_DENY_WRITE = &H20 Const OF_SHARE_EXCLUSIVE = &H10 Const OF_VERIFY = &H400 Const OF_WRITE = &H1
Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type
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 Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type
Private Type BITMAPINFO256 bmiHeader As BITMAPINFOHEADER bmiColors(0 To 255) As RGBQUAD End Type
Private Type AVI_RECT left As Long top As Long right As Long bottom As Long End Type
Private Type AVI_STREAM_INFO fccType As Long fccHandler As Long dwFlags As Long dwCaps As Long wPriority As Integer wLanguage As Integer dwScale As Long dwRate As Long dwStart As Long dwLength As Long dwInitialFrames As Long dwSuggestedBufferSize As Long dwQuality As Long dwSampleSize As Long rcFrame As AVI_RECT dwEditCount As Long dwFormatChangeCount As Long szName As String * 64 End Type
Private Declare Function DrawDibOpen Lib "MSVFW32.dll" () As Long
Private Declare Function DrawDibClose Lib "MSVFW32.dll" (ByVal hDD As Long) As Long
Private Declare Function DrawDibDraw Lib "MSVFW32.dll" ( _ ByVal hDD As Long, ByVal hdc As Long, _ ByVal xDst As Long, ByVal yDst As Long, _ ByVal dxDst As Long, ByVal dyDst As Long, _ lpbi As Any, lpBits As Any, _ ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dxSrc As Long, ByVal dySrc As Long, _ ByVal wFlags As Long) As Long
Private Declare Function AVIStreamReadFormat Lib "avifil32.dll" ( _ pavi As Any, _ ByVal lPos As Long, _ lpFormat As Any, _ ByRef lpcbFormat 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 AVIFileInit Lib "avifil32.dll" ()
Private Declare Function AVIStreamInfo Lib "avifil32.dll" ( _ ByVal pAVIStream As Long, _ ByRef psi As Any, _ ByVal lSize As Long) As Long
Private Declare Function AVIStreamStart Lib "avifil32.dll" ( _ ByVal pavi As Long) As Long
Private Declare Function AVIStreamOpenFromFile Lib "avifil32.dll" Alias "AVIStreamOpenFromFileA" ( _ ppavi As Any, ByVal szFile As String, _ ByVal fccType As Long, ByVal lParam As Long, _ ByVal mode As Long, pclsidHandler As Any _ ) As Long
Private Declare Function AVIStreamSampleToTime Lib "avifil32.dll" ( _ pavi As Any, _ ByVal lSample As Long) As Long
Private Declare Function AVIStreamLength Lib "avifil32.dll" ( _ ByVal pavi As Long) As Long
Private Declare Function ICInfo Lib "MSVFW32.dll" ( _ ByVal fccType As Long, _ ByVal fccHandler As Long, _ lpicinfo As Any _ ) As Long
Private Declare Function AVIStreamRelease Lib "avifil32.dll" ( _ ByVal pavi As Long) As Long
Private Declare Sub AVIFileExit Lib "avifil32.dll" ()
Private Declare Function GetDIBits Lib "GDI32.dll" (ByVal aHDC As Long, _ ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, _ ByRef lpBits As Any, ByRef lpbi As Any, ByVal wUsage As Long) As Long
Private Declare Function GetObject Lib "GDI32.dll" Alias "GetObjectA" ( _ ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" ( _ ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, _ ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _ ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetDIBits256 Lib "gdi32" Alias "GetDIBits" ( _ ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, _ ByVal nNumScans As Long, lpBits As Any, _ lpbi As Any, ByVal wUsage As Long) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" ( _ ByVal lpDriverName As String, lpDeviceName As Any, _ lpOutput As Any, lpInitData As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _ ByRef dest As Any, _ ByRef src As Any, _ ByVal dwLen As Long) |
We will put some initialization code in Class_Initialize event |
AVIFileInit must be called before any other AVI API calls. DrawDibOpen must be called before you use any DrawDib API.
Now some cleanup code. Its very important that you free GDI and other resources when object is unloaded. |
Lets write some utility functions for our class. One important point which should be noted is the return value from the AVI APIs. AVI APIs return COM HRESULT instead of just success or failure. Folloing image will give you more idead about 2 bytes HRESULT.
An HRESULT is a 32 bit unsigned integer where the high bit indicates whether it is an error or a success. The remaining bits in the high word indicate the "facility" of the error -- into what broad category does this error fall? The low word indicates the specific error for that facility.
HRESULTS are therefore usually talked about in hex, as the bit structure is a lot easier to read in hex! Consider &H80070013, for example. The high bit is set, so this is an error. The facility code is 7 and the error code is &H0013 = 19 in decimal. |
Click here to copy the following block | Private Function FAILED(ByVal hR As Long) As Boolean FAILED = Not (SUCCEEDED(hR)) End Function
Private Function SUCCEEDED(ByVal hR As Long) As Boolean SUCCEEDED = ((hR And &H80000000) = 0) End Function
Private Function FourCCToString(ByVal lFourCC As Long) As String Dim sRet As String Dim lUByte As Long sRet = Chr(lFourCC And &HFF) sRet = sRet & Chr((lFourCC And &HFF00&) \ &H100&) sRet = sRet & Chr((lFourCC And &HFF0000) \ &H10000) lUByte = (lFourCC And &H7F000000) \ &H1000000 If (lFourCC And &H80000000) = &H80000000 Then lUByte = lUByte Or &H80& End If sRet = sRet & Chr(lUByte) FourCCToString = sRet End Function
Private Function AVIStreamEndTime() As Long Dim lSample As Long lSample = AVIStreamStart(ByVal m_pAS) + AVIStreamLength(ByVal m_pAS) AVIStreamEndTime = AVIStreamSampleToTime(ByVal m_pAS, lSample) End Function
Private Function FileExists(ByVal file As String, ByRef lErr As Long) As Boolean Dim sTest As String On Error Resume Next sTest = Dir(file) lErr = Err.Number FileExists = ((lErr = 0) And Len(sTest) > 0) On Error GoTo 0 End Function
Private Sub pErr(ByVal lErr As Long) Dim sMsg As String Select Case lErr Case 1 sMsg = "File not found" Case 2 sMsg = "Failed to open AVI file" Case 3 sMsg = "Unable to open AVI frames" Case 4 sMsg = "AVI contains no frames" Case 5 sMsg = "Could not read the format of the AVI" Case 6 sMsg = "Unsupported AVI format" Case Else sMsg = "Unexpected error " & lErr End Select Err.Raise ERR_BASE + lErr, App.EXEName & ".clsAviExtract", sMsg End Sub |
Now lets understand LoadFramesFromFile function which is called when you set FileName property. This function performs the following steps.
- Call AVIStreamOpenFromFile to open VIDEO stream from a specified AVI file
- Call AVIStreamGetFrameOpen to get handle to avi frames
- Call AVIStreamLength to get number of frames and AVIStreamEndTime for total time of AVI. You can calculate FrameDuration using using totalTime / TotalFrames formula.
- Call AVIStreamReadFormat to fill BITMAPINFOHEADER which contains all information regarding to frame Bitmap. Now if you observe the code then we have called AVIStreamReadFormat 3 times. First call is passing NULL (i.e. ByVal 0&) in 3rd parameter lpFormat which is pointer to a location indicating the size of the memory block. If lpFormat is NULL then 4th parameter lpcbFormat will be set to the amount of memory needed to return the format. In our case first call to AVIStreamReadFormat will return the size required to store Bitmap format and second call fills the BITMAPINFOHEADER with data. If you know the structuare of Bitmap then Bitmap with Bits/Pixel <= 8 uses color palette which is stored as an array of RGBQUAD type. If BitCount in BITMAPINFOHEADER is less than or equal to 8 bit than again you have to call AVIStreamReadFormat to fill color information in BITMAPINFO256 structure which consists BITMAPINFOHEADER and RGBQUAD both. So now you understand why we need to call AVIStreamReadFormat 3 times. First call to get size required to store format of frame. Second call is to find Bits/pixel of frame and last call to fill RGBQUAD only if Bits/Pixel <= 8 Bits.
- Call AVIStreamInfo to retrive all information regarding opened stream.
|
Click here to copy the following block | Private Function LoadFramesFromFile(Filename As String) As Boolean Dim hR As Long Dim totalTime As Long Dim hIC As Long
hR = AVIStreamOpenFromFile(m_pAS, Filename, STREAM_TYPE_VIDEO, _ 0, OF_READ Or OF_SHARE_EXCLUSIVE, ByVal 0&) If FAILED(hR) Then m_pAS = 0 UnloadFrames pErr 2 Exit Function End If
m_pGF = AVIStreamGetFrameOpen(ByVal m_pAS, ByVal 0&) If (m_pGF = 0) Then UnloadFrames pErr 3 Exit Function End If
m_lFrames = AVIStreamLength(ByVal m_pAS) If (m_lFrames = 0) Then UnloadFrames pErr 4 Exit Function End If
totalTime = AVIStreamEndTime() m_lFrameDuration = (totalTime / m_lFrames)
Dim lSize As Long hR = AVIStreamReadFormat(ByVal m_pAS, 0, ByVal 0&, lSize) If (FAILED(hR) Or lSize < LenB(m_tBMIH)) Then pErr 5 Exit Function End If
lSize = LenB(m_tBMIH)
hR = AVIStreamReadFormat(ByVal m_pAS, 0, m_tBMIH, lSize) If FAILED(hR) Then Debug.Print "Read format error: " & Hex(hR) End If If (m_tBMIH.biBitCount <= 8) Then Select Case m_tBMIH.biBitCount Case 8 lSize = LenB(m_tBMI256) hR = AVIStreamReadFormat(ByVal m_pAS, 0, m_tBMI256, lSize) Case Else pErr 6 End Select End If
AVIStreamInfo ByVal m_pAS, m_tAVI, LenB(m_tAVI)
Debug.Print "Rate:" & m_tAVI.dwRate Debug.Print "Scale:" & m_tAVI.dwScale Debug.Print "FrameDuration:" & FrameDuration
LoadFramesFromFile = True End Function |
Let discuss another important function DrawFrame which we will use to draw a frame on a specified DC (Device Context).
We have used DrawDibDraw API to implement DrawFrame function. You can display a sequence of bitmaps with the same dimensions and formats by using the DrawDibDraw function with the DrawDibBegin function. DrawDibBegin improves the efficiency of DrawDibDraw by preparing the DrawDib DC for drawing.
Very first thing we have done here is call to AVIStreamGetFrame API which returns pointer to packed DIB of a specified frame number. You can pass this pointer to DrawDibDraw API along with all other required arguments. |
Click here to copy the following block | Public Sub DrawFrame( _ ByVal lhDC As Long, _ ByVal Index As Long, _ Optional ByVal x As Long = 0, _ Optional ByVal y As Long = 0, _ Optional ByVal lWidth As Long = -1, _ Optional ByVal lHeight As Long = -1, _ Optional ByVal Transparent As Boolean = False _ ) Dim lpbi As Long
If (lWidth < 0) Then lWidth = Width If (lHeight < 0) Then lHeight = Height Index = Index - 1
lpbi = AVIStreamGetFrame(ByVal m_pGF, Index) If (lpbi) Then DrawDibDraw m_hDrawDib, lhDC, x, y, _ lWidth, lHeight, ByVal lpbi, ByVal 0&, _ 0, 0, -1, -1, 0 End If End Sub |
Now the most important function of our class which requires good understanding of GDI Apis and Bitmap structure. |
Click here to copy the following block | Public Function SaveFrameBMP(FrameNumber As Long, SaveFileName As String, Optional BPP As Integer = 0) As Boolean Dim SaveBits() As Byte Dim fNum As Integer Dim RetVal As Long Dim hNewDc As Long, hNewBm As Long, hOldBm As Long, lhDC As Long
Dim tBH As BITMAPFILEHEADER Dim tBI As BITMAPINFO256 Dim tBM As BITMAP
If BPP = 0 And BPP <> 1 And BPP <> 4 And BPP <> 8 And BPP <> 24 Then BPP = BitsPerPixel
lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&) hNewDc = CreateCompatibleDC(lhDC) RetVal = DeleteDC(lhDC)
lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&) hNewBm = CreateCompatibleBitmap(lhDC, Width, Height) RetVal = DeleteDC(lhDC)
hOldBm = SelectObject(hNewDc, hNewBm)
Call DrawFrame(hNewDc, FrameNumber)
RetVal = SelectObject(hNewDc, hOldBm)
RetVal = GetObject(hNewBm, LenB(tBM), tBM) With tBI.bmiHeader .biSize = LenB(tBI.bmiHeader) .biWidth = tBM.bmWidth .biHeight = tBM.bmHeight .biPlanes = 1 .biBitCount = BPP If BPP = 8 Then .biCompression = BI_RLE8 Else .biSizeImage = ImageBufferSize(BPP) .biCompression = BI_RGB End If End With
Dim hDCComp As Long hDCComp = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
If BPP <= 8 Then Call CopyMemory(tBI.bmiColors(0), m_tBMI256.bmiColors(0), (2 ^ BPP) * LenB(tBI.bmiColors(0)))
RetVal = GetDIBits(hDCComp, hNewBm, 0, tBI.bmiHeader.biHeight, ByVal 0&, _ tBI, DIB_RGB_COLORS) End If
ReDim SaveBits(0 To tBI.bmiHeader.biSizeImage - 1)
RetVal = GetDIBits(hDCComp, hNewBm, 0, tBI.bmiHeader.biHeight, SaveBits(0), _ tBI, DIB_RGB_COLORS)
RetVal = DeleteDC(hDCComp)
With tBH .bfType = &H4D42 .bfOffBits = 14 + Len(tBI) .bfSize = .bfOffBits + tBI.bmiHeader.biSizeImage End With
RetVal = DeleteObject(hNewBm) RetVal = DeleteDC(hNewDc)
fNum = FreeFile
Open SaveFileName For Binary As fNum Put fNum, , tBH Put fNum, , tBI Put fNum, , SaveBits() Close fNum
SaveFrameBMP = True End Function
Private Function ImageBufferSize(Optional BitsPerPix As Integer = 0) As Long If BitsPerPix = 0 Then BitsPerPix = m_tBMI256.bmiHeader.biBitCount Dim lScanSize As Long
Select Case BitsPerPix Case 1 lScanSize = Width / 8 lScanSize = lScanSize + lScanSize Mod 4 ImageBufferSize = lScanSize * Height Case 4 lScanSize = Width / 2 lScanSize = lScanSize + lScanSize Mod 4 ImageBufferSize = lScanSize * Height Case 8 lScanSize = Width lScanSize = lScanSize + lScanSize Mod 4 ImageBufferSize = lScanSize * Height Case Else ImageBufferSize = ((Width * 3 + 3) And &HFFFFFFFC) * Height End Select End Function |
I have coded few important properties of AVI. Check the Filename property. When you set this property which is path of avi file, LoadFramesFromFile function is called along with Avi file parameter. |
Click here to copy the following block | Public Property Get Filename() As String Filename = m_sFileName End Property
Public Property Let Filename(ByVal value As String) UnloadFrames m_sFileName = value Dim lErr As Long If (FileExists(value, lErr)) Then LoadFramesFromFile m_sFileName Else pErr 1 End If End Property
Public Property Get Name() As String Dim sName As String Dim iPos As Long sName = StrConv(m_tAVI.szName, vbUnicode) iPos = InStr(sName, vbNullChar) If (iPos > 0) Then sName = left(sName, iPos - 1) End If Name = sName End Property
Public Property Get Width() As Long Width = m_tBMIH.biWidth End Property
Public Property Get Height() As Long Height = m_tBMIH.biHeight End Property
Public Property Get BitsPerPixel() As Long BitsPerPixel = m_tBMIH.biBitCount End Property
Public Property Get Compression() As Long Compression = m_tBMIH.biCompression End Property
Public Property Get FrameCount() As Long FrameCount = m_lFrames End Property
Public Property Get FrameDuration() As Long FrameDuration = m_lFrameDuration End Property
Public Property Get StreamHandler() As String StreamHandler = FourCCToString(m_tAVI.fccHandler) End Property
Public Property Get StreamType() As String StreamType = FourCCToString(m_tAVI.fccType) End Property |
|
|
|
Submitted By :
Nayan Patel
(Member Since : 5/26/2004 12:23:06 PM)
|
|
|
Job Description :
He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting. |
View all (893) submissions by this author
(Birth Date : 7/14/1981 ) |
|
|