Запись видео в AVI
В данном примере записывается видео с окна, в котором происходит некая
анимация. Пример примечателен тем, что в нем не используются никакие сторонние
библиотеки, только средствами FreeBasic.
Платформы: Windows , Linux.
Автор: D.J.Peters (Joshy) 2005.
' AVI File Creator ' Copyright by D.J.Peters (Joshy) ' 8/2005 FreeBASICForum.de ' 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 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 For i=l To 0 Step -1 r=rgbptr[i].r g=rgbptr[i].g b=rgbptr[i].b Put #hfile,,r Put #hfile,,g Put #hfile,,b Next Screenunlock avi.aviTotalframes+=1 End Sub Sub CloseAVIFile(Byval hFile As Integer) 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
