' open a new avi file and select from dialog the right encoder
avi_start "test.avi", width,height,fps ' = frames per second
' inside your render loop
use "avi_capture_gl" write curent opengl buffer as avi frame
or use "avi_capture" write curent fbgfx buffer as avi frame
on end use "avi_end" ' close the avi file
now you need this *.bi file
Code: Select all
' AVI Encoder
' Written by D.J. Peters (2009)
' Exported to a single BI file by Kristopher Windsor
#include once "fbgfx.bi"
Const AVIIF_KEYFRAME = &H10
Enum FILEFLAGS
OF_WRITE = &H0001
OF_CREATE = &H1000
End Enum
Enum AVISAVEFLAGS
ICMF_CHOOSE_KEYFRAME = (1 Shl 0)
ICMF_CHOOSE_DATARATE = (1 Shl 1)
ICMF_CHOOSE_PREVIEW = (1 Shl 2)
ICMF_CHOOSE_ALLCOMPRESSORS = (1 Shl 3)
End Enum
Type AVIFILEINFO
As Uinteger dwMaxBytesPerSec
As Uinteger dwFlags
As Uinteger dwCaps
As Uinteger dwStreams
As Uinteger dwSuggestedBufferSize
As Uinteger dwWidth
As Uinteger dwHeight
As Uinteger dwScale
As Uinteger dwRate
As Uinteger dwLength
As Uinteger dwEditCount
As String * 63 szFileType
End Type
Type AVISTREAMINFO
As Uinteger fccType
As Uinteger fccHandler
As Uinteger dwFlags
As Uinteger dwCaps
As Ushort wPriority
As Ushort wLanguage
As Uinteger dwScale
As Uinteger dwRate
As Uinteger dwStart
As Uinteger dwLength
As Uinteger dwInitialFrames
As Uinteger dwSuggestedBufferSize
As Uinteger dwQuality
As Uinteger dwSampleSize
As Uinteger l,t,w,b
As Uinteger dwEditCount
As Uinteger dwFormatChangeCount
As String * 63 szName
End Type
Type AVICOMPRESSOPTIONS
As Uinteger fccType
As Uinteger fccHandler
As Uinteger dwKeyFrameEvery
As Uinteger dwQuality
As Uinteger dwBytesPerSecond
As Uinteger dwFlags
As Any Ptr lpFormat
As Uinteger cbFormat
As Any Ptr lpParms
As Uinteger cbParms
As Uinteger dwInterleaveEvery
End Type
Type PAVICOMPRESSOPTIONS As AVICOMPRESSOPTIONS Ptr
Type BITMAPINFOHEADER
As Integer biSize
As Integer biWidth
As Integer biHeight
As Short biPlanes
As Short biBitCount
As Integer biCompression
As Integer biSizeImage
As Integer biXPelsPerMeter
As Integer biYPelsPerMeter
As Integer biClrUsed
As Integer biClrImportant
End Type
Type AVISaveCallback As Function (Byval nPercent As Integer) As Integer
Type AVIFILE As Any Ptr
Type AVISTREAM As Any Ptr
Declare Function String2FOURCC Lib "winmm" Alias "mmioStringToFOURCCA" (Byval As String, Byval As Uinteger=0) As Uinteger
Declare Sub AVIFileInit Lib "avifil32" Alias "AVIFileInit"
Declare Sub AVIFileExit Lib "avifil32" Alias "AVIFileExit"
Declare Function AVIFileOpen Lib "avifil32" Alias "AVIFileOpenA" (Byval As AVIFILE Ptr, Byval strfile As String, Byval flag As FILEFLAGS, Byval lpClass As Any Ptr) As Integer
Declare Function AVIFileRelease Lib "avifil32" Alias "AVIFileRelease" (Byval As AVIFILE) As Integer
Declare Function AVIFileCreateStream Lib "avifil32" Alias "AVIFileCreateStreamA" (Byval As AVIFILE, Byval As AVISTREAM Ptr, Byval As AVISTREAMINFO Ptr) As Integer
Declare Function AVIStreamRelease Lib "avifil32" Alias "AVIStreamRelease" (Byval As AVISTREAM) As Integer
Declare Function AVIMakeCompressedStream Lib "avifil32" Alias "AVIMakeCompressedStream"(Byval As AVISTREAM Ptr, Byval As AVISTREAM , Byval As AVICOMPRESSOPTIONS Ptr, Byval lpClassHandler As Any Ptr) As Integer
Declare Function AVISaveOptions Lib "avifil32" Alias "AVISaveOptions" (Byval hParent As Integer, Byval As AVISAVEFLAGS, Byval nStreams As Uinteger, Byval As AVISTREAM Ptr, Byval As PAVICOMPRESSOPTIONS Ptr) As Integer
Declare Function AVISaveOptionsFree Lib "avifil32" Alias "AVISaveOptionsFree" (Byval nStreams As Integer, Byval As PAVICOMPRESSOPTIONS Ptr) As Integer
Declare Function AVIStreamSetFormat Lib "avifil32" Alias "AVIStreamSetFormat" (Byval As AVISTREAM, Byval As Integer, Byval As Any Ptr, Byval As Integer) As Integer
Declare Function AVIStreamWrite Lib "avifil32" Alias "AVIStreamWrite" (Byval As AVISTREAM, Byval nPos As Integer, Byval nStream As Integer, Byval lpPixel As Any Ptr, Byval bytes As Integer, Byval flag As Integer, Byval swritten As Integer Ptr, Byval bwritten As Integer Ptr) As Integer
Dim Shared As AVIFILE file
Dim Shared As AVISTREAM stream
Dim Shared As AVISTREAM encoderstream
Dim Shared As AVISTREAMINFO streaminfo
Dim Shared As AVICOMPRESSOPTIONS compressoptions
Dim Shared As PAVICOMPRESSOPTIONS Ptr ArrayOptions
Dim Shared As BITMAPINFOHEADER Bitmapformat
' avicapture.bi
' written by d.j.peters (joshy)
Dim Shared As Byte Ptr avi_lpBits, avi_lpScreen
Dim Shared As Integer avi_screen_x, avi_screen_y, avi_frame_rate, avi_frame_count, avi_hWin
Dim Shared As Double avi_timer
ArrayOptions = Callocate(4)
ArrayOptions[0] = @compressoptions
Sub avi_start (file_name As String, _
screen_x As Integer, _
screen_y As Integer, _
frame_rate As Integer)
Dim As Integer ff = Freefile
avi_screen_x = screen_x
avi_screen_y = screen_y
avi_frame_rate = frame_rate
Open file_name For Output As ff: Close ff
ScreenControl fb.GET_WINDOW_HANDLE, avi_hWin
AVIFileInit
If AVIFileOpen(@file, file_name, OF_WRITE Or OF_CREATE,0)<>0 Then
AVIFileExit
? "error: AVIFileOpen!"
Beep: Sleep: End 1
End If
With streaminfo
.fccType = String2FOURCC("vids")
.dwScale = 1
.dwRate = avi_frame_rate
.dwSuggestedBufferSize = avi_screen_x * avi_screen_y * 3 ' RGB
.l = 0: .t = 0: .w = avi_screen_x:.b = avi_screen_y
End With
With BitmapFormat
.biSize = 40
.biWidth = avi_screen_x
.biHeight = avi_screen_y
.biPlanes = 1
.biBitCount = 24
.biCompression = 0 ' raw rgb
.biSizeImage = avi_screen_x * avi_screen_y * 3 ' rgb
avi_lpbits = Callocate(.biSizeImage)
End With
If AVIFileCreateStream(file, @stream, @streaminfo) Then
AVIFileRelease(file)
AVIFileExit
? "error: AVIFileCreateStream!": Beep: Sleep: End 1
End If
If AVISaveOptions(avi_hWin, &H7, 1, @stream,ArrayOptions) <> 1 Then
AVIStreamRelease(stream)
AVIFileRelease(file)
AVIFileExit
? "error: AVISaveOptions!": Beep: Sleep: End 1
End If
If AVIMakeCompressedStream(@encoderstream,stream,ArrayOptions[0], 0) Then
AVISaveOptionsFree(1, ArrayOptions)
AVIStreamRelease(stream)
AVIFileRelease(file)
AVIFileExit
? "error: AVIMakeCompressedStream!": Beep: Sleep: End 1
End If
If AVIStreamSetFormat(encoderstream, 0, @BitmapFormat, 40) Then
AVISaveOptionsFree(1, ArrayOptions)
AVIStreamRelease(encoderstream)
AVIStreamRelease(stream)
AVIFileRelease(file)
AVIFileExit
? "error: AVIStreamSetFormat!": Beep: Sleep: End 1
End If
End Sub
Sub avi_capture
Static As Integer x, y, d, s
If avi_frame_count = 0 Then avi_timer = Timer
avi_lpScreen = Screenptr
' from bottom to top
avi_lpScreen += (avi_screen_y - 1) * (avi_screen_x * 4)
For y=0 To avi_screen_y-1
d = y * avi_screen_x * 3: s = 0
For x = 0 To avi_screen_x - 1
' ARGB32 to RGB24
avi_lpBits[d + 0] = avi_lpScreen[s + 0]
avi_lpBits[d + 1] = avi_lpScreen[s + 1]
avi_lpBits[d + 2] = avi_lpScreen[s + 2]
d += 3: s += 4
Next
avi_lpScreen -= (avi_screen_x * 4)
Next
AVIStreamWrite(encoderstream, _
avi_frame_count, _
1, _
avi_lpBits, _
BitmapFormat.biSizeImage, 0, 0, 0)
avi_frame_count += 1
While avi_frame_count / (Timer - avi_timer) > avi_frame_rate: Wend 'limit FPS
End Sub
' save OpenGL framebuffer as AVI frame
Sub avi_capture_gl
dim as ubyte tmp
dim as ubyte ptr lpRGB
If avi_frame_count = 0 Then avi_timer = Timer
' get framebuffer
glReadPixels(0,0,avi_screen_x,avi_screen_y, _
GL_RGB,GL_UNSIGNED_BYTE,avi_lpBits)
' swap red and blue
lpRGB=avi_lpBits
for i as integer=0 to avi_screen_x*avi_screen_y-1
tmp=lpRGB[0]
lpRGB[0]=lpRGB[2]
lpRGB[2]=tmp
lpRGB+=3
next
' write one AVI frame
AVIStreamWrite(encoderstream, avi_frame_count, 1, avi_lpBits, BitmapFormat.biSizeImage, 0, 0, 0)
avi_frame_count += 1
While (avi_frame_count / (Timer - avi_timer)) > avi_frame_rate
sleep 3
Wend
End Sub
Sub avi_end
' now free saveoptions,release streams,file and dll
AVISaveOptionsFree(1,ArrayOptions)
AVIStreamRelease(EncoderStream)
AVIStreamRelease(Stream)
AVIFileRelease(File)
AVIFileExit
End SubCode: Select all
#include "fbgfx.bi"
#include "GL/gl.bi"
#include "GL/glu.bi"
#include "avicapture.bi"
'
' main
'
const scr_w=320
const scr_h=240
dim rtri as single, rquad as single
avi_start "test.avi", scr_w,scr_h, 20 ' 20 frames per second
ScreenRes scr_w,scr_h,,32,FB.GFX_OPENGL
glViewport 0,0,scr_w,scr_h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45, scr_w/scr_h, 0.1, 100
glMatrixMode GL_MODELVIEW
glLoadIdentity
glShadeModel GL_SMOOTH
glClearColor 0,0,0,1
glClearDepth 1
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
do
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glLoadIdentity
glTranslatef -1.5, 0, -6
glRotatef rtri, 0, 1, 0
glBegin GL_TRIANGLES
glColor3f 1, 0, 0:glVertex3f 0, 1, 0
glColor3f 0, 1, 0:glVertex3f -1,-1, 0
glColor3f 0, 0, 1:glVertex3f 1,-1, 0
glEnd
glLoadIdentity
glTranslatef 1.5, 0 ,-6
glRotatef rquad, 1, 0 , 0
glBegin GL_QUADS
glColor3f 1, 0, 0:glVertex3f -1, 1, 0
glColor3f 0, 1, 0:glVertex3f 1, 1, 0
glColor3f 0, 0, 1:glVertex3f 1,-1, 0
glColor3f 1, 1, 0:glVertex3f -1,-1, 0
glEnd
rtri += 1
rquad += 2
avi_capture_gl
flip
loop while inkey = ""
avi_end
end