21 de diciembre de 2015

Google Calendar API y oAuth 2.0 con Visual FoxPro 9

Aquí les dejo mi regalo de Navidad para todos los colegas de la Comunidad de Visual FoxPro en Español. Felices Fiestas y un excelente Año 2016 para todos!!!

Google Calendar API y oAuth 2.0 con Visual FoxPro 9

José Enrique Llopis
Alicante - España
Kansas City - Missouri - USA
jellopis@rocketmail.com
www.multilinkcrm.com
Mi perfil online: https://es.linkedin.com/in/pepellopis

A - Configurar Google Authentication OAuth 2.0

Ejecute la Google Developers Console https://console.developers.google.com y haga clic en Create a new Project:

Complete los datos del proyecto

Debe activar las API’s que usará en este proyecto, para hacer esto haga clic en el botón Enable and Manage APIs.

Seleccione Google Calendar API

Por supuesto esta técnica le abre la puerta para usar todas las restantes API de Google, no solo Calendar

Haga clic en el botón Enable API, como se muestra en la imagen

¡¡¡MUY IMPORTANTE!!! Debe crear las credenciales oAuth 2.0

Haga clic en Credentials y seleccione oAuth client ID

Ahora, usted podrá configurar la pantalla que Google mostrará al usuario para autorizar la aplicación, para hacer esto haga clic en Configure Consent Screen.

Complete los datos de la pantalla “Consent” y haga clic en Save

La siguiente cosa que debe hacer es seleccionar el tipo de aplicación, en este caso debe elegir la opción OTHER y hacer clic en Create.

Ahora tendrá las credenciales que le permitirán usar la aplicación con Google Calendar

¡¡¡GUARDE ESTOS DATOS!!!

Estos datos los puede ver posteriormente desde la Google Developers Console

B - Configurar la aplicación de ejemplo

Edite el fichero include: ./Include/xGCDefs.h

Debe cambiar donde pone YourClientID y YourClientSecret por las credenciales personalizadas que ha obtenido en el paso anterior 

#define GC_CLIENT_ID YourClientID
#define GC_CLIENT_SECRET YourClientSecret

Cambie el texto YourClientID por el dato Client_ID

Cambie el texto YourClientSecret por el dato ClientSecret

Guarde el incluye y ahora podrá ejecutar la aplicación de ejemplo

Haga clic en CONNECT y ESPERE!!!!

Ahora haga clic en el botón Permitir

En este momento usted podrá seleccionar el calendario correcto, por defecto corresponde con la dirección de GMAIL, aunque usted ha podido crear otros adicionales.

Por ultimo podrá ver los datos de los eventos de Calendar en un cursor local de Fox:

NOTA:

No puede duplicar una referencia de evento, incluso si lo borra del calendario

NOTA:

En mis aplicaciones yo uso Web Connection http://www.west-wind.com para hacer las llamadas a Internet, como no es un producto gratuito las he sustituido en este ejemplo por Microsoft.XMLHTTP

C - Descarga del proyecto

La descarga del proyecto completo y la documentación está disponible en el siguiente enlace: GCalconnect.rar (832 KB)

LEGAL DISCLAIMER

THIS SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Jose Enrique Llopis
jellopis@rocketmail.com
www.multilinkcrm.com
Etiquetas: ,
13 comentarios :

20 de diciembre de 2015

Imprimir imágenes individuales

Artículo original: PRINT INDIVIDUAL IMAGES
https://vfpimaging.blogspot.com/2006/05/print-individual-images.html
Autor: Cesar Ch.
Traducido por: Ana María Bisbé York

He visto en la Web algunos ejemplos que muestran cómo imprimir imágenes individuales directamente a la impresora. No se por qué; pero en algunas situaciones los ejemplos no funcionan. Posiblemente o probablemente sea ¿un bug del desarrollador? :(

Una de las formas más sencillas y seguras para hacer esta tarea es utilizar el Diseñador de informes nativo, y dejar que VFP se encargue de todo el proceso de impresión.

Debajo hay un ejemplo que recibe un archivo de imagen como un parámetro, crea el informe al vuelo, y agrega un objeto imagen OLE que va a imprimir la imagen seleccionada.

Este ejemplo se basa totalmente en MSKB 895602 "How to print pictures and how to display pictures that are stored in a Blob field in Visual FoxPro 9.0". El código adaptado debe trabajar en cualquier versión de VFP. Gracias a Trevor Hancock y MSDN. El código es fácil de entender. Puede cambiar fácilmente la posición de la imagen cambiando los valores HPOS y VPOS. Si quiere un ejemplo y necesita más información, vea en la Ayuda de VFP el tópico "Understanding and Extending Report Structure"

Guarde el código como PRINTIMAGE.PRG

Para imprimir una imagen, sólo hay que llamar PRINTIMAGE(GETPICT())

LPARAMETERS tcImage
*tcImage = GETPICT()
*--------------------------------------------------------
* Código VFP que muestra cómo imprimir archivos de imagen.
* Código adaptado del artículo 895602 de Microsoft Knowledge Base
* http://support.microsoft.com/kb/895602
*
* La mayor parte de este código y los comentarios son de
* Trevor Hancock, de MS
*--------------------------------------------------------
LOCAL lnArea
lnArea = SELECT()
CREATE CURSOR ReportTemp (ImageFile c(150))
INSERT INTO ReportTemp VALUES (tcImage)
*-- Llama a una función que crea un informe por programación.
*-- Se incluye aquí sólo para garantizar que este ejemplo se puede
*-- ejecutar tal cual, sin pedir al desarrollador que cree un
*-- informe manualmente.
MakeReport()
*-- Asegura que el cursor esté seleccionado,
*-- y luego ejecuta la Presentación preliminar del informe
*-- utilizando para ello, una instancia de nuestro Report Listener.
SELECT ReportTemp
REPORT FORM ___ImageReport PREVIEW
DELETE FILE "___ImageReport.fr*"
SELECT (lnArea)
RETURN
*--------------------------------
*-- Esta función crea un informe por programación
*-- con un control OLE Dependiente y otros archivos. Se incluye solamente
*-- con el propósito de demostrar su funcionamiento para que este
*-- código pueda ser ejecutado tal cual.
*-- Normalmente, usted creará su propio informe manualmente utilizando
*-- el diseñador de informes.
FUNCTION MakeReport
  CREATE REPORT ___ImageReport FROM ReportTemp
  *-- Abre el archivo de informe (FRX) como una tabla.
  USE ___ImageReport.FRX IN 0 ALIAS TheReport EXCLUSIVE
  SELECT TheReport
  *-- Elimina del FRX las etiquetas y campos auto generados
  DELETE FROM TheReport WHERE ObjType = 5 AND ObjCode = 0 && Elimina las etiquetas
  DELETE FROM TheReport WHERE ObjType = 8 AND ObjCode = 0 && Elimina los campos
  *-- Agrega un control Picture/OLE Dependiente al informe añadiendo un registro
  *-- con los valores apropiados. Es más fácil de ver qué valores se
  *-- corresponden con los campos
  *-- GATHER NAME para añadir el registro (al comparar con un comando
  *-- SQL-INSERT) utilizando un objeto basado en la clase EMPTY y más tarde el comando
  LOCAL loNewRecObj AS EMPTY
  loNewRecObj = NEWOBJECT( 'EMPTY' )
  ADDPROPERTY( loNewRecObj, 'PLATFORM', 'WINDOWS' )
  ADDPROPERTY( loNewRecObj, 'Uniqueid', SYS(2015) )
  ADDPROPERTY( loNewRecObj, 'ObjType', 17 ) && "Control Picture/OLE Dependiente "
    ADDPROPERTY( loNewRecObj, 'NAME', 'ReportTemp.ImageFile' ) && Referencia de objeto al objeto IMAGE.
  ADDPROPERTY( loNewRecObj, 'Hpos', 100)
  ADDPROPERTY( loNewRecObj, 'Vpos', 600)
  ADDPROPERTY( loNewRecObj, 'HEIGHT', 100000)
  ADDPROPERTY( loNewRecObj, 'WIDTH', 100000)
  ADDPROPERTY( loNewRecObj, 'DOUBLE', .T. ) && La imagen se centra en el control "Picture/OLE Dependiente"
    ADDPROPERTY( loNewRecObj, 'Supalways', .T. )
  *-- Para el control Picture/OLE Dependiente, el contenido del campo OFFSET especifica si
  *-- Nombre de archivo (0), Nombre de campo General (1), o Expresión (2) es la fuente.
  ADDPROPERTY( loNewRecObj, 'Offset', 2 )
  *-- Añade el registro del control Picture/OLE Dependiente al informe.
  APPEND BLANK IN TheReport
  GATHER NAME loNewRecObj MEMO
  *-- Realiza la limpieza y cierra la tabla del informe.
  PACK MEMO
  USE IN SELECT( 'TheReport' )
ENDFUNC
Etiquetas: ,
No hay comentarios. :

17 de diciembre de 2015

Controlar dinámicamente los datos de un Grid

Artículo original: Controlling grid data dynamically
http://www.ml-consult.co.uk/foxst-20.htm
Autor: Mike Lewis
Traducido por: Ana María Bisbé York

¿Cómo le puede dar a sus usuarios mayor control sobre los contenidos de un Grid en Visual FoxPro?

Supongamos que desea crear un formulario como el que se muestra en la figura 1. Como ve, utiliza un Grid para mostrar los datos de una tabla Productos. Los usuarios pueden controlar el contenido del Grid de las siguientes formas:

  • Pueden limitar los registros a mostrar en el Grid según la categoría seleccionada.
  • Pueden escoger cuál de los dos campos  - el nombre en Inglés o el nombre original - es el que va a aparecer en la columna Description.
  • Pueden estipular el orden para el Grid.

Figura1: Tres formas para que el usuario controle el Grid

Luego de hacer estas selecciones, el usuario presiona el botón Refresh. Los datos del Grid cambian para refrescar según la selección del usuario.

Está claro, ¿verdad? Entonces, ¿cómo podemos crear este formulario?

Primeras ideas

La primera idea pudiera ser acceder al dato por medio de una vista local. Esto suena razonable, ya que usted puede modificar el contenido de una vista parametrizada. Se puede hacer en la cláusula WHERE de una vista, de esta forma:

WHERE Products.Category = ?lcCat

Aquí, lcCat es una variable que guarda la categoría escogida por el usuario. Si especifica entonces la vista como RecordSource del Grid, el dato se filtrará por la categoría requerida tantas veces como se invoque la vista. La llamada a la función REQUERY() va en el evento Click del botón Refresh del formulario.

Hasta aquí todo bien, en lo relativo a los filtros. Pero no es posible parametrizar los campos a mostrar en las columnas dadas ni el orden de la vista. Es posible recrear toda la vista programáticamente cada vez que el usuario presione el botón Refresh; pero esto no es una solución particularmente elegante. ¿Existe alguna forma más sencilla?

Intentar SQL SELECT

Utilizar una instrucción SQL SELECT para crear un cursor suena muy prometedor. Sin mucha dificultad, puede escribir un SELECT que represente las opciones de los usuarios, y que genera un cursor, que puede ser utilizado como el RecordSource del Grid.

Vamos a asumir que hemos configurado las siguientes variables:

  • lcCat contiene la categoría requerida.
  • llEnglish es .T. si el usuario escoge English como el lenguaje para la descripción del producto (en cuyo caso vamos a utilizar el campo eng_name como la segunda columna). Es .F. si el usuario desea verlo en el lenguaje original (para lo cual va a utilizar en su lugar el campo prod_name).
  • lcOrder contiene el número de la columna por la que se ordenará el dato (se almacena como cadena de caracteres).

El código en el botón Refresh puede tener este aspecto:

SELECT product_id,; 
  IIF(llEnglish,eng_name,prod_name) AS descript,;
  unit_price, in_stock ;
  FROM Products ;
  WHERE ALLTRIM(Category) = ALLTRIM(lcCat) ; 
  ORDER BY &lcOrder INTO CURSOR csrTemp
THISFORM.refresh

La instrucción SELECT envía el dato requerido al cursor, csrTemp. Este es el RecordSource para el Grid, entonces después que el formulario fue refrescado, el Grid  debe mostrar exactamente el dato que necesita el usuario. Problema solucionado.

No es tan sencillo

Desafortunadamente, no es tan sencillo. Si va a crear este formulario y ejecutarlo, el SELECT debía traer el dato correcto; pero el Grid aparecería como un rectángulo vacío. No se verían los datos.

La razón para este comportamiento no es difícil de ver. Siempre que utilice SELECT para crear un cursor de esta forma, Visual FoxPro destruye primero el cursor existente (si existe), luego, construye completamente uno nuevo. El Grid se desestabiliza con esto, ya que no desea perder el RecordSource, ni siquiera por un pequeño instante. Debido a que los controles dentro del Grid, están enlazados al cursor, destruyendo el cursor se destruyen los controles dentro del Grid, por eso se ve el rectángulo vacío.

Existirá alguna diferencia si utilizamos una tabla física en lugar de un cursor para la salida del SELECT? No, no habrá diferencia alguna.

La solución

Sin embargo, una vez que se entiende lo que ocurre, no es difícil idear una solución. El truco es crear un segundo cursor como el RecordSource, y mover los datos desde el primer cursor (aquel creado por el SELECT) al segundo cursor, el que el usuario desea actualizar en el Grid.

Vamos a colocar el siguiente código en el evento Load del formulario:

CREATE CURSOR csrProducts ; 
  ( product_id C(6), descript C(40), ;
  unit_price N(6,2), in_stock N(6) )

Esto va a crear un cursor, llamado crsProducts, con la misma estructura que el generado por SELECT. Establezca este cursor como RecordSource del Grid.

En el botón Refresh, mantenga el SELECT tal y como lo tenía antes; pero agregue algo de código para copiar el contenido del cursor generado por ese SELECT (csrTemp) en un cursor nuevo (csrProducts). El código entonces sería así:

SELECT product_id, ;
  IIF(llEnglish,eng_name,prod_name) AS descript,;
  unit_price, in_stock ;
  FROM Products ;
  WHERE ALLTRIM(Category) = ALLTRIM(lcCat) ; 
  ORDER BY &lcOrder INTO CURSOR csrTemp
SELECT csrProducts 
ZAP 
APPEND FROM DBF("csrTemp")
THISFORM.refresh

El efecto de esto es copiar los resultados del SELECT en csrProducts. Después que se ha refrescado el formulario, el dato se mostrará correctamente en el Grid.

Vea que no puede utilizar el comando COPY TO para transferir los datos a csrProducts, debido a que ese comando crea un archivo nuevo. En su lugar, necesita limpiar (ZAP) el contenido existente de csrProducts y agregar los datos nuevos. Observe además, el uso de la función DBF(). Esto es necesario debido a que el comando APPEND FROM puede solamente copiar datos desde una tabla física. DBF() devuelve la ruta y el nombre del archivo real que guarda el cursor.

Un detalle final al que debe prestar atención. Probablemente desee que el Grid muestre algún dato inicialmente cuando aparece el formulario por primera vez. Este dato debe basarse en los valores predeterminados para las tres selecciones del usuario. Para lograr esto, simplemente agregue código al Init del formulario para hacer el Select y para abrir los resultados en csrProducts. Por supuesto, va a necesitar además código para configurar las variables utilizadas en el SELECT (lcCat, llEnglish and lcOrder),  pero dejaremos esto como ejercicio para el lector.

Agradecimientos

La técnica que se ha descrito está basada en parte en la información del excelente libro "1001 Things You Always Wanted to Know About Visual FoxPro", por Marcia Akins, Andy Kramek y Rick Schummer (Hentzenwerke, 2000). Puede ver un resumen de este libro en nuestra página dedicada a libros: http://www.ml-consult.demon.co.uk/MLCBooks.htm o buscar más información en Amazon.com.

Mike Lewis Consultants Ltd. Septiembre 2001

Etiquetas: ,
No hay comentarios. :

13 de diciembre de 2015

Hacer que las Filas (registros) de un Grid sean de sólo lectura según condición

Si utilizas Grids para captura en linea, quizás quieras limitar que ciertas filas no puedan ser modificadas, es decir, dejarlas como de sólo lectura....

Quizás te resulte algo truculento, pero en realidad sirve... Puedes hacer a TODO el grid de sólo lectura, y cuando se cambie de registro, poner en .T. o .F. el valor de la propiedad ReadOnly (del Grid) según sea tu condición...

Veamos un ejemplo:

public oForm
oForm = CREATEOBJECT("MyForm")
oForm.Show()
DEFINE CLASS MyForm AS Form
   ADD OBJECT MyGrid AS Grid
   PROCEDURE LOAD
       CREATE CURSOR Temp (nMes int,cMes c(15))
       RAND(-1)
       FOR lnCounter=1 TO 20
         lnMes = RAND()*11+1
        INSERT INTO temp VALUES(lnMes,cMONTH(DATE(2003,lnMes,01)))
       ENDFOR
   ENDPROC
   PROCEDURE INIT
      WITH This.MyGrid 
         .SetAll("DynamicBackColor", ;
                 "IIF(RECNO()%2 =0,RGB(255,255,255), ;
                                   RGB(0,255,0))",;
                 "Column")
      EndWith
   ENDPROC
   PROCEDURE UNLOAD
      USE IN SELECT("Temp")
   ENDPROC
   PROCEDURE MyGrid.AfterRowColChange
   LPARAMETERS nColIndex
      This.ReadOnly=(RECNO()%2 # 0)
   ENDPROC   
ENDDEFINE

Copia y Pega el código anterior en tu Command Window, selecciónalo y presiona ENTER, se ejecutará un formulario con un grid conteniendo valores obtenidos de una tabla llenada aleatoriamente, dicho grid le he pintado las filas impares (según el RECNO()), estas mismas líneas serán las que permanezcan de modo solo lectura, ¿Cómo realizaremos esto?, sencillo, en el método AfterRowColChange, si la fila actual es impar o no, pongo el valor de la propiedad ReadOnly a verdadero (.T.) o falso (.F.) según sea el caso.

Si, puede que sea muy "chapucero", pero funciona ;-), el chiste está en que debes establecer correctamente tu condicion de "Solo lectura" y hacerlo por medio del evento AfterRowColChange.

Este truco, se lo debemos a Drew Speddie!. Espero les sea de utilidad.

Espero que esta información les sea de utilidad.

Espartaco Palma Martínez

Etiquetas:
No hay comentarios. :

9 de diciembre de 2015

Convertir imágenes a distintos tipos de archivo

Una función que permite convertir imágenes a distintos formatos y calidad utilizando WIA (Windows Image Acquisition Automation Layer).

En este ejemplo solo utiliza el filtro de Conversión (Formato y Calidad). Pueden ver mas ejemplos de los distintos usos de filtros en la siguiente página: How to Use Filters.

* Ejemplo:
lcFile = GETPICT()
lcFileJPG = ConvertImageType(lcFile, "JPG", 90)
lcFileBMP = ConvertImageType(lcFile, "BMP")
lcFileGIF = ConvertImageType(lcFile, "GIF")
lcFilePNG = ConvertImageType(lcFile, "PNG")
lcFileTIF = ConvertImageType(lcFile, "TIF")

FUNCTION ConvertImageType(tcFileName, tcImageType, tnQuality)
  IF EMPTY(tcFileName) OR ;
      VARTYPE(tcFileName) <> "C" OR ;
      NOT FILE(tcFileName)
    RETURN .F.
  ENDIF

  IF EMPTY(tcImageType) OR ;
      VARTYPE(tcImageType) <> "C"
    tcImageType = "JPG"
  ENDIF

  IF EMPTY(tnQuality) OR ;
      VARTYPE(tnQuality) <> "N" OR ;
      BETWEEN(tnQuality,0,100)
    tnQuality = 100
  ENDIF

  LOCAL loImgFile, loImgProcess
  loImgFile = CREATEOBJECT("WIA.ImageFile")
  loImgProcess = CREATEOBJECT("WIA.ImageProcess")

  * Cargo la imagen a convertir
  loImgFile.LoadFile(tcFilename)

  * Agrego filtros
  loImgProcess.Filters.ADD(loImgProcess.FilterInfos("Convert").FilterID)

  * Nuevo tipo de archivo
  LOCAL lcFormatId
  DO CASE
    CASE tcImageType = "JPG"
      lcFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "BMP"
      lcFormatID = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "GIF"
      lcFormatID = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "PNG"
      lcFormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
    CASE tcImageType = "TIF"
      lcFormatID = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
    OTHERWISE
      tcImageType = "JPG"
      lcFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
  ENDCASE
  loImgProcess.Filters(1).Properties("FormatID").VALUE = lcFormatId

  * Calidad
  loImgProcess.Filters(1).Properties("Quality").VALUE = tnQuality && Calidad

  * Aplico filtros
  loImgFile  = loImgProcess.APPLY(loImgFile)

  LOCAL lcNewFileName
  lcNewFileName =   FORCEEXT(JUSTSTEM(tcFileName), tcImageType)

  * Que no exista el nombre de archivo
  LOCAL lnCount
  lnCount = 1
  DO WHILE FILE(lcNewFileName)
    lcNewFileName = FORCEEXT(JUSTSTEM(tcFileName) + TRANSFORM(lnCount), tcImageType)
    lnCount = lnCount + 1
  ENDDO

  * Guardo imagen procesada
  loImgFile.SaveFile(lcNewFileName)

  STORE NULL TO loImgFile, loImgProcess
  
  *Retorno el nuevo nombre de archivo convertido
  RETURN lcNewFileName
ENDFUNC

Luis María Guayán

Nota: Un reconocimiento al Blog de Jose Guillermo Ortiz Hernandez del cual tome información que me ayudo en la elaboración de esta función que cubre mis necesidades.

Etiquetas: ,
3 comentarios :

5 de diciembre de 2015

Saber la aplicación asociada a una extensión de archivo

Esta es la función en VFP:

FUNCTION AplicAsoc(tcExt)

Esta función retorna el nombre de la aplicación asociada a una extensión pasada como parámetro.

EJEMPLO:

? AplicAsoc("XLS")
EXCEL.EXE

Si la extensión pasada como parámetro no está asociada a ninguna aplicación, la función retorna una cadena vacia.

FUNCTION AplicAsoc(tcExt)
 LOCAL lcArc, lcApp, ln, ll, lc
 DECLARE LONG FindExecutable ;
  IN SHELL32.DLL ;
  STRING lpfile, ;
  STRING lpdirectory, ;
  STRING lpresult
 lcArc = FORCEEXT(SYS(5)+CURDIR()+SYS(2015),tcExt)
 ln = FCREATE(lcArc)
 ll = FCLOSE(ln)
 lc = SPACE(255)
 lcApp = ""
 IF FindExecutable(lcArc,"",@lc) >= 32
  lcApp = JUSTFNAME(SUBSTR(lc,1,AT(CHR(0),lc)-1))
 ENDIF
 IF FILE(lcArc)
  DELETE FILE (lcArc)
 ENDIF 
 RETURN lcApp
ENDFUNC

JMatheus

Etiquetas:
No hay comentarios. :

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
Etiquetas: ,
9 comentarios :
Suscribirse a: Entradas ( Atom )