In order for this site to work correctly we need to store a small file (called a cookie) on your computer. Most every site in the world does this, however since the 25th of May 2011, by law we have to get your permission first. Please abandon the forum if you disagree.

Para que este foro funcione correctamente es necesario guardar un pequeño fichero (llamado cookie) en su ordenador. La mayoría de los sitios de Internet lo hacen, no obstante desde el 25 de Marzo de 2011 y por ley, necesitamos de su permiso con antelación. Abandone este foro si no está conforme.

TWebCam ?

Foro público de Xailer en español
gabo1
Posts: 80
Joined: Mon Oct 13, 2014 9:42 am

TWebCam ?

Postby gabo1 » Wed Jun 24, 2020 6:04 pm

Hola..
Algun companero que pueda compartir la clase para usar la camara de la pc/laptop..
Saludos
User avatar
bingen
Posts: 433
Joined: Mon Jul 07, 2014 8:17 pm
Location: Bilbao
Contact:

Re: TWebCam ?

Postby bingen » Tue Jun 30, 2020 8:29 am

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)
) );
}



//------------------------------------------------------------------------------
BiSoft Desarrollo de software profesional
http://www.bisoft.es
gabo1
Posts: 80
Joined: Mon Oct 13, 2014 9:42 am

Re: TWebCam ?

Postby gabo1 » Fri Jul 03, 2020 9:48 pm

Bingen, Muchas Gracias!

Return to “Spanish”