I used your code as a basis but refactored several things.
There is now one big AVI header type that is rewritten in the end.
Also image and audiosamples are now generated inline so no mem limit anymore.
You can now create AVI's up to 4GB (I think that is some AVI limit?)
There is now one big AVI header type that is rewritten in the end.
Also image and audiosamples are now generated inline so no mem limit anymore.
You can now create AVI's up to 4GB (I think that is some AVI limit?)
Code: (Select All)
CreateAVI "VideoTest.avi", 3, 800, 600, 30, 44100
Sub CreateAVI (avi$, videoDuration As Integer, frameWidth As Long, frameHeight As Long, vidFPS As Integer, sampleRate As Long)
Const bytesPerPixel = 4
Type AVIheader
riffHeader As String * 4
riffSize As Long
aviSig As String * 4
listHdrl As String * 4
hdrlSize As Long ' Size from hdrlSig to cbSize (74*4 + 7*2)
hdrlSig As String * 4
avihChunkID As String * 4
avihChunkSize As Long
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
vwidth As Long ' Video width in pixels
vheight As Long ' Video height in pixels
reserved As String * 16 ' Reserved bytes (set to 0)
listStrlVid As String * 4
strlVidSize As Long ' Size from strlVidSig to clrImportant (=31*4)
strlVidSig As String * 4
strhVidID As String * 4
strhVidSize As Long
fccType As String * 4 ' Stream type (e.g., "vids" or "auds")
fccHandler As String * 4 ' Codec handler (e.g., "DIB " for uncompressed video)
streamflags As Long ' Stream flags
priority As Integer ' Priority (unused)
language As Integer ' Language code (unused)
initialFrames0 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)
streamSuggestedBufferSize 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
strfVidID As String * 4
strfVidSize As Long
size As Long ' Size of this header (40 bytes)
iwidth As Long ' Width of the image in pixels
iheight 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)
listStrlAud As String * 4
strlAudSize As Long ' Size from strlAudSig to cbSize (22*4 + 7*2)
strlAudSig As String * 4
strhAudID As String * 4
strhAudSize As Long
afccType As String * 4 ' AUDIO Stream type (e.g., "vids" or "auds")
afccHandler As String * 4 ' AUDIO Codec handler (e.g., "DIB " for uncompressed video)
astreamflags As Long ' AUDIO Stream flags
apriority As Integer ' AUDIO Priority
alanguage As Integer ' AUDIO Language code
ainitialFrames As Long ' AUDIO Initial frames
ascale As Long ' AUDIO Time scale for the stream
arate As Long ' AUDIO Data rate (scale/rate = FPS for video)
astart As Long ' AUDIO Start time (usually 0)
alength As Long ' AUDIO Length of the stream (in time units)
astreamSuggestedBufferSize As Long ' AUDIO Suggested buffer size for the stream
aquality As Long ' AUDIO Quality indicator (-1 for default)
asampleSize As Long ' AUDIO Sample size (0 for video, nonzero for audio)
aframeLeft As Long ' AUDIO For video: left coordinate of the source rectangle
aframeTop As Long ' AUDIO For video: top coordinate of the source rectangle
aframeRight As Long ' AUDIO For video: right coordinate of the source rectangle
aframeBottom As Long ' AUDIO For video: bottom coordinate of the source rectangle
strfAudID As String * 4
strfAudSize As Long
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)
listMovi As String * 4
moviSize As Long
moviSig As String * 4
End Type
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 header As AVIheader
Dim numFrames As Long: numFrames = vidFPS * videoDuration
Dim frameSize As Long: frameSize = frameWidth * frameHeight * bytesPerPixel ' Total size of one 32-bit frame
Dim totalSamplesPerChannel As Long: totalSamplesPerChannel = videoDuration * sampleRate
Dim idxArr(1 To numFrames + videoDuration) As ChunkIndex
Dim idxCount As Long: idxCount = 0
If _FileExists(avi$) Then Kill avi$
Dim fileNum As Integer: fileNum = FreeFile: Open avi$ For Binary As #fileNum
header.riffHeader = "RIFF"
header.riffSize = 0
header.aviSig = "AVI "
header.listHdrl = "LIST"
header.hdrlSize = 74 * 4 + 7 * 2
header.hdrlSig = "hdrl"
header.avihChunkID = "avih"
header.avihChunkSize = 56
header.microSecPerFrame = 1000000 \ vidFPS
header.maxBytesPerSec = frameSize * vidFPS
header.paddingGranularity = 0
header.flags = &H110 ' AVIF_HASINDEX flag
header.totalFrames = numFrames
header.initialFrames = 0
header.streams = 2 ' 2 streams: video + audio (stereo is 1 stream and mono also)
header.suggestedBufferSize = frameSize
header.vwidth = frameWidth
header.vheight = frameHeight
header.reserved = String$(16, Chr$(0))
header.listStrlVid = "LIST"
header.strlVidSize = 29 * 4 + 4 * 2
header.strlVidSig = "strl"
header.strhVidID = "strh"
header.strhVidSize = 64
header.fccType = "vids"
header.fccHandler = "DIB " ' Uncompressed video (DIB)
header.streamflags = 0
header.priority = 0
header.language = 0
header.initialFrames = 0
header.scale = 1
header.rate = vidFPS
header.start = 0
header.length = numFrames
header.streamSuggestedBufferSize = frameSize
header.quality = -1
header.sampleSize = 0
header.frameLeft = 0
header.frameTop = 0
header.frameRight = frameWidth
header.frameBottom = frameHeight
header.strfVidID = "strf"
header.strfVidSize = 40
header.size = 40
header.iwidth = frameWidth
header.iheight = -frameHeight ' Negative height indicates top-down format
header.planes = 1
header.bitCount = 32
header.compression = 0 ' BI_RGB = uncompressed
header.sizeImage = frameSize
header.xPelsPerMeter = 0
header.yPelsPerMeter = 0
header.clrUsed = 0
header.clrImportant = 0
header.listStrlAud = "LIST"
header.strlAudSize = 22 * 4 + 7 * 2
header.strlAudSig = "strl"
header.strhAudID = "strh"
header.strhAudSize = 64
header.afccType = "auds"
header.afccHandler = String$(4, 0) ' For PCM audio, this is typically empty
header.astreamflags = 0
header.apriority = 0
header.alanguage = 0
header.ainitialFrames = 0
header.ascale = 1
header.arate = sampleRate
header.astart = 0
header.alength = totalSamplesPerChannel
header.astreamSuggestedBufferSize = sampleRate * 4 ' 2 channels x 2 bytes per sample (is used 16bit stereo waveform sound, 1 integer to 1 sample)
header.aquality = -1
header.asampleSize = 4 ' 4 bytes per stereo sample (2 bytes left + 2 bytes right)
header.aframeLeft = 0
header.aframeTop = 0
header.aframeRight = 0
header.aframeBottom = 0
header.strfAudID = "strf"
header.strfAudSize = 16
header.wFormatTag = 1
header.nChannels = 2
header.nSamplesPerSec = sampleRate
header.wBitsPerSample = 16
header.nBlockAlign = header.nChannels * (header.wBitsPerSample \ 8)
header.nAvgBytesPerSec = header.nSamplesPerSec * header.nBlockAlign
header.cbSize = 0
header.listMovi = "LIST"
header.moviSize = 0
header.moviSig = "movi"
Put #fileNum, , header
Dim moviDataStart As Long: moviDataStart = Seek(fileNum)
' --------------------------------------------------------------
' 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 chunkOffset As Long
Dim frameChunkID As String: frameChunkID = "00db"
Dim padByte As String: padByte = Chr$(0)
Dim chunkOffsetAud As Long
Dim audioChunkID As String: audioChunkID = "01wb"
Dim audioChunkSize As Long
Dim As Integer SampleL, SampleR 'Variables for left and right channel samples
Dim sm As _MEM
Dim img As Long: img = _NewImage(frameWidth, frameHeight, 32)
'Dim img2 As Long: img2 = _NewImage(frameWidth, frameHeight, 32)
Dim freq As Single: freq = 500 'Starting frequency in Hz
Dim videoIndex As Long: videoIndex = 0
Dim frame As String: frame = Space$(frameSize)
For sec% = 1 To videoDuration
Locate , 1, 0: Print sec%; '@@
' Write video chunks
For i% = 1 To vidFPS
chunkOffset = Seek(fileNum) - moviDataStart
Put #fileNum, , frameChunkID
Put #fileNum, , frameSize
videoIndex = videoIndex + 1
_Dest img '@@
Cls: _PrintMode _KeepBackground
For j% = 1 To 100
Line (Rnd * frameWidth, Rnd * frameHeight)-(Rnd * frameWidth, Rnd * frameHeight), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), B
Next j%
_PrintString (350, 250), "Video Frame " + _ToStr$(videoIndex)
_Dest 0
'_PutImage (0, 0), img, img2, (0, frameHeight)-(frameWidth, 0) ' For VLC Player
'_PutImage (0, 0), img, img2 ' For WMP, MPC-HC Player
sm = _MemImage(img)
frame = Space$(frameSize)
_MemGet sm, sm.OFFSET, frame
_MemFree sm
Put #fileNum, , frame
If (frameSize Mod 2) <> 0 Then Put #fileNum, , padByte
idxCount = idxCount + 1
idxArr(idxCount).chunkID = frameChunkID
idxArr(idxCount).flags = &H10 ' Keyframe flag
idxArr(idxCount).offset = chunkOffset
idxArr(idxCount).size = frameSize
Next i%
' Write audio chunk for the current second
chunkOffsetAud = Seek(fileNum) - moviDataStart
Put #fileNum, , audioChunkID
audioChunkSize = sampleRate * 2 * 2 ' 1 second = sampleRate * (2 channels x 2 bytes)
Put #fileNum, , audioChunkSize
audioBuffer$ = String$(sampleRate * 4, 0)
For l& = 0 To sampleRate - 1
t! = l& / sampleRate: pan! = l& / totalSamplesPerChannel
freq = freq + 5 - 10 * Int(Rnd * 2)
SampleL = (32767 * 0.9 * (1 - pan!) * Sin(2 * 3.14159 * freq * t!)) And &HFFFF
SampleR = (32767 * 0.9 * pan! * Sin(2 * 3.14159 * freq * t!)) And &HFFFF
Asc(audioBuffer$, l& * 4 + 1) = SampleL And &HFF
Asc(audioBuffer$, l& * 4 + 2) = (SampleL \ 256) And &HFF
Asc(audioBuffer$, l& * 4 + 3) = SampleR And &HFF
Asc(audioBuffer$, l& * 4 + 4) = (SampleR \ 256) And &HFF
Next l&
Put #fileNum, , audioBuffer$
idxCount = idxCount + 1
idxArr(idxCount).chunkID = audioChunkID
idxArr(idxCount).flags = 0
idxArr(idxCount).offset = chunkOffsetAud
idxArr(idxCount).size = audioChunkSize
Next sec%
_Dest 0
_FreeImage img
currPos = Seek(fileNum)
header.moviSize = currPos - moviSizePos - 4
header.riffSize = Seek(fileNum) - 8
Dim idxHeader As String: idxHeader = "idx1": Put #fileNum, , idxHeader
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
Put #fileNum, 1, header
Close #fileNum
Print
End Sub
45y and 2M lines of MBASIC>BASICA>QBASIC>QBX>QB64 experience