AVI File Creator in FreeBASIC for LINUX and WINDOWS

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

AVI File Creator in FreeBASIC for LINUX and WINDOWS

Post by D.J.Peters »

WIN Realplayer,Windows Mediaplayer and WINAmp (thanx DrV)
LIN Realplayer, MPlayer, XINE and others

24BPP uncompressed.

Joshy

Code: Select all

' 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)
  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
Last edited by D.J.Peters on Feb 01, 2008 1:48, edited 5 times in total.
mjs
Site Admin
Posts: 842
Joined: Jun 16, 2005 19:50
Location: Germany

Post by mjs »

Very nice ... this might be useful for applications that want to capture some output or something alike.

Regards,
Mark
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Post by dumbledore »

doesn't seem to work for me, WMP can't play it and neither can realplayer...
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

dumbledore wrote:doesn't seem to work for me, WMP can't play it and neither can realplayer...
Hello dumbledore,
sorry it's the first version from last night.
i have used diffrent players only under Linux.

now this night i surching the problem.

Joshy
Rattrapmax6
Posts: 334
Joined: May 29, 2005 1:45
Location: At my Computer
Contact:

Post by Rattrapmax6 »

Aye.... messes up on mine too.... Just locks up my realplayer...

Win98<
RealPlayer v10<
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

Rattrapmax6 wrote:Aye.... messes up on mine too.... Just locks up my realplayer...

Win98<
RealPlayer v10<
Now the code is right.
WIN Realplayer Windows Mediaplayer
LIN Realplayer Mplayer XINE and others


Joshy
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

If it makes trouble with your favourit player please post an message.

Thanx for your help.

Joshy
Last edited by D.J.Peters on Nov 30, 2012 20:21, edited 1 time in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

mjs wrote:Very nice ... this might be useful for applications that want to capture some output or something alike.

Regards,
Mark
I was looking for a way to have an visual DEBUG output for the FreeSpeedRacer 3D engine.
And yes it's nice for replays or demos too.Image

Joshy
Last edited by D.J.Peters on Nov 30, 2012 20:21, edited 1 time in total.
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:

Post by cha0s »

really cool!!!

great work, joshy ^.^
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

cha0s wrote:really cool!!!

great work, joshy ^.^
I don't think so it is really hot Image
No DirectX Medialayer or any VideoForWindows lib is needed.

Joshy
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Post by dumbledore »

neat, seems to get a lil choppy toward the end in wmp though, fine in mplayer except it looks fuzzy.
any chance of adding codec (xvid, divx) support? :D
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

dumbledore wrote:neat, seems to get a lil choppy toward the end in wmp though.
any chance of adding codec (xvid, divx) support? :D
Do you replay the avifile in original size?

the original replay recorder/player from FreeSpeedRacer used my fast de/compressor and the files end in *.FSR and it exist no codec for this types.

Feel free and add your codec support and write an player in FreeBASIC i think other people will love your work. but if you are do it do it not only for WINDOWS. I try to write all stuff for Lin and Win.

Joshy
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Post by dumbledore »

i found a free program on sourceforge which can add standard avi compressions to the output:
http://virtualdub.sourceforge.net/
free, and works very well. it reduced your program's output from 131mb to 500k with the xvid codec. ;)
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

hi dumbledore,
yes for real movies you need an compressor / codec but i was made an loseless compressor.
I need it only to debug the 3d engine output from the FreeSpeedRacer project.
If any goes wrong with the 3d engine i can step later picture for picture to find the renderproblem.

When i use and codec with good compresion then many pixel ditals are lost.

Have a nice time and thanx for the link.
(it is only for Windows OS)

Joshy
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

any one an idea to make this litle bit faster ?
32 BPP to 24 BPP

Joshy

Code: Select all

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
Post Reply