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