esempio per fare una foto ed inserirla nel campo get

Silvio · Post by **Silvio** » Fri Mar 23, 2007 10:58 am

avete un esempio per fare una foto con una webcam nel momento dell'inserimento del record e quindi salvarla in jpg e inserire il nome dela file esempio 0001.jpg nel get corrispondente?

Quale classe usare o meglio quale classe in xharbour funziona senza interuzioni ( ho visto che con capcature fatto tre o quattro foto mi dice che non c'è nessuna webcam installata)

grazie

Silvio · Post by **Silvio** » Thu Mar 29, 2007 3:48 pm

fate finta che non vi ho scritto niente

Thu Mar 29, 2007 4:35 pm

Hai risolto o hai rinunciato?

EMG

Silvio · Post by **Silvio** » Fri Mar 30, 2007 8:24 am

Non ho risolto

1. ho linkato una funziona scatta_foto() ad un pulsante

2. nella funzione scatta_foto ho chiamato la tscan di carmona

la classe mi fa selezionare il source twain ma quando deve create la foto mi fa errore general failure Msg_opened

c'è qualcosa di funzionante in giro ?

devo far scattare una foto direttamente dal dialogo di inserimento : il cliente si siede davanti al computer e quindi l'operatore puo' fargli la foto quando inserisce il record

hai qualcosa di funzionante per caso ?

io ho acquistato una semplice webcam NOTE@acam ed ho installato i driver sul pc in win xp

da premettere che se uso la classe tvideo o tcapture dello stesso autore funziona egregiamente ma ma me inteessa fare una foto e non un video

saluti.

Fri Mar 30, 2007 9:03 am

Non ne so niente, mi dispiace.

EMG

Silvio · Post by **Silvio** » Fri Mar 30, 2007 11:28 pm

sui forum mi hanno risposto con questo prg ma a me non va
potresti provarlo tu per favore ( spero tu abbia una webcam) perchè a me fa errore

Code: Select all

#include "Fivewin.ch"

Static cWebCamDriver := "Microsoft WDM Image Capture" 
Static _oWebcam_ := nil 
************************************************************************ 
* 
************************************************************************ 
Function WebCam(codart,xalias,ori) 
  Local oDlg_Cam, oImg,oWc,bton,oGet,cFich,lVale:=.F.,cFichero:=SPACE(254) 
  
  if codart=NIL 
     codart:="imap" + DTOS(date()) + strtran(time(),":") 
  end if 
  cFichero:="\" + codart + ".bmp" 
  cFich:= "\" + codart + ".bmp" 
  
  oWC:=tWebCamPhoto():New() 

  DEFINE DIALOG oDlg_Cam TITLE "Adquirir imagen del Producto via WebCam" FROM 0,0 TO 290,725 PIXEL 
    @ 5,180 IMAGE oImg OF oDlg_Cam SIZE 160,120 PIXEL ADJUST 
    @ 130,10 BUTTON "Capturar" OF oDlg_Cam SIZE 30,10 PIXEL ACTION oWc:Save(oImg,cFich) 
    @ 130,45 BUTTON "Aceptar"  OF oDlg_Cam SIZE 30,10 PIXEL ACTION (oWc:Disconnect(),lVale:=.T.,oDlg_Cam:End()) 
    @ 130,80 BUTTON "Cancelar" OF oDlg_Cam SIZE 30,10 PIXEL ACTION (oWc:Disconnect(),oDlg_Cam:End()) 

    @ 132,180 SAY oSay PROMPT "Localizacion fichero " PIXEL 
    @ 130,230 GET oGet VAR cFich OF oDlg_Cam SIZE 110,10 PIXEL WHEN .F. 

    oImg:nProgress:=0 

  ACTIVATE DIALOG oDlg_Cam CENTER ON INIT; 
    (oWC:CreateWnd(oDlg_Cam,10,10,260,180),oWc:Connect()) 
  if lVale 
     sele (xAlias) 
     replace (xalias)->foto with cFichero 
     &&ori:Refresh() 
     ori:setbmp(cFichero) 
     ori:refresh() 
     sysrefresh() 
  end if 
return lVale 



/********************************************************** 
* 
* 
* 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(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 

  METHOD End() INLINE ::Disconnect()   // Finaliza el objeto 

ENDCLASS 
*=========================================================================== 
METHOD New(cDriver,lSelect) 
  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(oWnd,nTop,nLeft,nWidth,nHeight,nStyle,cTitle) 
  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, oWnd:hWnd, 0)
  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) 
  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() 
    IF !(lSucc:=File(cFile)) 
      MsgAlert("No pudo crearse "+cFile,cdi:vTitulo) 
    ELSEIF oImg<>nil 
       oImg:LoadImage(nil,cFile) 
       oImg:Refresh() 
    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() 
    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 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 "Seleccionar Webcam" 
        @ 0,0 COMBOBOX oCbx VAR cDriver OF oDlg ITEMS aDrivers; 
          SIZE 160,50 PIXEL 
        @ 1.5, 4 BUTTON "Seleccionar" OF oDlg SIZE 40,12; 
           ACTION (nDriver:=oCbx:nAt ,oDlg:End()) 
        @ 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 
**************************************************************************** 
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" 
************************************************************************

Sat Mar 31, 2007 9:54 am

No, non ho una webcam, mi dispiace.

EMG

Silvio · Post by **Silvio** » Mon Apr 02, 2007 12:42 pm

non hai proprio modo di provare il codice ?

Mon Apr 02, 2007 12:50 pm

Senza webcam direi proprio di no.

EMG