03-22-2025, 08:00 PM
I've been wanting this for a really long time. A program that creates a valid AVI format with sound. The following program only creates (does not play) an uncompressed AVI file, which also contains uncompressed stereo audio. For this reason, prepare about 180 megabytes of free disk space for the test. I think it's already quite complicated, so if I add compression to it, it would be much more complicated. I will deal with compression, but I don't know how far I will get, because I encounter many obstacles.
I must warn you that Windows Media Player blurs the image due to the player's internal filters, VLC player has the best outputs. MPC-HC plays it too, but it rotates the image. I can rotate the image in AVI, but then it is rotated again in Windows Media Player and in VLC. It's kind of a beginning... and also an extreme. First I deal with compression in GIF and save every byte and now tens of MegaBytes are no big deal...
It's uncompressed, so expect a data rate somewhere around 60 megabytes per second. QB64PE can handle that speed just fine.
I must warn you that Windows Media Player blurs the image due to the player's internal filters, VLC player has the best outputs. MPC-HC plays it too, but it rotates the image. I can rotate the image in AVI, but then it is rotated again in Windows Media Player and in VLC. It's kind of a beginning... and also an extreme. First I deal with compression in GIF and save every byte and now tens of MegaBytes are no big deal...
It's uncompressed, so expect a data rate somewhere around 60 megabytes per second. QB64PE can handle that speed just fine.
Code: (Select All)
' Program creates an uncompressed AVI file with uncompressed animation and uncompressed audio.
' The uncompressed format is easier to understand, though I discovered that the AVI file itself
' is a topic suitable for psychiatry... 
' -------------------------
' Structure Definitions
' -------------------------
Type AVIMainHeader
microSecPerFrame As Long ' Microseconds per frame
maxBytesPerSec As Long ' Maximum data rate
paddingGranularity As Long ' Padding granularity
flags As Long ' AVI flags (e.g., HASINDEX)
totalFrames As Long ' Total number of frames in the video
initialFrames As Long ' Initial frames (typically 0)
streams As Long ' Number of streams (video, audio, etc.)
suggestedBufferSize As Long ' Suggested buffer size for playback
width As Long ' Video width in pixels
height As Long ' Video height in pixels
reserved As String * 16 ' Reserved bytes (set to 0)
End Type
Type AVIStreamHeader
fccType As String * 4 ' Stream type (e.g., "vids" or "auds")
fccHandler As String * 4 ' Codec handler (e.g., "DIB " for uncompressed video)
flags As Long ' Stream flags
priority As Integer ' Priority (unused)
language As Integer ' Language code (unused)
initialFrames As Long ' Initial frames (unused)
scale As Long ' Time scale for the stream
rate As Long ' Data rate (scale/rate = FPS for video)
start As Long ' Start time (usually 0)
length As Long ' Length of the stream (in time units)
suggestedBufferSize As Long ' Suggested buffer size for the stream
quality As Long ' Quality indicator (-1 for default)
sampleSize As Long ' Sample size (0 for video, nonzero for audio)
frameLeft As Long ' For video: left coordinate of the source rectangle
frameTop As Long ' For video: top coordinate of the source rectangle
frameRight As Long ' For video: right coordinate of the source rectangle
frameBottom As Long ' For video: bottom coordinate of the source rectangle
End Type
Type BITMAPINFOHEADER
size As Long ' Size of this header (40 bytes)
width As Long ' Width of the image in pixels
height As Long ' Height of the image (negative for top–down)
planes As Integer ' Number of color planes (must be 1)
bitCount As Integer ' Bits per pixel (24 for 24-bit, 32 for 32-bit)
compression As Long ' Compression method (0 = BI_RGB for uncompressed)
sizeImage As Long ' Size of the image data in bytes
xPelsPerMeter As Long ' Horizontal resolution (pixels per meter)
yPelsPerMeter As Long ' Vertical resolution (pixels per meter)
clrUsed As Long ' Number of colors used (0 = all)
clrImportant As Long ' Number of important colors (0 = all)
End Type
Type WAVEFORMATEX
wFormatTag As Integer ' Audio format code (1 = PCM)
nChannels As Integer ' Number of audio channels (2 for stereo)
nSamplesPerSec As Long ' Sample rate in Hz
nAvgBytesPerSec As Long ' Average bytes per second
nBlockAlign As Integer ' Block alignment in bytes
wBitsPerSample As Integer ' Bits per sample (16 for 16-bit PCM)
cbSize As Integer ' Extra size (0 for PCM)
End Type
' -------------------------
' Video Constants
' -------------------------
Const vidFPS = 30 ' Frames per second for the video
Const bytesPerPixel = 4 ' Each pixel in 32-bit image (BGRA) takes 4 bytes
' -------------------------
' Video Parameters
' -------------------------
Dim numFrames As Long: numFrames = 90 ' 90 frames = 3 seconds of video
Dim frameWidth As Long: frameWidth = 800 ' Video width in pixels
Dim frameHeight As Long: frameHeight = 600 ' Video height in pixels
Dim frameSize As Long: frameSize = frameWidth * frameHeight * bytesPerPixel ' Total size of one 32-bit frame
' -------------------------
' Create Test Frame Array
' -------------------------
Dim Frames(1 To numFrames) As String
Dim i As Long, s As String, sm As _MEM
s = Space$(frameSize)
$If WIN Then
pad$ = "\"
$Else
pad$ = "/"
$End If
fn$ = _CWD$ + pad$ + "VideoTest.avi"
Print "Generating file "; fn$
preDest = _Dest ' Save current destination settings
For i = 1 To numFrames
Dim img As Long, img2 As Long
img2 = _NewImage(frameWidth, frameHeight, 32)
_Dest img2 ' Set current destination to img2
Cls ' Set not transparent background in frame
_PrintMode _KeepBackground
' Draw 100 random colored lines
For x = 1 To 100
Line (Rnd * 50, Rnd * 50)-(Rnd * 750, Rnd * 550), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), B
Next
' Print frame number text at a fixed position
_PrintString (350, 250), "Video Frame " + Str$(i), img2
img = _NewImage(frameWidth, frameHeight, 32)
' For VLC Player use this line:
' _PutImage (0, 0), img2, img, (0, frameHeight)-(frameWidth, 0)
' For WMP, MPC-HC Player use:
_PutImage (0, 0), img2, img
_FreeImage img2
sm = _MemImage(img)
_MemGet sm, sm.OFFSET, s
_MemFree sm
_FreeImage img
Frames(i) = s ' Store frame data as string
Next i
_Dest preDest ' Restore previous destination
' -------------------------
' Simulate Audio
' -------------------------
Dim sampleRate As Long: sampleRate = 44100 ' Audio sample rate in Hz
Dim totalSeconds As Long: totalSeconds = numFrames \ vidFPS ' Duration of video in seconds
Dim totalSamplesPerChannel As Long: totalSamplesPerChannel = totalSeconds * sampleRate
Dim totalSamples As Long: totalSamples = totalSamplesPerChannel * 2 ' Stereo: two channels
ReDim audioSamples(1 To totalSamples) As Integer
' Generate a tone with panning effect (from left to right)
Dim freq As Single: freq = 500 ' Starting frequency in Hz
Dim As Integer SampleL, SampleR ' Variables for left and right channel samples
Dim t As Single, normAmp As Single: normAmp = 0.9
For i = 1 To totalSamplesPerChannel - 1
t = i / sampleRate
' Calculate pan value from 0 (left) to 1 (right)
pan = i / (totalSamplesPerChannel - 1)
' Left channel amplitude = 0.9*(1 - pan), right channel amplitude = 0.9*pan
If Rnd * 10 > 5 Then f = 5 Else f = -5
freq = freq + f
SampleL = 32767 * 0.9 * (1 - pan) * Sin(2 * 3.14159 * freq * t)
SampleR = 32767 * 0.9 * pan * Sin(2 * 3.14159 * freq * t)
audioSamples(2 * i + 1) = SampleL
audioSamples(2 * i + 2) = SampleR
Next i
' ---------------------------
' Create AVI file with audio
' ---------------------------
If _FileExists("VideoTest.avi") Then Kill "VideoTest.avi"
CreateAVI Frames(), frameWidth, frameHeight, numFrames, audioSamples(), sampleRate
Print "File created. Open it with your media player program. Recommended is VLC Player."
' -------------------------------------------------------------
' Function to write an AVI file with video + audio (16-bit PCM)
' -------------------------------------------------------------
Sub CreateAVI (Frames() As String, frameWidth As Long, frameHeight As Long, _
numFrames As Long, audioSamples() As Integer, sampleRate As Long)
Dim frameSize As Long: frameSize = frameWidth * frameHeight * bytesPerPixel
Dim fileNum As Integer: fileNum = FreeFile
Open "VideoTest.avi" For Binary As #fileNum
Dim videoDuration As Long
videoDuration = numFrames \ vidFPS
Dim totalAudioSamples As Long
totalAudioSamples = UBound(audioSamples)
Dim stereoFrames As Long
stereoFrames = totalAudioSamples \ 2
' -------------------------------------------
' Define chunk index structure for AVI index
' -------------------------------------------
Type ChunkIndex
chunkID As String * 4 ' Chunk identifier (e.g., "00db" for video, "01wb" for audio)
flags As Long ' Flags (e.g., keyframe flag)
offset As Long ' Offset of chunk data from start of 'movi' section
size As Long ' Size of chunk data in bytes
End Type
Dim maxChunks As Long
maxChunks = numFrames + videoDuration + 10
Dim idxArr(1 To maxChunks) As ChunkIndex
Dim idxCount As Long: idxCount = 0
' --------------------------------------------------------
' RIFF and AVI chunks
' --------------------------------------------------------
Dim riffHeader As String: riffHeader = "RIFF"
Dim tmpStr As String: tmpStr = riffHeader
Put #fileNum, , tmpStr
Dim riffSizePos As Long: riffSizePos = LOF(fileNum) + 1
Dim dummyLong As Long: dummyLong = 0
Put #fileNum, , dummyLong ' placeholder for RIFF size
Dim aviSig As String: aviSig = "AVI "
tmpStr = aviSig
Put #fileNum, , tmpStr
' --------------------------------------------------------
' LIST hdrl chunk (header list)
' --------------------------------------------------------
Dim listHdrl As String: listHdrl = "LIST"
tmpStr = listHdrl
Put #fileNum, , tmpStr
Dim hdrlSizePos As Long: hdrlSizePos = LOF(fileNum) + 1
Put #fileNum, , dummyLong ' placeholder for hdrl size
Dim hdrlSig As String: hdrlSig = "hdrl"
tmpStr = hdrlSig
Put #fileNum, , tmpStr
' --------------------------------------------------------
' avih chunk (Main AVI header)
' --------------------------------------------------------
Dim avihChunkID As String: avihChunkID = "avih"
tmpStr = avihChunkID
Put #fileNum, , tmpStr
Dim avihChunkSize As Long: avihChunkSize = 56
Put #fileNum, , avihChunkSize
Dim mainHdr As AVIMainHeader
mainHdr.microSecPerFrame = 1000000 \ vidFPS
mainHdr.maxBytesPerSec = frameSize * vidFPS
mainHdr.paddingGranularity = 0
mainHdr.flags = &H110 ' AVIF_HASINDEX flag
mainHdr.totalFrames = numFrames
mainHdr.initialFrames = 0
mainHdr.streams = 2 ' 2 streams: video + audio (stereo is 1 stream and mono also)
mainHdr.suggestedBufferSize = frameSize
mainHdr.width = frameWidth
mainHdr.height = frameHeight
mainHdr.reserved = String$(16, Chr$(0))
Put #fileNum, , mainHdr
' --------------------------------------------------------
' LIST strl chunk for video stream
' --------------------------------------------------------
Dim listStrlVid As String: listStrlVid = "LIST"
tmpStr = listStrlVid
Put #fileNum, , tmpStr
Dim strlVidSizePos As Long: strlVidSizePos = LOF(fileNum) + 1
Put #fileNum, , dummyLong
Dim strlVidSig As String: strlVidSig = "strl"
tmpStr = strlVidSig
Put #fileNum, , tmpStr
' -- strh (video stream header)
Dim strhVidID As String: strhVidID = "strh"
tmpStr = strhVidID
Put #fileNum, , tmpStr
Dim strhVidSize As Long: strhVidSize = 64
Put #fileNum, , strhVidSize
Dim streamHdrVid As AVIStreamHeader
streamHdrVid.fccType = "vids"
streamHdrVid.fccHandler = "DIB " ' Uncompressed video (DIB)
streamHdrVid.flags = 0
streamHdrVid.priority = 0
streamHdrVid.language = 0
streamHdrVid.initialFrames = 0
streamHdrVid.scale = 1
streamHdrVid.rate = vidFPS
streamHdrVid.start = 0
streamHdrVid.length = numFrames
streamHdrVid.suggestedBufferSize = frameSize
streamHdrVid.quality = -1
streamHdrVid.sampleSize = 0
streamHdrVid.frameLeft = 0
streamHdrVid.frameTop = 0
streamHdrVid.frameRight = frameWidth
streamHdrVid.frameBottom = frameHeight
Put #fileNum, , streamHdrVid
' --------------------------------------------------------
' -- strf (video format chunk) -> BITMAPINFOHEADER
' --------------------------------------------------------
Dim strfVidID As String: strfVidID = "strf"
tmpStr = strfVidID
Put #fileNum, , tmpStr
Dim strfVidSize As Long: strfVidSize = 40
Put #fileNum, , strfVidSize
Dim bmpInfo As BITMAPINFOHEADER
bmpInfo.size = 40
bmpInfo.width = frameWidth
bmpInfo.height = -frameHeight ' Negative height indicates top-down format
bmpInfo.planes = 1
bmpInfo.bitCount = 32
bmpInfo.compression = 0 ' BI_RGB = uncompressed
bmpInfo.sizeImage = frameSize
bmpInfo.xPelsPerMeter = 0
bmpInfo.yPelsPerMeter = 0
bmpInfo.clrUsed = 0
bmpInfo.clrImportant = 0
Put #fileNum, , bmpInfo
Dim currPos As Long
currPos = LOF(fileNum) + 1
Dim calcStrlVidSize As Long: calcStrlVidSize = currPos - strlVidSizePos - 4
Seek #fileNum, strlVidSizePos
Put #fileNum, , calcStrlVidSize
Seek #fileNum, currPos
' --------------------------------------------------------
' LIST strl chunk for audio stream
' --------------------------------------------------------
Dim listStrlAud As String: listStrlAud = "LIST"
tmpStr = listStrlAud
Put #fileNum, , tmpStr
Dim strlAudSizePos As Long: strlAudSizePos = LOF(fileNum) + 1
Put #fileNum, , dummyLong
Dim strlAudSig As String: strlAudSig = "strl"
tmpStr = strlAudSig
Put #fileNum, , tmpStr
' --------------------------------------------------------
' -- strh (audio stream header)
' --------------------------------------------------------
Dim strhAudID As String: strhAudID = "strh"
tmpStr = strhAudID
Put #fileNum, , tmpStr
Dim strhAudSize As Long: strhAudSize = 64
Put #fileNum, , strhAudSize
Dim streamHdrAud As AVIStreamHeader
streamHdrAud.fccType = "auds"
streamHdrAud.fccHandler = String$(4, 0) ' For PCM audio, this is typically empty
streamHdrAud.flags = 0
streamHdrAud.priority = 0
streamHdrAud.language = 0
streamHdrAud.initialFrames = 0
streamHdrAud.scale = 1
streamHdrAud.rate = sampleRate
streamHdrAud.start = 0
streamHdrAud.length = stereoFrames
streamHdrAud.suggestedBufferSize = sampleRate * 4 ' 2 channels x 2 bytes per sample (is used 16bit stereo waveform sound, 1 integer to 1 sample)
streamHdrAud.quality = -1
streamHdrAud.sampleSize = 4 ' 4 bytes per stereo sample (2 bytes left + 2 bytes right)
streamHdrAud.frameLeft = 0
streamHdrAud.frameTop = 0
streamHdrAud.frameRight = 0
streamHdrAud.frameBottom = 0
Put #fileNum, , streamHdrAud
' --------------------------------------------------------
' -- strf (audio format chunk) -> WAVEFORMATEX (16 bytes)
' --------------------------------------------------------
Dim strfAudID As String: strfAudID = "strf"
tmpStr = strfAudID
Put #fileNum, , tmpStr
Dim strfAudSize As Long: strfAudSize = 16
Put #fileNum, , strfAudSize
Dim wf As WAVEFORMATEX
wf.wFormatTag = 1
wf.nChannels = 2
wf.nSamplesPerSec = sampleRate
wf.wBitsPerSample = 16
wf.nBlockAlign = wf.nChannels * (wf.wBitsPerSample \ 8)
wf.nAvgBytesPerSec = wf.nSamplesPerSec * wf.nBlockAlign
wf.cbSize = 0
Put #fileNum, , wf
currPos = LOF(fileNum) + 1
Dim calcStrlAudSize As Long: calcStrlAudSize = currPos - strlAudSizePos - 4
Seek #fileNum, strlAudSizePos
Put #fileNum, , calcStrlAudSize
Seek #fileNum, currPos
currPos = LOF(fileNum) + 1
Dim hdrlSize As Long: hdrlSize = currPos - hdrlSizePos - 4
Seek #fileNum, hdrlSizePos
Put #fileNum, , hdrlSize
Seek #fileNum, currPos
' ----------------------------------------------------------
' LIST movi chunk (contains the actual video and audio data)
' ----------------------------------------------------------
Dim listMovi As String: listMovi = "LIST"
tmpStr = listMovi
Put #fileNum, , tmpStr
Dim moviSizePos As Long: moviSizePos = LOF(fileNum) + 1
Put #fileNum, , dummyLong
Dim moviSig As String: moviSig = "movi"
tmpStr = moviSig
Put #fileNum, , tmpStr
Dim moviDataStart As Long: moviDataStart = LOF(fileNum) + 1
' --------------------------------------------------------------
' Interleaved writing of video and audio chunks:
' For each second: 30 video frames and 1 audio chunk (1 second) - this solution MUST NOT BE ALWAYS OPTIMAL! is possible writing sound data after every 5 th frame...
' --------------------------------------------------------------
Dim framesPerSec As Long: framesPerSec = vidFPS
Dim videoIndex As Long: videoIndex = 1
Dim sec As Long
For sec = 1 To videoDuration
' Write video chunks
Dim f As Long
For f = 1 To framesPerSec
If videoIndex > numFrames Then Exit For
Dim chunkOffset As Long
chunkOffset = LOF(fileNum) - moviDataStart + 1
Dim frameChunkID As String: frameChunkID = "00db"
tmpStr = frameChunkID
Put #fileNum, , tmpStr
Dim currFrameSize As Long: currFrameSize = frameSize
Put #fileNum, , currFrameSize
Put #fileNum, , Frames(videoIndex)
If (currFrameSize Mod 2) <> 0 Then
Dim padByte As String: padByte = Chr$(0)
Put #fileNum, , padByte
End If
idxCount = idxCount + 1
idxArr(idxCount).chunkID = frameChunkID
idxArr(idxCount).flags = &H10 ' Keyframe flag
idxArr(idxCount).offset = chunkOffset
idxArr(idxCount).size = currFrameSize
videoIndex = videoIndex + 1
Next f
' Write audio chunk for the current second
Dim chunkOffsetAud As Long
chunkOffsetAud = LOF(fileNum) - moviDataStart + 1
Dim audioChunkID As String: audioChunkID = "01wb"
tmpStr = audioChunkID
Put #fileNum, , tmpStr
Dim audioChunkSize As Long
audioChunkSize = sampleRate * 2 * 2 ' 1 second = sampleRate * (2 channels x 2 bytes)
Put #fileNum, , audioChunkSize
Dim startAud As Long: startAud = (sec - 1) * (sampleRate * 2) + 1
Dim endAud As Long: endAud = startAud + (sampleRate * 2) - 1
If endAud > UBound(audioSamples) Then endAud = UBound(audioSamples)
Dim k As Long
Dim audioBuffer As String
audioBuffer = ""
Dim sampleValue As Integer
Dim uVal As Long
For k = startAud To endAud
sampleValue = audioSamples(k)
uVal = sampleValue And &HFFFF ' Convert to 16-bit two's complement representation
audioBuffer = audioBuffer + Chr$(uVal And &HFF) + Chr$((uVal \ 256) And &HFF)
Next k
Put #fileNum, , audioBuffer
If (audioChunkSize Mod 2) <> 0 Then
Dim padByteAud As String: padByteAud = Chr$(0)
Put #fileNum, , padByteAud
End If
idxCount = idxCount + 1
idxArr(idxCount).chunkID = audioChunkID
idxArr(idxCount).flags = 0
idxArr(idxCount).offset = chunkOffsetAud
idxArr(idxCount).size = audioChunkSize
Next sec
currPos = LOF(fileNum) + 1
Dim moviSize As Long
moviSize = currPos - moviSizePos - 4
Seek #fileNum, moviSizePos
Put #fileNum, , moviSize
Seek #fileNum, currPos
Dim riffSize As Long
riffSize = LOF(fileNum) - 8 + 1
Seek #fileNum, riffSizePos
Put #fileNum, , riffSize
Seek #fileNum, LOF(fileNum) + 1
Dim idxHeader As String: idxHeader = "idx1"
tmpStr = idxHeader
Put #fileNum, , tmpStr
Dim idxSize As Long: idxSize = idxCount * 16
Put #fileNum, , idxSize
Dim n As Long
For n = 1 To idxCount
Put #fileNum, , idxArr(n).chunkID
Put #fileNum, , idxArr(n).flags
Put #fileNum, , idxArr(n).offset
Put #fileNum, , idxArr(n).size
Next n
Close #fileNum
End Sub