www.FiveTechSoft.com
https://forums.fivetechsupport.com/
Code: Select all | Expand
#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
************************************************************************