eu acho que é isso:
funct adq_imagempr(p_01,p_02,codigo_v,nome_v)
define Dialog oCeca_b;
resource "INFSEN" of oCeca
REDEFINE BUTTONBMP oBtnBmp id 4031 OF oceca_b;
ACTION (oWC:Connect()) ;
BITMAP "database-save.bmp" PROMPT "Conectar Webcam" TEXTRIGHT
REDEFINE BUTTONBMP oBtnBmp id 4032 OF oceca_b;
ACTION (oWC:Save(oImg,v_localproduto+"\"+nome_v+alltrim(trans(codigo_v,"99999"))+'.bmp'),f_001(nome_v,codigo_v));
BITMAP "webcam.bmp" PROMPT "Adquirir Imagem" TEXTRIGHT
REDEFINE BUTTONBMP oBtnBmp id 4033 OF oceca_b;
ACTION oWC:Disconnect() ;
BITMAP "database-save.bmp" PROMPT "Desconectar Webcam" TEXTRIGHT
activate dialog oCeca_B center on init;
(oWC:CreateWnd(oCeca_b,18,11,190,200) )
if getkeystate(27) .or. oceca_b:End()
endif
return .t.
id=code>id=code>arquivo webcam32.prg
#include "Fivewin.ch"
#include "image.ch"
Static cWebCamDriver := "Microsoft WDM Image Capture"
Static _oWebcam_ := nil
Static hDllW
************************************************************************
*
************************************************************************
Function Test()
Local oWnd, oMenu, oImg
Local oWC
oWC:=tWebCamPhoto():New()
MENU oMenu
MENUITEM "Cámara"
MENU
MENUITEM "Conectar" ACTION oWC:Connect()
MENUITEM "Desconectar" ACTION oWC:Disconnect()
SEPARATOR
MENUITEM "Fuente" ACTION oWC:Source()
MENUITEM "Formato" ACTION oWC:Format()
ENDMENU
MENUITEM "Capturar"
MENU
MENUITEM "Clipboard" ACTION oWC:Clipboard(oImg)
SEPARATOR
MENUITEM "BMP" ACTION oWC:Save(oImg,'webcam32.bmp')
MENUITEM "JPG" ACTION oWC:Save(oImg,'webcam32.jpg',80)
ENDMENU
MENUITEM "Salir" ACTION (oWC:End(), oWnd:End())
ENDMENU
DEFINE WINDOW oWnd FROM 0,0 TO 30,80 MENU oMenu TITLE "Captura de fotos con Webcams"
@ 60,400 IMAGE oImg OF oWnd SIZE 160,120 PIXEL ADJUST
oImg:nProgress:=0
ACTIVATE WINDOW oWnd ON INIT;
(oWnd:Center(), oWC:CreateWnd(oWnd,60,10,320,240) )
return nil
************************************************************************
*
************************************************************************
Function fFotografia(x)
Local oWnd, oMenu, oImg
Local oWC,oBtn
Local cPath := ALLTRIM(CURDRIVE())+":\"+CURDIR()+'\Tempo\'
DEFAULT x := "NADA"
IF x=="NADA" .OR. x!="GsT"
RETURN ''
ENDIF
hDLLW := LoadLibrary("avicap32.dll")
oWC:=tWebCamPhoto():New()
IF oWC = NIL
FreeLibrary( hDLLW )
RETURN ''
ENDIF
/*
MENU oMenu
MENUITEM "Cámara"
MENU
MENUITEM "Conectar" ACTION oWC:Connect()
MENUITEM "Desconectar" ACTION oWC:Disconnect()
SEPARATOR
MENUITEM "Fuente" ACTION oWC:Source()
MENUITEM "Formato" ACTION oWC:Format()
ENDMENU
MENUITEM "Capturar"
MENU
MENUITEM "Clipboard" ACTION oWC:Clipboard(oImg)
SEPARATOR
MENUITEM "BMP" ACTION oWC:Save(oImg,'webcam32.bmp')
MENUITEM "JPG" ACTION oWC:Save(oImg,'webcam32.jpg',80)
ENDMENU
MENUITEM "Salir" ACTION (oWC:End(), oWnd:End())
ENDMENU
*/
DEFINE WINDOW oWnd FROM 0,0 TO 30,80 MENU oMenu TITLE "CAPTURA DE FOTOGRAFIA"
@ 60,400 IMAGE oImg OF oWnd SIZE 160,120 PIXEL ADJUST
oImg:nProgress:=0
@ 01,12 BUTTON oBtn PROMPT "Tomar foto" OF oWnd SIZE 70,35 ;
ACTION ( oWC:Save(oImg,'tmp.jpg',80),oWnd:End(),(IF(FILE(cPath+"caced.gst"),FERASE(cPath+"caced.gst"),.t.)), ;
FILEMOVE("tmp.jpg",cPath+"caced.gst") )
ACTIVATE WINDOW oWnd MAXIMIZED ON INIT;
( oWnd:Center(),oWC:CreateWnd(oWnd,60,20,320,240),oWC:Connect() )
* ( oWnd:Center(),oWC:CreateWnd(oWnd,60,10,320,240),oWC:Connect(),MSGALERT((oWnd:nHeight-3)) )
FreeLibrary( hDLLW )
return cPath+"caced.gst"
/**********************************************************
*
* 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
*
* Modificada para FWH2.5 - 13/12/2005
* Correção do posicionamento e tamanho da janela - 14.04.2008 by LAugusto
***********************************************************/
#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 LIB_LOAD 1
#define LIB_FREE 2
#define LIB_FREE_ALL 3
//-------------------------------------------------------
// EXIT Procedure WebcamDisconnect()
// Asegura la desconexión de la cámara.
//-------------------------------------------------------
EXIT Procedure WebcamDisconnect()
IF _oWebcam_ <> nil
_oWebcam_:Disconnect()
_owebcam_ := nil
EndIF
Return
****************************************************************************
#xtranslate BYNAME [, ] => :: := [; :: := ]
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 ventana de la imagen
DATA aDrivers //Drivers de captura disponibles
DATA nDriver //número del driver instalado + 1
DATA cDriver
DATA lConnected INIT .F. //¿Está conectada>
DATA oWnd
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( oWnd, nLeft, nTop, nWidth, nHeight, nStyle, cTitle ) // Crea la ventana para la cámara en oWnd.
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
// Finaliza el objeto
METHOD End() INLINE ( ::Disconnect(), DllLoadAndFree( "avicap32.dll", LIB_FREE ), IF( !Empty( ::oWnd ), ::oWnd:End(), nil ) )
ENDCLASS
#xtranslate UTRAN( ) => Upper( StrTran( , " " ) )
*===========================================================================
METHOD New( cDriver, lSelect )
DEFAULT cDriver := cWebCamDriver
DEFAULT lSelect := .F.
::aDrivers := WebCamList()
::nDriver := aScan( ::aDrivers,{ |u| UTran( cDriver ) == UTran( u ) } )
IF ::nDriver = 0 .or. lSelect
::nDriver := WebCamSelect( ::nDriver, ::aDrivers )
ENDIF
_oWebCam_ := Self
Return Self
*===========================================================================
METHOD CreateWnd( oWnd, nTop, nLeft, nWidth, nHeight, nStyle, cTitle )
Local hWnd, cDriver
DEFAULT nTop := 0, nLeft := 0, nWidth := 160, nHeight := 120
DEFAULT nStyle := nOr( WS_VISIBLE, WS_CHILD, WS_BORDER )
*? ::nDriver,::aDrivers[::nDriver]
IF ::nDriver > 0
cDriver := ::aDrivers[::nDriver]
::hWnd := wCamCreaWnd( cDriver, nStyle, nLeft, nTop, nWidth, nHeight, oWnd:hWnd, 0 )
::oWnd := tWindow():New()
::oWnd:hWnd := ::hWnd
IF cTitle <> nil
::oWnd:SetText( cTitle )
ENDIF
ENDIF
Return ::hWnd
*===========================================================================
METHOD Connect()
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
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 )
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, bAction )
LOCAL lSucc := .F., cExec
LOCAL cFileExt := UPPER( cFileExt( cFile ) )
LOCAL cFileName := IF( AT( ".", cFile ) > 0, SUBSTR( cFile, 1, AT( ".", cFile ) - 1 ), cFile )
IF ::hWnd <> nil
CursorWait()
IF ( cFileExt == "JPG" .OR. cFileExt == "JPEG" )
IF ::Clipboard()
DEFAULT nQuality := ::nJpgQuality
::nJpgQuality := MAX( MIN( INT( nQuality ), 100 ), 10 )
cExec := "bmptojpg.exe" + ' -q' + LTRIM( STR( ::nJpgQuality, 3, 0 ) ) + ' -c' + cFileName + ' -o -s'
WAITRUN( cExec, 0 )
ENDIF
ELSEIF cFileExt == 'BMP'
SendMessage( ::hWnd, WM_CAP_FILE_SAVEDIB, 0, cFile )
ENDIF
CursorArrow()
SysRefresh()
IF !( lSucc := FILE( cFile ) )
MsgAlert( "Não foi possÃvel criar " + cFile, "Atenção Operador" )
ELSE
IF !Empty( bAction ) .and. cFileExt == "JPG"
Eval( bAction, cFile )
ENDIF
IF oImg <> nil
oImg:cResName := ""
oImg:cBmpFile := cFile
oImg:Reload()
ENDIF
ENDIF
ENDIF
Return lSucc
//--------------------------------------------------------------------------
METHOD Source()
IF ::hWnd <> nil .and. ::lConnected
SendMessage( ::hWnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0 )
EndIF
Return nil
*===========================================================================
METHOD Format()
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()
Local oStatus
IF ::hWnd <> nil .and. ::lConnected
SysRefresh()
oStatus := ::GetStatus()
// Just do it!
oStatus:nWidth := 200 // 14.04.2008 by LAugusto
oStatus:nHeight := 200 // 14.04.2008 by LAugusto
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
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 WebcamSelect( nDriver, aDrivers )
Local oDlg, oCbx
Local cDriver
Local lSelect:=.F.
DEFAULT nDriver := 0, aDrivers := WebcamList()
IF Empty( aDrivers )
MsgAlert( 'Webcam Não Instalada', 'Atenção Operador' )
return 0
ELSEIF Len( aDrivers ) = 1
nDriver := 1
ELSE
cDriver := aDrivers[Max( 1, nDriver )]
DEFINE DIALOG oDlg FROM 0,0 to 6,40 TITLE "Selecione uma webcam"
@ 0,0 COMBOBOX oCbx VAR cDriver OF oDlg ITEMS aDrivers SIZE 160,50 PIXEL
@ val("1.5"), 4 BUTTON "Selecionar" OF oDlg SIZE 40,12 ACTION( nDriver := oCbx:nAt, oDlg:End() )
@ val("1.5"),16 BUTTON "Cancelar" 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
****************************************************************************
EXIT PROCEDURE DllFreeAll()
DllLoadAndFree( "avicap32.dll", LIB_FREE_ALL )
Return
****************************************************************************
Function DllLoadAndFree( cLib, nAction )
Local nPos, hDll, u
Static aSt_hDll
DEFAULT nAction := LIB_LOAD
IF aSt_hDll = nil
aSt_hDll := {}
ENDIF
IF nAction = LIB_FREE_ALL
aEval( aSt_hDll,{ |u| IF( Abs( u[2] ) > 32, FreeLibrary(u[ 2] ), nil ) } )
aSt_hDll := nil
ELSE
nPos := aScan( aSt_hDll,{ |u| u[1] == Upper( Alltrim( cLib ) ) } )
IF nAction = LIB_LOAD
IF nPos = 0
hDll := LoadLibrary(cLib)
aAdd( aSt_hDll,{ Upper( Alltrim( cLib ) ), hDll } )
ELSE
hDll := aSt_hDll[nPos, 2 ]
ENDIF
ELSEIF nAction = LIB_FREE .and. nPos > 0
IF Abs( aSt_hDll[nPos,2] ) > 32
FreeLibrary( aSt_hDll[nPos,2] )
ENDIF
aDel( aSt_hDll, nPos )
aSize( aSt_hDll, Len( aSt_hDll ) - 1 )
ENDIF
ENDIF
Return hDll
****************************************************************************
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 DllLoadAndFree( "avicap32.dll", LIB_LOAD )
************************************************************************
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 DllLoadAndFree( "avicap32.dll", LIB_LOAD )
************************************************************************
Function FileMove(cArqOri,cArqDest)
Return fRename(cArqOri,cArqDest)
id=code>id=code>fw10.8harbour-xDev.70 Studio-bcc582-Mysql-Pelles
programadorcp80@hotmail.com.br ;
