AVI File Creator in FreeBASIC for LINUX and WINDOWS

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Sep 02, 2005 20:12

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 ()


and, your code with that in it:

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


=)
D.J.Peters
Posts: 8189
Joined: May 28, 2005 3:28
Contact:

Postby D.J.Peters » Sep 03, 2005 20:51

thanx i will try it out.
how faster is it on your PC?

joshy
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Sep 04, 2005 0:06

in the beginning, it flies. then it slows down as the program nears the end. all in all, Much faster than the original.
thesanman112
Posts: 538
Joined: Jul 15, 2005 4:13

how about opengl?

Postby thesanman112 » Sep 05, 2005 0:40

does anyone knoe if this will work while rendering in opengl?
Also, is there a way to display avi files with this code?
It seems if you are reading from screen, then it should be easy to reverse engineer this progy to write avi to screen...
dumbledore
Posts: 680
Joined: May 28, 2005 1:11
Contact:

Postby dumbledore » Sep 05, 2005 2:23

if it were possible, it would only be with uncompressed avi files, since there isn't any codec support, and 99% of all avi files have a codec in them, sry...
Mysoft
Posts: 779
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Postby Mysoft » Feb 27, 2006 18:46

D.J.Peters wrote: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


well you need to do a BUFFER with only the RGB first
cuz write the whole buffer is really faster
i mean one frame or what size of buffer you want.
and use ASM for this really speeds up the thing ^^
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Postby 1000101 » Feb 27, 2006 22:45

The problem with this whole thing is that there are too many variable factors.

For example: The biggest thing is that you need a fast defragged harddrive, otherwise most of the time is spent simply by the OS allocating and navigating the disk.

Another: Too many uses of RND. Random number generation is SLOW! Further, each run of the program is exactly that - Random. You never know the differences because one run could be huge boxes, the next tiny ones. You need to use a constant data-set between runs.

Finally. To get the true speed of the program - use the profiling option. This will allow you to determine which parts are slow.

Here is a sample profile from my own trials (and optimizing):

Code: Select all

Profiling results:
------------------

Executable name: E:\freeBASIC\junk\AVI_Writer.exe
Launched on: 02-27-2006, 16:56:58
Total program execution time: 3.946 seconds

Per function timings:

        Function:                               Time:         Total%:   Proc%:

(main)                                          3.94646       100.00%

        WRITEINAVIFILE                          3.41369       86.50%    86.50%
        fb_GfxPut                               0.32848       8.32%     8.32%
        fb_GfxScreenRes                         0.12270       3.11%     3.11%
        fb_GfxLine                              0.06869       1.74%     1.74%
        fb_GfxSetWindowTitle                    0.00518       0.13%     0.13%
        CLOSEAVIFILE                            0.00452       0.11%     0.11%
        fb_GfxImageCreate                       0.00167       0.04%     0.04%
        PREPAREAVIFILE                          0.00041       0.01%     0.01%
        fb_GfxImageDestroy                      0.00009       0.00%     0.00%
        fb_DoubleToStr                          0.00002       0.00%     0.00%
        fb_StrAssign                            0.00001       0.00%     0.00%
        fb_FloatToStr                           0.00001       0.00%     0.00%
        fb_StrConcat                            0.00001       0.00%     0.00%
        fb_Timer                                0.00000       0.00%     0.00%
        fb_StrDelete                            0.00000       0.00%     0.00%


CLOSEAVIFILE                                    0.00452       0.11%

        fb_FileClose                            0.00404       0.10%     89.43%
        fb_FilePut                              0.00022       0.01%     4.88%
        fb_FileSeek                             0.00005       0.00%     1.11%


PREPAREAVIFILE                                  0.00041       0.01%

        fb_FileOpen                             0.00037       0.01%     88.96%
        fb_SPACE                                0.00001       0.00%     2.57%
        fb_FilePutStr                           0.00001       0.00%     2.23%
        fb_FilePut                              0.00001       0.00%     1.29%
        fb_StrDelete                            0.00000       0.00%     0.68%
        fb_StrAssign                            0.00000       0.00%     0.41%
        fb_FileFree                             0.00000       0.00%     0.41%


WRITEINAVIFILE                                  3.41369       86.50%

        fb_FilePut                              2.35286       59.62%    68.92%
        free                                    0.01088       0.28%     0.32%
        fb_FileSeek                             0.00692       0.18%     0.20%
        malloc                                  0.00300       0.08%     0.09%



Global timings:

(main)                                          3.94646  (100.00%)
WRITEINAVIFILE                                  3.41369  (86.50%)
fb_GfxPut                                       0.32848  (8.32%)
fb_GfxScreenRes                                 0.12270  (3.11%)
fb_GfxLine                                      0.06869  (1.74%)
free                                            0.01088  (0.28%)
fb_FileSeek                                     0.00692  (0.18%)
fb_GfxSetWindowTitle                            0.00518  (0.13%)
CLOSEAVIFILE                                    0.00452  (0.11%)
fb_FileClose                                    0.00404  (0.10%)
malloc                                          0.00300  (0.08%)
fb_GfxImageCreate                               0.00167  (0.04%)
PREPAREAVIFILE                                  0.00041  (0.01%)
fb_FileOpen                                     0.00037  (0.01%)
fb_GfxImageDestroy                              0.00009  (0.00%)
fb_DoubleToStr                                  0.00002  (0.00%)
fb_SPACE                                        0.00001  (0.00%)
fb_FilePutStr                                   0.00001  (0.00%)
fb_FloatToStr                                   0.00001  (0.00%)
fb_StrConcat                                    0.00001  (0.00%)
fb_FilePut                                      0.00001  (0.00%)
fb_Timer                                        0.00000  (0.00%)
fb_StrDelete                                    0.00000  (0.00%)
fb_StrAssign                                    0.00000  (0.00%)
fb_FileFree                                     0.00000  (0.00%)


As can be seen, no matter how much you tweak the program, most of the programs time (59.62%) is spend simply on writing the data to the file in one function alone. While everything else could be trimmed down to maximize the time it as to do this, for the most part, it really wouldn't make a difference in the actual processing time.
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Postby 1000101 » Feb 27, 2006 23:29

By the way, the code I used to generate that profiled file:

Code: Select all

' AVI File Creator
' Copyright by D.J.Peters (Joshy)
' 8/2005 FreeBASICForum.de
' www.freebasicforum.de
'
' Heavily cleaned up and made readable by 1000101 (Eric Cowles)
' 27/02/2006
' ecowles.dyndns.org

Option Explicit

'$profile
'$stop_scan

'' Direct protos to fb's File Get/Put routines
Declare Function fbPut Alias "fb_FilePut" ( ByVal FileNum As Integer, ByVal FileOffset As Integer, ByVal DataPtr As Any Ptr, ByVal Bytes As Integer ) As Integer
Declare Function fbGet Alias "fb_FileGet" ( ByVal FileNum As Integer, ByVal FileOffset As Integer, ByVal DataPtr As Any Ptr, ByVal Bytes As Integer ) As Integer

' Your character code 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 doesn'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 gfx_Buffer Field = 1
   As UShort      BPP:3
   As UShort      W:13
   As UShort      H
   Union
      As UByte    p_8b
      As UShort   p_15b
      As UShort   p_16b
      As UInteger p_24b
      As UInteger p_32b
   End Union
End Type

Type AVIRGB       Field = 1
   As UByte       R, G, B, A
End Type

Type AVIFILE      Field = 1
   As uInteger     RIFFChunk             '0 "RIFF"
   As uInteger     RIFFSize              '4 '2048 +  n * (imagesize+8+16)
   As uInteger     AVI_Chunk             '8 "AVI "

   As uInteger     AVILISTChunk          '12 "LIST"
   As uInteger     AVILISTSize           '16 (192)

   As uInteger     hdrlChunk             '20 "hdrl"
   As uInteger     avihChunk             '24 "avih"
   As uInteger     avihSize              '28 (56)
   As uInteger     aviMicroSecPerFrame   '32 4  (0) frame display rate (or 0L)
   As uInteger     aviMaxBytesPerSec     '36 8  (0) max. transfer rate
   As uInteger     aviPaddingGranularity '40 12 (0) pad to multiples of this size as long normally 2K.
   As uInteger     aviFlag               '44 16 (&H810)
   As uInteger     aviTotalFrames        '48 20 (number of frames)
   As uInteger     aviInitFrames         '52 24 (0)
   As uInteger     aviStreams            '56 28 (1)
   As uInteger     aviSuggestedBufferSize'60 32 (w*h*3)
   As uInteger     aviWidth              '64 36 (w)
   As uInteger     aviHeight             '68 40 (h)
   As uInteger     aviReserved1          '72 44 (0)
   As uInteger     aviReserved2          '76 48 (0)
   As uInteger     aviReserved3          '80 52 (0)
   As uInteger     aviReserved4          '84 56 (0)

   As uInteger     STREAMLISTChunk       '88 "LIST"
   As uInteger     STREAMLISTSize        '92 (116)

   As uInteger     strlChunk             '96  "strl"
   As uInteger     strhChunk             '100 "strh"
   As uInteger     strhSize              '104 (56)
   As uInteger     fccType               '108 4 "vids"
   As uInteger     fccHandler            '112 8 "DIB "
   As uInteger     dwAVITF_              '116 12 (0)
   As uShort       wPriority             '120 14 (0)
   As uShort       wLanguage             '122 16 (0)
   As uInteger     dwInitFrames          '124 20 (0)
   As uInteger     dwScale               '128 24 (1)
   As uInteger     dwRate                '132 28 (frames per second) dwRate / dwScale = samples/second
   As uInteger     dwStart               '136 32 (0)
   As uInteger     dwLength              '140 36 (number of frames)
   As uInteger     dwSuggestedBufferSize '144 40 (ImageSize)
   As uInteger     dwQuality             '148 44 (10000)=100%
   As uInteger     dwSampleSize          '152 48 (0)
   As uShort       wLeft                 '156 50 !!!(0)
   As uShort       wTop                  '158 52 (0)
   As uShort       wRight                '160 54 (width)
   As uShort       wBottom               '162 56 (height)

   As uInteger     strfChunk             '164 "strf" Streamformat
   As uInteger     strfSize              '168 (40)
   As uInteger     FormatSize            '172 4  (40)
   As uInteger     dwWidth               '176 8  (width)
   As uInteger     dwHeight              '180 12 (height)
   As uShort       wPlanes               '184 14 (1)
   As uShort       wBitcount             '186 16 (24)
   As uInteger     compression           '188 20 (0)
   As uInteger     Imagesize             '192 24  (w * h * 3)
   As uInteger     xpels                 '196 28 (0)
   As uInteger     ypels                 '200 32 (0)
   As uInteger     ColorsUsed            '204 36 (0)
   As uInteger     ColorsImportent       '208 40 (0)

   As uInteger     JUNK                  '212  "JUNK"
   As uInteger     JUNKSize              '216-220 (1816)=2036 ok
End Type

Type AVI_MOVI_LIST                       'at 2036
   As uInteger     LISTChunk             '2036 "LIST"
   As uInteger     LISTSize              '2040
   As uInteger     moviChunk             '2044 "movi"
End Type
Type AVI_MOVI_LIST_ENTRY                 'at 2048
   As uInteger     ChunkId               '2048  "00db" "00dc" or "01wb"
   As uInteger     ChunkSize             '2052  (w*h*3) Bitmap or wave datasize
End Type
Type AVI_INDEX_LIST                      ' at 2048 + (num_of_frames * (8+Imagesize))
   As uInteger     idx1Chunk             ' "idx1"
   As uInteger     idx1Size              ' num_of_entry * 16 = Sizeof(index_entry)
End Type
Type AVI_INDEX_ENTRY
   As uInteger     chunkid               ' "00db" "00dc" or "01wb"
   As uInteger     dwAVIIF_              ' (&H10) Keyframe
   As uInteger     dwChunkOffset         ' Position of chunk
   As uInteger     dwChunkLength         ' 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 = Space$( 1816 )
   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
   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, ByVal pBuff As Any Ptr )
   Dim As Byte        r,g,b
   Dim As AVIRGB Ptr  rgbptr
   dim as UByte Ptr   rgb_buff
   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

   rgbptr   = pBuff
   rgb_buff = Allocate( l * 3 )

   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 i
   _count = 0

   fbPut hfile, 0, rgb_buff, l * 3

   Deallocate rgb_Buff

   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= sizeof(movi) + n * ( 8 + imagesize )
   Seek #hfile, 2041
   Put  #hfile, , s

   s = n * ( l + 8 ) '= n * ( imagesize + sizeof( 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 i

   '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
Const Duration   As Single   = 10.0
Const FPS        As Single   = 15.0
Const Frames     As Single   = Duration * FPS

Dim As Integer          myfile, i
Dim as single           Start_Time, Finish_Time
dim as single           X1, Y1, X2, Y2, XA, YA, C, CA
Dim As gfx_Buffer Ptr   Buffer

ScreenRes scr_width, scr_height, 32

Buffer = ImageCreate( scr_width, scr_height )

myfile=PrepareAVIFile( "test1.avi", scr_width, scr_height, FPS )

X1 = 0
Y1 = 0
X2 = scr_Width  - 1
Y2 = scr_Height - 1
XA = scr_Width  / ( Frames * 2 )
YA = scr_Height / ( Frames * 2 )
C  = 1.0
CA = 1.0 / ( Frames )

Start_Time = Timer

For i = 1 To Frames

   Line Buffer, ( X1, Y1 )-( X2, Y2 ), Rgb( C * 255, C * 255, C * 255 ), BF
   Put (0, 0), Buffer, pset
   WriteInAVIFile myfile, @Buffer->p_32b

   X1 += XA : X2 -= XA
   Y1 += YA : Y2 -= YA
   C  -= CA

Next i

Finish_Time = Timer

WindowTitle "Total Time: " & ( Finish_Time - Start_Time ) & "   Avg. Frame Time: " & ( Finish_Time - Start_Time ) / Frames

CloseAVIFile myfile
ImageDestroy Buffer

'Sleep
End
Last edited by 1000101 on Feb 28, 2006 15:38, edited 1 time in total.
VirusScanner
Posts: 775
Joined: Jul 01, 2005 18:45

Postby VirusScanner » Feb 28, 2006 2:54

That requires fpp though. Use the -profile option when compiling with the command line.
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Postby anonymous1337 » Feb 28, 2006 10:54

Any way you can turn this into a program that gets the image on my computer screen?

You know, something that takes a pic of my current screen and puts it into the avi data. I've been wanting to make a demo movie of my program running FOREVER.
redcrab
Posts: 619
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Postby redcrab » Feb 28, 2006 11:24

D.J.Peters wrote: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


Here my proposal ... may be converted in ASM but I don't know how ... sorry
but by assuming that 3 x 32bits = 4 x 24 bits
and asuming that (nbpixel mod 4 = 0) then
reduce the 4 times the loop and write less to file
4 pixels(3 byte) in 3 uinteger (4 byte)

Code: Select all

dim as integer  i1, i2, i3
dim as uinteger w1, w2, w3

for i=l to 0 step -4
    i1 = i - 1 : i2 = i - 2 : i3 = i-3
    w1 = rgbptr[i1].r or (rgbptr[i ].b shl 8) or (rgbptr[i ].g shl 16) or (rgbptr[i ].r shl 24)
    w2 = rgbptr[i2].g or (rgbptr[i2].r shl 8) or (rgbptr[i1].b shl 16) or (rgbptr[i1].g shl 24)
    w3 = rgbptr[i3].b or (rgbptr[i3].g shl 8) or (rgbptr[i3].r shl 16) or (rgbptr[i1].b shl 24)
    put #hfile,, w1
    put #hfile,, w2
    put #hfile,, w3
next


I didn't test it but it must be something like that ...

As may say Mysoft .... a Buffer could be better
The most CPU consuming instruction is the "put" then , buffer may make less "put"


Have fun!
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Postby anonymous1337 » Feb 28, 2006 14:21

EDIT: Never mind...I kinda just made it into a .bi and called the functions...Hahah. Easy, but I didn't think about that before O_O

DJ Peters, you should make a DLL version of this or something of the sorts. It'd be awesome to be able to do this:

Code: Select all

#include "Avi.bi" 'Include the header file :P
do
draw_stuff 'Put down graphics
Write_Avi_File 'Save .avi of current screen
loop
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Postby 1000101 » Feb 28, 2006 14:32

VirusScanner wrote:That requires fpp though. Use the -profile option when compiling with the command line.


Actually, it doesn't.

The fpp directives happen to be in there because I use fpp. But there is nothing about it that "requires" it.

Infact, it's impossible to "require" fpp as fpp does nothing other then translate such things as '$profile into -profile on the command-line of fbc. Just the same as Z!res command parser isn't a "requirement" but a simple handy tool.

My code will compile with fbc with no modifications (infact, fpp makes no modifications to the source, it just looks for compiler directives).
D.J.Peters
Posts: 8189
Joined: May 28, 2005 3:28
Contact:

Postby D.J.Peters » Feb 28, 2006 14:38

anonymous1337 wrote:DJ Peters, you should make a DLL version of this or something of the sorts. It'd be awesome

Fell free and do with this simple code what you need.

Joshy
Sterling Christensen
Posts: 142
Joined: May 27, 2005 6:13

Postby Sterling Christensen » Mar 01, 2006 2:53

About 35% faster with inline asm and [de]allocation moved out of WriteInAVIFile:

Code: Select all

' AVI File Creator
' Copyright by D.J.Peters (Joshy)
' 8/2005 FreeBASICForum.de
' www.freebasicforum.de
'
' Heavily cleaned up and made readable by 1000101 (Eric Cowles)
' 27/02/2006
' ecowles.dyndns.org
'
' Inline asm and a few small speed/code size changes by Sterling Christensen
' 28/02/2006
'

Option Explicit

'$profile
'$stop_scan

' Your character code 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 doesn'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 gfx_Buffer Field = 1
   As UShort      BPP:3
   As UShort      W:13
   As UShort      H
   Union
      As UByte    p_8b
      As UShort   p_15b
      As UShort   p_16b
      As UInteger p_24b
      As UInteger p_32b
   End Union
End Type

Type AVIRGB       Field = 1
   As UByte       R, G, B, A
End Type

Type AVIFILE       Field = 1
   As uInteger     RIFFChunk             '0 "RIFF"
   As uInteger     RIFFSize              '4 '2048 +  n * (imagesize+8+16)
   As uInteger     AVI_Chunk             '8 "AVI "

   As uInteger     AVILISTChunk          '12 "LIST"
   As uInteger     AVILISTSize           '16 (192)

   As uInteger     hdrlChunk             '20 "hdrl"
   As uInteger     avihChunk             '24 "avih"
   As uInteger     avihSize              '28 (56)
   As uInteger     aviMicroSecPerFrame   '32 4  (0) frame display rate (or 0L)
   As uInteger     aviMaxBytesPerSec     '36 8  (0) max. transfer rate
   As uInteger     aviPaddingGranularity '40 12 (0) pad to multiples of this size as long normally 2K.
   As uInteger     aviFlag               '44 16 (&H810)
   As uInteger     aviTotalFrames        '48 20 (number of frames)
   As uInteger     aviInitFrames         '52 24 (0)
   As uInteger     aviStreams            '56 28 (1)
   As uInteger     aviSuggestedBufferSize'60 32 (w*h*3)
   As uInteger     aviWidth              '64 36 (w)
   As uInteger     aviHeight             '68 40 (h)
   As uInteger     aviReserved1          '72 44 (0)
   As uInteger     aviReserved2          '76 48 (0)
   As uInteger     aviReserved3          '80 52 (0)
   As uInteger     aviReserved4          '84 56 (0)

   As uInteger     STREAMLISTChunk       '88 "LIST"
   As uInteger     STREAMLISTSize        '92 (116)

   As uInteger     strlChunk             '96  "strl"
   As uInteger     strhChunk             '100 "strh"
   As uInteger     strhSize              '104 (56)
   As uInteger     fccType               '108 4 "vids"
   As uInteger     fccHandler            '112 8 "DIB "
   As uInteger     dwAVITF_              '116 12 (0)
   As uShort       wPriority             '120 14 (0)
   As uShort       wLanguage             '122 16 (0)
   As uInteger     dwInitFrames          '124 20 (0)
   As uInteger     dwScale               '128 24 (1)
   As uInteger     dwRate                '132 28 (frames per second) dwRate / dwScale = samples/second
   As uInteger     dwStart               '136 32 (0)
   As uInteger     dwLength              '140 36 (number of frames)
   As uInteger     dwSuggestedBufferSize '144 40 (ImageSize)
   As uInteger     dwQuality             '148 44 (10000)=100%
   As uInteger     dwSampleSize          '152 48 (0)
   As uShort       wLeft                 '156 50 !!!(0)
   As uShort       wTop                  '158 52 (0)
   As uShort       wRight                '160 54 (width)
   As uShort       wBottom               '162 56 (height)

   As uInteger     strfChunk             '164 "strf" Streamformat
   As uInteger     strfSize              '168 (40)
   As uInteger     FormatSize            '172 4  (40)
   As uInteger     dwWidth               '176 8  (width)
   As uInteger     dwHeight              '180 12 (height)
   As uShort       wPlanes               '184 14 (1)
   As uShort       wBitcount             '186 16 (24)
   As uInteger     compression           '188 20 (0)
   As uInteger     Imagesize             '192 24  (w * h * 3)
   As uInteger     xpels                 '196 28 (0)
   As uInteger     ypels                 '200 32 (0)
   As uInteger     ColorsUsed            '204 36 (0)
   As uInteger     ColorsImportent       '208 40 (0)

   As uInteger     JUNK                  '212  "JUNK"
   As uInteger     JUNKSize              '216-220 (1816)=2036 ok
End Type

Type AVI_MOVI_LIST Field = 1             'at 2036
   As uInteger     LISTChunk             '2036 "LIST"
   As uInteger     LISTSize              '2040
   As uInteger     moviChunk             '2044 "movi"
End Type
Type AVI_MOVI_LIST_ENTRY Field = 1       'at 2048
   As uInteger     ChunkId               '2048  "00db" "00dc" or "01wb"
   As uInteger     ChunkSize             '2052  (w*h*3) Bitmap or wave datasize
End Type
Type AVI_INDEX_LIST Field = 1            ' at 2048 + (num_of_frames * (8+Imagesize))
   As uInteger     idx1Chunk             ' "idx1"
   As uInteger     idx1Size              ' num_of_entry * 16 = Sizeof(index_entry)
End Type
Type AVI_INDEX_ENTRY Field = 1
   As uInteger     chunkid               ' "00db" "00dc" or "01wb"
   As uInteger     dwAVIIF_              ' (&H10) Keyframe
   As uInteger     dwChunkOffset         ' Position of chunk
   As uInteger     dwChunkLength         ' Length of chunk
End Type


Dim Shared avi As avifile
Dim Shared avi_framebuffer As uByte Ptr

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 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
   Seek #hfile, Seek(hfile) + 1816 'now 2036 bytes are written
   Put #hfile,,aml 'now 2048 bytes are written
   
   avi_framebuffer = Allocate(avi.aviWidth * avi.aviHeight * 3)

   Function = hfile
End Function

Sub WriteInAVIFile(ByVal hfile As Integer, ByVal pBuff As Any Ptr )
   Dim As AVIRGB Ptr  rgbptr
   dim as UByte Ptr   rgb_buff
   Dim As Integer     l,n
   
   Dim As AVI_MOVI_LIST_ENTRY listEntry

   n = avi.aviTotalframes
   l = avi.aviWidth * avi.aviHeight
   
   If l < 1 Then Exit Sub
   
   With listEntry
      .ChunkId = nndb
      .ChunkSize = avi.ImageSize
   End With
   
   Put #hfile, 2049 + ( ( 8 + avi.ImageSize ) * n ), listEntry

   rgbptr   = pBuff
   rgb_buff = avi_framebuffer

#if 0
   Dim As Byte        r,g,b
   dim As Integer i, _count
   For i = l-1 To 0 Step -1
      rgb_buff[ _count     ] = rgbptr[ i ].r
      rgb_buff[ _count + 1 ] = rgbptr[ i ].g
      rgb_buff[ _count + 2 ] = rgbptr[ i ].b

      _count += 3
   Next i
   _count = 0
#else
   asm
      push eax
      push ecx
      push esi
      push edi
     
      mov  ecx, [l]

      ' esi = rgbptr + (l - 1) * 4
      mov  esi, [rgbptr]
      lea  esi, [esi + ecx * 4 - 4]
     
      mov  edi, [rgb_buff]
     
      asm_32_to_24_loop:
         
         ' Copy 3 bytes from [esi] to [edi]
         mov  eax, [esi]
         mov  [edi], ax
         shr  eax, 16
         mov  [edi+2], al
         
         add  edi, 3
         sub  esi, 4
         
         dec  ecx
      jnz  short asm_32_to_24_loop
     
      pop  edi
      pop  esi
      pop  ecx
      pop  eax
   end asm
#endif

   Put #hfile, , *rgb_buff, l * 3

   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
   
   deallocate avi_framebuffer

   l = avi.ImageSize
   n = avi.aviTotalFrames

   'update number of total frames
   Put  #hfile, 49, avi.aviTotalFrames
   Put  #hfile, 141, avi.aviTotalFrames

   s = 4 + n * ( l + 8 )
   'LIST xxxx movi xxxx= sizeof(movi) + n * ( 8 + imagesize )
   Put  #hfile, 2041, s

   s = n * ( l + 8 ) '= n * ( imagesize + sizeof( 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 i

   'RIFF xxxx "AVI "
   '      (idx1xxxx) imagesize + 00dbxxxx + ( 00dd flag offset size )
   s = 2040 + 8 + n * ( avi.imagesize + 8 + 16 )
   Put   #hfile, 5, s
   Close #hFile

End Sub

'''
''' main
'''
Const scr_width  As uInteger = 640
Const scr_height As uInteger = 480
Const Duration   As Single   = 10.0
Const FPS        As Single   = 15.0
Const Frames     As Single   = Duration * FPS

Dim As Integer          myfile, i
Dim as double           Start_Time, Finish_Time
dim as single           X1, Y1, X2, Y2, XA, YA, C, CA
Dim As gfx_Buffer Ptr   Buffer

ScreenRes scr_width, scr_height, 32

Buffer = ImageCreate( scr_width, scr_height )

myfile=PrepareAVIFile( "test1.avi", scr_width, scr_height, FPS )

X1 = 0
Y1 = 0
X2 = scr_Width  - 1
Y2 = scr_Height - 1
XA = scr_Width  / ( Frames * 2 )
YA = scr_Height / ( Frames * 2 )
C  = 1.0
CA = 1.0 / ( Frames )

sleep 1

Start_Time = Timer

For i = 1 To Frames

   Line Buffer, ( X1, Y1 )-( X2, Y2 ), Rgb( C * 255, C * 255, C * 255 ), BF
   Put (0, 0), Buffer, pset
   WriteInAVIFile myfile, @Buffer->p_32b

   X1 += XA : X2 -= XA
   Y1 += YA : Y2 -= YA
   C  -= CA

Next i

Finish_Time = Timer

WindowTitle "Total Time: " & ( Finish_Time - Start_Time ) & "   Avg. Frame Time: " & ( Finish_Time - Start_Time ) / Frames

CloseAVIFile myfile
ImageDestroy Buffer

Sleep
End

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 8 guests