Tomando fotos con la webcam

[armando.lagunas]

Hola

esta función solo refresca el objeto en donde quiero la fotografía, en este caso es un control image.

Code: Select all  Expand view

STATIC FUNCTION LeerClipBoard( oImg )

  oImg:LoadFromClipboard()
  oImg:Refresh()

RETURN Nil

 

[José Vicente Beltrán]

Armando y Karinha, gracias a ambos por adaptar la clase a BCC7, funciona muy bien y me ha sido de gran utilidad.

[karinha]

Hola, todos los reclamos/créditos son de Armando que és una persona fantástica. Gracias y felicitaciones Armando.

[FiveWiDi]

Hola a todos, en especial a Armando.

Es posible disponer la clase para la versión para Harbour y BCC7 a 32b?

Muchas gracias.

[groiss]

Es posible disponer la clase para la versión para Harbour y BCC7 a 32b?

FiveWidi:
La clase la tienes publicada unos post más atrás, solo tienes que compilarla y enlazala, va de maravilla en cualquiera de los BCC.
Un lujo de regalo.
Un saludo y mil gracias a su autor.

[Tatoo]

Hola a todos...y otra genialidad de los autores de este foro...
Alguno tuvo problemas con la selección de una webcam usb?
Lo estoy probando con una webcam incorporada en una notebook con W7 Professional...
Con software de cámaras la reconoce...es una Genius iSlim 300X...
También si está conectada la usb no saca la foto...como si no pudiera buscar bien en el array de cámaras...
Dejo la consulta...
Abrazo para todos...

[karinha]

Saludos Tatoo, intenta con esta:

https://www.4shared.com/zip/we6AbPf2ba/TSCAN32.html

[cnavarro]

Buenas tardes compañeros
Alguien ha utilizado esta clase del compañero Armando en una tablet con dos cámaras?
No consigo que funcione ( la cámara me refiero )

[Patricio Avalos Aguirre]

Hola a tod@s

consulta, como sacar fotos de una cámara que tiene un pc all on one o notebook?
aparece que no hay cámara instalada

[leandro]

Armando buenas tardes,

Integre a mi aplicación tu clase, para la toma de fotografías, yo uso borland, pero no logro hacerla andar. Me podrías echar una manita.
Cabe aclarar que el sistema operativo es Windows 10.

Code: Select all  Expand view

FUNCTION FotoCamara()
LOCAL xWnd, xImg, oWC, lClick := .f., oBtn, cFile

    oWC           :=  tWebCamPhoto():New()
    cFile         := ".\fotos\Capturawebcam.bmp"
   
    Define Font xFont Name "Calibri" Size 0,-13
 
    DEFINE WINDOW xWnd FROM 2,2 TO 25, 75 TITLE "Capturar Fotografia por WebCam" NOZOOM NOMINIMIZE

           @ 25, 350 IMAGE xImg OF xWnd SIZE 200,160 PIXEL ADJUST UPDATE
                           xImg:nProgress := 0

           @ 280,  25 BUTTON oBtn PROMPT "Capturar" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION ( oWC:Clipboard( xImg, cFile ), lClick := .t., xWnd:Update())
           @ 280, 120 BUTTON oBtn PROMPT "Traspasa" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION ( LeerClipBoard( oImg ), oWC:End(), xWnd:End(),  ) WHEN lClick
           @ 280, 215 BUTTON oBtn PROMPT "Salir"    OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION ( oWC:End()    , xWnd:End())
           @ 200, 360 BUTTON oBtn PROMPT "Opciones" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION oWC:Source()
           @ 200, 460 BUTTON oBtn PROMPT "Formato"  OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION oWC:Formato()

    ACTIVATE WINDOW xWnd ON INIT ( xWnd:Center(), oWC:CreateWnd( xWnd , 25, 10, 300, 220), oWC:Connect() )

RETURN Nil

FUNCTION LeerClipBoard( oImg )

  oImg:LoadFromClipboard()
  oImg:Refresh()

RETURN Nil

 

Code: Select all  Expand view

#Include "FiveWin.ch"
#include "Struct.ch"

#define WM_CAP_START             WM_USER
#define WM_CAP_DRIVER_CONNECT    WM_CAP_START + 10
#define WM_CAP_DRIVER_DISCONNECT WM_CAP_START + 11
#define WM_CAP_SET_PREVIEW       WM_CAP_START + 50
#define WM_CAP_SET_PREVIEWRATE   WM_CAP_START + 52
#define WM_CAP_SET_SCALE         WM_CAP_START + 53

#define WM_CAP_EDIT_COPY         WM_CAP_START + 30
#define WM_CAP_FILE_SAVEDIB      WM_CAP_START + 25

#define WM_CAP_DLG_VIDEOFORMAT   WM_CAP_START + 41
#define WM_CAP_DLG_VIDEOSOURCE   WM_CAP_START + 42
#define WM_CAP_GET_STATUS        WM_CAP_START + 54

#define HWND_BOTTOM   1
#define SWP_NOMOVE    2
#define SWP_NOSIZE    1
#define SWP_NOZORDER  4

STATIC _oWebcam_      :=  Nil

//------------------------------------------------

EXIT Procedure WebcamDisconnect()
  if _oWebcam_  <>  nil
     _oWebcam_:Disconnect()
     _owebcam_:=nil
  endif
return

//------------------------------------------------

CREATE CLASS tWebCamPhoto

  DATA nFrameRate                    INIT 66      // Velocidad de actualización de la WebCam
  DATA nJpgQuality                   INIT 75      // Calidad de los JPG

  DATA hWnd                                       // Handle de la centana de la imagen
  DATA aDrivers                                   // Drivers de captura disponibles
  DATA nDriver                                    // número del driver instalado + 1
  DATA lConnected                    INIT .F.     // ¿Está conectada>
  DATA cWebCamDriver                 INIT "Microsoft WDM Image Capture (Win32)"

  METHOD New( cDriver, lSelect )     CONSTRUCTOR  // Construye el objeto. cDriver es el nombre del driver a usar, recomendado guardar en ini. Si lSelect=.T. muestra la lista para escogerlo

  METHOD CreateWnd( oWnd1, nLeft, nTop, nWidth, nHeight, nStyle, cTitle )
                                                  // Crea la ventana para la cámara en oWnd1.

  METHOD Connect                                  // Conecta la cámara
  METHOD Disconnect                               // Desconecta la cámara
  METHOD Clipboard( oImg, cFile )                 // Captura la imagen en clipboard actualiza a oImg con la imagen capturada y guarda un archivo bmp
  METHOD Source()                                 // Configura la fuente de la webcam
  METHOD Formato()                                // Configura el formato de la imagen
  METHOD GetStatus()                              // Status de la imagen
  METHOD Resize()                                 // Redimensiona la ventana de la imagen
  METHOD End() INLINE ::Disconnect()              // Finaliza el objeto

ENDCLASS

//------------------------------------------------

METHOD New( cDriver, lSelect ) CLASS tWebCamPhoto

  DEFAULT cDriver :=   ::cWebCamDriver
  DEFAULT lSelect :=   .f.

  LoadLibrary("avicap32.dll")

  ::aDrivers      :=   WebCamList()
  ::nDriver       :=   aScan(::aDrivers,{|u| Upper(StrTran(cDriver,' '))==Upper(StrTran(u,' '))})

  IF ::nDriver    ==   0 .or. lSelect
     ::nDriver    :=   WebCamSelect( ::nDriver, ::aDrivers )
  ENDIF

  _oWebCam_       :=   Self

return Self

//------------------------------------------------

METHOD CreateWnd( oWnd1, nTop, nLeft, nWidth, nHeight, nStyle, cTitle ) CLASS tWebCamPhoto

  DEFAULT nTop    :=   0, ;
          nLeft   :=   0, ;
          nWidth  := 160, ;
          nHeight := 120
  DEFAULT nStyle  := nOr( WS_VISIBLE, WS_CHILD, WS_BORDER )

  IF    ::nDriver  > 0
        ::hWnd    := wCamCreaWnd( ::aDrivers[ ::nDriver ], nStyle, nLeft, nTop, nWidth, nHeight, oWnd1:hWnd, 0 )
  ENDIF

return  ::hWnd

//------------------------------------------------

METHOD Connect() CLASS tWebCamPhoto

   if   ::hWnd    <>  nil
        if SendMessage( ::hWnd, WM_CAP_DRIVER_CONNECT, ::nDriver-1, 0) = 1

           ::cWebCamDriver :=  ::aDrivers[ ::nDriver ]
           SendMessage(::hWnd, WM_CAP_SET_SCALE, 1, 0)
           SendMessage(::hWnd, WM_CAP_SET_PREVIEWRATE, ::nFrameRate, 0)
           SendMessage(::hWnd, WM_CAP_SET_PREVIEW, 1, 0)

           ::lConnected    :=  .T.
           ::Resize()

        else

           ::lConnected    :=  .F.
           ::hWnd          :=  Nil

        endif
   endif
return ::lConnected

//------------------------------------------------

METHOD Disconnect CLASS tWebCamPhoto

   IF  ::hWnd     <>  Nil .and. ::lConnected
       if SendMessage( ::hWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0) = 1

          ::lConnected     :=  .F.
          _oWebCam_        :=  nil
       endif
   ENDIF
return nil

//------------------------------------------------

METHOD Clipboard( oImg, cFile ) CLASS tWebCamPhoto
  Local lSucc     :=.F.

  if   ::hWnd     <>   nil

      lSucc       :=  (  SendMessage( ::hWnd, WM_CAP_EDIT_COPY, 0, 0) = 1 )
      IF lSucc .and. oImg <> nil
         SendMessage( ::hWnd, WM_CAP_FILE_SAVEDIB, 0, cFile )
         oImg:LoadFromClipboard()
         oImg:Refresh()
      ENDIF

  endif
return lSucc

//------------------------------------------------

METHOD Source() CLASS tWebCamPhoto

  if  ::hWnd<>nil .and. ::lConnected
        SendMessage( ::hWnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0 )
  endif

return nil

//------------------------------------------------

METHOD Formato() CLASS tWebCamPhoto

  if  ::hWnd<>nil .and. ::lConnected
        SendMessage( ::hWnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0 )
        ::Resize()
  endif

return nil

//------------------------------------------------

METHOD GetStatus()
  Local oPoint, oStatus, cBuffer

  STRUCT oPoint
    MEMBER X AS LONG
    MEMBER Y AS LONG
  ENDSTRUCT

  STRUCT oStatus
    MEMBER nWidth         AS LONG                   // Width of the image
    MEMBER nHeight        AS LONG                   // Height of the image
    MEMBER lLive          AS LONG                   // Now Previewing video?
    MEMBER lOverlay       AS LONG                   // Now Overlaying video?
    MEMBER lScale         AS LONG                   // Scale image to client?
    MEMBER oXYScroll      AS STRING LEN 8           // AS POINTAPI     // Scroll position
    MEMBER lDefPalette    AS LONG                   // Using default driver palette?
    MEMBER lAudHardware   AS LONG                   // Audio hardware present?
    MEMBER lCapFile       AS LONG                   // Does capture file exist?
    MEMBER nCurVidFrm     AS LONG                   // # of video frames cap'td
    MEMBER nCurVidDropped AS LONG                   // # of video frames dropped
    MEMBER nCurWavSamples AS LONG                   // # of wave samples cap'td
    MEMBER nCurTimeEl     AS LONG                   // Elapsed capture duration
    MEMBER hPalCur        AS LONG                   // Current palette in use
    MEMBER lCapturing     AS LONG                   // Capture in progress?
    MEMBER nReturn        AS LONG                   // Error value after any operation
    MEMBER nVidAlloc      AS LONG                   // Actual number of video buffers
    MEMBER wAudAlloc      AS LONG                   // Actual number of audio buffers
  ENDSTRUCT

  oPoint:x           :=  0
  OPoint:y           :=  0
  oStatus:oXYScroll  :=  oPoint:cBuffer

  cBuffer            :=  oStatus:cBuffer

  SendMessage( ::hWnd, WM_CAP_GET_STATUS, Len(cBuffer), @cBuffer)

  oStatus:cBuffer    := cBuffer
return oStatus

//------------------------------------------------

METHOD Resize() CLASS tWebCamPhoto
  Local oStatus

  if ::hWnd<>nil .and. ::lConnected
    SysRefresh()
    oStatus   := ::GetStatus()
    SetWindowPos(::hWnd,HWND_BOTTOM,0,0,oStatus:nWidth,oStatus:nHeight,;
                 nOr(SWP_NOMOVE,SWP_NOZORDER ) )
    SysRefresh()
  endif

return nil

//------------------------------------------------

Function WebcamList()
   Local aDrivers    := {}, ;
         nDriver     := 0 , ;
         cName            , ;
         cVersion         , ;
         nLen        := 255

   DO WHILE .T.
      cName     :=  space(nLen)
      cVersion  :=  space(nLen)
      IF !wCamGetDrvDesc(nDriver, @cName, nLen, @cVersion, nLen)
         EXIT
      ENDIF
      if chr(0)$cName
         cName       :=  Left(cName,At(chr(0),cName)-1)
      endif
      if chr(0)$cVersion
         cVersion    :=  Left(cVersion,At(chr(0),cVersion)-1)
      endif
      aAdd( aDrivers ,  cName)
      nDriver++
   ENDDO

return aDrivers

//------------------------------------------------

STATIC Function WebcamSelect( nDriver, aDrivers )
  Local oDlg, oCbx
  Local cDriver
  Local lSelect    := .F.

  DEFAULT nDriver  := 0 , aDrivers  :=  WebcamList()
  IF Empty(aDrivers)
    MsgAlert('No Webcams')
    return 0
  ELSE
    cDriver  :=  aDrivers[Max(1,nDriver)]
    DEFINE DIALOG oDlg FROM 0,0 to 6,40 TITLE "Select webcam"
        @ 0,0 COMBOBOX oCbx VAR cDriver OF oDlg ITEMS aDrivers;
          SIZE 160,50 PIXEL
        @ 1.5, 4 BUTTON "Select" OF oDlg SIZE 40,12;
           ACTION (nDriver:=oCbx:nAt ,oDlg:End())
        @ 1.5,16 BUTTON "Cancel" OF oDlg SIZE 40,12;
           ACTION oDlg:End()
    ACTIVATE DIALOG oDlg CENTERED
  ENDIF

return nDriver

//------------------------------------------------

Function WebCamVersion(nDriver)
  Local cName, cVersion, nLen:=255
  DEFAULT nDriver:=0
  IF nDriver>0
    cName:=space(nLen); cVersion:=space(nLen)
    IF wCamGetDrvDesc(nDriver-1, @cName, nLen, @cVersion, nLen)
      if chr(0)$cVersion
        cVersion:=Left(cVersion,At(chr(0),cVersion)-1)
      endif
    ELSE
      cVersion:=nil
    ENDIF
  ENDIF
return cVersion

//------------------------------------------------

DLL32 STATIC FUNCTION wCamGetDrvDesc( nDriver AS _INT, cName AS STRING, nName AS LONG, cVersion AS STRING, nVersion AS LONG) AS BOOL PASCAL FROM "capGetDriverDescriptionA" LIB "avicap32.dll"

//------------------------------------------------

DLL32 STATIC FUNCTION wCamCreaWnd   ( cTitle AS STRING, nStyle AS LONG, x AS LONG, y AS LONG, nWidth AS LONG, nHeight AS LONG, hWndParent AS LONG, nID AS LONG) AS LONG PASCAL FROM "capCreateCaptureWindowA" LIB "avicap32.dll"

//------------------------------------------------


 

[leandro]

Con la clase de Javier LLoris, la que viene integrada con fw, sucede los siguiente:



Aunque activa la camara, la imagen no se muestra.

No se por donde mas revisar. Probé en tres computadores, pero en ninguno funciona.

[MOISES]

Hola:

Sí, en efecto la clase no funciona debidamente ya bajo Windows 10.

Yo tampoco he conseguido que funcione, y no sé dónde puede estar el problema.

[cnavarro]

Como ya he mencionado, en mis equipos funciona correctamente ( Windows 10 64 bits/32 bits), aunque si es cierto que hace tiempo que algún compañero dijo que les daba problemas con algunos modelos de cámara, pero según parece era un problema de drivers.

[leandro]

Cristobal, gracias por responder, tienes razón, lo probé en un tercer equipo, con windows 10 64 bits marca hp. Y funciono correctamente, pero el problema es debo garantizar el funcionamiento para un proyecto de urgencia que salio.

Y el porcentaje de efectividad es bajo, lo probe en 3 compus y solo funciono en uno 1.

Se me ocurre de momento intentar compilar con visual studio, pero la verdad no se que debo descargar. El instalador me sugiere lo siguiente:




De todo eso que debo descargar para poder compilar la aplicación?.

De antemano gracias

[MOISES]

No creo que sea un problema de drivers, porque la web cam funciona por ejemplo perfectamente con Skype.