Creating an AVI File From Bitmaps Using ltmmSampleSource Example for Visual Basic

The following code utilizes ltmmSampleSource and ltmmConvertCtrl to generate an AVI file from generated 24-bit device independent bitmaps.

' declarations
Private Type BITMAPINFOHEADER '40 bytes
        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 RECT    ' 16 bytes
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type REFERENCE_TIME  ' 8 bytes
    lowpart As Long
    highpart As Long
End Type

Private Type VIDEOINFOHEADER ' 88 bytes
    rcSource As RECT
    rcTarget As RECT
    dwBitRate As Long
    dwBitErrorRate As Long
    AvgTimePerFrame As REFERENCE_TIME
    bmiHeader As BITMAPINFOHEADER
End Type
Private Type VIDEOINFOHEADERARRAY
  buffer(88 - 1) As Byte
End Type

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long


Function DrawCenteredText(s As String) 
' draw centered text in the picture control
Dim cx As Single
Dim cy As Single
pictCounter.Line (0, 0)-(pictCounter.ScaleWidth, pictCounter.ScaleHeight), RGB(0, 0, 255), BF
cx = pictCounter.TextWidth(s) 
cy = pictCounter.TextHeight(s) 
pictCounter.CurrentX = (pictCounter.ScaleWidth - cx) / 2
pictCounter.CurrentY = (pictCounter.ScaleHeight - cy) / 2
pictCounter.ForeColor = RGB(255, 255, 0) 
pictCounter.Print s
End Function

Private Sub cmdGenerate_Click()
Dim smpsrc As ltmmSampleSource
Dim mt As ltmmMediaType
Dim vih As VIDEOINFOHEADER
Dim viha As VIDEOINFOHEADERARRAY
Dim ms As ltmmMediaSample
Dim buf() As Byte
Dim frames As Integer

On Error GoTo BadFrames
frames = CInt(txtFrames.Text) 

' create sample source object
Set smpsrc = New ltmmSampleSource


' create a new media type wrapper
Set mt = New ltmmMediaType

' set the type to 24-bit RGB video
mt.Type = "{73646976-0000-0010-8000-00AA00389B71}" ' MEDIATYPE_Video
mt.Subtype = "{e436eb7d-524f-11ce-9f53-0020af0ba770}" ' MEDIASUBTYPE_RGB24

' setup the video info header
vih.bmiHeader.biCompression = 0 ' BI_RGB
vih.bmiHeader.biBitCount = 24
vih.bmiHeader.biSize = 40
vih.bmiHeader.biWidth = pictCounter.ScaleX(pictCounter.ScaleWidth, pictCounter.ScaleMode, vbPixels) 
vih.bmiHeader.biHeight = pictCounter.ScaleY(pictCounter.ScaleHeight, pictCounter.ScaleMode, vbPixels) 
vih.bmiHeader.biPlanes = 1
vih.bmiHeader.biSizeImage = (((vih.bmiHeader.biWidth * 3) + 3) And &HFFFFFFFC) * vih.bmiHeader.biHeight
vih.bmiHeader.biClrImportant = 0
vih.AvgTimePerFrame.lowpart = (10000000# / 15#)
vih.dwBitRate = vih.bmiHeader.biSizeImage * 8 * 15

' set the format
mt.FormatType = "{05589f80-c356-11ce-bf01-00aa0055595a}" ' FORMAT_VideoInfo
LSet viha = vih
mt.SetFormatData 88, viha.buffer


' set fixed size samples matching the bitmap size
mt.SampleSize = vih.bmiHeader.biSizeImage
mt.FixedSizeSamples = True


' assign the source media type
smpsrc.SetMediaType mt


' select the LEAD compressor
ltmmConvertCtrl1.VideoCompressors.Selection = ltmmConvertCtrl1.VideoCompressors.Find("@device:sw:{33D9A760-90C8-11D0-BD43-00A0C911CE86}\LEAD MCMP/MJPEG Codec A COmpressor Also known as an encoder, this is a module or algorithm to compress data. Playing that data back requires a decompressor, or decoder. combined with a DECompressor, or encoder Also known as compressor, this is a module or algorithm to compress data. Playing that data back requires a decompressor, or decoder. and a decoder Also known as a decompressor, this is a module or algorithm to decompress data., which allows you to both compress and decompress that same data. (2.0)")
' assign the converter source
ltmmConvertCtrl1.SourceObject = smpsrc
' set the output file name
ltmmConvertCtrl1.TargetFile = txtFile.Text

' need a buffer to hold the bitmap bits
ReDim buf(vih.bmiHeader.biSizeImage) 

On Error GoTo ConvertError
ltmmConvertCtrl1.StartConvert
For i = 1 To frames
    DrawCenteredText CStr(i) 
    pictCounter.Refresh
    GetDIBits pictCounter.hDC, pictCounter.Image, 0, vih.bmiHeader.biHeight, buf(0), vih.bmiHeader, 0
    Set ms = smpsrc.GetSampleBuffer (1000) 
    ms.SyncPoint = True
    ms.SetData vih.bmiHeader.biSizeImage, buf
    ms.SetTime 0, frames - 1, 0, frames
    smpsrc.DeliverSample 1000, ms
    ' critical that we release the sample buffer so that we can get another
    Set ms = Nothing
Next
smpsrc.DeliverEndOfStream 1000
Exit Sub

BadFrames: 
    MsgBox "Illegal frame count... Please enter an integer greater than 1"
    Exit Sub
ConvertError: 
    MsgBox "Error generating file... procedure aborted." 
    Exit Sub
End Sub


Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
txtFrames.Text = CStr(30) 
txtFile.Text = "c:\count.avi"
pictCounter.Move pictCounter.Left, pictCounter.Top, pictCounter.ScaleX(321, vbPixels) + (pictCounter.Width - pictCounter.ScaleWidth), pictCounter.ScaleY(241, vbPixels) + (pictCounter.Height - pictCounter.ScaleHeight) 
pictCounter.FontName = "Arial"
pictCounter.FontSize = pictCounter.ScaleY(pictCounter.ScaleHeight, pictCounter.ScaleMode, vbPoints) 
pictCounter.AutoRedraw = True
DrawCenteredText "?"
End Sub