http://www.xvid.org/
I needed to capture a window in high quality for my job
so i wrote a windows dll with my old VS6.
Download: XVidCapture.zip
I made it easy as posible :-)
I's nice to post FreeBASIC fbGFX or OpenGL demos/games on youtube with audio.
Joshy
test01.bas
Code: Select all
' test01.bas 32bit pixel stream without audio
#include once "xvidcapture.bi"
const as integer iWidth = 320
const as integer iHeight = 240
const as integer iBPP = 32
chdir exepath
if OpenVideoStream("test01.avi",iWidth,iHeight)=0 then
print "error: OpenVideoStream() !"
beep:sleep:end 1
end if
screenres iWidth,iHeight,iBPP
dim as integer nFrames,nBytes
while nFrames<(iHeight/2)
nFrames+=1
windowtitle "only " & nBytes & " written"
cls
draw string (nFrames*2 mod iWidth,nFrames*2 mod iHeight), "Frame " & nFrames
screenlock
select case iBPP
case 32 : nBytes+=Write32BitPixels(ScreenPtr())
case 16 : nBytes+=Write16BitPixels(ScreenPtr())
end select
screenunlock
sleep 100
wend
CloseStream()
Code: Select all
' test02.bas 16bit pixel stream without audio
#include once "xvidcapture.bi"
const as integer iWidth = 320
const as integer iHeight = 240
const as integer iBPP = 16
chdir exepath
if OpenVideoStream("test02.avi",iWidth,iHeight)=0 then
print "error: OpenVideoStream() !"
beep:sleep:end 1
end if
screenres iWidth,iHeight,iBPP
dim as integer nFrames,nBytes
while nFrames<(iHeight/2)
nFrames+=1
windowtitle "only " & nBytes & " written"
cls
draw string ((nFrames*2) mod iWidth,(nFrames*2) mod iHeight), "Frame " & nFrames
screenlock
select case iBPP
case 32 : nBytes+=Write32BitPixels(ScreenPtr())
case 16 : nBytes+=Write16BitPixels(ScreenPtr())
end select
screenunlock
sleep 100
wend
CloseStream()
Code: Select all
' test03.bas
' video 32bit pixel 24 FPS
' with audio 16bit mono 22KHz.
#include once "xvidcapture.bi"
const as integer iWidth = 320
const as integer iHeight = 240
const as integer iBPP = 32
const as integer iFPS = 24
const as integer iQuality = 75
const as integer iChannels = 1
const as integer iBits = 16
const as integer iRate = 22050
chdir exepath
if OpenVideoAudioStream("test03.avi",iWidth,iHeight,iFPS,iQuality,iChannels,iBits,iRate)=0 then
print "error: OpenVideoAudioStream() !"
beep:sleep:end 1
end if
' how many audio samples per frame ?
const as integer nSamples = iRate\iFPS
' how many bytes per audio buffer
const as integer BufferSize = nSamples*sizeof(short)
' a 16 bit mono audio buffer
dim as short Samples(nSamples-1)
const as single Hz = 880
const as single PI = atn(1)*4
const as single wStep = (2*PI)/iRate*Hz
screenres iWidth,iHeight,iBPP
windowtitle "MPG4 Video + Audio encoding"
dim as single w
dim as integer nFrames,nBytes
while nFrames<(iHeight/2)
nFrames+=1
cls
draw string ((nFrames*2) mod iWidth,(nFrames*2) mod iHeight), "Frame " & nFrames
screenlock
select case iBPP
case 32 : Write32BitPixels(ScreenPtr())
case 16 : Write16BitPixels(ScreenPtr())
end select
screenunlock
for i as integer=0 to nSamples-1
Samples(i)=sin(w)*5000
w+=wStep*cos(i/50)
next
WriteAudioSamples(@Samples(0),BufferSize)
sleep 100
wend
CloseStream()