WEBCAM EN WINDOWS 64 BITS

WEBCAM EN WINDOWS 64 BITS

Postby karinha » Wed Jun 04, 2014 1:28 pm

Señores, porque traba el programa?

Alguno de ustedes tien una versón que funcione en windows de 64 bits?

Gracias, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7824
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: WEBCAM EN WINDOWS 64 BITS

Postby George » Wed Jun 04, 2014 5:41 pm

Karinha,
El siguiente codigo (desde un directorio llamado C:\_CK_NEW\), basado en la clase WebCam desarrollada por Cesar E. Lozada, me funciona sin problemas en Windows 8.1 - 64 Bits.
Code: Select all  Expand view

#include "Fivewin.ch"
#DEFINE FALSE  .F.
#DEFINE TRUE   .T.

Static _oWebcam_ := nil, DllWebCam

Static cWebCamDriver := "Microsoft WDM Image Capture (Win32)"
************************************************************************
*
************************************************************************
Function Test(oImage1)
  Local oWnd1, oMenu, oImg, oBtn
  Local oWC, lClick := FALSE


  DllWebCam:=LoadLibrary("avicap32.dll")
  oWC:=tWebCamPhoto():New()

  MENU oMenu UPDATE
    MENUITEM "File"
      MENU
        MENUITEM "Click" ACTION (oWC:Save(oImg,'C:\_CK_NEW\WEBCAM32.jpg',80), lClick := TRUE, oWnd1:Update(),;
             oMenu:Refresh())
          MENUITEM "Save/Exit" ACTION (oWC:End(), PutFoto(oImage1), oWnd1:End()) WHEN lClick
      ENDMENU

      MENUITEM "Setup"
      MENU
        MENUITEM "Source" ACTION oWC:Source()
        MENUITEM "Format" ACTION oWC:Format()
      ENDMENU
     MENUITEM "Cancel" ACTION (oWC:End(), oWnd1:End())
    MENUITEM "Exit" ACTION (lQue := CkSalir(lClick), IIF( lQue,(oWC:End(), oWnd1:End()),))

  ENDMENU
  DEFINE WINDOW oWnd1 FROM 2,2 TO 28, 75 MENU oMenu NOZOOM;
        NOMINIMIZE

    @ 25, 380 IMAGE oImg OF oWnd1 SIZE 160,120 PIXEL ADJUST UPDATE
    oImg:nProgress:=0

     @ 18.00, 22 BUTTON  oBTN PROMPT "Click" of oWnd1 SIZE 85, 22 UPDATE;
        ACTION (oWC:Save(oImg,'C:\_CK_NEW\WEBCAM32.jpg',80), lClick := TRUE, oWnd1:Update())

     @ 9.75, 70.5 BUTTON  oBTN PROMPT "Save/Exit" of oWnd1 SIZE 85, 22 WHEN lClick UPDATE;
        ACTION (oWC:End(), PutFoto(oImage1), oWnd1:End())

     @ 11.75, 70.5 BUTTON  oBTN PROMPT "Cancel" of oWnd1 SIZE 85, 22 UPDATE;
        ACTION ((lQue := CkSalir(lClick), IIF( lQue,(oWC:End(), oWnd1:End()),)))

     @ 13.75, 70.5 BUTTON  oBTN PROMPT "Source" of oWnd1 SIZE 85, 22;
        ACTION (oWC:Source())

     @ 15.75, 70.5 BUTTON  oBTN PROMPT "Format" of oWnd1 SIZE 85, 22 UPDATE;
        ACTION (oWC:Format())

    ACTIVATE WINDOW oWnd1 ON INIT ( oWC:CreateWnd(oWnd1,25, 5, 300,220), oWC:Connect() )
return nil

FUNCTION CkSalir(lClick)
    LOCAL lReturn := FALSE
    IF lClick
        IF MsgNoYes("The picture will not be saved. Are you sure to quit?")
            lReturn := TRUE
        ELSE
            lReturn := FALSE
        ENDIF
    ELSE
        lReturn := TRUE
    ENDIF

RETURN (lReturn)

/**********************************************************
*
*
* 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(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) //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) CLASS tWebCamPhoto
  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(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) CLASS tWebCamPhoto
  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) CLASS tWebCamPhoto
  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()
     sndplaySound("CAMERA.WAV")

    IF !(lSucc:=File(cFile))
      MsgAlert(' Picture file was no created!')
    ELSEIF oImg<>nil
       oImg:LoadImage(nil,cFile)
       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 Format() CLASS tWebCamPhoto
  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() 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
  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 PutFoto(oImage1)
    IF file("C:\_CK_NEW\WEBCAM32.JPG")
        oImage1:LoadBmp( "C:\_CK_NEW\WEBCAM32.JPG" )
    ENDIF
RETURN (.T.)

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 DllWebCam

************************************************************************
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 DllWebCam
************************************************************************
 


Saludos,

George
George
 
Posts: 725
Joined: Tue Oct 18, 2005 6:49 pm

Re: WEBCAM EN WINDOWS 64 BITS

Postby karinha » Wed Jun 04, 2014 6:19 pm

Gracias George,

Saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7824
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 25 guests