Integre a mi aplicación tu clase, para la toma de fotografías, yo uso borland, pero no logro hacerla andar. Me podrías echar una manita.
Cabe aclarar que el sistema operativo es Windows 10.
Code: Select all | Expand
FUNCTION FotoCamara()
LOCAL xWnd, xImg, oWC, lClick := .f., oBtn, cFile
oWC := tWebCamPhoto():New()
cFile := ".\fotos\Capturawebcam.bmp"
Define Font xFont Name "Calibri" Size 0,-13
DEFINE WINDOW xWnd FROM 2,2 TO 25, 75 TITLE "Capturar Fotografia por WebCam" NOZOOM NOMINIMIZE
@ 25, 350 IMAGE xImg OF xWnd SIZE 200,160 PIXEL ADJUST UPDATE
xImg:nProgress := 0
@ 280, 25 BUTTON oBtn PROMPT "Capturar" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION ( oWC:Clipboard( xImg, cFile ), lClick := .t., xWnd:Update())
@ 280, 120 BUTTON oBtn PROMPT "Traspasa" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION ( LeerClipBoard( oImg ), oWC:End(), xWnd:End(), ) WHEN lClick
@ 280, 215 BUTTON oBtn PROMPT "Salir" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION ( oWC:End() , xWnd:End())
@ 200, 360 BUTTON oBtn PROMPT "Opciones" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION oWC:Source()
@ 200, 460 BUTTON oBtn PROMPT "Formato" OF xWnd SIZE 85, 22 PIXEL UPDATE FONT xFont ACTION oWC:Formato()
ACTIVATE WINDOW xWnd ON INIT ( xWnd:Center(), oWC:CreateWnd( xWnd , 25, 10, 300, 220), oWC:Connect() )
RETURN Nil
FUNCTION LeerClipBoard( oImg )
oImg:LoadFromClipboard()
oImg:Refresh()
RETURN Nil
Code: Select all | Expand
#Include "FiveWin.ch"
#include "Struct.ch"
#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
STATIC _oWebcam_ := Nil
//------------------------------------------------
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>
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")
::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, 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"
//------------------------------------------------
Armando y Karinha, gracias a ambos por adaptar la clase a BCC7, funciona muy bien y me ha sido de gran utilidad.
