[VB6] Uncompressed AVI Writer

Here is a minimalistic cAviWriter class (less than 200 LOC w/ no dependencies) that can be used to create uncompressed AVIs for use in standard animation control.

Code:

---

Option Explicit

'=========================================================================
' API
'=========================================================================

'--- for AVIFileOpen
Private Const OF_WRITE                      As Long = &H1
Private Const OF_CREATE                    As Long = &H1000
'--- for CreateDIBSection
Private Const DIB_RGB_COLORS                As Long = 0

Private Declare Sub AVIFileInit Lib "avifil32.dll" ()
Private Declare Sub AVIFileExit Lib "avifil32.dll" ()
Private Declare Function AVIFileOpen Lib "avifil32.dll" Alias "AVIFileOpenA" (ppfile As Long, ByVal szFile As String, ByVal uMode As Long, ByVal lpHandler As Long) As Long
Private Declare Function AVIFileCreateStream Lib "avifil32.dll" (ByVal pfile As Long, ppavi As Long, psi As TAVISTREAMINFO) As Long
Private Declare Function AVIFileRelease Lib "avifil32.dll" (ByVal pfile As Long) As Long
Private Declare Function AVIStreamSetFormat Lib "avifil32.dll" (ByVal pavi As Long, ByVal lPos As Long, lpFormat As Any, ByVal cbFormat As Long) As Long
Private Declare Function AVIStreamWrite Lib "avifil32.dll" (ByVal pavi As Long, ByVal lStart As Long, ByVal lSamples As Long, ByVal lpBuffer As Long, ByVal cbBuffer As Long, ByVal dwFlags As Long, plSampWritten As Long, plBytesWritten As Long) As Long
Private Declare Function AVIStreamRelease Lib "avifil32.dll" (ByVal pavi As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, lpBitsInfo As BITMAPINFOHEADER, ByVal wUsage As Long, lpBits As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ApiBitBlt Lib "gdi32" Alias "BitBlt" (ByVal hdcDest As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Private Type RECT
    Left                As Long
    Top                As Long
    Right              As Long
    Bottom              As Long
End Type

Private Type TAVISTREAMINFO
    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 RECT
    dwEditCount        As Long
    dwFormatChangeCount As Long
    szName(0 To 63)    As Byte
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

'=========================================================================
' Constants and member variables
'=========================================================================

Private m_hAviFile              As Long
Private m_hAviStream            As Long
Private m_lSample              As Long
Private m_uBmpInfo              As BITMAPINFOHEADER
Private m_hDC                  As Long
Private m_hDib                  As Long
Private m_hPrevDib              As Long
Private m_lpBits                As Long

'=========================================================================
' Methods
'=========================================================================

Public Function Init( _
            sFile As String, _
            ByVal lWidth As Long, _
            ByVal lHeight As Long, _
            Optional ByVal lRate As Long = 10) As Boolean
    Dim uStream        As TAVISTREAMINFO
   
    Terminate
    If AVIFileOpen(m_hAviFile, sFile, OF_CREATE Or OF_WRITE, 0) < 0 Then
        GoTo QH
    End If
    With uStream
        .fccType = pvToFourCC("vids")
        .fccHandler = 0 ' pvToFourCC("DIB ")
        .dwScale = 1
        .dwRate = lRate
        .rcFrame.Right = lWidth
        .rcFrame.Bottom = lHeight
    End With
    If AVIFileCreateStream(m_hAviFile, m_hAviStream, uStream) < 0 Then
        GoTo QH
    End If
    With m_uBmpInfo
        .biSize = Len(m_uBmpInfo)
        .biWidth = lWidth
        .biHeight = lHeight
        .biPlanes = 1
        .biBitCount = 24 ' 32
        .biSizeImage = ((lWidth * .biBitCount \ 8 + 3) And -4&) * lHeight
    End With
    If AVIStreamSetFormat(m_hAviStream, 0, m_uBmpInfo, Len(m_uBmpInfo)) < 0 Then
        GoTo QH
    End If
    m_hDC = CreateCompatibleDC(0)
    m_hDib = CreateDIBSection(m_hDC, m_uBmpInfo, DIB_RGB_COLORS, m_lpBits, 0, 0)
    m_hPrevDib = SelectObject(m_hDC, m_hDib)
    m_lSample = 0
    '--- success
    Init = True
    Exit Function
QH:
    Terminate
End Function

Public Function AddFrame( _
            oPic As StdPicture, _
            Optional ByVal lX As Long, _
            Optional ByVal lY As Long) As Boolean
    Dim hTempDC        As Long
    Dim hPrevBmp        As Long
   
    hTempDC = CreateCompatibleDC(m_hDC)
    hPrevBmp = SelectObject(hTempDC, oPic.handle)
    Call ApiBitBlt(m_hDC, 0, 0, m_uBmpInfo.biWidth, m_uBmpInfo.biHeight, hTempDC, lX, lY, vbSrcCopy)
    Call SelectObject(hTempDC, hPrevBmp)
    Call DeleteDC(hTempDC)
    If AVIStreamWrite(m_hAviStream, m_lSample, 1, m_lpBits, m_uBmpInfo.biSizeImage, 0, 0, 0) < 0 Then
        GoTo QH
    End If
    m_lSample = m_lSample + 1
    '--- success
    AddFrame = True
QH:
End Function

Private Sub Terminate()
    If m_hAviStream <> 0 Then
        Call AVIStreamRelease(m_hAviStream)
        m_hAviStream = 0
    End If
    If m_hAviFile <> 0 Then
        Call AVIFileRelease(m_hAviFile)
        m_hAviFile = 0
    End If
    If m_hDC <> 0 Then
        If m_hPrevDib <> 0 Then
            Call SelectObject(m_hDC, m_hPrevDib)
            m_hPrevDib = 0
        End If
        If m_hDib <> 0 Then
            Call DeleteObject(m_hDib)
            m_hDib = 0
            m_lpBits = 0
        End If
        Call DeleteDC(m_hDC)
        m_hDC = 0
    End If
End Sub

'= private ===============================================================

Private Function pvToFourCC(sText As String) As Long
    Call CopyMemory(pvToFourCC, ByVal StrPtr(StrConv(sText, vbFromUnicode)), 4)
End Function

'=========================================================================
' Base class events
'=========================================================================

Private Sub Class_Initialize()
    Call AVIFileInit
End Sub

Private Sub Class_Terminate()
    Terminate
    Call AVIFileExit
End Sub

---

The sample projects loads a transparent ajax-loader PNG strip and blends it with current vbButtonFace color (Form's back color). Then the frames are split from the bitmap strip and appended to a temporary AVI file. Then an animation control is placed on the form (all API) and the temp AVI file is loaded and played.

The nice thing about animation control is that it uses a separate thread to cycle the animation, so when long running tasks are executed on the UI thread the ajax-loader continues to spin. Enjoy!

cheers,
</wqw>

Excellent class! :thumb:

CreateStreamOnHGlobal wasn't declared. On XP, the animation control froze while the 5 second tight loop ran.

Oops, a stray typelib reference is left in the project with the API declare, will fix it.

Try the tight loop when compiled. On XP and Win8 here still spinning.

cheers,
</wqw>

I did try it both compiled and in IDE. The animation just won't spin. Perhaps DoEvents is needed?

No DoEvents needed, thats the point. Otherwise one can use a timer and switch bitmaps instead of making the effort to convert the strip to an AVI file.

I just tested compiled version here on Win7 -- spinning ok. Have to test it on more machines.

cheers,
</wqw>

BTW, I added a BAS module and changed Startup Object to Sub Main so that InitCommonControlsEx can be called as early as possible because using Form1 as Startup Object raises the "System Error &H80070583 (-2147023485). Class does not exist." when running compiled. Also had to supply the correct declaration for CreateStreamOnHGlobal and had modified this line accordingly:

Code:

---


Call CreateStreamOnHGlobal(hMem, 1, pStream)

---

I'm using XP Pro SP2. A manifest was automatically embedded in the exe by vbAdvance.


EDIT

I tried compiling the exe without the manifest but still using Sub Main as the Startup Object and calling InitCommonControlsEx there enabled the Animation control to play continuously while the loop ran. So, it seems the Animation control from the newer comctl32.dll does not run on a separate thread. Process Explorer confirmed my suspicion when it displayed just 2 threads for the manifest-equipped exe versus 3 threads for the exe without one.

Ahhh, this explains the behavior I'm seeing here. My IDE is themed and the animation indeed stops in the tight loop while compiled EXE (no manifest) works as expected. Thought that not supplying ACS_TIMER will force it to use a thread.

Here is what I found in MSDN:

Quote:

---

Originally Posted by http://msdn.microsoft.com/en-us/library/windows/desktop/bb761886(v=vs.85).aspx

ACS_TIMER
By default, the control creates a thread to play the AVI clip. If you set this flag, the control plays the clip without creating a thread; internally the control uses a Win32 timer to synchronize playback.
Comctl32.dll version 6 and later: This style is not supported. By default, the control plays the AVI clip without creating a thread.

---

This explains the behavior. Using SetWindowTheme to disable theme on the animation control seems not to help.

Animation control from Microsoft Windows Common Controls-2 6.0 is immune to the manifest and always uses a separate thread. Also its animation seems to run a bit faster (!)

Will try to use LoadLibrary "c:\windows\system32\comctl32.dll" and GetProcAddress "InitCommonControls" to register ANIMATE_CLASS to comctl 5.x before calling CreateWindowEx.

cheers,
</wqw>

Thank you for your codebank submission.

However, in accordance with this CodeBank policy regarding attachments, I have edited yours and removed all compiled files

Please post only source code in any CodeBank attachment.

Thank you. :)