Help making photo with webcam

[Silvio]

can U send me a sample with tscan of carmona or another class to capture from a webcam a picture and save it into jpg file
I try with test sample but it make error "General failure in response MSH_Opends" when I try to call my webcam to create a photo from a application

[Mike Serra]

Espero que te sirva, a mi me funciona correctamente. Si te falta algún fichero me lo comentas. SALUDOS

Code: Select all  Expand view  RUN

#include "Fivewin.ch"

Static cWebCamDriver := "Microsoft WDM Image Capture"
Static _oWebcam_ := nil
************************************************************************
*
************************************************************************
Function WebCam(codart,xalias,ori)
  Local oDlg_Cam, oImg,oWc,bton,oGet,cFich,lVale:=.F.,cFichero:=SPACE(254)
 
  if codart=NIL
     codart:="imap" + DTOS(date()) + strtran(time(),":")
  end if
  cFichero:="\" + codart + ".bmp"
  cFich:= "\" + codart + ".bmp"

  oWC:=tWebCamPhoto():New()

  DEFINE DIALOG oDlg_Cam TITLE "Adquirir imagen del Producto via WebCam" FROM 0,0 TO 290,725 PIXEL
    @ 5,180 IMAGE oImg OF oDlg_Cam SIZE 160,120 PIXEL ADJUST
    @ 130,10 BUTTON "Capturar" OF oDlg_Cam SIZE 30,10 PIXEL ACTION oWc:Save(oImg,cFich)
    @ 130,45 BUTTON "Aceptar"  OF oDlg_Cam SIZE 30,10 PIXEL ACTION (oWc:Disconnect(),lVale:=.T.,oDlg_Cam:End())
    @ 130,80 BUTTON "Cancelar" OF oDlg_Cam SIZE 30,10 PIXEL ACTION (oWc:Disconnect(),oDlg_Cam:End())

    @ 132,180 SAY oSay PROMPT "Localizacion fichero " PIXEL
    @ 130,230 GET oGet VAR cFich OF oDlg_Cam SIZE 110,10 PIXEL WHEN .F.

    oImg:nProgress:=0

  ACTIVATE DIALOG oDlg_Cam CENTER ON INIT;
    (oWC:CreateWnd(oDlg_Cam,10,10,260,180),oWc:Connect())
  if lVale
     sele (xAlias)
     replace (xalias)->foto with cFichero
     &&ori:Refresh()
     ori:setbmp(cFichero)
     ori:refresh()
     sysrefresh()
  end if
return lVale



/**********************************************************
*
*
* Clase tWebCamPhoto (Sólo para FWH)
*  Objetivo: Capturar fotos con una Webcam
*
*  César E. Lozada, cesarlozada@hotmail.com
*  Los Teques, Venezuela - 22/06/2003
*
*
***********************************************************/
#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


*********************************************************
* EXIT Procedure WebcamDisconnect()
* Asegura la desconexión de la cámara.
*********************************************************
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>

  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(oWnd,nLeft,nTop,nWidth,nHeight,nStyle,cTitle) 
             // Crea la ventana para la cámara en oWnd.


  METHOD Connect          // Conecta la cámara
  METHOD Disconnect       // Desconecta la cámara

  METHOD Clipboard(oImg) //Captura la imagen en clipboard. Opcionalmente
                         //actualiza a oImg con la imagen capturada

  METHOD Save(oImg,cFile,nQuality)     //Captura la imagen y guarda en archivo (BMP/JPG).
                                       //Opcionalmente actualiza a oImg con la imagen capturada

  METHOD Source()                      //Configura la fuente de la webcam

  METHOD Format()                      //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)
  DEFAULT cDriver:=cWebCamDriver
  DEFAULT lSelect:=.F.
  ::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(oWnd,nTop,nLeft,nWidth,nHeight,nStyle,cTitle)
  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, oWnd:hWnd, 0)
  ENDIF
return ::hWnd
*===========================================================================
METHOD Connect()
  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
  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)
  Local lSucc:=.F.
  if ::hWnd<>nil
    lSucc:=(SendMessage(::hWnd, WM_CAP_EDIT_COPY, 0, 0)=1)
    IF lSucc .and. oImg<>nil
      oImg:LoadFromClipboard()
      oImg:Refresh()
    ENDIF
  endif
return lSucc
*===========================================================================
METHOD Save(oImg,cFile,nQuality)
  Local lSucc:=.F.
  Local cFileExt:=Upper(cFileExt(cFile))
  Local cFileName:=cFileNoExt(cFile)
  Local cExec:='BMPtoJPG.EXE'
  if ::hWnd<>nil
    CursorWait()
    IF (cFileExt=="JPG" .or. cFileExt=="JPEG")
      IF ::Clipboard()
        DEFAULT nQuality:=::nJpgQuality
        ::nJpgQuality:=Max(Min(Int(nQuality),100),10)
        WaitRun(cExec+' -q'+LTrim(Str(::nJpgQuality,3,0))+' -c'+cFileName+' -o -s',0)
      ENDIF
    ELSEIF cFileExt=='BMP'
      SendMessage(::hWnd, WM_CAP_FILE_SAVEDIB, 0, cFile)
    ENDIF
    CursorArrow()
    SysRefresh()
    IF !(lSucc:=File(cFile))
      MsgAlert("No pudo crearse "+cFile,cdi:vTitulo)
    ELSEIF oImg<>nil
       oImg:LoadImage(nil,cFile)
       oImg:Refresh()
    ENDIF
  endif
return lSucc
*===========================================================================
METHOD Source()
  if ::hWnd<>nil .and. ::lConnected
    SendMessage(::hWnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0)
  endif
return nil
*===========================================================================
METHOD Format()
  if ::hWnd<>nil .and. ::lConnected
    SendMessage(::hWnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
    ::Resize()
  endif
return nil
*===========================================================================
#include "Struct.ch"
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
*===========================================================================
#define HWND_BOTTOM   1
#define SWP_NOMOVE    2
#define SWP_NOSIZE    1
#define SWP_NOZORDER  4
METHOD Resize()
  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
  Local 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
****************************************************************************
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 "Seleccionar Webcam"
        @ 0,0 COMBOBOX oCbx VAR cDriver OF oDlg ITEMS aDrivers;
          SIZE 160,50 PIXEL
        @ 1.5, 4 BUTTON "Seleccionar" OF oDlg SIZE 40,12;
           ACTION (nDriver:=oCbx:nAt ,oDlg:End())
        @ 1.5,16 BUTTON "Cancelar" 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"
************************************************************************





[Silvio]

I try it but the program at first let me select the camera then it make error

[Mike Serra]

can you send me the error?. Posibly i don't send you all files. Sorry, but my english is so bad.

best regards.

[Silvio]

first


and then











Application
===========
Path and name: C:\work\prg\CICLISMO\Source\camfoto.Exe (32 bits)
Size: 1,215,488 bytes
Time from start: 0 hours 0 mins 0 secs
Error occurred at: 03/31/07, 01:25:59
Error description: Error BASE/1126 Argument error: STRTRAN
Args:
[ 1] = U
[ 2] = C
[ 3] = U

Stack Calls
===========
Called from: => STRTRAN(0)
Called from: camfoto.prg => (b)TWEBCAMPHOTO:NEW(124)
Called from: => ASCAN(0)
Called from: camfoto.prg => TWEBCAMPHOTO:NEW(124)
Called from: camfoto.prg => WEBCAM(17)

[Silvio]

I hope you help me

[AIDA]

a poco se puede usar una webcam con fivewin??

vere como se puede usar y si no puedo pues dare lata

Saluditos