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
1
Anónimo
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!