Code: Select all
ReDim rgb_buff ( l * 3 + 1 ) As uByte
For i=l To 0 Step -1
rgb_buff(( _count * 3 )) = rgbptr[i].r
rgb_buff(( _count * 3 ) + 1 ) = rgbptr[i].g
rgb_buff(( _count * 3 ) + 2 ) = rgbptr[i].b
_count += 1
Next
_count = 0
Put #hfile, , rgb_buff ()Code: Select all
' AVI File Creator
' Copyright by D.J.Peters (Joshy)
' 8/2005 FreeBASICForum.de
' www.freebasicforum.de
Option Explicit
' vour caractercode to string
#Define cc4_to_Str(c) Chr$(c And &h000000FF,(c And &h0000FF00) Shr 8,(c And &h00FF0000) Shr 16,(c And &hFF000000) Shr 24)
Const AVIF_HASINDEX As uInteger = &H10 ' Index at end of file?
Const AVIF_MUSTUSEINDEX As uInteger = &H20
Const AVIF_ISINTERLEAVED As uInteger = &H100
Const AVIF_TRUSTCKTYPE As uInteger = &H800 ' Use CKType to find key frames?
Const AVIF_WASCAPTUREFILE As uInteger = &H10000
Const AVIF_COPYRIGHTED As uInteger = &H20000
'!!! string * 4 don't work in binary mode !!!
Const RIFF As uInteger = &H46464952 '"RIFF"
Const AVI_ As uInteger = &H20495641 '"AVI "
Const LIST As uInteger = &H5453494c '"LIST"
Const hdrl As uInteger = &H6c726468 '"hdrl" Headerlist
Const avih As uInteger = &H68697661 '"avih" AVIheader
Const strl As uInteger = &H6c727473 '"strl" Streamlist
Const strh As uInteger = &H68727473 '"strh" Streamheader
Const vids As uInteger = &H73646976 '"vids" Videostream
Const auds As uInteger = &H73647561 '"auds" Audiostream
Const DIB_ As uInteger = &H20424944 '"DIB " Device independent bitmap
Const strf As uInteger = &H66727473 '"strf" Streamformat
Const movi As uInteger = &H69766f6d '"movi" on filepos 2036 LIST size "movie"
Const nndb As uInteger = &H62643030 '"00db" Stream 00 DIB bytes
Const nndc As uInteger = &H62643030 '"00dc" Stream 00 DIB compressed
Const nnwb As uInteger = &H62773030 '"01wb" Stream 01 Wave bytes
Const idx1 As uInteger = &H31786469 '"idx1" 'Indexlist
Const JUNK As uInteger = &H4b4e554a '"JUNK"
Type AVIRGB
r As Byte
g As Byte
b As Byte
a As Byte
End Type
Type AVIFILE
RIFFChunk As uInteger '0 "RIFF"
RIFFSize As uInteger '4 '2048 + n * (imagesize+8+16)
AVI_Chunk As uInteger '8 "AVI "
AVILISTChunk As uInteger '12 "LIST"
AVILISTSize As uInteger '16 (192)
hdrlChunk As uInteger '20 "hdrl"
avihChunk As uInteger '24 "avih"
avihSize As uInteger '28 (56)
aviMicroSecPerFrame As uInteger '32 4 (0) frame display rate (or 0L)
aviMaxBytesPerSec As uInteger '36 8 (0) max. transfer rate
aviPaddingGranularity As uInteger '40 12 (0) pad to multiples of this size as long normally 2K.
aviFlag As uInteger '44 16 (&H810)
aviTotalFrames As uInteger '48 20 (number of frames)
aviInitFrames As uInteger '52 24 (0)
aviStreams As uInteger '56 28 (1)
aviSuggestedBufferSize As uInteger '60 32 (w*h*3)
aviWidth As uInteger '64 36 (w)
aviHeight As uInteger '68 40 (h)
aviReserved1 As uInteger '72 44 (0)
aviReserved2 As uInteger '76 48 (0)
aviReserved3 As uInteger '80 52 (0)
aviReserved4 As uInteger '84 56 (0)
STREAMLISTChunk As uInteger '88 "LIST"
STREAMLISTSize As uInteger '92 (116)
strlChunk As uInteger '96 "strl"
strhChunk As uInteger '100 "strh"
strhSize As uInteger '104 (56)
fccType As uInteger '108 4 "vids"
fccHandler As uInteger '112 8 "DIB "
dwAVITF_ As uInteger '116 12 (0)
wPriority As uShort '120 14 (0)
wLanguage As uShort '122 16 (0)
dwInitFrames As uInteger '124 20 (0)
dwScale As uInteger '128 24 (1)
dwRate As uInteger '132 28 (frames per second) dwRate / dwScale = samples/second
dwStart As uInteger '136 32 (0)
dwLength As uInteger '140 36 (number of frames)
dwSuggestedBufferSize As uInteger '144 40 (ImageSize)
dwQuality As uInteger '148 44 (10000)=100%
dwSampleSize As uInteger '152 48 (0)
wLeft As uShort '156 50 !!!(0)
wTop As uShort '158 52 (0)
wRight As uShort '160 54 (width)
wBottom As uShort '162 56 (height)
strfChunk As uInteger '164 "strf" Streamformat
strfSize As uInteger '168 (40)
FormatSize As uInteger '172 4 (40)
dwWidth As uInteger '176 8 (width)
dwHeight As uInteger '180 12 (height)
wPlanes As uShort '184 14 (1)
wBitcount As uShort '186 16 (24)
compression As uInteger '188 20 (0)
Imagesize As uInteger '192 24 (w * h * 3)
xpels As uInteger '196 28 (0)
ypels As uInteger '200 32 (0)
ColorsUsed As uInteger '204 36 (0)
ColorsImportent As uInteger '208 40 (0)
JUNK As uInteger '212 "JUNK"
JUNKSize As uInteger '216-220 (1816)=2036 ok
End Type
Type AVI_MOVI_LIST 'at 2036
LISTChunk As uInteger '2036 "LIST"
LISTSize As uInteger '2040
moviChunk As uInteger '2044 "movi"
End Type
Type AVI_MOVI_LIST_ENTRY 'at 2048
ChunkId As uInteger '2048 "00db" "00dc" or "01wb"
ChunkSize As uInteger '2052 (w*h*3) Bitmap or wave datasize
End Type
Type AVI_INDEX_LIST ' at 2048 + (num_of_frames * (8+Imagesize))
idx1Chunk As uInteger ' "idx1"
idx1Size As uInteger ' num_of_entry * 16 = Sizeof(index_entry)
End Type
Type AVI_INDEX_ENTRY
chunkid As uInteger ' "00db" "00dc" or "01wb"
dwAVIIF_ As uInteger ' (&H10) Keyframe
dwChunkOffset As uInteger ' Position of chunk
dwChunkLength As uInteger ' Length of chunk
End Type
Dim Shared avi As avifile
Function PrepareAVIFile(strFile As String,ByVal w As uInteger,ByVal h As uInteger,ByVal FramesPerSecond As uInteger) As Integer
Dim As Integer hFile
Dim As String pad
Dim As AVI_MOVI_LIST aml
With avi
.RIFFChunk = RIFF
.RIFFSize = 2040
.AVI_Chunk = AVI_
.AVILISTChunk =LIST
.AVILISTSize =192
.hdrlChunk =hdrl
.avihChunk =avih
.avihSize =56
.aviFlag =&h810
.aviTotalFrames=0
.aviStreams=1
.aviSuggestedBufferSize=w*h*3
.aviWidth=w
.aviHeight=h
.STREAMLISTChunk=LIST
.STREAMLISTSize =116
.strlChunk=strl
.strhChunk=strh
.strhSize=56
.fccType=vids
.fccHandler=DIB_
.dwScale=1
.dwRate=framespersecond
.dwLength=0
.dwSuggestedBufferSize=w*h*3
.dwQuality=10000
.wRight=w
.wBottom=h
.strfChunk=strf
.strfSize=40
.FormatSize=40
.dwWidth=w
.dwHeight=h
.wPlanes=1
.wBitcount=24
.compression=0
.Imagesize=w*h*3
.JUNK=JUNK
.JUNKSize=1816
End With
With aml
.LISTChunk = LIST
.moviChunk = movi
End With
hfile=FreeFile
Open strfile For Binary As #hfile
Put #hfile,,avi
pad=Space$(1816)
Put #hfile,,pad 'now 2036 bytes are written
Put #hfile,,aml 'now 2048 bytes are written
Function=hfile
End Function
Sub WriteInAVIFile(ByVal hfile As Integer)
Dim As Byte r,g,b
Dim rgbptr As AVIRGB Ptr
Dim As Integer i,l,n,c, _count
n=avi.aviTotalframes
l=(avi.aviWidth * avi.aviHeight)-1
c=nndb
Seek #hfile,2049+((8+avi.ImageSize)*n)
Put #hfile,,c
Put #hfile,,avi.ImageSize
ScreenLock
rgbptr=ScreenPtr
ReDim rgb_buff ( l * 3 + 1 ) As uByte
For i=l To 0 Step -1
rgb_buff(( _count * 3 )) = rgbptr[i].r
rgb_buff(( _count * 3 ) + 1 ) = rgbptr[i].g
rgb_buff(( _count * 3 ) + 2 ) = rgbptr[i].b
_count += 1
Next
_count = 0
Put #hfile, , rgb_buff ()
ScreenUnlock
avi.aviTotalframes+=1
End Sub
Sub CloseAVIFile(ByVal hFile)
Dim As AVI_INDEX_LIST ail
Dim As AVI_INDEX_ENTRY aie
Dim As Integer l,n,s,i
l=avi.ImageSize
n=avi.aviTotalFrames
'update number of total frames
Seek #hfile,49
Put #hfile,,avi.aviTotalFrames
Seek #hfile,141
Put #hfile,,avi.aviTotalFrames
s=4+n*(l+8)
'LIST xxxx movi xxxx= sizeoff(movi) + n*(8+imagesize)
Seek #hfile,2041
Put #hfile,,s
s=n*(l+8) '= n*(imagesize+sizeoff(dd00,imagesize))
Seek #hfile,2049+s
'idx1 xxxx xxxx=n*sizeoff(indexentry)
ail.idx1Chunk=idx1
ail.idx1Size =n*16
Put #hFile,,ail
'db00 flag offset size
aie.chunkid=nndb ' "00db"
aie.dwAVIIF_=&H10 ' Keyframe
aie.dwChunkLength=l ' imagesize
For i=0 To n-1
aie.dwChunkOffset=4+i*(l+8)
Put #hfile,,aie
Next
'RIFF xxxx "AVI "
' (idx1xxxx) imagesize+00dbxxxx+(00dd flag offset size)
s=2040 + 8 + n * (avi.imagesize+8+16)
Seek #hfile,5
Put #hfile,,s
Close #hFile
End Sub
'''
''' main
'''
Const scr_width As uInteger=640
Const scr_height As uInteger=480
Dim As Integer myfile,i
ScreenRes scr_width,scr_height,32
myfile=PrepareAVIFile("test1.avi",scr_width,scr_height,15)
For i=1 To 150
Line (Rnd*scr_width,Rnd*scr_height)-(Rnd*320,Rnd*200),Rgb(Rnd*255,Rnd*255,Rnd*255),bf
WriteInAVIFile myfile
Next
CloseAVIFile myfile
Sleep
End