' xvideocapture.bas freeware 2013 (NGUYEN.Chung)
' video 32bit pixel 10 FPS
' with audio 16bit stereo 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 As Integer maxtime=1800 'max 30mn recording
Dim Shared As integer xmax    = 500'320
Dim shared As integer ymax   = 400'240
const as integer iBPP      = 32
Dim Shared As integer iFPS      = 10'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 ?
dim shared As integer nSamplesvideo
nsamplesvideo = ichannels*iRate\iFPS
' how many bytes per audio buffer
Dim Shared As integer BufferSize
buffersize = nSamplesvideo*sizeof(short)
' a 16 bit mono audio buffer
dim Shared As short Samples(ichannels*irate\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,resp
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

Dim As String ficin
Dim As String ficini="xvideocapture.ini"
Dim As Integer File
file=FreeFile
Open ficini For Input As #file
mode="fullscreen"
If Not Eof(file) Then Line Input #file,ficin:mode=Trim(ficin)
windowx=100:windowy=100
If Not Eof(file) Then Line Input #file,ficin:windowx=Val(ficin)
If Not Eof(file) Then Line Input #file,ficin:windowy=Val(ficin)
windowdx=400:windowdy=300
If Not Eof(file) Then Line Input #file,ficin:windowdx=Val(ficin)
If Not Eof(file) Then Line Input #file,ficin:windowdy=Val(ficin)
zonex=100:zoney=100
If Not Eof(file) Then Line Input #file,ficin:zonex=Val(ficin)
If Not Eof(file) Then Line Input #file,ficin:zoney=Val(ficin)
zonedx=400:zonedy=300
If Not Eof(file) Then Line Input #file,ficin:zonedx=Val(ficin)
If Not Eof(file) Then Line Input #file,ficin:zonedy=Val(ficin)
ifps=10
If Not Eof(file) Then Line Input #file,ficin:ifps=Val(ficin)
Close #file

Sub subquit
    quit=1
End Sub
Sub subresp
resp=guigettext("winprompt.resp")
End Sub
Sub prompt(ByRef msg As String,ByRef resp0 As String)
statictext("winprompt.msg","msg",10,10,400,40)
edittext("winprompt.resp","",@subresp,10,60,400,20)
openwindow("winprompt","xvideocapture_chung",50,50,450,180)
printgui("winprompt.msg",msg)
printgui("winprompt.resp",resp0)
guisetfocus("winprompt.resp")
While guitestkey(vk_escape)=0 And guitestkey(vk_return)=0
	guiwait
	Sleep 100
Wend
guiscan
resp=guigettext("winprompt.resp")
guiclosewindow("winprompt")
End Sub
Sub subfps
Dim As Integer i
	resp=Str(ifps)
	msg="tips: ctrl+F5 => start record / ctrl+F6 => stop record"+Chr(13)+Chr(10)
	msg+="framerate fps : enter a number (5..50)  last="+Str(ifps)
	prompt(msg,resp)
	If resp<>"" Then
		i=Val(resp)
   	i=max2(5,min2(50,i))
	   ifps=i
	EndIf 
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
Else
	wdx=zonex:wdy=zoney
	xmax=zonedx:ymax=zonedy
EndIf
'wdx=0:wdy=0:xmax=400:ymax=300
xmax=2*Int((xmax+2)\2):ymax=2*Int((ymax+2)\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)
nsamplesvideo = ichannels*iRate\iFPS
buffersize = nSamplesvideo*sizeof(short)
If OpenVideoAudioStream("video/test.avi",xmax,ymax,iFPS,iQuality,iChannels,iBits,iRate)=0 then
  guinotice "error: OpenVideoAudioStream() !"
Else
  record=1 
  mybuffersoundj=mybuffersoundi-nSamplesvideo
  If mybuffersoundj<1 Then mybuffersoundj+=nsample
  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
		hwin=GetAncestor(hwin, GA_ROOT)
      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+"                         ")
showwindow(winh,sw_minimize)
showwindow(winh,sw_restore)
Sleep 500
setforegroundwindow(getguih("win"))
End Sub
Dim Shared As Integer tsubzone=0,tmouse,tdraw
Dim Shared As Any Ptr graphbuffer,myimage
Sub subzone
	tsubzone=1
End Sub
Sub subleftmouse
If tmouse=0 Then
	tmouse=1
	zonex=guimousex
	zoney=guimousey
ElseIf tmouse=1 Then
	tmouse=0
	zonedx=max2(1,guimousex-zonex)
	zonedy=max2(1,guimousey-zoney)
EndIf
sleep 500
End Sub
Sub subrightmouse
If tmouse=0 Then
	If Abs(zonex+zonedx-guimousex)<15 And Abs(zoney+zonedy-guimousey)<15 Then
		tmouse=1
	Else 	
		quit=1
	EndIf
Else
	tmouse=0
EndIf
Sleep 500
End Sub
Sub submovemouse
If tmouse=1 Then
	zonedx=max2(1,guimousex-zonex)
	zonedy=max2(1,guimousey-zoney)	
   Put graphbuffer,(0,0),myimage,pset
   Line graphbuffer,(zonex,zoney)-Step(zonedx,zonedy),RGB(200,0,0),b
   tdraw=1
EndIf
End Sub
Sub subzone2()
Dim As Integer i,j
printgui("win.mode","zone     ")
mode="zone"
tmouse=0
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-4,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
myimage=ImageCreate(x,y,RGB(0,200,0),32)
memcpy(myimage+32,bmpbits,(x*y-1)*4-32)
button("win2.done","done",@subquit,200,28,55,20)
graphicbox("win2.graph",0,0,x,y,"gfx")
openwindow("win2","select zone",0,0,x+4,y+4,ws_popup)
trapclose("win2",@subquit)
disablegui("win")
guisetfocus("win2.done")

trapLeftmouse("win2.graph",@subleftmouse)
trapRightmouse("win2.graph",@subrightmouse)
trapmovemouse("win2.graph",@submovemouse)

graphbuffer=getguigfxbuffer("win2.graph")
Put graphbuffer,(0,0),myimage,PSet 
Line graphbuffer,(zonex,zoney)-Step(zonedx,zonedy),RGB(200,0,0),b
guirefreshwindow("win2")

While quit=0 And guitestkey(vk_escape)=0
	guiscan
	Sleep 80
	If tdraw=1 Then tdraw=0: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 Point mousepoint

'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
  getcursorpos(@mousepoint)
  If mousepoint.x>=wdx And mousepoint.x<=(wdx+x) Then
     If mousepoint.y>=wdy And mousepoint.y<=(wdy+y) Then
     	  DrawIcon bmpdc, mousepoint.x-wdx,mousepoint.y-wdy, GetCursor
     EndIf
  EndIf
  select case iBPP
  	Case 32 : Write32BitPixels(bmpbits)'myimage)'ScreenPtr())
  	Case 16 : Write16BitPixels(bmpbits)'myimage)'ScreenPtr())
  end select
  
  for i As integer=0 to nSamplesvideo-1
  	 If Abs(mybuffersoundj-mybuffersoundi)>nsamplesvideo Then'SamplesPerBuffer Then 
       mybuffersoundj+=1:If mybuffersoundj>nsample Then mybuffersoundj=0
    EndIf 
    samples(i)=mybuffersound(mybuffersoundj)
  next
  WriteAudioSamples(@Samples(0),BufferSize)  
  time1+=1.0/ifps
  If Timer<time1 Then
  	Sleep Int(min(0.4,time1-Timer)*1000)
  Else
   'Sleep 0
  EndIf 
  If Timer>timerec+maxtime Or (guitestkey(vk_f6) And guitestkey(vk_control)) Then
  	  showwindow(winh,sw_restore)
     substop() 'maxtime sec max
  EndIf 
  time2=Timer
  i=Int((time2-timerec)\60):i=time2-timerec-i*60
  If i<10 Then timemsg="0"+Str(i) Else timemsg=Str(i)
  timemsg=Str(Int((time2-timerec)\60))+":"+timemsg+"   "
Else
  Sleep 80
  time1=timer
  time2=Timer
  timemsg=Time$
  If guitestkey(vk_f1) Then subfps()
  If guitestkey(vk_f5) And guitestkey(vk_control) Then
  	  showwindow(winh,sw_minimize)
  	  subrecord()
  EndIf
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))


file=freefile
Open ficini For Output As #file
Print #file,mode
Print #file,windowx
Print #file,windowy
Print #file,windowdx
Print #file,windowdy
Print #file,zonex
Print #file,zoney
Print #file,zonedx
Print #file,zonedy
Print #file,ifps
Close #file


guiclose()
guiquit()
End 


