Fotos en visual basic
Podrías ayudarme con un programa que tome fotos y las guarde con nombre, ¿fecha y hora?
1 respuesta
Respuesta de niwdeloko
1
¿Qué tome fotos...?
Ok pero da más detalles quieres utilizar algún hadsware en especial o solo con una camar web... o como lo quieres especifica poco más... ¿o si tienes algo avanzado o no?
Ok pero da más detalles quieres utilizar algún hadsware en especial o solo con una camar web... o como lo quieres especifica poco más... ¿o si tienes algo avanzado o no?
Gracias por contestarme, es muy importante, lo que deseo hacer es un programa que tome fotos a través the un webcam o cualquier cámara, que a su vez guarde la foto con nombre, día, y hora, es que tengo un programa en access y quiero sacar fortos cuando le doy un click en un record especifico, se que a través de visual basic puedo hacerlo y luego llamar la rutina que haya hecho en visual basic. Gracias por tu disponibilidad y ayuda.
Ok entonces lo que te falta es la rutina para tomar fotos ... que hardware usas tipo de web cam... etc, pero mira esto haber te sirve... lo comentas
Como primera cosa, debés bajarte esta OCX. Es una OCX pública que el autor puso a disposición para manejar la webcam: http://www.shrinkwrapvb.com/ezvidcap.htm
La versión que tenés que bajar es la correspondiente a Visual Basic 6 (VB6)
Una vez bajada, deberás registrarla. El procedimiento es:
Inicio->Ejecutar:
c:\Directorio_de_Windows\Directorio_system\regsvr32.exe Directorio_de_la_OCX\ezVidC60.ocx
Una vez que ya disponés de la OCX registrada, acá tenés el código fuente para hacer andar la captura de fotos:
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="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
#DEFINE WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)
LOCAL lcFile
lcFile = "" && File name to create
lcFile = "c:\temp\sample.bmp"
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
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)
Fíjate que en el procedimiento GetFrame, aparece una variable lcFile como la que contiene el archivo que te genera el bitmap. En lo particular, yo invoco a este procedimiento con un parámetro (que deberías ponerle al principio). Ese parámetro es el ID del registro, con el cual me aseguro tener un nombre único para los archivos de fotos. Y con eso estaría, justamente ahora estoy viendo cómo almacenar ese archivo en un campo general, para eso entré al foro y me encontré con tu consulta. Espero haberte servido de utilidad.
Este código fuente estaba en http://fox.wikis.com/wc.dll?Wiki~VideoCaptureApi~VFP así que le doy créditos a quien lo realizó. Espero, por lo menos, haberte subsanado todo el tiempo de búsqueda en la web que tuve yo ayer para encontrar ésto. :-D
Abrazos, edwin.
Como primera cosa, debés bajarte esta OCX. Es una OCX pública que el autor puso a disposición para manejar la webcam: http://www.shrinkwrapvb.com/ezvidcap.htm
La versión que tenés que bajar es la correspondiente a Visual Basic 6 (VB6)
Una vez bajada, deberás registrarla. El procedimiento es:
Inicio->Ejecutar:
c:\Directorio_de_Windows\Directorio_system\regsvr32.exe Directorio_de_la_OCX\ezVidC60.ocx
Una vez que ya disponés de la OCX registrada, acá tenés el código fuente para hacer andar la captura de fotos:
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="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
#DEFINE WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25)
LOCAL lcFile
lcFile = "" && File name to create
lcFile = "c:\temp\sample.bmp"
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
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)
Fíjate que en el procedimiento GetFrame, aparece una variable lcFile como la que contiene el archivo que te genera el bitmap. En lo particular, yo invoco a este procedimiento con un parámetro (que deberías ponerle al principio). Ese parámetro es el ID del registro, con el cual me aseguro tener un nombre único para los archivos de fotos. Y con eso estaría, justamente ahora estoy viendo cómo almacenar ese archivo en un campo general, para eso entré al foro y me encontré con tu consulta. Espero haberte servido de utilidad.
Este código fuente estaba en http://fox.wikis.com/wc.dll?Wiki~VideoCaptureApi~VFP así que le doy créditos a quien lo realizó. Espero, por lo menos, haberte subsanado todo el tiempo de búsqueda en la web que tuve yo ayer para encontrar ésto. :-D
Abrazos, edwin.
Creo que con esta rutina voy a lograr lo que quiero, ahora bien mi aplicación esta en access, dime donde inserto el código, se que puedo hacerlo llamando esta rutina desde access, al editar el visual basic... gracias..
Ahhh ok ahora caigo.. estas trabajando solo desde access. Nada de código nativo en vb6.. estas utilizando el visual de office que trae access...
Mira casi no trabajo directamente desde el vb hago todo pero haber que podemos hacer como exactamente estas trabajando...
Porque el código que te di debes ponerlo en un botón
Mira casi no trabajo directamente desde el vb hago todo pero haber que podemos hacer como exactamente estas trabajando...
Porque el código que te di debes ponerlo en un botón
Tratare de explicarme mejor; tengo una pequeña aplicación en access, en una forma tengo los records de personas donde los records de personas tienen nombre, numero de registro, entrega, y fecha, en el campo de la fecha cuando le doy click automáticamente me da la fecha, en este mismo campo lo que quiero es que tome una foto de la persona con la webcam y la guarde en un campo ya determinado como OLE Object el cual ya es parte del record, no necesito que aparezca ninguna otra pantalla, simplemente tire la foto y la guarde. Gracias nuevamente por tu disponibilidad.
Mirea man ahí si ta la dificultad, el código que te proporcione trabaja con un activeX OCX. Y al menos no podría decirte como aplicarlo mediante access pues todo trabajo lo hago mediante vb6, que es más fácil.
