' xvideocapture.bas 
' video 32bit pixel 12 FPS
' with audio 16bit mono 44khz

#include once "xvidcapture.bi"
#Include Once "gui_chung.bi"
#include once "win/mmsystem.bi"
#include Once "crt/string.bi"
#Include Once "wavein.bi"

Dim Shared As integer xmax    = 500'320
Dim shared As integer ymax   = 400'240
const as integer iBPP      = 32
const as integer iFPS      = 12'24
const as integer iQuality  = 75
const as integer iChannels =  2
const as integer iBits     = 16
const as integer iRate     = 44100'22050

chdir exepath

' how many audio samples per frame ?
const as integer nSamplesvideo = ichannels*iRate\iFPS
' how many bytes per audio buffer
const as integer BufferSize = nSamplesvideo*sizeof(short)
' a 16 bit mono audio buffer
dim Shared As short Samples(nSamplesvideo-1)

Dim Shared As WAVEIN_DEVICE mywavein

mywavein.wstart(-1)'mydev) wavein mapper

Dim Shared As Integer quit=0,wx,wy,depth,winx,winy,windx,windy
Dim Shared As Integer record,wdx,wdy,windowx,windowy,windowdx,windowdy
Dim Shared As Integer zonex,zoney,zonedx,zonedy
Dim Shared As Double timerec
Dim Shared As String mode,windowtext
mode="window" 
Dim Shared As hWnd hwnd,wintexth,winh
Dim Shared As hdc hdc 
hWnd=Cast(hwnd,GetDesktopWindow())
hDC= Cast(hdc,GetWindowDC(Cast(hwnd,hWnd)))
Dim Shared As hbitmap hbmp
Dim Shared As hdc bmpdc
Dim Shared As Integer x,y
Dim Shared As UByte bit8
Dim Shared As UByte Ptr bmpbits
Sub subquit
    quit=1
End Sub
Sub substop
printgui("win.record","record")
If record=0 Then Exit Sub
CloseStream()
If bmpdc<>0 Then deletedc(bmpdc):bmpdc=0
If hbmp<>0 Then deleteobject(hbmp):hbmp=0
record=0
guistatictextinkcolor(0,0,0)  
End Sub
Sub subrecord
If record=1 Then substop():Exit Sub 
ReleaseDC(Cast(hwnd,hWnd),Cast(hdc,hDC))
hWnd=Cast(hwnd,GetDesktopWindow())
hDC= Cast(hdc,GetWindowDC(Cast(hwnd,hWnd)))
If mode="fullscreen" Then
	wdx=0:wdy=0
	xmax=wx-4:ymax=wy-38
ElseIf mode="window" Then
	wdx=windowx:wdy=windowy
	xmax=windowdx:ymax=windowdy
EndIf
xmax=2*Int(xmax\2):ymax=2*Int(ymax\2)
x=xmax:y=ymax
If bmpdc<>0 Then deletedc(bmpdc):bmpdc=0
If hbmp<>0 Then deleteobject(hbmp):hbmp=0
hbmp=guicreateDIBbmp(x,-y)
bmpbits=guigetbmpdibbits(hbmp)
bmpdc=createcompatibleDC(guiwindc0)
selectobject(bmpdc,hbmp)
If OpenVideoAudioStream("test.avi",xmax,ymax,iFPS,iQuality,iChannels,iBits,iRate)=0 then
  guinotice "error: OpenVideoAudioStream() !"
Else
  record=1
  timerec=Timer 	
  printgui("win.record","stop")
  guistatictextinkcolor(255,255,0)
End If	
End Sub
Sub subfullscreen
printgui("win.mode","fullscreen     ")
mode="fullscreen"	
End Sub
Sub subwindow
printgui("win.msg","select window          ")
mode="window"
disablegui("win")
Var test=0
While quit=0 And guitestkey(vk_escape)=0 And test=0
	guiscan
	Sleep 80
	Var hwin=getForegroundWindow()
	If hwin<>winh Then
		test=1
      Dim As rect winrect
	   GetWindowRect(hwin,@winrect)
      windowx=winrect.left
      windowy=winrect.top
      windowdx=min2(wx,winrect.right)-windowx
      windowdy=min2(wy,winrect.bottom)-windowy
      Var text=Space(255)+Chr(0)
      GetWindowText(hwin, text,255)
      windowtext=Trim(text)
	EndIf
Wend
enablegui("win")
printgui("win.mode","window     ")
printgui("win.msg",windowtext+"                         ")
Sleep 500
setforegroundwindow(getguih("win"))
End Sub
Dim Shared As Integer tsubzone=0
Sub subzone
	tsubzone=1
End Sub
Sub subzone2()
Dim As Integer i,j
printgui("win.mode","zone     ")
mode="zone"
ReleaseDC(Cast(hwnd,hWnd),Cast(hdc,hDC))
hWnd=Cast(hwnd,GetDesktopWindow())
hDC= Cast(hdc,GetWindowDC(Cast(hwnd,hWnd)))
If bmpdc<>0 Then deletedc(bmpdc):bmpdc=0
If hbmp<>0 Then deleteobject(hbmp):hbmp=0
Var x=wx-2,y=wy-38
hbmp=guicreateDIBbmp(x,-y)
bmpbits=guigetbmpdibbits(hbmp)
bmpdc=createcompatibleDC(guiwindc0)
selectobject(bmpdc,hbmp)
  bitblt(bmpdc,0,0,x-8,y-8,hdc,0,0,srccopy)
  For i=0 To (x*y-1)*4 Step 4
      'bit8=bmpbits[i]
      'bmpbits[i]=bmpbits[i+2]
      'bmpbits[i+2]=bit8
  Next
Var myimage=ImageCreate(x,y,RGB(0,200,0),32)
memcpy(myimage+32,bmpbits,(x*y-1)*4-32)
graphicbox("win2.graph",0,0,x,y,"gfx")
button("win2.quit","done",@subquit,5,5,40,20)
openwindow("win2","select zone",0,0,x+1,y+1,ws_popup)
trapclose("win2",@subquit)
disablegui("win")

Var graphbuffer=getguigfxbuffer("win2.graph")
Put graphbuffer,(0,0),myimage
Line graphbuffer,(100,100)-(400,400),RGB(200,0,0),b

While quit=0 And guitestkey(vk_escape)=0
	guiscan
	Sleep 80
	guirefreshwindow("win2")
Wend

ImageDestroy(myimage)
If bmpdc<>0 Then deletedc(bmpdc):bmpdc=0
If hbmp<>0 Then deleteobject(hbmp):hbmp=0
guiclosewindow("win2")
enablegui("win")
Sleep 500
guiscan
quit=0
setforegroundwindow(getguih("win"))
End Sub
Dim Shared As String timemsg

guibackgroundcolor(70,200,70)
ScreenInfo wx,wy,depth
winx=1:winy=1
windx=270'xmax'+20
windy=100'ymax'+20
button("win.quit","quit",@subquit,5,4,40,22)
button("win.fullscreen","fullscreen",@subfullscreen,55,5,70,20)
button("win.window","window",@subwindow,135,5,55,20)
button("win.zone","zone",@subzone,200,5,55,20)
button("win.record","record",@subrecord,5,35,60,25)
statictext("win.text","00:00",84,37,70,16)
statictext("win.mode","window",165,37,80,16)
statictext("win.msg","",140,54,125,16)
openwindow("win","xvideocapture",winx,winy,windx,windy)

trapclose("win",@subquit)
printgui("win.mode",mode+"      ")
winh=getguih("win")

Dim as integer i,j,k
Dim Shared As Double time0,time1,time2

'Dim As Any Ptr myimage
'myimage=ImageCreate(xmax,ymax,RGB(100,200,0),iBPP)

wintexth=getguih("win.text")

time0=Timer:time1=Timer

while quit=0 And guitestkey(vk_escape)=0 
  guiscan 
  If tsubzone=1 Then tsubzone=0:subzone2()
If record=1 Then 
  'bitblt(bmpdc,0,0,x,y,hdc,winx,winy,srccopy)
  bitblt(bmpdc,0,0,x,y,hdc,wdx,wdy,srccopy)
  For i=0 To (x*y-1)*4 Step 4
      bit8=bmpbits[i]
      bmpbits[i]=bmpbits[i+2]
      bmpbits[i+2]=bit8
  Next
  select case iBPP
  	Case 32 : Write32BitPixels(bmpbits)'myimage)'ScreenPtr())
  	Case 16 : Write16BitPixels(bmpbits)'myimage)'ScreenPtr())
  end select
  
  for i=0 to nSamplesvideo-1
  	 If Abs(mybuffersoundj-mybuffersoundi)>SamplesPerBuffer Then 
       mybuffersoundj+=1:If mybuffersoundj>nsample Then mybuffersoundj=0
    EndIf 
    samples(i)=mybuffersound(mybuffersoundj)
  next
  WriteAudioSamples(@Samples(0),BufferSize)  
  time1+=1/ifps
  If Timer<time1 Then
  	Sleep Int(min(0.2,time1-Timer)*1000)
  Else
   Sleep 0
  EndIf 
  If Timer>timerec+600 Then substop() '10mn max
  time2=Timer
  i=Int((time2-timerec)/60)
  If i<10 Then timemsg="0"+Str(i) Else timemsg=Str(i)
  timemsg=Str(Int(time2-timerec-i*60))+":"+timemsg+"   "
Else
  Sleep 80
  time2=Timer
  timemsg=Time$
EndIf
If Int(time2-time0)>0 Then time0=time2:printguih(wintexth,timemsg+"     ")

Wend
'ImageDestroy(myimage)
If record=1 Then substop()
mywavein.wclose()
If bmpdc<>0 Then deletedc(bmpdc):bmpdc=0
If hbmp<>0 Then deleteobject(hbmp):hbmp=0
ReleaseDC(Cast(hwnd,hWnd),Cast(hdc,hDC))

guiclose()
guiquit()
End 


