Xailer forum

Hola..
Algun companero que pueda compartir la clase para usar la camara de la pc/laptop..
Saludos

Aquí lo tienes compañero pero no funciona con todas las cámaras del mercado.

/*
* Proyecto: Propósito general
* Fichero: Webcam.prg
* Descripción: Fotografías a través de WebCam
* Autor: Bingen Ugaldebere
* Fecha: 16/05/2008 - 22/05/2012
*/


#include "Xailer.ch"
#include "Bisoft.ch"

#define GHW_HWNDFIRST 0
#define GHW_HWNDNEXT 2
#define GWW_HINSTANCE -6

CLASS TWebCam FROM TForm

ACCESS cUserFile INLINE Appdata:cAppPath+"UserData\"+AppData:cUserName+".Ini"


//Datas que puede recibir
Data nDeviceId Init 0
Data cAppName Init ""
Data cImageName Init ""
Data lSaveChanges Init .T.
Data nPreviewRate INIT 1

//Otros datas - Other data
Data lPreview Init .F.

Component oOcx
COMPONENT oBevel
COMPONENT oBtnSelectDevice
COMPONENT oLabel
COMPONENT oBtnSalir
COMPONENT oFileSaveDlg
COMPONENT oBtnFoto
COMPONENT oBevel1


METHOD CreateForm()
METHOD FormClose( oSender, @lClose )
METHOD BtnSelectDeviceClick( oSender )
METHOD BtnSalirClick( oSender )


METHOD Test( oSender )
METHOD FormShow( oSender )
METHOD CongelarFoto( oSender )

ENDCLASS

#include "WebCam.xfm"

//------------------------------------------------------------------------------
METHOD FormShow( oSender ) CLASS TWebCam
Local lOk:=.T.

Application:lBusy:=.T.

//Identificar al usuario
If !AppData:IsData( "cUsername" )
AppData:AddData("cUserName",NameCase( GetUserName()) )
End

//Carpeta de destino de las imagenes
If !AppData:IsData( "cDataImage" )
AppData:AddData("cDataImage",Application:cDirectory)
End

//Activar la WebCam
with Object ::oOcx:=tWebCamCapture():New(::oBevel1)
If :EnumDrivers()=0
Application:lBusy:=.F.
MsgStop("No hay ninguna cámara web instalada en este equipo o no está correctamente configurada.")
::oOcx:End()
::Close()
Return .F.
Endif
:Connect()
End


//Tomar ultimo dispositivo usado del INI
WITH OBJECT TIni():New( ::cUserFile )
::oOcx:nIndex := :GetEntry( "WebCam", "CurrentDevice" , -1 )
End With

If ::nDeviceId>0
::oOcx:nIndex =::nDeviceId
Endif

//Si el dispositivo es -1 es que no está seleccionado asi que obligar a seleccionarlo
Do While ::oOcx:nIndex=-1
::BtnSelectDeviceClick( oSender )
Enddo

//Indicar dispositivo seleccionado
::oLabel:cText := ::oOcx:ListDrivers()[::oOcx:nIndex+1]

::oOcx:PreviewRate( ::nPreviewRate )
::oOcx:Preview(.T.)
::oOcx:PreviewScale(.T.)

Application:lBusy:=.F.

RETURN Nil

//------------------------------------------------------------------------------
//Seleccionar una cámara web
METHOD BtnSelectDeviceClick( oSender ) CLASS TWebcam
Local nItem:= MsgArray(::oOcx:ListDrivers,{"Cámaras web"},"Seleccione una cámara web de su equipo","Cámaras Web")
If nItem>0
::oOcx:nIndex:=nItem-1
::oLabel:cText := ::oOcx:ListDrivers()[::oOcx:nIndex+1]
Endif
RETURN Nil

//------------------------------------------------------------------------------
//Congela la imagen o la descongela
METHOD CongelarFoto( oSender ) CLASS TWebCam
If ::nPreviewRate=1
::nPreviewRate:= 0
::oBtnFoto:cText:="Descartar esta foto"
::oBtnSalir:lEnabled:=.T.
Else
::nPreviewRate:= 1
::oBtnFoto:cText:="Sacar una foto"
::oBtnSalir:lEnabled:=.F.
Endif
::oOcx:PreviewRate( ::nPreviewRate )
RETURN Nil

//------------------------------------------------------------------------------
//Grabar la imagen y salir
METHOD BtnSalirClick( oSender ) CLASS TWebcam

//En caso de no haberse suministrado un nombre
If Empty(::cImageName)
::oFileSaveDlg:cInitialDir:=AppData:cDataImage
::oFileSaveDlg:Run()
::cImageName:=::oFileSaveDlg:cFullFileName
Endif

If Empty(::cImageName)
MsgInfo("Nombre de imagen incorrecto, vuelva a intentarlo.","Imagen no guardada")
Return .F.
Endif

::oOcx:SaveFoto(::cImageName)

::oOcx:End()

::oBtnSalir:lEnabled:=.F.

::Close()

RETURN Nil

//------------------------------------------------------------------------------
//Cerrar
METHOD FormClose( oSender, lClose ) CLASS TWebcam


If ::oBtnSalir:lEnabled
If !MsgNoYes("¿Desea salir sin grabar la imagen capturada?","Imagen no guardada")
Return .F.
Endif
Endif

::oOcx:End()

If ::lSaveChanges
WITH OBJECT TIni():New( ::cUserFile )
:SetEntry( "WebCam", "CurrentDevice" , ::nDeviceId )
End With
Endif

RETURN Nil

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

METHOD Test( oSender ) CLASS TWebcam
local oForm

With Object oForm:=tWebcam():New()
:cImageName := "Test de la webcam.Jpg"
:ShowModal()
End With


Return Nil

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

//------------------------------------------------------------------------------
/**
Clase de captura de imágenes a través de WebCam

Original de Rafa Carmona THE FULL
con la colaboración de José Lalín

Modificaciones de Pablo Herranz y Bingen Ugaldebere
**/

//------------------------------------------------------------------------------
CLASS tWebCamCapture FROM TControl

DATA oWnd, hWndC
DATA nIndex INIT 0 // By Default index first found

METHOD New() CONSTRUCTOR
METHOD Connect() INLINE ConnectDriver(::hWndC, ::nIndex )
METHOD End() INLINE DisConnectDriver(::hWndC )
METHOD StartCapture() INLINE Capture(::hWndC )
METHOD StopCapture() INLINE CaptureStop(::hWndC )
METHOD Preview( lPreview ) INLINE CapPreview( ::hWndC, lPreview )
METHOD PreviewRate( nRate ) INLINE CapPreviewRate(::hWndC, nRate )
METHOD PreViewScale( lScale ) INLINE CapPreviewScale(::hWndC,lScale )
METHOD CreateWndCapture()
METHOD FileSaveAs( cFileName ) INLINE CapFileSaveAs(::hWndC, cFilename )
METHOD SaveFoto( cFile ) INLINE capFileSaveDIB(::hWndC, cFile)
*METHOD SetFile( cFile ) INLINE CapFileSetWebCamCaptureFile( ::hWndC, cFile )
METHOD SetupCapture() INLINE CapCaptureSetSetup( ::hWndC )

METHOD SetupVideo() INLINE SetupVideo(::hWndC )
*METHOD Overlay( lMode ) INLINE CapOverlay(::hWndC, lMode )
*METHOD FramesPerSec( nFrames ) INLINE CapFramesPerSec( ::hWndC, nFrames )
*METHOD VideoCompression() INLINE CapDlgVideoCompression( ::hWndC )
METHOD ListDrivers()
METHOD EnumDrivers()

END CLASS

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

METHOD New( oCtrl ) CLASS tWebCamCapture
::oWnd := oCtrl
IF Len( CapGetDrivers() ) > 0
::CreateWndCapture()
ELSE
Application:lBusy:=.F.
MsgStop("No se ha encontrado el driver de la cámara Web")
ENDIF

RETURN Self

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

METHOD EnumDrivers() CLASS tWebCamCapture
Return( Len( ::ListDrivers() ) )

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

METHOD ListDrivers() CLASS tWebCamCapture
Local aWebcamDrivers:=CapGetDrivers(), nItem:=0
For nItem:=1 to Len(aWebcamDrivers)
If aWebcamDrivers[nItem]=Nil
ArrayDel(aWebcamDrivers,nItem,.T.)
nItem--
Endif
Next
Return aWebcamDrivers

//------------------------------------------------------------------------------
METHOD CreateWndCapture() CLASS tWebCamCapture
::hWndC := CaptureWin( "", nOR( WS_CHILD, WS_VISIBLE ),;
::oWnd:nClientLeft, ::oWnd:nClientTop,;
::oWnd:nClientWidth,::oWnd:nClientHeight,;
::oWnd:handle, 0 )
RETURN NIL

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



#pragma BEGINDUMP

#include <windows.h>
#include <vfw.h>
#include "hbapi.h"
#include "winable.h"
#include "Xailer.h"
#include "math.h"

HB_FUNC( CAPTUREWIN )
{
HWND hVentana = (HWND) capCreateCaptureWindow( hb_parc( 1 ), (DWORD) hb_parnl( 2 ), hb_parni( 3 ) ,hb_parni( 4 ),hb_parni( 5 ),hb_parni( 6 ),
(HWND) hb_parnl( 7 ),hb_parni(8) );
hb_retnl( (LONG) hVentana );
}

HB_FUNC( CAPTURE )
{
hb_retl( SendMessage ( (HWND) hb_parnl( 1 ),
WM_CAP_SEQUENCE, 0, 0L) );
}


HB_FUNC( CAPTURESTOP )
{
hb_retl( SendMessage ( (HWND) hb_parnl( 1 ), WM_CAP_STOP,0, 0L) );
}


HB_FUNC( CAPCAPTURESEQUENCENOFILE )
{
hb_retl( capCaptureSequenceNoFile( (HWND) hb_parnl(1) )
);
}

HB_FUNC( CONNECTDRIVER )
{
hb_retl( SendMessage ( (HWND) hb_parnl( 1 ),WM_CAP_DRIVER_CONNECT, hb_parni(2) , 0L) );
// hb_retl( capDriverConnect( (HWND) hb_parnl( 1 ),hb_parni(2) ) );
}

HB_FUNC( DISCONNECTDRIVER )
{
hb_retl( capDriverDisconnect( (HWND) hb_parnl( 1 ) ));
}

HB_FUNC( CAPCAPTURESETSETUP )
{
CAPTUREPARMS Capture;
hb_retl( capCaptureSetSetup( (HWND) hb_parnl( 1 ),&Capture, sizeof( CAPTUREPARMS ) ));
}


HB_FUNC( CAPGRABFRAME )
{
hb_retl( capGrabFrame( (HWND) hb_parnl( 1 ) ) );
}


HB_FUNC( CAPFILESAVEAS )
{
hb_retl( capFileSaveAs( (HWND) hb_parnl(1), hb_parc( 2
)));
}

/*
HB_FUNC( CapFileSetWebCamCaptureFile )
{
BOOL fResult;
fResult = CapFileSetWebCamCaptureFile( (HWND)hb_parnl(1),(LPSTR) hb_parc(2) );
// preallocate a file of 5 MB.
capFileAlloc( (HWND) hb_parnl(1), (1024L * 1024L * 5));
hb_retl( fResult );
}
*/
HB_FUNC( CAPPREVIEW )
{
hb_retl( capPreview( (HWND) hb_parnl( 1 ), hb_parl( 2 )
));
}

HB_FUNC( CAPPREVIEWSCALE )
{
hb_retl( capPreviewScale( (HWND) hb_parnl( 1 ), hb_parl( 2 ) ));
}

HB_FUNC( CAPPREVIEWRATE )
{
hb_retl( capPreviewRate( (HWND) hb_parnl( 1 ), hb_parni( 2 ) ));
}


HB_FUNC( CAPDLGVIDEOSOURCE )
{
hb_retl( capDlgVideoSource( (HWND) hb_parnl( 1 ) ) );
}

HB_FUNC( CAPDLGVIDEODISPLAY )
{
hb_retl( capDlgVideoDisplay( (HWND) hb_parnl( 1 ) ) );
}


HB_FUNC( CAPDLGVIDEOCOMPRESSION )
{
hb_retl( capDlgVideoCompression( (HWND) hb_parnl(1)) );
}


HB_FUNC( SETUPVIDEO )
{
CAPDRIVERCAPS CapDriverCaps;
CAPSTATUS CapStatus;

capDriverGetCaps( (HWND) hb_parnl( 1 ), &CapDriverCaps,sizeof (CAPDRIVERCAPS));

// Video source dialog box.
if (CapDriverCaps.fHasDlgVideoSource)
capDlgVideoSource( (HWND) hb_parnl( 1 ) );

// Video format dialog box.
if (CapDriverCaps.fHasDlgVideoFormat)
{
capDlgVideoFormat( (HWND) hb_parnl( 1 ) );

// Are there new image dimensions?
capGetStatus( (HWND) hb_parnl( 1 ), &CapStatus, sizeof (CAPSTATUS));
// New Dimensions of Window
SetWindowPos( (HWND) hb_parnl( 1 ), NULL, 0, 0, CapStatus.uiImageWidth, CapStatus.uiImageHeight, SWP_NOZORDER| SWP_NOMOVE);

// If so, notify the parent of a size change.
}

// Video display dialog box.
if (CapDriverCaps.fHasDlgVideoDisplay)
capDlgVideoDisplay( (HWND) hb_parnl( 1 ) );
}

HB_FUNC( CAPFRAMESPERSEC ) // hWnd, framesperSec
{
CAPTUREPARMS CaptureParms;
float FramesPerSec = (FLOAT)hb_parnl( 2 );

capCaptureGetSetup( (HWND)hb_parnl(1), &CaptureParms,
sizeof(CAPTUREPARMS));
CaptureParms.dwRequestMicroSecPerFrame = (DWORD) (1.0e6 /
FramesPerSec);
hb_retl( capCaptureSetSetup( (HWND)hb_parnl(1),
&CaptureParms, sizeof (CAPTUREPARMS)) );
}


HB_FUNC( CAPOVERLAY )
{
CAPDRIVERCAPS CapDrvCaps;
capDriverGetCaps( (HWND) hb_parnl( 1 ), &CapDrvCaps,
sizeof (CAPDRIVERCAPS));

if (CapDrvCaps.fHasOverlay)
hb_retl( capOverlay( (HWND) hb_parnl( 1 ), hb_parl( 2
) ) );
else
hb_retl( FALSE );
}

HB_FUNC( CAPGETDRIVERS )
{
char szDeviceName[80];
char szDeviceVersion[80];
int wIndex;
// Maximos dispositivos a tratar. Del 0...9
hb_reta(10);

for (wIndex = 0; wIndex < 10; wIndex++)
{
if (capGetDriverDescription (wIndex, szDeviceName,
sizeof (szDeviceName),
szDeviceVersion,
sizeof (szDeviceVersion)))
{
// Append name to list of installed capturedrivers
// and then let the user select a driver to use.
//MessageBox( GetActiveWindow(), szDeviceName,szDeviceVersion, MB_SYSTEMMODAL );
#ifdef __XHARBOUR__
hb_storc( szDeviceName , -1, ( wIndex + 1 ) );
#else
hb_storvc( szDeviceName , -1, ( wIndex + 1 ) );
#endif
}
}

}

// Codigo por Jose Lalin en base de pruebas.
// Gracias Jose!!!
/*
#include "hbapiitm.h"

HB_FUNC( WC_CAPTURAS )
{

// He cambiado la declaracion porque capGetDrivers necesita
un puntero
// a la memoria donde almacenar szDeviceName y
szDeviceVersion
char szDeviceName[80];
char szDeviceVersion[80];
WORD wIndex;
WORD wDevices;

PHB_ITEM pReturn;

for( wIndex = 0; wIndex < 10; wIndex++ )
{
if( capGetDriverDescription( wIndex, (LPTSTR)
&szDeviceName,
sizeof( szDeviceName ),
(LPTSTR) &szDeviceVersion,
sizeof( szDeviceVersion ) ) )
{
wDevices = wIndex + 1;
}
}

pReturn = hb_itemArrayNew( wDevices );

for( wIndex = 0; wIndex < wDevices ; wIndex++ )
{
if( capGetDriverDescription( wIndex, szDeviceName,
sizeof( szDeviceName ), szDeviceVersion,
sizeof( szDeviceVersion ) ) )
{
PHB_ITEM pDriver = hb_itemPutC( NULL, (char*)
szDeviceName );
PHB_ITEM pVersion = hb_itemPutC( NULL, (char*)
szDeviceVersion );
PHB_ITEM pSub = hb_itemArrayNew( 2 );

hb_itemArrayPut( pSub, 1, pDriver );
hb_itemArrayPut( pSub, 2, pVersion );

hb_itemRelease( pDriver );
hb_itemRelease( pVersion );

hb_itemArrayPut( pReturn, wIndex + 1, pSub );

hb_itemRelease( pSub );

}
}

hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
}
*/
HB_FUNC( CAPFILESAVEDIB )
{
hb_retl( capFileSaveDIB( (HWND) hb_parnl( 1 ), hb_parc(2)
) );
}



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

Bingen, Muchas Gracias!