test-dib.tcl

简单的vc视频捕捉

#cd i:/vfwtcl/debug
load vfwtcl.dll
avicap .avi
pack .avi
.avi connect 0
.avi preview 50
.avi setcapturesetup -thread 1 -captureaudio 0
if {[.avi compressdlg]!="DIB "} {
	set compressed 1
	.avi begincompression	
} else {
	set compressed 0
}
dib .dib 640 480
.dib begin [.avi getbmpinfo $compressed]
pack .dib
proc video_callback {w data datalen videohdr} {
	.dib draw $data
}
pack [button .stop -text "Exit" -command stop]
.avi cbkonvideostream video_callback $compressed
.avi capture
proc stop {} {
	global compressed
	.avi stopcapture
	if {$compressed} {
		.avi endcompression
	}
	.dib end
	.dib destroy
	catch {.avi disconnect}
	.avi destroy
	# Do not forget to destroy at the end
	exit
}