RE:Capturar fotos desde webcam??
Prueba con este código ...
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=500
Height=400
AutoCenter=.T.
Caption="Using Video Capture"
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="Get Frame",;
Enabled=.F.
Add Object cmdPreview As CommandButton With Default=.T.,;
Left=106, Top=264, Height=27, Width=100, Caption="Preview Video",;
Enabled=.F.
Add Object cmdClose As CommandButton With Cancel=.T.,;
Left=250, Top=264, Height=27, Width=70, Caption="Close"
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)
#DEFINE WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)
LOCAL lcFile
lcFile = "c:\sample.bmp"
THIS.msg(WM_CAP_GRAB_FRAME, 0,0)
THIS.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,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 + ": connected, " + lTRIM(Str(This.capWidth)) + "x" + LTRIM(Str(This.capHeight))
Else
This.Caption = This.Caption + ": failed to connect"
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)
David Amador Tapia
WebMaster "La Web de Davphantom"
www.davphantom.net
Cartagena. Colombia