Tomar una fotografía desde un formulario en Fox

Hola, recientemente me estoy iniciando en fox pro 9, me parece un lenguaje muy completo e insteresante, bueno mi pregunta es la siguiente, o mas bien yo deseo crear un sistema en el que al momento en que un usuario inicie sesion, o acceda a mi sistema una webcam que estee conectada al equipo tome una fotografia a esa persona, de forma automatica y otro formulario en el que yo mediante un command tome una fotografia a esa persona y que guarde esa fotografia en una tabla, la verdad me es muy urgente solucionar este problema y de ante mano muchas gracias por tu ayuda.

1 Respuesta

Respuesta
1
Te paso un código para obtener capturas desde una webcam.
Salu2!
************
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="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="Capturar",;
Enabled=.F.
ADD object cmdPreview As CommandButton WITH Default=.T.,;
Left=106, Top=264, Height=27, Width=100, Caption="Vista Previa",;
Enabled=.F.
ADD object cmdClose As CommandButton WITH Cancel=.T.,;
Left=250, Top=264, Height=27, Width=70, Caption="Cerrar"
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
#define WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)
lcFile = "" && File name to create
lcFile = "c:tmpSAMPLES.JPG"
this.msg(WM_CAP_GRAB_FRAME, 0,0)
this.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1)
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 + ": 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, gt0
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)
hola pues disculpa por volver a molestarte, gracias por el codigo, pero pienso que seria mejor si me enviaras un ejemplo pues la verdad no entiendo mucho el codigo solo algunas partes y no se que clase de control es el que se usa pata visualizar la imagen, gracias por la ayuda. mi correo es [email protected]
Se envió por mail un ejemplo.
Salu2!
Muchisimas gracias amigo, me sirvio de maravilla lo que me enviaste, gracias. pero disculpa que te moleste otra vez esque se me presento otra dificultad, mira tengo un buscador en un formulario es un combobox donde me filtra los nombres de los clientes en un grid, me funciona perfectamente, pero mira yo quisiera que todos esos nombres que me aparecen en el grid al momento de hacer  la busqueda, al momento de hacer doble clic sobre uno de esos nombres me lleve a otro formulario donde automaticamente complete los campos de codigo, nombres, direccion todos los datos que estaban en el grid se trasladen a otro formulario. No se si podrias ayudarme con esa otra dificultad. de ante mano muchas gracias por tu tiempo..!
Con gusto responderé a todas tus dudas, simplemente necesito que cierres esta pregunta calificando mi desempeño y realices una nueva para que no se mezclen las preguntas.
Salu2!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas