Capturar imagenes desde una webcam a VFP

Este codigo te permite capturar imagenes y videos... espero que te sirva...
Local oform
oform = createobject("tform")
oform.show(1)
* end of main
define class tform as form
#define wm_cap_start 0x0400
#define wm_cap_driver_connect (wm_cap_start+10)
#define wm_cap_driver_disconnect (wm_cap_start+11)
#define wm_cap_driver_get_caps (wm_cap_start+14)
#define wm_cap_set_preview (wm_cap_start+50)
#define wm_cap_set_overlay (wm_cap_start+51)
#define wm_cap_set_previewrate (wm_cap_start+52)
#define wm_cap_get_status (wm_cap_start+54)
#define wm_cap_grab_frame (wm_cap_start+60)
width=340
height=310
autocenter=.t.
caption="captura de fotos / video"
minbutton=.f.
maxbutton=.f.
hwindow=0
hcapture=0
capwidth=0
capheight=0
capoverlay=0
add object cmdgetframe as commandbutton with default=.t.,;
left=15, top=264, height=27, width=90, caption="tomar foro",;
enabled=.f.
add object cmdpreview as commandbutton with default=.t.,;
left=106, top=264, height=27, width=100, caption="tomar video",;
enabled=.f.
add object cmdclose as commandbutton with cancel=.t.,;
left=250, top=264, height=27, width=70, caption="salir"
procedure activate
if this.hwindow = 0
declare integer getfocus in user32
this.hwindow = getfocus()
this.createcapturewindow
this.driverconnect
endif
procedure destroy
this.releasecapturewindow
procedure cmdclose.click
thisform.release
procedure cmdgetframe.click
thisform.getframe
procedure cmdpreview.click
thisform.startpreview
procedure getframe
this.msg(wm_cap_grab_frame, 0,0)
procedure createcapturewindow
#define ws_child 0x40000000
#define ws_visible 0x10000000
declare integer capcreatecapturewindow in avicap32;
string lpszwindowname, long dwstyle,;
integer x, integer y,;
integer nwidth, integer nheight,;
integer hparent, integer nid
this.hcapture = capcreatecapturewindow("",;
ws_child+ws_visible,;
10,8,320,240, this.hwindow, 1)
procedure driverconnect
this.msg(wm_cap_driver_connect, 0,0)
if this.iscaptureconnected()
this.getcapturedimensions
store .t. to this.cmdgetframe.enabled,;
this.cmdpreview.enabled
this.caption = this.caption + ": conexxion, " +;
ltrim(str(this.capwidth)) + "x" +;
ltrim(str(this.capheight))
else
this.caption = this.caption + ": fallida"
endif
procedure driverdisconnect
this.msg(wm_cap_driver_disconnect, 0,0)
procedure releasecapturewindow
if this.hcapture <> 0
this.driverdisconnect
declare integer destroywindow in user32 integer hwnd
= destroywindow(this.hcapture)
this.hcapture = 0
endif
procedure msg(msg, wparam, lparam, nmode)
if this.hcapture = 0
return
endif
if vartype(nmode) <> "n" or nmode=0
declare integer sendmessage in user32;
integer hwnd, integer msg,;
integer wparam, integer lparam
= sendmessage(this.hcapture, msg, wparam, lparam)
else
declare integer sendmessage in user32;
integer hwnd, integer msg,;
integer wparam, string @lparam
= sendmessage(this.hcapture, msg, wparam, @lparam)
endif
function iscaptureconnected
* analyzing fcaptureinitialized member of the capdrivercaps structure
#define capdrivercaps_size 44
local cbuffer, nresult
cbuffer = repli(chr(0),capdrivercaps_size)
this.msg(wm_cap_driver_get_caps, len(cbuffer), @cbuffer, 1)
this.capoverlay = buf2dword(substr(cbuffer,5,4))
nresult = asc(substr(cbuffer, 21,1))
return (nresult<>0)
procedure getcapturedimensions
* reading uiimagewidth and uiimageheight members
* of the capstatus structure
#define capstatus_size 76
local cbuffer
cbuffer = repli(chr(0), capstatus_size)
this.msg(wm_cap_get_status, len(cbuffer), @cbuffer, 1)
this.capwidth = buf2dword(substr(cbuffer,1,4))
this.capheight = buf2dword(substr(cbuffer,5,4))
procedure startpreview
this.msg(wm_cap_set_previewrate, 30,0)
this.msg(wm_cap_set_preview, 1,0)
if this.capoverlay <> 0
this.msg(wm_cap_set_overlay, 1,0)
endif
procedure stoppreview
this.msg(wm_cap_set_preview, 0,0)
enddefine
function buf2dword(lcbuffer)
return asc(substr(lcbuffer, 1,1)) + ;
bitlshift(asc(substr(lcbuffer, 2,1)), 8) +;
bitlshift(asc(substr(lcbuffer, 3,1)), 16) +;
bitlshift(asc(substr(lcbuffer, 4,1)), 24)
*by implementing the code below into the getframe method
*the captured frame will save to a bmp file when the getframe
*button is clicked.
#define wm_cap_file_savedib (wm_cap_start + 25)
local lcfile
lcfile = "" && file name to create
lcfile = "c:\chino.bmp"
this.msg(wm_cap_grab_frame, 0,0)
this.msg(wm_cap_file_savedib, 0,lcfile,1)