1 de diciembre de 2015

Capturando imágenes desde una cámara web

Código de ejemplo para capturar una imagen desde la cámara web

LOCAL oForm
oForm = CREATEOBJECT("Tform")
oForm.VISIBLE = .T.
READ EVENTS

DEFINE CLASS Tform AS FORM
  WIDTH = 760
  HEIGHT = 500
  AUTOCENTER = .T.
  CAPTION = "Using Video Capture"
  MINBUTTON = .F.
  MAXBUTTON = .F.
  SHOWWINDOW = 2
  BORDERSTYLE = 2
  SHOWTIPS = .T.

  ADD OBJECT cmdClose AS COMMANDBUTTON WITH CANCEL = .T.,;
    LEFT = 10, TOP = 150, HEIGHT = 27, WIDTH = 100, CAPTION = "Close"

  ADD OBJECT cmdGetFrame AS COMMANDBUTTON WITH;
    LEFT = 10, TOP = 5, HEIGHT = 27, WIDTH = 100, CAPTION = "Get Frame",;
    ENABLED = .F., TOOLTIPTEXT = "Updates the frame"

  ADD OBJECT cmdPreview AS COMMANDBUTTON WITH DEFAULT = .T.,;
    LEFT = 10, TOP = 33, HEIGHT = 27, WIDTH = 100, CAPTION = "Preview Video",;
    ENABLED = .F., TOOLTIPTEXT = "Turns preview mode on"

  ADD OBJECT cmdSave AS COMMANDBUTTON WITH LEFT = 10, TOP = 61,;
    HEIGHT = 27, WIDTH = 100, CAPTION = "Save to BMP",;
    TOOLTIPTEXT = "Saves current frame to BMP file"

  ADD OBJECT cmdFormat AS COMMANDBUTTON WITH LEFT = 10, TOP = 100,;
    HEIGHT = 27, WIDTH = 100, CAPTION = "Format",;
    TOOLTIPTEXT = "Displays available formats"

  ADD OBJECT capwindow AS TCaptureWindow

  PROCEDURE INIT
    =BINDEVENT(THIS.capwindow, "ResizeCaptureWindow",THIS, "OnCaptureWindowResized", 1)
  ENDPROC

  PROCEDURE ACTIVATE
    IF THIS.capwindow.hWindow = 0
      IF THIS.capwindow.InitCaptureWindow(THIS.HWND, 120, 5)
        STORE .T. TO THIS.cmdGetFrame.ENABLED,;
          THIS.cmdPreview.ENABLED
        THISFORM.capwindow.StartPreview
      ENDIF
    ENDIF
  ENDPROC

  PROCEDURE DESTROY
    CLEAR EVENTS
  ENDPROC

  PROCEDURE cmdClose.CLICK
    THISFORM.RELEASE
  ENDPROC

  PROCEDURE cmdGetFrame.CLICK
    THISFORM.capwindow.GetFrame
  ENDPROC

  PROCEDURE cmdPreview.CLICK
    THISFORM.capwindow.StartPreview
  ENDPROC

  PROCEDURE cmdFormat.CLICK
    THISFORM.capwindow.FormatDlg
  ENDPROC

  PROCEDURE cmdSave.CLICK
    THISFORM.capwindow.SaveToDib
  ENDPROC

  PROCEDURE OnCaptureWindowResized
    WITH THIS.capwindow
      IF .capWidth = 0 OR .capHeight = 0
        RETURN
      ENDIF
      THIS.WIDTH = MAX(320, .capLeft+.capWidth+5)
      THIS.HEIGHT = MAX(240, .capTop+.capHeight+25)
      THIS.cmdClose.TOP = THIS.HEIGHT-60
    ENDWITH
  ENDPROC

ENDDEFINE

DEFINE CLASS TCaptureWindow AS CUSTOM
  #DEFINE WM_CAP_START  0x0400
  #DEFINE WM_CAP_DRIVER_CONNECT    (WM_CAP_START+10)
  #DEFINE WM_CAP_DRIVER_DISCONNECT (WM_CAP_START+11)
  #DEFINE WM_CAP_DRIVER_GET_CAPS   (WM_CAP_START+14)
  #DEFINE WM_CAP_FILE_SAVEDIB      (WM_CAP_START+25)
  #DEFINE WM_CAP_DLG_VIDEOFORMAT   (WM_CAP_START+41)
  #DEFINE WM_CAP_GET_VIDEOFORMAT   (WM_CAP_START+44)
  #DEFINE WM_CAP_SET_VIDEOFORMAT   (WM_CAP_START+45)
  #DEFINE WM_CAP_SET_PREVIEW       (WM_CAP_START+50)
  #DEFINE WM_CAP_SET_OVERLAY       (WM_CAP_START+51)
  #DEFINE WM_CAP_SET_PREVIEWRATE   (WM_CAP_START+52)
  #DEFINE WM_CAP_SET_SCALE         (WM_CAP_START+53)
  #DEFINE WM_CAP_GET_STATUS        (WM_CAP_START+54)
  #DEFINE WM_CAP_GRAB_FRAME        (WM_CAP_START+60)

  #DEFINE WS_CHILD 0x40000000
  #DEFINE WS_VISIBLE 0x10000000
  #DEFINE SWP_SHOWWINDOW 0x40
  #DEFINE BITMAPINFOHEADER_SIZE 40
  #DEFINE CAPDRIVERCAPS_SIZE 44

  hWindow = 0
  hCapture = 0
  capWidth = 0
  capHeight = 0
  capOverlay = 0
  capLeft = 0
  capTop = 0

  PROCEDURE INIT
    THIS.DECLARE
  ENDPROC

  PROCEDURE DESTROY
    THIS.ReleaseCaptureWindow
  ENDPROC

  PROCEDURE InitCaptureWindow(hParent, nLeft, nTop)
    WITH THIS
      .hWindow = m.hParent
      .capLeft = m.nLeft
      .capTop = m.nTop
      STORE 0 TO .capWidth, .capHeight

      .hCapture = capCreateCaptureWindow("",;
        BITOR(WS_CHILD,WS_VISIBLE), .capLeft, .capTop,;
        1,1, .hWindow, 1)

      IF .DriverConnect()
        .msg(WM_CAP_SET_SCALE, 1, 0)
        .ResizeCaptureWindow
      ENDIF
    ENDWITH
    RETURN THIS.IsCaptureConnected()
  ENDPROC

  PROCEDURE msg(msg, wParam, LPARAM, nMode)
    DO CASE
      CASE THIS.hCapture = 0
      CASE VARTYPE(nMode) <> "N" OR nMode = 0
        =SendMsgInt(THIS.hCapture, msg, wParam, LPARAM)
      OTHERWISE
        =SendMsgStr(THIS.hCapture, msg, wParam, @LPARAM)
    ENDCASE
  ENDPROC

  PROCEDURE ResizeCaptureWindow
    THIS.GetVideoFormat
    =SetWindowPos(THIS.hCapture, 0, THIS.capLeft,THIS.capTop,;
      THIS.capWidth, THIS.capHeight, SWP_SHOWWINDOW)
  ENDPROC

  PROCEDURE DriverConnect
    THIS.msg(WM_CAP_DRIVER_CONNECT, 0,0)
    IF THIS.IsCaptureConnected()
      RETURN .T.
    ELSE
      RETURN .F.
    ENDIF
  ENDPROC

  PROCEDURE DriverDisconnect
    THIS.msg(WM_CAP_DRIVER_DISCONNECT, 0,0)
  ENDPROC

  PROCEDURE ReleaseCaptureWindow
    IF THIS.hCapture <> 0
      THIS.DriverDisconnect
      = DestroyWindow(THIS.hCapture)
      THIS.hCapture = 0
    ENDIF
  ENDPROC

  PROCEDURE GetFrame
    THIS.msg(WM_CAP_GRAB_FRAME, 0,0)
  ENDPROC

  PROCEDURE GetVideoFormat
    LOCAL cBuffer, nBufsize
    nBufsize = 4096
    cBuffer = PADR(THIS.num2dword(BITMAPINFOHEADER_SIZE), nBufsize, CHR(0))
    THIS.msg(WM_CAP_GET_VIDEOFORMAT, nBufsize, @cBuffer, 1)
    THIS.capWidth = THIS.buf2dword(SUBSTR(cBuffer, 5,4))
    THIS.capHeight = THIS.buf2dword(SUBSTR(cBuffer, 9,4))
  ENDPROC

  PROCEDURE FormatDlg
    THIS.msg(WM_CAP_DLG_VIDEOFORMAT, 0,0)
    THIS.ResizeCaptureWindow
  ENDPROC

  FUNCTION IsCaptureConnected
    LOCAL cBuffer, nResult
    cBuffer = REPLI(CHR(0),CAPDRIVERCAPS_SIZE)
    THIS.msg(WM_CAP_DRIVER_GET_CAPS, LEN(cBuffer), @cBuffer, 1)
    THIS.capOverlay = THIS.buf2dword(SUBSTR(cBuffer,5,4))
    nResult = ASC(SUBSTR(cBuffer, 21,1))
    RETURN (nResult <> 0)
  ENDPROC

  PROCEDURE StartPreview
    THIS.msg(WM_CAP_SET_PREVIEWRATE,30,0)
    THIS.msg(WM_CAP_SET_PREVIEW, 1,0)
    IF THIS.capOverlay <> 0
      THIS.msg(WM_CAP_SET_OVERLAY,1,0)
    ENDIF
  ENDPROC

  PROCEDURE StopPreview
    THIS.msg(WM_CAP_SET_PREVIEW, 0,0)
  ENDPROC

  PROCEDURE SaveToDib
    LOCAL cFilename
    cFilename = "pic" + SYS(2015) + ".bmp" + CHR(0)
    THIS.msg(WM_CAP_FILE_SAVEDIB, 0, @cFilename, 1)
  ENDPROC

  PROCEDURE DECLARE
    DECLARE INTEGER DestroyWindow IN user32 INTEGER hWindow

    DECLARE INTEGER capCreateCaptureWindow IN avicap32;
      STRING lpszWindowName, LONG dwStyle,;
      INTEGER x, INTEGER Y, INTEGER nWidth,;
      INTEGER nHeight, INTEGER hParent, INTEGER nID

    DECLARE INTEGER SetWindowPos IN user32;
      INTEGER hWindow, INTEGER hWndInsertAfter,;
      INTEGER x, INTEGER Y, INTEGER cx, INTEGER cy,;
      INTEGER wFlags

    DECLARE INTEGER SendMessage IN user32 AS SendMsgInt;
      INTEGER hWindow, INTEGER Msg,;
      INTEGER wParam, INTEGER LPARAM

    DECLARE INTEGER SendMessage IN user32 AS SendMsgStr;
      INTEGER hWindow, INTEGER Msg,;
      INTEGER wParam, STRING @LPARAM
  ENDPROC

  PROCEDURE buf2dword(lcBuffer)
    RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ;
      BITLSHIFT(ASC(SUBSTR(lcBuffer, 2,1)),  8) +;
      BITLSHIFT(ASC(SUBSTR(lcBuffer, 3,1)), 16) +;
      BITLSHIFT(ASC(SUBSTR(lcBuffer, 4,1)), 24)
  ENDPROC

  PROCEDURE num2dword(lnValue)
    #DEFINE m0 0x100
    #DEFINE m1 0x10000
    #DEFINE m2 0x1000000
    IF lnValue < 0
      lnValue = 0x100000000 + lnValue
    ENDIF
    LOCAL b0, b1, b2, b3
    b3 = INT(lnValue/m2)
    b2 = INT((lnValue - b3*m2)/m1)
    b1 = INT((lnValue - b3*m2 - b2*m1)/m0)
    b0 = MOD(lnValue, m0)
    RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3)
  ENDPROC

ENDDEFINE

9 comentarios :

  1. Muchas gracias por tu aportación, funciona muy bien. Sólo hay un problema, en las tablets con Windows con cámaras integradas no he conseguido que funcione, se ve la pantalla en negro.

    ResponderBorrar
    Respuestas
    1. Mira, te paso otro ejemplo que esta en el Blog de JgohOrtiz

      -- FoxPro WebCam - Tomar fotografiá y recortarla con WIA --
      http://jgohortiz.blogspot.com.ar/2014/04/foxpro-webcam-tomar-fotografia-y.html

      Saludos,

      Borrar
    2. Buen día Luis.
      El link de arriba ya no está disponible.
      Oportunamente pude capturar imágenes desde TWAIN pero con Windows 10 ya no funciona (Unable to open default data Source)
      Acudo a tu amplio conocimiento en las herramientas para resolverlo.

      Saludos
      Marcelo desde San Nicolás - Argentina

      Borrar
  2. Impresionante, copie el codigo y lo corri, me parece que con el zorro se pueden agrrgar muchos juguetes a las aplicaciones que uno desarrolla.

    Saludos.

    ResponderBorrar
  3. Alguien podría ser tan amable de darme las pautas para poder incluir esto en un formulario previamente realizado, hecho con el diseñador y que funciona de maravillas... no quiero "romperlo" jeje
    La cuestión es como meto en ese form el objeto con la preview de la cámara y luego capturar la imagen y meterlo en un control de imagen que finalmente irá a para a un campo de una tabla.

    ¡Desde ya mil gracias!

    ResponderBorrar
    Respuestas
    1. Que tal Gastón, vi tu pregunta y no se si ya la resolviste. Yo tengo un formulario...y buscando una respuesta encontré tu pregunta. Si ya lo resolviste no hay problema, pero si aún necesitas el formulario avísame. Sin embargo, tiene un detalle que no puedo corregir...En modo diseño funciona a la perfección, tengo WIN10 y se me hace que por ahí viene el problema. En modo de Ejecución la pantalla no da video aunque prende la cámara de mi lap. Alguien que tenga una respuesta ???

      Borrar
  4. donde debo insertar este codigo para que corra ?

    ResponderBorrar

Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.