VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFOTABMPToAVI"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private m_saFileList() As String
Private m_nCur As Long
Private m_nMax As Long

Private m_nFPS As Double

Public Property Get FPS() As Double
    FPS = m_nFPS
End Property
Public Property Let FPS(nNewVal As Double)

    m_nFPS = nNewVal
    If m_nFPS < 1 Then m_nFPS = 1
    If m_nFPS > 30 Then m_nFPS = 30
    
End Property

Public Sub AddFile(sFileName As String)

    If m_nCur > m_nMax Then
        m_nMax = m_nMax * 2
        ReDim Preserve m_saFileList(0 To m_nMax) As String
    End If

    m_saFileList(m_nCur) = sFileName
    m_nCur = m_nCur + 1

End Sub

Public Sub WriteOutAVI(sAVIFileName As String)
    Call WriteOut(sAVIFileName, , False)
End Sub

Public Sub WriteOutCompressedAVI(nMEHwnd As Long, sAVIFileName As String)
    Call WriteOut(sAVIFileName, nMEHwnd, True)
End Sub

Private Sub WriteOut(sAVIFileName As String, Optional nMEHwnd As Long = 0, Optional bCompress As Boolean = True)

    Dim pfile As Long 'ptr PAVIFILE
    Dim oBitMap As cDib
    Dim nPs As Long 'ptr PAVISTREAM
    Dim nPsCompressed As Long 'ptr PAVISTREAM
    Dim nStdHeader As AVI_STREAM_INFO
    Dim oBI As BITMAPINFOHEADER
    Dim oOptions As AVI_COMPRESS_OPTIONS
    Dim pOpts As Long
    Dim res As Long
    Dim i As Long
    Dim nWidth As Long
    Dim nHeight As Long
    Dim sError As String
    
    If m_nCur = 0 Then
        Call Err.Raise(-1, "WriteOutAVI", "No files have been added.")
    Else
        'Open the file for writing
        If AVIFileOpen(pfile, sAVIFileName, OF_WRITE Or OF_CREATE, 0&) <> AVIERR_OK Then
            sError = "Unable to open AVI for writting <" & sAVIFileName & ">"
            GoTo Error
        End If
    
        'Get the first bmp in the list for setting format
        Set oBitMap = New cDib
        If oBitMap.CreateFromFile(m_saFileList(0)) <> True Then
            sError = "Could not load first bitmap file in list!"
            GoTo Error
        End If
        nWidth = oBitMap.Width
        nHeight = oBitMap.Height
    
        'Fill in the header for the video stream
        nStdHeader.fccType = mmioStringToFOURCC("vids", 0&)    '// stream type video
        nStdHeader.fccHandler = 0&                             '// default AVI handler
        nStdHeader.dwScale = 1
        nStdHeader.dwRate = Val(m_nFPS)                        '// fps
        nStdHeader.dwSuggestedBufferSize = oBitMap.SizeImage       '// size of one frame pixels
        Call SetRect(nStdHeader.rcFrame, 0, 0, oBitMap.Width, oBitMap.Height)       '// rectangle for stream
    
        'And create the stream
        If AVIFileCreateStream(pfile, nPs, nStdHeader) <> AVIERR_OK Then
            sError = "Failed to create AVI file stream"
            GoTo Error
        End If
    
        'Get the compression options from the user
        If bCompress = True Then
            'Careful! this API requires a pointer to a pointer to a UDT
            'returns TRUE if User presses OK, FALSE if Cancel, or error code
            pOpts = VarPtr(oOptions)
            If AVISaveOptions(nMEHwnd, ICMF_CHOOSE_KEYFRAME Or ICMF_CHOOSE_DATARATE, 1, nPs, pOpts) <> 1 Then
                Call AVISaveOptionsFree(1, pOpts)
                sError = "Unable to set AVI compression options."
                GoTo Error
            End If
            
            'make compressed stream
            If AVIMakeCompressedStream(nPsCompressed, nPs, oOptions, 0&) <> AVIERR_OK Then
                sError = "Unable to compress AVI stream"
                GoTo Error
            End If
            
        End If
        
        'set format of stream according to the bitmap
        oBI.biBitCount = oBitMap.BitCount
        oBI.biClrImportant = oBitMap.ClrImportant
        oBI.biClrUsed = oBitMap.ClrUsed
        oBI.biCompression = oBitMap.Compression
        oBI.biHeight = oBitMap.Height
        oBI.biWidth = oBitMap.Width
        oBI.biPlanes = oBitMap.Planes
        oBI.biSize = oBitMap.SizeInfoHeader
        oBI.biSizeImage = oBitMap.SizeImage
        oBI.biXPelsPerMeter = oBitMap.XPPM
        oBI.biYPelsPerMeter = oBitMap.YPPM
        
        'set the format of the compressed stream
        If bCompress = False Then
            res = AVIStreamSetFormat(nPs, 0, ByVal oBitMap.PointerToBitmapInfo, oBitMap.SizeBitmapInfo)
        Else
            res = AVIStreamSetFormat(nPsCompressed, 0, ByVal oBitMap.PointerToBitmapInfo, oBitMap.SizeBitmapInfo)
        End If
        If res <> AVIERR_OK Then
            sError = "Unable to set AVI stream format"
            GoTo Error
        End If
    
        'Now write out each video frame
        For i = 0 To m_nCur - 1
            Call oBitMap.CreateFromFile(m_saFileList(i))  'load the bitmap (ignore errors)
            
            'Check the size!
            If Not nWidth = oBitMap.Width Or Not nHeight = oBitMap.Height Then
                sError = "Bitmaps are not all the same size!  <" & m_saFileList(i) & ">"
                GoTo Error
            End If
            
            If bCompress = True Then
                res = AVIStreamWrite(nPsCompressed, _
                                    i, 1, oBitMap.PointerToBits, oBitMap.SizeImage, _
                                    AVIIF_KEYFRAME, ByVal 0&, ByVal 0&)
            Else
                res = AVIStreamWrite(nPs, _
                                    i, 1, oBitMap.PointerToBits, oBitMap.SizeImage, _
                                    AVIIF_KEYFRAME, ByVal 0&, ByVal 0&)
            End If
            If res <> AVIERR_OK Then
                sError = "Failed to add Bitmap to AVI stream <" & m_saFileList(i) & ">"
                GoTo Error
            End If
        Next
    End If

Error:
    'Now close the file
    Set oBitMap = Nothing
    
    If (nPs <> 0) Then Call AVIStreamClose(nPs)
    If (nPsCompressed <> 0) Then Call AVIStreamClose(nPsCompressed)
    If (pfile <> 0) Then Call AVIFileClose(pfile)

    Call AVIFileExit

    If res <> AVIERR_OK Or Len(sError) > 0 Then
        Call Err.Raise(-1, "WriteOutAVI", "There was an error writing the file." & vbCrLf & sError)
    End If

End Sub

Private Sub Class_Initialize()
    
    Call AVIFileInit   '// opens AVIFile library

    m_nCur = 0
    m_nMax = 10
    ReDim m_saFileList(0 To m_nMax) As String
    m_nFPS = 1

End Sub

Private Sub Class_Terminate()
    Call AVIFileExit   '// releases AVIFile library
End Sub
