Tomando fotos con la webcam

[Antonio Linares]

Pruebalo de nuevo sin maquillarlo

[AIDA]

pasa lo mismo internamente no responde nada, externamente sip

[AIDA]

pasa lo mismo internamente no responde nada, externamente sip

no se si sera algo que este causando problema en el inicio de mi programa

Code: Select all  Expand view

#include "FiveWin.ch"
#include "taskpanel.ch"
#include "OutLook.ch"
#include "dtpicker.ch"
#include "Ord.ch"
#include "CdoSys.ch"
#include "tdolphin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
#include "FastRepH.ch"
#include "Slider.ch"
#include "browseget.ch"
#include "GIF.ch"

//***************

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

HB_FUNC( GETUSERDEFAULTUILANGUAGE )
{
   hb_retnl( GetUserDefaultUILanguage( ) ) ;
}

#pragma ENDDUMP

#ifdef __XHARBOUR__
 #define hb_CurDrive() CurDrive()

#endif

#define WS_3DLOOK  4
#define CLR_HBROWN nRGB( 205, 192, 176 )
#define CLR_NBLUE  nRGB( 142, 171, 194 )
#define  HKEY_LOCAL_MACHINE     2147483650

#define CLR_MSPURPLE RGB( 128,  57, 123 )
#define CLR_MSRED    RGB( 232,  17,  35 )
#define CLR_MSGRAY   RGB( 229, 229, 229 )

#ifndef TRUE
 #define TRUE              .T.
 #define FALSE             .F.
#endif

#define D_WIDTH           4
#define D_HEIGHT          13
#define COLOR_BTNFACE   15


REQUEST HB_LANG_EN
REQUEST HB_LANG_ES
REQUEST HB_LANG_IT
REQUEST HB_LANG_DE

REQUEST DBFCDX
//---------------------------------------------------------------------------------------------

static FIRST, lSeekWild := .t.
static lShared         := .T.
static lPijama         := .T.
STATIC rNueva1,nLanguage,oWnd,MARCAS1,catego,oBtnOkKMA2,lenguita,lenguitas
STATIC rNueva2,oMenu
STATIC oSof,oDlgOP,cNombre,cNombreM,cNombreE,cVigencia1,cVigencia2,cNombreP,cVAR,VALORT,VALORTa,oBrw,negrow,cFile,cSeccion,cEntry,vDato
STATIC oGet,oGet1,oGet2,oGet3,oGet4,cVige1,cVige2,n,oApp,oTmr,oBtnOkKMx,OBTNOKM,oBtnOkKM,oTaskPanel,oPanel,tipo,marcas
STATIC cTexto,cTexto1,oDlg,oClp,cIp,cIpx,oWnd2,XoBrw,oBjBLA,cantiX,Mentra10,Mentra11,oFr ,oQry,daty,colorix,finale,prutas,titulo,base,negro,lVar1
STATIC bGrad := { | lInvert | If( ! lInvert, ;
                  { { 1, nRGB( 255, 255, 255 ), nRGB( 230, 234, 239 ) } }, ;
                  { { 1/3, nRGB( 255, 253, 222 ), nRGB( 255, 231, 151 ) }, ;
                    { 2/3, nRGB( 255, 215,  84 ), nRGB( 255, 233, 162 ) }  ;
                    } ) }




PROCEDURE MAIN()

[Antonio Linares]

Prueba a cambiar la acción de este botón así:

@ 200, 360 BUTTON oBtn PROMPT "Opciones" OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ;
ACTION ( MsgInfo( oWC:hWnd ), MsgInfo( oWC:nDriver ), MsgInfo( oWC:lConnected ), MsgInfo( oWC:cWebCamDriver ) )

y dinos que te aparece

gracias

[AIDA]

pues primero sale un
nil

despues un

1

despues un

F

AL FINAL ESTO




Lo que no sale cuando lo ejecuto dentro de mi programa es este cuadro que pregunta cual dispositivo usar

Prueba a cambiar la acción de este botón así:

@ 200, 360 BUTTON oBtn PROMPT "Opciones" OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ;
ACTION ( MsgInfo( oWC:hWnd ), MsgInfo( oWC:nDriver ), MsgInfo( oWC:lConnected ), MsgInfo( oWC:cWebCamDriver ) )

y dinos que te aparece

gracias

[Antonio Linares]

Aida,

Prueba a modificar este método así y dime que te aparece:

Code: Select all  Expand view

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 )
        MsgInfo( GetErrMsg(), Str( ::hWnd ) )
  ENDIF

return  ::hWnd
 

[AIDA]

Ahora sale este letrero y después sigue igual sin funcionar

[MOISES]

Aida:

Revisa los permisos de Windows de acceso a la cámara y tu aplicación.

[Antonio Linares]

Aida,

Comprueba que estes usando #include "struct.ch"

y dime si te aparece algún "warning" al compilar

[AIDA]

los permisos de windows están bien y si esta el struct.ch no sale ningún warning al compilar

usando photos.exe funciona muy bien

pero si lo integro a mi programa modelos.exe
y lo ejecuto desde mi aplicación photos()
ya no funciona, también use el ejemplo webcam y pasa lo mismo
por fuera funciona pero desde mi programa ya no

Creo que algo en mi programa es lo que causa el problema

si me salto todo mi programa y ante pongo el de photos tampoco funciona

Code: Select all  Expand view

#include "FiveWin.ch"
#include "taskpanel.ch"
#include "OutLook.ch"
#include "dtpicker.ch"
#include "Ord.ch"
#include "CdoSys.ch"
#include "tdolphin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
#include "FastRepH.ch"
#include "Slider.ch"
#include "browseget.ch"
#include "GIF.ch"
#include "Struct.ch"
//***************

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

HB_FUNC( GETUSERDEFAULTUILANGUAGE )
{
   hb_retnl( GetUserDefaultUILanguage( ) ) ;
}

#pragma ENDDUMP

#ifdef __XHARBOUR__
 #define hb_CurDrive() CurDrive()

#endif

#define WS_3DLOOK  4
#define CLR_HBROWN nRGB( 205, 192, 176 )
#define CLR_NBLUE  nRGB( 142, 171, 194 )
#define  HKEY_LOCAL_MACHINE     2147483650

#define CLR_MSPURPLE RGB( 128,  57, 123 )
#define CLR_MSRED    RGB( 232,  17,  35 )
#define CLR_MSGRAY   RGB( 229, 229, 229 )

#ifndef TRUE
 #define TRUE              .T.
 #define FALSE             .F.
#endif

#define D_WIDTH           4
#define D_HEIGHT          13
#define COLOR_BTNFACE   15


REQUEST HB_LANG_EN
REQUEST HB_LANG_ES
REQUEST HB_LANG_IT
REQUEST HB_LANG_DE

REQUEST DBFCDX
//---------------------------------------------------------------------------------------------

static FIRST, lSeekWild := .t.
static lShared         := .T.
static lPijama         := .T.
STATIC rNueva1,nLanguage,oWnd,MARCAS1,catego,oBtnOkKMA2,lenguita,lenguitas
STATIC rNueva2,oMenu
STATIC oSof,oDlgOP,cNombre,cNombreM,cNombreE,cVigencia1,cVigencia2,cNombreP,cVAR,VALORT,VALORTa,oBrw,negrow,cFile,cSeccion,cEntry,vDato
STATIC oGet,oGet1,oGet2,oGet3,oGet4,cVige1,cVige2,n,oApp,oTmr,oBtnOkKMx,OBTNOKM,oBtnOkKM,oTaskPanel,oPanel,tipo,marcas
STATIC cTexto,cTexto1,oDlg,oClp,cIp,cIpx,oWnd2,XoBrw,oBjBLA,cantiX,Mentra10,Mentra11,oFr ,oQry,daty,colorix,finale,prutas,titulo,base,negro,lVar1
STATIC bGrad := { | lInvert | If( ! lInvert, ;
                  { { 1, nRGB( 255, 255, 255 ), nRGB( 230, 234, 239 ) } }, ;
                  { { 1/3, nRGB( 255, 253, 222 ), nRGB( 255, 231, 151 ) }, ;
                    { 2/3, nRGB( 255, 215,  84 ), nRGB( 255, 233, 162 ) }  ;
                    } ) }




PROCEDURE MAIN()

LOCAL  aArray, nFor,cOnfi,cSeria,cName,ADATA,XX1,dFecha,cCadena,oCursor,oMenu2
   LOCAL dFechaNueva,cURL,oHttp,cIpAddress,nCombo,XLK,titulin
   LOCAL cPassword := "xxxxx"
   local rNueva0:=rNueva0,cTequedan,colori,nogrande,cCrypt //,NUMPC
   LOCAL oSay1,oYn1 , cAlias := "CUST"


FotoCamara()

Aida,

Comprueba que estes usando #include "struct.ch"

y dime si te aparece algún "warning" al compilar

[Antonio Linares]

Aida,

He copiado el código de photos.prg al final del ejemplo fivedbu.prg y funciona correctamente

Así que solo se me ocurre que me envies por privado todos los fuentes de tu app para poder construirla aqui
y ver que pueda estar ocurriendo

[AIDA]

como puedo saber si se esta cargando la avicap32.dll
puede que ahí este el problema

[Antonio Linares]

MsgInfo( LoadLibrary( "avicap32.dll" ) )

[AIDA]

MsgInfo( LoadLibrary( "avicap32.dll" ) )

salio esto



Quite todo el código de mi programa solo deje el de la cámara como el principal y deje todo la configuración de inicio de mi programa lo compile y sale el mismo problema estoy usando tdolphin, taskpanel, FastReport no se si algo de esto sea la causa

Code: Select all  Expand view

#include "FiveWin.ch"
#include "taskpanel.ch"
#include "OutLook.ch"
#include "dtpicker.ch"
#include "Ord.ch"
#include "CdoSys.ch"
#include "tdolphin.ch"
#include "xbrowse.ch"
#include "InKey.ch"
#include "FastRepH.ch"
#include "Slider.ch"
#include "browseget.ch"
#include "GIF.ch"
#include "Struct.ch"
//***************

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

HB_FUNC( GETUSERDEFAULTUILANGUAGE )
{
   hb_retnl( GetUserDefaultUILanguage( ) ) ;
}

#pragma ENDDUMP

#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




#ifdef __XHARBOUR__
 #define hb_CurDrive() CurDrive()

#endif

#define WS_3DLOOK  4
#define CLR_HBROWN nRGB( 205, 192, 176 )
#define CLR_NBLUE  nRGB( 142, 171, 194 )
#define  HKEY_LOCAL_MACHINE     2147483650

#define CLR_MSPURPLE RGB( 128,  57, 123 )
#define CLR_MSRED    RGB( 232,  17,  35 )
#define CLR_MSGRAY   RGB( 229, 229, 229 )

#ifndef TRUE
 #define TRUE              .T.
 #define FALSE             .F.
#endif

#define D_WIDTH           4
#define D_HEIGHT          13
#define COLOR_BTNFACE   15


REQUEST HB_LANG_EN
REQUEST HB_LANG_ES
REQUEST HB_LANG_IT
REQUEST HB_LANG_DE

REQUEST DBFCDX
//---------------------------------------------------------------------------------------------
STATIC oWebcam
static FIRST, lSeekWild := .t.
static lShared         := .T.
static lPijama         := .T.
STATIC rNueva1,nLanguage,oWnd,MARCAS1,catego,oBtnOkKMA2,lenguita,lenguitas
STATIC rNueva2,oMenu
STATIC oSof,oDlgOP,cNombre,cNombreM,cNombreE,cVigencia1,cVigencia2,cNombreP,cVAR,VALORT,VALORTa,oBrw,negrow,cFile,cSeccion,cEntry,vDato
STATIC oGet,oGet1,oGet2,oGet3,oGet4,cVige1,cVige2,n,oApp,oTmr,oBtnOkKMx,OBTNOKM,oBtnOkKM,oTaskPanel,oPanel,tipo,marcas
STATIC cTexto,cTexto1,oDlg,oClp,cIp,cIpx,oWnd2,XoBrw,oBjBLA,cantiX,Mentra10,Mentra11,oFr ,oQry,daty,colorix,finale,prutas,titulo,base,negro,lVar1
STATIC bGrad := { | lInvert | If( ! lInvert, ;
                  { { 1, nRGB( 255, 255, 255 ), nRGB( 230, 234, 239 ) } }, ;
                  { { 1/3, nRGB( 255, 253, 222 ), nRGB( 255, 231, 151 ) }, ;
                    { 2/3, nRGB( 255, 215,  84 ), nRGB( 255, 233, 162 ) }  ;
                    } ) }




PROCEDURE MAIN()

   LOCAL  aArray, nFor,cOnfi,cSeria,cName,ADATA,XX1,dFecha,cCadena,oCursor,oMenu2
   LOCAL dFechaNueva,cURL,oHttp,cIpAddress,nCombo,XLK,titulin
   LOCAL cPassword := "xxxxx"
   local rNueva0:=rNueva0,cTequedan,colori,nogrande,cCrypt
   LOCAL oSay1,oYn1 , cAlias := "CUST"
   LOCAL oWnd, oImg, lClick := .f., oBtn, cFile, oFont,oBrush,bim,oWC  //variables de la camara



  oWC           :=  tWebCamPhoto():New()
  cFile         := ".\fotos\Capturawebcam.bmp"
WebcamList()
  Define Font oFont Name "Calibri" Size 0,-13

    DEFINE BRUSH oBrush FILE "FOND\gray6.bmp"


  DEFINE DIALOG oWnd SIZE 1200, 700 TITLE "Capturar Fotografia de tus modelos cajas o material por WebCam"  BRUSH oBrush //TRANSPARENT     , oWC:End(), oWnd:End()




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

  @ 280,  25 BTNBMP oBtn PROMPT "Capturar" center OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ;
     ACTION ( oWC:Clipboard( oImg, cFile ), lClick := .t., oWnd:Update())
    oBtn:SetColor( CLR_WHITE, CLR_BLACK )

  @ 280, 120 BTNBMP oBtn PROMPT "Traspasa" center  OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ;
     ACTION ( LeerClipBoard( oImg ) ) WHEN lClick
        oBtn:SetColor( CLR_WHITE, CLR_BLACK )

  @ 280, 215 BTNBMP oBtn PROMPT "Salir" center   OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ACTION ( oWC:End()    , oWnd:End())
     oBtn:SetColor( CLR_WHITE, CLR_BLACK )

    @ 200, 360 BTNBMP oBtn PROMPT "Opciones" center OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ACTION  oWC:Source()
    oBtn:SetColor( CLR_WHITE, CLR_BLACK )

   *@ 200, 360 BUTTON oBtn PROMPT "Opciones" OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ;
    *ACTION ( MsgInfo( oWC:hWnd ), MsgInfo( oWC:nDriver ), MsgInfo( oWC:lConnected ), MsgInfo( oWC:cWebCamDriver ) )

    @ 200, 460 BTNBMP oBtn PROMPT "Formato" center OF oWnd SIZE 85, 22 PIXEL UPDATE FONT oFont ACTION oWC:Formato()
    oBtn:SetColor( CLR_WHITE, CLR_BLACK )

   @ 235, 400 BITMAP bim  File "FOND\webcam.bmp" OF oWnd  SIZE 100,80 PIXEL ADJUST UPDATE
  *IMAGE oImg OF oWnd SIZE 200,160 PIXEL ADJUST UPDATE

  ACTIVATE DIALOG oWnd ON INIT ( oWnd:Center(), oWC:CreateWnd( oWnd , 25, 10, 200, 120 ), oWC:Connect() )

RETURN Nil

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

FUNCTION LeerClipBoard( oImg )

  oImg:LoadFromClipboard()
  oImg:Refresh()

RETURN Nil

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

EXIT Procedure WebcamDisconnect()

  if oWebcam  <>  nil
     oWebcam:Disconnect()
     oWebcam:=nil
  endif

return

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

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")

  *MsgInfo( 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 )


        MsgInfo( GetErrMsg(), Str( ::hWnd ) )
  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"

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


 

lo compile con el buildx.bat sin la librerias   tdolphin, taskpanel, FastReport

Y FUNCIONO  :shock:




entonces no se podrá usar una cámara si uso tdolphin, taskpanel, FastReport

[Antonio Linares]

Añade ahora por separado cada uno de ellos hasta que localicemos de donde viene el problema

muy bien