29 de agosto de 2006

Captar porciones de pantalla

Artículo original: CAPTURE SCREEN PORTIONS
https://vfpimaging.blogspot.com/2006/03/capture-screen-portions_7775.html
Autor: Cesar Ch.
Traducido por: Ana María Bisbé York


Este ejemplo, corto; pero poderoso emplea muchas llamadas a API, para accesos de memoria y conversión de datos desde el portapapeles. No necesita de ningún control OCX y trabaja con VFP desde la versión 5 hasta la 9. El autor lo ha creado porque mucha gente ha estado buscando herramientas para capturar imágenes desde cámaras web y otros accesorios de imágenes enlazados a programas. Este ejemplo muestra nuevamente que podemos hacer muchas cosas con Visual FoxPro. Echemos un vistazo a lo que el ha hecho en un formulario sencillo.

Este es uno de mis códigos preferidos de uno de mis colegas del foro brasileño www.foxbrasil.com.br/forum, Gelson L. Bremm, de Florianopolis - Brasil, quien me ha autorizado a publicarlo aquí. Pienso que realmente vale la pena compartirlo con el resto de la comunidad.

En este enlace puede encontrar más información sobre Gelson: http://www.foxbrasil.com.br/forum/viewtopic.php?t=2044

Desde aquí, puede descargar el código fuente que tiene debajo: https://bit.ly/CaptureScreens

*!* IMAGECAPTURE.PRG
*!* Autor : Gelson L. Bremm
*!* Descripción : Captura cualquier imagen de la pantalla
PUBLIC oCapturaImg
oCapturaImg = CREATEOBJECT("CapturaImagem")
oCapturaImg.Show()

DEFINE CLASS CapturaImagem AS Form
  Height = 147
  Width = 115
  Desktop = .T.
  ShowWindow = 2
  DoCreate = .T.
  ShowTips = .T.
  AutoCenter = .T.
  Caption = "Capturar"
  HalfHeightCaption = .T.
  MaxButton = .F.
  MinButton = .F.
  MinHeight = 80
  AlwaysOnTop = .T.
  Name = "CAPTURE"

  ADD OBJECT Command1 AS myCmdButton

  PROCEDURE Init
    WITH THIS
      .DeclareFunctions()
      .Resize()
    ENDWITH
  ENDPROC

  PROCEDURE SetTransparent
    LOCAL lnControlBottom, lnControlRight, lnControlLeft, lnControlTop, lnBorderWidth, ;
      lnTitleHeight, lnFormHeight, lnFormWidth, lnInnerRgn, lnOuterRgn, lnCombinedRgn, ;
      lnControlRgn, lnControl, lnRgnDiff, lnRgnOr, llTrue

    lnRgnDiff = 4
    lnRgnOr = 2
    llTrue = -1

    WITH THIS
      lnBorderWidth = SYSMETRIC(3)
      lnTitleHeight = SYSMETRIC(9)-SYSMETRIC(4)
      lnFormWidth = .Width + (lnBorderWidth * 2)
      lnFormHeight = .Height + lnTitleHeight + lnBorderWidth
      lnOuterRgn = CreateRectRgn(0, 0, lnFormWidth, lnFormHeight)
      lnInnerRgn = CreateRectRgn(lnBorderWidth, lnTitleHeight, ;
        lnFormWidth - lnBorderWidth, lnFormHeight - lnBorderWidth)
      lnCombinedRgn = CreateRectRgn(0, 0, 0, 0)
      CombineRgn(lnCombinedRgn, lnOuterRgn, lnInnerRgn, lnRgnDiff)
      FOR EACH Control in .Controls
        lnControlLeft = Control.Left + lnBorderWidth
        lnControlTop = Control.Top + lnTitleHeight
        lnControlRight = Control.Width + lnControlLeft
        lnControlBottom = Control.Height + lnControlTop
        lnControlRgn = CreateRectRgn(lnControlLeft, lnControlTop, lnControlRight, lnControlBottom)
        CombineRgn(lnCombinedRgn, lnCombinedRgn, lnControlRgn, lnRgnOr)
      ENDFOR
      SetWindowRgn(.HWnd , lnCombinedRgn, llTrue)
    ENDWITH
  ENDPROC

  PROCEDURE num2dword
    LPARAMETERS lnValue

    #DEFINE m0 256
    #DEFINE m1 65536
    #DEFINE m2 16777216

    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

  PROCEDURE declarefunctions
    DECLARE INTEGER CombineRgn in "gdi32" integer hDestRgn, integer hRgn1, integer hRgn2, integer nMode
    DECLARE INTEGER CreateRectRgn in "gdi32" integer X1, integer Y1, integer X2, integer Y2
    DECLARE INTEGER SetWindowRgn in "user32" integer hwnd, integer hRgn, integer nRedraw

    DECLARE INTEGER SelectObject IN gdi32 integer hdc, integer hObject
    DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd, INTEGER hdc
    DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
    DECLARE INTEGER CloseClipboard IN user32
    DECLARE INTEGER GetFocus IN user32
    DECLARE INTEGER EmptyClipboard IN user32
    DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
    DECLARE INTEGER OpenClipboard IN user32 INTEGER hwnd
    DECLARE INTEGER SetClipboardData IN user32 INTEGER wFormat, INTEGER hMem
    DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
      INTEGER hdc, INTEGER nWidth, INTEGER nHeight
    DECLARE INTEGER BitBlt IN gdi32;
      INTEGER hDestDC, INTEGER x, INTEGER y,;
      INTEGER nWidth, INTEGER nHeight, INTEGER hSrcDC,;
      INTEGER xSrc, INTEGER ySrc, INTEGER dwRop

    DECLARE INTEGER GetActiveWindow IN user32
    DECLARE INTEGER GetClipboardData IN user32 INTEGER uFormat
    DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
    DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem

    DECLARE INTEGER GetObject IN gdi32 AS GetObjectA;
      INTEGER hgdiobj, INTEGER cbBuffer, STRING @lpvObject

    DECLARE INTEGER GetObjectType IN gdi32 INTEGER h

    DECLARE RtlZeroMemory IN kernel32 As ZeroMemory;
      INTEGER dest, INTEGER numBytes

    DECLARE INTEGER GetDIBits IN gdi32;
      INTEGER hdc, INTEGER hbmp, INTEGER uStartScan,;
      INTEGER cScanLines, INTEGER lpvBits, STRING @lpbi,;
      INTEGER uUsage

    DECLARE INTEGER CreateFile IN kernel32;
      STRING lpFileName, INTEGER dwDesiredAccess,;
      INTEGER dwShareMode, INTEGER lpSecurityAttr,;
      INTEGER dwCreationDisp, INTEGER dwFlagsAndAttrs,;
      INTEGER hTemplateFile

    DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject

    DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
  ENDPROC

  PROCEDURE CopyToClipBoard
    WITH THIS
      .Caption = "Capturing"
      .Command1.Left = .Width+.Command1.Width
      .Cls()
      .SetTransparent()
      =Sleep(100)

      #DEFINE CF_BITMAP 2
      #DEFINE SRCCOPY 13369376

      lnLeft = SYSMETRIC(3)
      lnTop = SYSMETRIC(4)+(SYSMETRIC(20)-SYSMETRIC(11))
      lnRight = 0
      lnBottom = 0
      lnWidth = .Width
      lnHeight = .Height-1

      *hwnd = GetFocus()
      hdc = GetWindowDC(.HWnd)
      hVdc = CreateCompatibleDC(hdc)
      hBitmap = CreateCompatibleBitmap(hdc, lnWidth, lnHeight)

      = SelectObject(hVdc, hBitmap)
      = BitBlt(hVdc, 0, 0, lnWidth, lnHeight, hdc, lnLeft, lnTop, SRCCOPY)
      = OpenClipboard(.HWnd)
      = EmptyClipboard()
      = SetClipboardData(CF_BITMAP, hBitmap)
      = CloseClipboard()
      = DeleteObject(hBitmap)
      = DeleteDC(hVdc)
      = ReleaseDC(.HWnd, hdc)

      .Command1.Left = VAL(.Command1.Tag)
      .SetTransparent()
      .Caption = "Capturar"
    ENDWITH
  ENDPROC

  PROCEDURE CopyToFile
    #DEFINE CF_BITMAP 2
    #DEFINE SRCCOPY 13369376
    #DEFINE OBJ_BITMAP 7
    #DEFINE DIB_RGB_COLORS 0
    #DEFINE BFHDR_SIZE 14
    #DEFINE BHDR_SIZE 40
    #DEFINE GENERIC_WRITE 1073741824
    #DEFINE FILE_SHARE_WRITE 2
    #DEFINE CREATE_ALWAYS 2
    #DEFINE FILE_ATTRIBUTE_NORMAL 128
    #DEFINE INVALID_HANDLE_VALUE -1
    #DEFINE BITMAP_STRU_SIZE 24
    #DEFINE BI_RGB 0
    #DEFINE RGBQUAD_SIZE 4
    #DEFINE BHDR_SIZE 40
    #DEFINE GMEM_FIXED 0

    LOCAL cDefault, cNameFile, hClipBmp
    LOCAL pnWidth, pnHeight, pnBitsSize, pnRgbQuadSize, pnBytesPerScan
    LOCAL hFile, lnFileSize, lnOffBits, lcBFileHdr
    LOCAL lnBitsPerPixel, lcBIHdr, lcRgbQuad
    LOCAL lpBitsArray, lcBInfo
    LOCAL hdc, hMemDC, lcBuffer

    cDefault = FULLPATH(SYS(5))
    cNameFile = GETPICT("BMP")
    SET DEFAULT TO (cDefault)
    IF EMPTY(cNameFile)
      RETURN
    ENDIF

    IF FILE(cNameFile)
      IF MESSAGEBOX("Esta carpeta ya contiene un archivo llamado '"+PROPER(JUSTFNAME(cNameFile))+;
          "'"+CHR(13)+"¿Sobreescribir el archivo existente ?",36+256,"Confirmar sobreescribir") = 7
        RETURN
      ENDIF
    ENDIF
    ERASE (cNameFile)

    WITH THIS
      .CopyToClipBoard()

      = OpenClipboard (0)
      hClipBmp = GetClipboardData (CF_BITMAP)
      = CloseClipboard()

      IF hClipBmp = 0 Or GetObjectType(hClipBmp) # OBJ_BITMAP
        =MESSAGEBOX("No hay ninguna imagen en el portapapeles.",48,"Error al crear el archivo")
        RETURN
      ENDIF

      STORE 0 TO pnWidth, pnHeight, pnBytesPerScan, pnBitsSize, pnRgbQuadSize
      lcBuffer = REPLI(CHR(0), BITMAP_STRU_SIZE)
      IF GetObjectA (hClipBmp, BITMAP_STRU_SIZE, @lcBuffer) # 0
        pnWidth = ASC(SUBSTR(lcBuffer, 5,1)) + ;
          ASC(SUBSTR(lcBuffer, 6,1)) * 256 +;
          ASC(SUBSTR(lcBuffer, 7,1)) * 65536 +;
          ASC(SUBSTR(lcBuffer, 8,1)) * 16777216

        pnHeight = ASC(SUBSTR(lcBuffer, 9,1)) + ;
          ASC(SUBSTR(lcBuffer, 10,1)) * 256 +;
          ASC(SUBSTR(lcBuffer, 11,1)) * 65536 +;
          ASC(SUBSTR(lcBuffer, 12,1)) * 16777216
      ENDIF

      lnBitsPerPixel = 24
      pnBytesPerScan = INT((pnWidth * lnBitsPerPixel)/8)
      IF MOD(pnBytesPerScan, 4) # 0
        pnBytesPerScan = pnBytesPerScan + 4 - MOD(pnBytesPerScan, 4)
      ENDIF

      lcBIHdr = .num2dword(BHDR_SIZE) + .num2dword(pnWidth) +;
        .num2dword(pnHeight) + (CHR(MOD(1,256))+CHR(INT(1/256))) + (CHR(MOD(lnBitsPerPixel,256))+;
        CHR(INT(lnBitsPerPixel/256))) + .num2dword(BI_RGB) + REPLI(CHR(0), 20)

      IF lnBitsPerPixel <= 8
        pnRgbQuadSize = (2^lnBitsPerPixel) * RGBQUAD_SIZE
        lcRgbQuad = REPLI(CHR(0), pnRgbQuadSize)
      ELSE
        lcRgbQuad = ""
      ENDIF
      lcBInfo = lcBIHdr + lcRgbQuad
      pnBitsSize = pnHeight * pnBytesPerScan
      lpBitsArray = GlobalAlloc (GMEM_FIXED, pnBitsSize)
      = ZeroMemory (lpBitsArray, pnBitsSize)

      *hwnd = GetActiveWindow()
      hdc = GetWindowDC(.HWnd)
      hMemDC = CreateCompatibleDC (hdc)
      = ReleaseDC (.HWnd, hdc)
      = GetDIBits (hMemDC, hClipBmp, 0, pnHeight, lpBitsArray, @lcBInfo, DIB_RGB_COLORS)

      lnFileSize = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize + pnBitsSize
      lnOffBits = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize
      lcBFileHdr = "BM" + .num2dword(lnFileSize) + .num2dword(0) + .num2dword(lnOffBits)

      hFile = CreateFile(cNameFile, GENERIC_WRITE, FILE_SHARE_WRITE, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

      IF hFile # INVALID_HANDLE_VALUE
        DECLARE INTEGER WriteFile IN kernel32;
          INTEGER hFile, STRING @lpBuffer, INTEGER nBt2Write,;
          INTEGER @lpBtWritten, INTEGER lpOverlapped
        = WriteFile (hFile, @lcBFileHdr, Len(lcBFileHdr), 0, 0)
        = WriteFile (hFile, @lcBInfo, Len(lcBInfo), 0, 0)

        DECLARE INTEGER WriteFile IN kernel32;
          INTEGER hFile, INTEGER lpBuffer, INTEGER nBt2Write,;
          INTEGER @lpBtWritten, INTEGER lpOverlapped
        = WriteFile (hFile, lpBitsArray, pnBitsSize, 0, 0)
        = CloseHandle (hFile)
      ELSE
        = MESSAGEBOX("Error al crear un archivo: " + cNameFile, "Operación no concluida")
      ENDIF

      = GlobalFree(lpBitsArray)
      = DeleteDC (hMemDC)
      = DeleteObject (hClipBmp)
    ENDWITH
  ENDPROC

  PROCEDURE Resize
    WITH THIS
      .Command1.Left = .Width-.Command1.Width
      .Command1.Top = .Height-.Command1.Height
      .Command1.Tag = ALLT(STR(.Command1.Left))

      .SetTransparent()
    ENDWITH
  ENDPROC

  PROCEDURE Destroy
    oCapturaImg = .F.
    RELEASE oCapturaImg
  ENDPROC
ENDDEFINE

DEFINE CLASS myCmdButton AS Commandbutton
  Top = 126
  Left = 97
  Height = 21
  Width = 18
  FontName = "Webdings"
  Caption = "6"
  ToolTipText = "Opciones"
  Name = "Command1"

  PROCEDURE Click
    cOptMenu = ""
    DEFINE POPUP _menu_clip SHORTCUT RELATIVE FROM MROW(), MCOL()
    DEFINE BAR CNTBAR("_menu_clip")+1 OF _menu_clip PROMPT "Copiar al portapapeles"
    ON SELECTION BAR CNTBAR("_menu_clip") OF _menu_clip cOptMenu = "CLIPBOARD"
    DEFINE BAR CNTBAR("_menu_clip")+1 OF _menu_clip PROMPT "Copiar al archivo"
    ON SELECTION BAR CNTBAR("_menu_clip") OF _menu_clip cOptMenu = "FILE"
    ACTIVATE POPUP _menu_clip
    RELEASE POPUPS _menu_clip

    DO CASE
      CASE cOptMenu == "CLIPBOARD"
        THISFORM.CopyToClipBoard()

      CASE cOptMenu == "FILE"
        THISFORM.CopyToFile()
    ENDCASE
  ENDPROC
ENDDEFINE

25 de agosto de 2006

Gráficas con objetos 100% VFP

En estos últimos días he estado atento a los artículos de Cesar Ch. (San Pablo, Brasil), referidos a los gráficos de barras y de torta generados con código VFP puro. Estos artículos publicados en su Blog y traducidos por Ana María Bisbé York para PortalFox son los siguientes:
y
La técnica utilizada para crear estas gráficas, es mediante el uso de objetos Labels y Lines respectivamente.

El objetivo de este artículo es tener otra opción (siempre VFP nos da esta posibilidad) de generar gráficas con solo el uso del objeto Shape, sin depender del uso de ninguna otra herramienta de terceras partes.

La idea

Con el uso del objeto Shape es fácil crear barras rectangulares configurando las propiedades Width (ancho) y Height (alto) con las dimensiones correspondientes, según la cantidad de barras del gráfico y el valor a graficar. El tema aquí es como graficar las distintas porciones de una torta (sección circular) o las secciones de un anillo con este objeto.

A partir de Visual FoxPro 9.0, disponemos de la nueva propiedad PolyPoints en el objeto Shape (también en el objeto Line), que nos permiten graficar formas poligonales (ver el artículo Dibujando polígonos con VFP 9.0). Con esta técnica, graficaremos cada porción como un polígono con sus respectivas dimensiones, e iremos añadiendo las restantes porciones hasta completar la gráfica como se observa en las figuras siguientes.



Nota: Las opciones del tipo de gráfica torta, anillo y cono, solo se podrá ejecutar en la versión 9.0 de Visual FoxPro, por el uso de la propiedad PolyPoints de los objetos Shapes.

La clase

Como mencioné al principio de estas líneas, mi objetivo es generar gráficas con código VFP puro, para ello he creado una clase a partir de un objeto Container, al que se irán agregando en tiempo de ejecución los objetos Shape para formar la gráfica y también se agregaran las correspondientes leyendas. Su uso es muy fácil, y solo de deben configurar 5 propiedades y ejecutar el método GenerarGrafica() como se expone en las siguientes líneas de código:
WITH THISFORM.lmGraph
  .TipoGrafica = 1 && Anillo
  .TipoLeyenda = 3 && Rótulos
  .TipoColor = 0 && Aleatorios
  .TituloGrafica = "Consumos por mes"
  .Alias = "MiTabla"
  .GenerarGrafica()
ENDWITH
Las propiedades de la clase y sus valores son los siguientes:
  • TipoGrafica: 0=Torta, 1=Anillo, 2=Barras verticales, 3=Barras horizontales, 4=Conos verticales, y 5=Conos horizontales
  • TipoLeyenda: 0=Sin leyendas, 1=Valores, 2=Porcentajes, 3=Rótulos, 4=Rótulos y valores, y 5=Porcentajes y rótulos
  • TipoColor: 0=Aleatorios y 1=Colores básicos (28 colores definidos)
  • TituloGrafica: Cadena con el título superior de la gráfica
  • Alias: Alias de la tabla o cursor que contiene los rótulos y valores a graficar
Sobre la tabla o cursor que contiene los datos a graficar, ésta debe estar abierta al momento de ejecutar el método GenerarGrafica(), y debe tener al menos dos campos. El contenido y la estructura de los dos primeros campos debe ser:
  • 1° Campo: Este campo contiene los valores y debe ser Numérico.
  • 2° Campo: Este campo contiene los rótulos y puede ser de tipo Caracter, Date, DateTime o Numérico.

Los ejemplos

Ejecutando el formulario de ejemplo con la clase incluida, podemos lograr gráficas simples y agradables como lo muestran las figuras siguientes:

Gráfica de torta, con leyenda de porcentajes y rótulos, y colores aleatorios


Gráfica de anillo, con leyenda de rótulos y valores, y colores básicos


Gráfica de barras verticales, con leyenda de rótulos, y colores aleatorios


Gráfica de barras horizontales, sin leyenda, y colores básicos


Gráfica de conos verticales, con leyenda de porcentajes, y colores aleatorios


Gráfica de conos verticales, con leyenda de valores, y colores aleatorios


El formulario del ejemplo tiene una casilla de verificación (DEMO) que marcada, generará aleatoria y automáticamente cada 2 segundos, las distintas combinaciones posibles para cada una de las propiedades de la clase.

El código

El siguiente es el código del formulario de ejemplo y la clase para generar las gráficas:
PUBLIC goForm
goForm = CREATEOBJECT("frmEjemplo")
goForm.SHOW
RETURN
*--
*-- Definición del formulario de ejemplo
*--
DEFINE CLASS frmejemplo AS FORM
  HEIGHT = 431
  WIDTH = 496
  SHOWWINDOW = 2
  AUTOCENTER = .T.
  CAPTION = "Gráficas con VFP9"
  ICON = (HOME(4) + "icons\office\graph11.ico")
  NAME = "frmEjemplo"
  ADD OBJECT tmr AS TIMER WITH ;
    ENABLED = .F., INTERVAL = 2000, NAME = "tmr"
  ADD OBJECT opgColores AS OPTIONGROUP WITH ;
    BUTTONCOUNT = 2, ANCHOR = 6, VALUE = 1, ;
    HEIGHT = 48, LEFT = 344, TOP = 280, WIDTH = 136, ;
    TABINDEX = 4, NAME = "opgColores", ;
    Option1.BACKSTYLE = 0, Option1.CAPTION = "Colores aleatorios", ;
    Option1.VALUE = 1, Option1.HEIGHT = 17, Option1.LEFT = 8, Option1.TOP = 8, ;
    Option1.WIDTH = 120, Option1.AUTOSIZE = .T., Option1.NAME = "Option1", ;
    Option2.BACKSTYLE = 0, Option2.CAPTION = "Colores básicos", ;
    Option2.VALUE = 0, Option2.HEIGHT = 17, Option2.LEFT = 8, Option2.TOP = 24, ;
    Option2.WIDTH = 109, Option2.AUTOSIZE = .T., Option2.NAME = "Option2"
  ADD OBJECT cmdGenerar AS COMMANDBUTTON WITH ;
    TOP = 392, LEFT = 376, HEIGHT = 32, WIDTH = 104, ;
    ANCHOR = 6, WORDWRAP = .T., CAPTION = "Generar gráfica", ;
    TABINDEX = 9, NAME = "cmdGenerar"
  ADD OBJECT opgGraficas AS OPTIONGROUP WITH ;
    BUTTONCOUNT = 6, ANCHOR = 6, VALUE = 1, ;
    HEIGHT = 112, LEFT = 16, TOP = 280, WIDTH = 144, ;
    TABINDEX = 2, NAME = "opgGraficas", ;
    Option1.BACKSTYLE = 0, Option1.CAPTION = "Torta", ;
    Option1.VALUE = 1, Option1.HEIGHT = 17, Option1.LEFT = 8, Option1.TOP = 8, ;
    Option1.WIDTH = 46, Option1.AUTOSIZE = .T., Option1.NAME = "Option1", ;
    Option2.BACKSTYLE = 0, Option2.CAPTION = "Anillo", ;
    Option2.VALUE = 0, Option2.HEIGHT = 17, Option2.LEFT = 8, Option2.TOP = 24, ;
    Option2.WIDTH = 48, Option2.AUTOSIZE = .T., Option2.NAME = "Option2", ;
    Option3.BACKSTYLE = 0, Option3.CAPTION = "Barras verticales", ;
    Option3.HEIGHT = 17, Option3.LEFT = 8, Option3.TOP = 40, Option3.WIDTH = 110, ;
    Option3.AUTOSIZE = .T., Option3.NAME = "Option3", ;
    Option4.BACKSTYLE = 0, Option4.CAPTION = "Barras horizontales", ;
    Option4.HEIGHT = 17, Option4.LEFT = 8, Option4.TOP = 56, Option4.WIDTH = 125, ;
    Option4.AUTOSIZE = .T., Option4.NAME = "Option4", ;
    Option5.BACKSTYLE = 0, Option5.CAPTION = "Conos verticales", ;
    Option5.HEIGHT = 17, Option5.LEFT = 8, Option5.TOP = 72, Option5.WIDTH = 110, ;
    Option5.AUTOSIZE = .T., Option5.NAME = "Option5", ;
    Option6.BACKSTYLE = 0, Option6.CAPTION = "Conos horizontales", ;
    Option6.HEIGHT = 17, Option6.LEFT = 8, Option6.TOP = 88, Option6.WIDTH = 125, ;
    Option6.AUTOSIZE = .T., Option6.NAME = "Option6"
  ADD OBJECT opgLeyendas AS OPTIONGROUP WITH ;
    BUTTONCOUNT = 6, ANCHOR = 6, VALUE = 6, ;
    HEIGHT = 112, LEFT = 176, TOP = 280, WIDTH = 152, ;
    TABINDEX = 3, NAME = "opgLeyendas", ;
    Option1.BACKSTYLE = 0, Option1.CAPTION = "Sin leyendas", ;
    Option1.HEIGHT = 17, Option1.LEFT = 8, Option1.TOP = 8, Option1.WIDTH = 89, ;
    Option1.AUTOSIZE = .T., Option1.NAME = "Option1", ;
    Option2.BACKSTYLE = 0, Option2.CAPTION = "Valores", ;
    Option2.HEIGHT = 17, Option2.LEFT = 8, Option2.TOP = 24, Option2.WIDTH = 60, ;
    Option2.AUTOSIZE = .T., Option2.NAME = "Option2", ;
    Option3.BACKSTYLE = 0, Option3.CAPTION = "Porcentajes", ;
    Option3.HEIGHT = 17, Option3.LEFT = 8, Option3.TOP = 40, Option3.WIDTH = 84, ;
    Option3.AUTOSIZE = .T., Option3.NAME = "Option3", ;
    Option4.BACKSTYLE = 0, Option4.CAPTION = "Rótulos", ;
    Option4.HEIGHT = 17, Option4.LEFT = 8, Option4.TOP = 56, Option4.WIDTH = 61, ;
    Option4.AUTOSIZE = .T., Option4.NAME = "Option4", ;
    Option5.BACKSTYLE = 0, Option5.CAPTION = "Rótulos y valores", ;
    Option5.VALUE = 0, Option5.HEIGHT = 17, Option5.LEFT = 8, Option5.TOP = 72, ;
    Option5.WIDTH = 112, Option5.AUTOSIZE = .T., Option5.NAME = "Option5", ;
    Option6.BACKSTYLE = 0, Option6.CAPTION = "Porcentajes y rótulos", ;
    Option6.VALUE = 1, Option6.HEIGHT = 17, Option6.LEFT = 8, Option6.TOP = 88, ;
    Option6.WIDTH = 133, Option6.AUTOSIZE = .T., Option6.NAME = "Option6"
  ADD OBJECT lmGraph AS lmgraph WITH ;
    ANCHOR = 15, TOP = 8, LEFT = 8, WIDTH = 480, HEIGHT = 264, ;
    TABINDEX = 1, NAME = "lmGraph", lbl.NAME = "lbl"
  ADD OBJECT chk AS CHECKBOX WITH ;
    TOP = 404, LEFT = 304, HEIGHT = 17, WIDTH = 53, ANCHOR = 6, ;
    WORDWRAP = .T., AUTOSIZE = .T., ALIGNMENT = 0, BACKSTYLE = 0, ;
    CAPTION = "DEMO", VALUE = .F., TABINDEX = 8, NAME = "chk"
  ADD OBJECT opgDatos AS OPTIONGROUP WITH ;
    BUTTONCOUNT = 2, ANCHOR = 6, VALUE = 1, HEIGHT = 48, ;
    LEFT = 344, TOP = 336, WIDTH = 136, TABINDEX = 5, NAME = "opgDatos", ;
    Option1.BACKSTYLE = 0, Option1.CAPTION = "Ejemplo semanal", ;
    Option1.VALUE = 1, Option1.HEIGHT = 17, Option1.LEFT = 8, Option1.TOP = 8, ;
    Option1.WIDTH = 116, Option1.AUTOSIZE = .T., Option1.NAME = "Option1", ;
    Option2.BACKSTYLE = 0, Option2.CAPTION = "Ejemplo anual", ;
    Option2.VALUE = 0, Option2.HEIGHT = 17, Option2.LEFT = 8, Option2.TOP = 24, ;
    Option2.WIDTH = 98, Option2.AUTOSIZE = .T., Option2.NAME = "Option2"
  ADD OBJECT lblTitulo AS LABEL WITH ;
    AUTOSIZE = .T., ANCHOR = 6, BACKSTYLE = 0, CAPTION = "Título", ;
    HEIGHT = 17, LEFT = 16, TOP = 404, WIDTH = 32, TABINDEX = 6, NAME = "lblTitulo"
  ADD OBJECT txtTitulo AS TEXTBOX WITH ;
    ANCHOR = 6, VALUE = "TOTAL DE VENTAS", HEIGHT = 23, LEFT = 56, ;
    TABINDEX = 7, TOP = 400, WIDTH = 232, NAME = "txtTitulo"
  PROCEDURE GenerarCursor
    LPARAMETERS tnDatos
    CREATE CURSOR MiCursor (Valor N(10,2), Rotulo C(20))
    IF tnDatos = 1
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Lunes")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Martes")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Miércoles")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Jueves")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Viernes")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Sábado")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Domingo")
    ELSE
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Enero")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Febrero")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Marzo")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Abril")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Mayo")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Junio")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Julio")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Agosto")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Setiembre")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Octubre")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Noviembre")
      INSERT INTO MiCursor VALUES (RAND() * 1000 + 250, "Diciembre")
    ENDIF
  ENDPROC
  PROCEDURE tmr.TIMER
    THISFORM.opgGraficas.VALUE = CEILING(RAND()*6)
    THISFORM.opgLeyendas.VALUE = CEILING(RAND()*6)
    THISFORM.opgColores.VALUE = CEILING(RAND()*2)
    THISFORM.opgDatos.VALUE = CEILING(RAND()*2)
    THISFORM.txtTitulo.VALUE = IIF(THISFORM.opgDatos.VALUE = 1, ;
      "Total de ventas por día", "Total de ventas por mes")
    THISFORM.cmdGenerar.CLICK
  ENDPROC
  PROCEDURE cmdGenerar.CLICK
    WITH THISFORM.lmGraph
      .TipoGrafica = THISFORM.opgGraficas.VALUE - 1
      .TipoLeyenda = THISFORM.opgLeyendas.VALUE - 1
      .TipoColor = THISFORM.opgColores.VALUE - 1
      .ALIAS = "MiCursor"
      .TituloGrafica = ALLTRIM(THISFORM.txtTitulo.VALUE)
      THISFORM.GenerarCursor(THISFORM.opgDatos.VALUE)
      .GenerarGrafica()
    ENDWITH
  ENDPROC
  PROCEDURE chk.VALID
    IF THIS.VALUE
      THISFORM.tmr.TIMER
    ENDIF
    THISFORM.SETALL("Enabled", NOT THIS.VALUE, "CommandButton")
    THISFORM.SETALL("Enabled", NOT THIS.VALUE, "OptionGroup")
    THISFORM.SETALL("Enabled", NOT THIS.VALUE, "TextBox")
    THISFORM.tmr.ENABLED = THIS.VALUE
  ENDPROC
ENDDEFINE
*--
*-- Definición de la clase lmGraph
*--
DEFINE CLASS lmgraph AS CONTAINER
  WIDTH = 200
  HEIGHT = 100
  SPECIALEFFECT = 1
  BACKCOLOR = RGB(255,255,255)
  ALIAS = ""
  TipoLeyenda = 5
  TipoColor = 0
  TipoGrafica = 0
  TituloGrafica = "Título"
  NAME = "lmgraph"
  ADD OBJECT lbl AS LABEL WITH ;
    AUTOSIZE = .T., FONTBOLD = .T., BACKSTYLE = 0, ;
    CAPTION = "lmGraph v.1.0", HEIGHT = 17, LEFT = 8, ;
    TOP = 8, VISIBLE = .F., WIDTH = 79, NAME = "lbl"
  *-- Genera la Gráfica
  PROCEDURE GenerarGrafica
    LOCAL lcCampoRotulo, lcCampo, lnSaltoH, lnSaltoV, lnReg, ;
      lnTotal, lnCantReg, lnMaximo, lnMaxWidth, lcRotulo, lnValor, lnPorc, ;
      lcObjPor, lcObjShp, lcObjLey, lnDim, lnHasta, ;
      lnI, lnJ, lnAng, lnCos, lnSen, lcObj1, lcObj2
    *--
    *-- Limpio los objetos del gráfico
    *--
    THIS.LimpiarGrafica()
    *---
    *--- Verifico la versión de VFP y tipo de gráfica
    *---
    IF VERSION(5) < 900 AND INLIST(THIS.TipoGrafica, 0, 1, 4, 5)
      MESSAGEBOX("El tipo de gráfica seleccionada no esta disponible para" + ;
        CHR(13) + VERSION(), 48, "lmGraph")
      RETURN
    ENDIF
    *--
    *-- Tabla de datos
    *--
    IF EMPTY(THIS.ALIAS)
      MESSAGEBOX("No especificó la propiedad Alias.", 48, "lmGraph")
      RETURN
    ENDIF
    IF NOT USED(THIS.ALIAS)
      MESSAGEBOX("La tabla " + PROPER(THIS.ALIAS) + ;
        " no está en uso.", 48, "lmGraph")
      RETURN
    ENDIF
    IF AFIELDS(la,THIS.ALIAS) < 2
      MESSAGEBOX("La tabla " + PROPER(THIS.ALIAS) + ;
        " tiene menos de dos campos.", 48, "lmGraph")
      RETURN
    ENDIF
    IF NOT INLIST(la(1,2), "N", "I")
      MESSAGEBOX("El segundo campo de la tabla " + PROPER(THIS.ALIAS) + ;
        " no es numérico.", 48, "lmGraph")
      RETURN
    ENDIF
    SELECT (THIS.ALIAS)
    lcCampoValor = la(1,1)
    lcCampoRotulo = la(2,1)
    CALCULATE COUNT() TO lnCantReg
    IF lnCantReg = 0
      MESSAGEBOX("La tabla " + PROPER(THIS.ALIAS) + ;
        " no contiene datos.", 48, "lmGraph")
      RETURN
    ENDIF
    CALCULATE SUM(EVALUATE(lcCampoValor)) TO lnTotal
    CALCULATE MAX(EVALUATE(lcCampoValor)) TO lnMaximo
    *--
    *-- Variables y área del gráfico
    *--
    #DEFINE AnguloPrimerSector 270
    #DEFINE AngulosParaGraficar 360
    lnAnguloSector = AnguloPrimerSector
    lnLeft = 10
    lnTop = IIF(EMPTY(THIS.TituloGrafica),10,30)
    lnWidth = THIS.WIDTH - lnLeft * 2
    lnHeight = THIS.HEIGHT - lnTop - lnLeft
    lnSaltoH = FLOOR(lnHeight / lnCantReg)
    *--
    *-- Titulo del gráfico
    *--
    IF NOT EMPTY(THIS.TituloGrafica) && Con título
      THIS.ADDOBJECT("lblTitulo","Label")
      WITH THIS.lblTitulo
        .BACKSTYLE = 0
        .ALIGNMENT = 2
        .FONTSIZE = 12
        .FONTBOLD = .T.
        .CAPTION = THIS.TituloGrafica
        .TOP = 5
        .LEFT = lnLeft
        .WIDTH = lnWidth
        .HEIGHT = 30
      ENDWITH
    ENDIF
    *--
    *-- Armo leyenda y tomo el ancho
    *--
    IF THIS.TipoLeyenda # 0 && Con leyenda
      lnMaxWidth = 0
      lnReg = 1
      SCAN ALL
        lcRotulo = ALLTRIM(TRANSFORM(EVALUATE(lcCampoRotulo)))
        lnValor = EVALUATE(lcCampoValor)
        lnPorc = lnValor / lnTotal * 100
        lcObjLey = "oLey" + TRANSFORM(lnReg)
        THIS.ADDOBJECT(lcObjLey,"Label")
        WITH THIS.&lcObjLey
          .TOP = lnSaltoH * lnReg - lnSaltoH + lnTop
          DO CASE
            CASE THIS.TipoLeyenda = 1
              .CAPTION = TRANSFORM(lnValor)
            CASE THIS.TipoLeyenda = 2
              .CAPTION = TRANSFORM(ROUND(lnPorc,2)) + "%"
            CASE THIS.TipoLeyenda = 3
              .CAPTION = lcRotulo
            CASE THIS.TipoLeyenda = 4
              .CAPTION = lcRotulo + " - " + TRANSFORM(lnValor)
            OTHERWISE
              .CAPTION = TRANSFORM(ROUND(lnPorc,2)) + "% - " + lcRotulo
          ENDCASE
          .FONTSIZE = 8
          .BACKSTYLE = 0
          .LEFT = lnWidth + 100
          .AUTOSIZE = .T.
          .VISIBLE = .T.
          lnMaxWidth = MAX(lnMaxWidth,.WIDTH)
        ENDWITH
        lnReg = lnReg + 1
      ENDSCAN
      lnLeftLeyenda = MAX(lnWidth * .60, lnWidth - lnMaxWidth - 40)
    ENDIF
    *--
    *-- Armo el resto del gráfico
    *--
    lnReg = 1
    SCAN ALL
      lnValor = EVALUATE(lcCampoValor)
      lnPorc = lnValor / lnTotal * 100
      *--
      *-- Armo cada porcion
      *--
      lcObjPor = "oPor" + TRANSFORM(lnReg)
      THIS.ADDOBJECT(lcObjPor,"Shape")
      WITH THIS.&lcObjPor
        DO CASE
          CASE THIS.TipoGrafica = 0 OR THIS.TipoGrafica = 1 && Torta/Anillo
            IF THIS.TipoLeyenda = 0  && Sin leyenda
              STORE MIN(lnWidth ,lnHeight) TO .WIDTH, .HEIGHT
              .TOP = FLOOR((lnHeight - .HEIGHT) / 2 + lnTop)
              .LEFT = FLOOR((lnWidth - .WIDTH) / 2 + lnLeft)
            ELSE
              STORE MIN(lnLeftLeyenda, lnHeight) TO .WIDTH, .HEIGHT
              .TOP = FLOOR((lnHeight - .HEIGHT) / 2 + lnTop)
              .LEFT = FLOOR((lnLeftLeyenda - .WIDTH) / 2 + lnLeft)
            ENDIF
            .POLYPOINTS = "This.aPoly"
            lnDim = AngulosParaGraficar * lnPorc / 100
            lnHasta = CEILING(lnDim) + 1
            .ADDPROPERTY("aPoly[" + TRANSFORM(lnHasta) + ",2]")
            STORE 50 TO .aPoly[1,1], .aPoly[1,2]
            FOR lnI = 2 TO lnHasta
              lnAng = (360 / AngulosParaGraficar) * (lnI - 2)
              lnCos = COS(DTOR(lnAng + lnAnguloSector))
              lnSen = SIN(DTOR(lnAng + lnAnguloSector))
              .aPoly(lnI,1) = 50 * lnCos + 50
              .aPoly(lnI,2) = 50 * lnSen + 50
            ENDFOR
            lnAnguloSector = lnAnguloSector + lnDim * 360 / AngulosParaGraficar
          CASE THIS.TipoGrafica = 2 OR THIS.TipoGrafica = 4 && Barras/Conos Verticales
            IF THIS.TipoLeyenda = 0 && Sin leyenda
              lnSaltoV = FLOOR(lnWidth / lnCantReg)
            ELSE
              lnSaltoV = FLOOR(lnLeftLeyenda / lnCantReg)
            ENDIF
            .WIDTH = lnSaltoV + 1
            .LEFT = lnSaltoV * lnReg - lnSaltoV + lnLeft
            .HEIGHT = lnValor / lnMaximo * lnHeight
            .TOP = lnHeight - .HEIGHT + lnTop
            IF THIS.TipoGrafica = 4 && Conos
              .POLYPOINTS = "This.aPoly"
              .ADDPROPERTY("aPoly[" + TRANSFORM(4) + ",2]")
              STORE 0 TO .aPoly[1,1], .aPoly[2,2], .aPoly[3,2]
              STORE 100 TO .aPoly[1,2], .aPoly[4,1], .aPoly[4,2]
              .aPoly[2,1] = 30
              .aPoly[3,1] = 70
            ENDIF
          CASE THIS.TipoGrafica = 3 OR THIS.TipoGrafica = 5 && Barras/Conos Horizontales
            IF THIS.TipoLeyenda = 0 && Sin leyenda
              .WIDTH = lnValor / lnMaximo * lnWidth
            ELSE
              .WIDTH = lnValor / lnMaximo * lnLeftLeyenda
            ENDIF
            .LEFT = lnLeft
            .HEIGHT = lnSaltoH + 1
            .TOP = lnSaltoH * lnReg - lnSaltoH + lnTop
            IF THIS.TipoGrafica = 5 && Conos
              .POLYPOINTS = "This.aPoly"
              .ADDPROPERTY("aPoly[" + TRANSFORM(4) + ",2]")
              STORE 0 TO .aPoly[1,1], .aPoly[2,1], .aPoly[2,2]
              STORE 100 TO .aPoly[1,2], .aPoly[3,1], .aPoly[4,1]
              .aPoly[3,2] = 25
              .aPoly[4,2] = 75
            ENDIF
          OTHERWISE
            MESSAGEBOX("Tipo de gráfica no definida.", 48, "lmGraph")
            RETURN
        ENDCASE
        *--
        *-- Color de la porción
        *--
        IF THIS.TipoColor = 0
          .BACKCOLOR = FLOOR(RAND() * 16777216) && Aleatorio
        ELSE
          .BACKCOLOR = THIS.ColoresBasicos(lnReg)
        ENDIF
      ENDWITH
      *--
      *-- Armo leyendas
      *--
      IF THIS.TipoLeyenda # 0 && Con leyenda
        lcObjShp = "oShp" + TRANSFORM(lnReg)
        THIS.ADDOBJECT(lcObjShp,"Shape")
        WITH THIS.&lcObjShp
          .HEIGHT = 12
          .WIDTH = 12
          .BACKCOLOR = EVALUATE("THIS.oPor" + TRANSFORM(lnReg) + ".BACKCOLOR")
          .TOP = lnSaltoH * lnReg - lnSaltoH + lnTop
          .LEFT = lnLeftLeyenda + lnLeft  + 10
        ENDWITH
        lcObjLey = "oLey" + TRANSFORM(lnReg)
        WITH THIS.&lcObjLey
          .LEFT = lnLeftLeyenda + lnLeft + 30
        ENDWITH
      ENDIF
      lnReg = lnReg + 1
    ENDSCAN
    *--
    *-- Anillo
    *--
    IF THIS.TipoGrafica = 1 && Anillo
      THIS.ADDOBJECT("oShpMed","Shape")
      WITH THIS.oShpMed
        IF THIS.TipoLeyenda = 0  && Sin leyenda
          STORE MIN(lnWidth ,lnHeight) * .45 TO .WIDTH, .HEIGHT
          .TOP = FLOOR((lnHeight - .HEIGHT) / 2 + lnTop)
          .LEFT = FLOOR((lnWidth - .WIDTH) / 2 + lnLeft)
        ELSE
          STORE MIN(lnLeftLeyenda, lnHeight) * .45 TO .WIDTH, .HEIGHT
          .TOP = FLOOR((lnHeight - .HEIGHT) / 2 + lnTop)
          .LEFT = FLOOR((lnLeftLeyenda - .WIDTH) / 2 + lnLeft)
        ENDIF
        .BACKCOLOR = THIS.BACKCOLOR
        .CURVATURE = 99
      ENDWITH
    ENDIF
    *--
    *-- Uno porciones en Torta/Anillo
    *--
    IF THIS.TipoGrafica = 0 OR THIS.TipoGrafica = 1 && Torta/Anillo
      FOR lnI = 1 TO lnCantReg - 1
        lcObj1 = "This.oPor" + TRANSFORM(lnI)
        lcObj2 = "This.oPor" + TRANSFORM(lnI+1)
        lnJ = ALEN(&lcObj1..aPoly,1)
        &lcObj1..aPoly(lnJ,1) = &lcObj2..aPoly(2,1)
        &lcObj1..aPoly(lnJ,2) = &lcObj2..aPoly(2,2)
      ENDFOR
      lcObj1 = "This.oPor" + TRANSFORM(1)
      lnJ = ALEN(&lcObj2..aPoly,1)
      &lcObj2..aPoly(lnJ,1) = &lcObj1..aPoly(2,1)
      &lcObj2..aPoly(lnJ,2) = &lcObj1..aPoly(2,2)
    ENDIF
    *--
    *-- Hago visible los objetos creados
    *--
    THIS.SETALL("Visible",.T., "Shape")
    THIS.SETALL("Visible",.T., "Label")
  ENDPROC
  PROCEDURE ColoresBasicos
    LPARAMETERS tn
    LOCAL la(28)
    tn = MOD(tn-1,28)+1
    la(1) = RGB(255,0,0) && Rojo
    la(2) = RGB(255,255,  0) && Amarillo
    la(3) = RGB(0,0,255) && Azul
    la(4) = RGB(0,128,0) && Verde Oscuro
    la(5) = RGB(255,128,0) && Anaranjado
    la(6) = RGB(128,64,0) && Marrón
    la(7) = RGB(255,0,255) && Magenta
    la(8) = RGB(128,0,255) && Violeta
    la(9) = RGB(0,255,255) && Cyan
    la(10) = RGB(192,192,0) && Amarillo Oscuro
    la(11) = RGB(192,0,0) && Rojo Oscuro
    la(12) = RGB(0,255,0) && Verde
    la(13) = RGB(0,0,128) && Azul Oscuro
    la(14) = RGB(255,192,0) && Anaranjado Claro
    la(15) = RGB(0,192,255) && Azul claro
    la(16) = RGB(128,128,0) && Marrón Claro
    la(17) = RGB(255,192,255) && Magenta Claro
    la(18) = RGB( 64,128,128) && Verde Azulado
    la(19) = RGB(255,0,128) && Fucsia
    la(20) = RGB(255,255,192) && Amarillo Claro
    la(21) = RGB(192,0,255) && Violeta Claro
    la(22) = RGB(192,255,192) && Verde Claro
    la(23) = RGB(128,0,128) && Violeta Oscuro
    la(24) = RGB(192,255,255) && Cyan Claro
    la(25) = RGB(128,128,128) && Gris Oscuro
    la(26) = RGB(255,255,255) && Blanco
    la(27) = RGB(192,192,192) && Gris
    la(28) = RGB(0,0,0) && Negro
    RETURN la(tn)
  ENDPROC
  PROCEDURE LimpiarGrafica
    LOCAL lnI
    FOR lnI = THIS.CONTROLCOUNT TO 1 STEP -1
      THIS.REMOVEOBJECT(THIS.CONTROLS(lnI).NAME)
    ENDFOR
  ENDPROC
  PROCEDURE INIT
    SET TALK OFF
    RAND(-1)
  ENDPROC
ENDDEFINE

La descarga

Pueden descargar el proyecto con el formulario de ejemplo y la clase lmGraph desde el enlace siguiente:

El final

Con la clase presentada en este artículo, ustedes podrán generar gráficas simples y muy fáciles de incorporar en formularios de VFP. Si necesitan gráficas mas avanzadas utilizando solo Visual FoxPro, los invito a que lean el excelente artículo de Cesar Ch. publicado en la revista UTMag y se sorprenderán de todo lo que se puede realizar con GDI+

Los comentarios

Cualquier comentario que quieran realizar sobre este artículo y esta clase, será bienvenido. Solo envien sus comentario haciendo clic en el botón "Enviar comentario" al final de este artículo.

Hasta la próxima.

Luis María Guayán

24 de agosto de 2006

Gráficas de tarta con código VFP puro


Artículo original: PIE GRAPHICS WITH PURE VFP CODE
https://vfpimaging.blogspot.com/2006/03/pie-graphics-with-pure-vfp-code_9269.html
Autor: Cesar Ch.
Traducido por: Ana María Bisbé York




¿Sabía usted que es posible dibujar un gráfico al estilo tarta con VFP sin necesidad de emplear ningún ActiveX o llamar a una función API? ¿Con código VFP puro?

Para dibujar cualquier círculo hay dos parámetros principales: un punto con las coordenadas en el centro del círculo (x,y) y el radio. Teniendo esto, es muy fácil calcular las coordenadas de cualquier punto en el borde de la circunferencia.

Incluso, si ya ha utilizado antes GDI+ o cualquier ActiveX para dibujar gráficos, pienso que es interesante conocer cómo se puede crear un círculo y cómo calcular las posiciones de cada punto.

Con este propósito, necesitaré recordarle los conceptos de seno y coseno.

En cualquier triángulo rectángulo, para cada ángulo:

Seno del ángulo = longitud del lado opuesto / longitud de la hipotenusa
Coseno del ángulo = longitud del lado adyacente / longitud de la hipotenusa

Hipotenusa de un triángulo es el lado más largo, el que es el opuesto al ángulo recto. El lado adyacente es el lado entre el ángulo en cuestión y el ángulo recto. El lado opuesto es el opuesto al ángulo en cuestión.


Entonces, imagine un triángulo rectángulo dentro de una circunferencia, como la imagen que se muestra debajo.

Seno del ángulo = el lado opuesto (altura o "Y") / hipotenusa (Radio) !!!

Altura = Seno del ángulo * Radio


Coseno del ángulo = lado adyacente (Ancho o "X" / hipotenusa (Radio) !!!

Ancho = Coseno del ángulo * Radio


Ahora, podemos crear un lazo comenzando con el ángulo 0 (cero) y terminando en 360 grados. Para cada paso, podemos calcular la posición de cada punto del círculo.

Entonces, todo será más sencillo para dibujar el gráfico. Para todos los propósitos., voy a utilizar el objeto line para dibujar líneas desde el centro del círculo hasta el punto X,Y que acabamos de calcular. ¡¡¡ Y eso es todo !!!

Existe un problema con el objeto line en VFP. Para dibujar una línea, necesitamos utilizar las propiedades Top, Left, Width, Height y LineSlant (especifica la forma de inclinación de las líneas, en dependencia del ángulo y la posición resultante en el cuadrante (un cuarto de la conferencia o círculo), necesité crear algo de código extra para ocuparme de eso. Preste atención al comando DO CASE que se muestra debajo.

PROCEDURE DRAWPIE
  PARAMETERS tnCenterX, tnCentery, tnRadius, tnStart, tnEnd, tnColor
  LOCAL lnLineWidth, n, x, y, lcObj, lnPointLeft, lnPointTop, lcSlant
  lnLineWidth = 3
  FOR n = tnStart TO tnEnd STEP (1 * lnLineWidth)
    x = COS(DTOR(n)) * tnRadius
    y = SIN(DTOR(n)) * tnRadius
    lcObj = "line" + TRANSFORM(n*100)
    Thisform.Container1.AddObject(lcObj,"line")
    DO CASE 
      CASE n >= 0 AND n < 90 && 1er cuadrante
        lnPointLeft = tnCenterX
        lnPointTop = tnCenterY - y
        lcSlant = "/"
      CASE n >=90 AND n < 180 && 2do cuadrante
        lnPointLeft = tnCenterx + x
        lnPointTop = tnCenterY - y
        lcSlant = "\"
      CASE n >= 180 AND n < 270 && 3er cuadrante
        lnPointLeft = tnCenterX + x
        lnPointTop = tnCenterY
        lcSlant = "/" 
      CASE n >= 270 AND n <= 360 && 4to cuadrante
        lnPointLeft = tnCenterX
        lnPointTop = tnCenterY
        lcSlant = "\" 
    ENDCASE 
    WITH Thisform.Container1.&lcObj.
      .LineSlant = lcSlant
      .BorderColor = tnColor
      .BorderWidth = lnLineWidth
      .Width = ABS(x)
      .Height = ABS(y)
      .left = lnPointLeft
      .Top = lnPointTop
      .Visible = .T.
    ENDWITH
  ENDFOR
RETURN

Puede que encuentre un poco lento este procedimiento, especialmente si lo ejecuta en una máquina lenta; ¡ pero funciona ! El problema fundamental es que añade muchos objetos en un formulario, en el caso de un lazo con paso 1, ¡ al menos 360 líneas!

Si dibujamos una línea con BorderWidth = 1, en algunos casos, los puntos calculados creará unos huecos entre las líneas. Un borde más ancho resolverá el problema. El paso más grande en el lazo (desde 0 a 360 grados), el más rápido el procedimiento que ejecuta, y menos objetos los que serán agregados.

Ejecute el formulario PieGraphics.scx desde el archivo adjunto, cambie los valores del cursor, radio, pasos y linewidth (ancho de líneas) y verifique todos los procedimientos para entender mejor este artículo.

¿Qué es lo próximo?

Por supuesto, en uno de mis futuros post, voy a trabajar el Gráfico de estilo tarta utilizando GDI+
Algunos de los aspectos descritos aquí, ayudarán a crear más gráficos interesantes.

Como siempre, por favor, envíe sus comentarios, sugerencias o arreglos.

Nota de la traductora: Junto a la autorización para publicar la traducción de este artículo, el autor, ha solicitado que: (y escribo textualmente) "coloque una referencia al artículo en UTMAG (www.utmag.com/wconnect/wc.dll?9,7,10,Spanish,2094), que aborda el tema de modo más completo, pero utilizando GDI+ (obviamente, ya traducido al español). Contiene códigos fuente, con una clase que permite crear gráficos planos y 3D, controlando la altura, controlar el tamaño del círculo, a colores y monocromático y colores en gradientes , separar fragmentos y controlar la distancia del centro , escribir encima de los fragmentos, agregar un título al gráfico, crear leyendas, controlar fuentes, controlar colores del fragmento y del borde, ocultar fragmentos"


23 de agosto de 2006

VFP también hace Mp3

Artículo original: VFP does Mp3 too!
http://weblogs.foxite.com/vassilisaggelakos/2006/07/04/vfp-does-mp3-too
Autor: Vassilis Aggelakos
Traducido por: Ana María Bisbé York


La semana pasada mi novia quería configurar una nueva canción mp3 como tono para su teléfono móvil. Entonces, abrió un VAIO completamente nuevo (por una instalación preinstalada) y trató de encontrar la aplicación apropiada para recortar un mp3. No quería tener 4 minutos de canción como tono, en su lugar quería crear un archivo nuevo con una pequeña parte de la canción original (10-15 segundos).

Lo primero que me preguntó fue ¿Cómo puedo hacer algo como esto? Respondí: "Solamente abre Visual FoxPro y te mostraré", ella dijo " Ah ¡ tu todo lo haces con VFP ! Mi súper portátil está lleno de utilidades, debe haber algo aquí para hacer algo tan simple..." Yo dije, "Bien", y encendí la televisión, porque estaba comenzando el partido de Brasil. 90 minutos después, la encontré intentando aun con varias ventanas abiertas en la pantalla. No pudo encontrar nada así que cuando le dije, "Bien, abre el Visual FoxPro" se dio por vencida.

Cargué el Visual FoxPro e inmediatamente apareció la ventana de comandos. Escribí 5 comandos:

lcFile = FiletoStr("C:\music\a.mp3")
lnFileLen = Len(lcFile)
lnSizePerSec = lnFileLen / 200 && 3.20 Tiempo total de la canción, en segundos.
lcNewFile = Substr(lcFile, lnSizePerSec * 20, lnSizePerSec * 15)
? StrToFile(lcNewFile, "c:\music\new.mp3")

Y voila! el archivo mp3 nuevo era justo lo que ella quería !

¡ VFP también hace tonos !

Por supuesto que esto es un caso muy sencillo que no hace nada extraordinario desde el punto de vista del programador. Cualquiera pudo crear un programa similar con su herramienta de programación favorita PERO aquí hay un detalle. ¡ Yo no cree ningún programa ! ¡ Todos esos comandos fueron ejecutados directamente desde la mágica ventana de comandos de VFP !

Nunca ví este tipo de ventana de comandos en otro lenguaje. Si sabe algo que yo me halla perdido, por favor, hágamelo saber.

P.S. ¡ No olvide que VFP hace todo cuanto usted puede imaginar !

17 de agosto de 2006

Gráficas de barra sin complicaciones

Artículo original: BAR GRAPHICS WITHOUT COMPLICATIONS
https://vfpimaging.blogspot.com/2006/03/bar-graphics-without-complications_7232.html
Autor: Cesar Ch.
Traducido por: Ana María Bisbé York


Siempre veo gente preguntando cómo crear gráficos sin controles ActiveX.

En mi opinión, la forma más sencilla de hacerlo es empleando etiquetas. Las etiquetas son muy versátiles, podemos cargar sus propiedades BackColor, Caption, Width, Height. Estas cuatro propiedades son todo lo que necesitamos para crear un sencillo gráfico, como este que vemos debajo en la figura.



El gráfico está dibujado en un contenedor. Podemos configurar el color de la etiqueta para el color de la barra, en su título podemos guardar los valores, sus alturas son proporcionales a sus valores, y el ancho depende de la división entre el ancho del contenedor y la cantidad de barras.

Las barras se auto ajustan a si mismas, en dependencia del dato que reciben, y las dimensiones del contenedor.

Todo está hecho en un método sencillo. En el formulario de ejemplo, he puesto este código en el método Refresh() del objeto Container. Es necesario un cursor para guardar los datos, en el que el primer campo, FIELD(1), recibe los valores y el segundo, FIELD(2) recibe las títulos. El nombre del cursor se guarda en la propiedad Tag del contenedor. ¡ Y esto es todo !

Se agregó código extra para permitir el redimensionamiento del formulario.

Coloque este código en en evento Load del formulario:
CREATE CURSOR sales (amount n(8,2), cName c(6))
INSERT INTO sales VALUES (250,"JAN")
INSERT INTO sales VALUES (128,"FEB")
INSERT INTO sales VALUES ( 90,"MAR")
INSERT INTO sales VALUES (330,"APR")
INSERT INTO sales VALUES (190,"MAY")
INSERT INTO sales VALUES (250,"JUN")
INSERT INTO sales VALUES ( 50,"JUL")
INSERT INTO sales VALUES ( 80,"AUG")
INSERT INTO sales VALUES ( 50,"SEP")
INSERT INTO sales VALUES ( 19,"OCT")
INSERT INTO sales VALUES (160,"NOV")
INSERT INTO sales VALUES (199,"DEC")
Y esto en el evento Refresh:
*!* Crea una matriz de 12 colores que serán utilizados
DIMENSION laColors(12)
laColors(1) = RGB(255,128,128) && Rojo
laColors(2) = RGB(0,255,0) && Verde Claro
laColors(3) = RGB(128,128,255) && Azul Oscuro
laColors(4) = RGB(255,0,255) && Rosa
laColors(5) = RGB(0,255,255) && Cyan
laColors(6) = RGB(255,255,0) && Amarillo
laColors(7) = RGB(160,160,210) && Azul Claro
laColors(8) = RGB(255,160,30) && Naranja
laColors(9) = RGB(200,140,140) && Marrón Oscuro
laColors(10) = RGB(96,196,96) && Verde Oscuro
laColors(11) = RGB(255,200,200) && Marrón Claro
laColors(12) = RGB(200,200,200) && Gris
lnBlack = RGB(28,28,28) && Negro
lnWhite = RGB(255,255,255) && Blanco
lcTable = This.Tag
SELECT "&lcTable"
*!* Calcula el ancho de cada barra
lnlargura = INT(This.Width / RECCOUNT())
lnAltura = This.Height
lcFldValor = This.Tag + "." + FIELD(1)
IF FCOUNT() > 1
  lcFldLegenda = This.Tag + "." + FIELD(2)
ELSE
  lcFldLegenda = ""
ENDIF
CALCULATE MAX(EVALUATE(lcFldValor)) TO lnMax
*!* Agrega etiquetas que serán las barras y los títulos
SCAN 
  n = RECNO()
  lcObj = "label" + TRANSFORM(n)
  lcLeg = "lname" + TRANSFORM(n)
  *!* Verifica que existe ya el objeto, para evitar errores
  IF TYPE("This."+lcObj) <> "O"
    This.AddObject(lcObj,"label")
    This.AddObject(lcLeg,"label")
  ENDIF
  WITH This.&lcObj.
    .BackStyle = 1 && opaco
    .Backcolor = laColors(IIF(n>12,n-12,n))
    .Width = lnLargura
    lnValor = EVALUATE(lcFldValor)
    lnBarra = ( lnValor / lnMax) * (This.Height - 1 - 17)
    .Height = lnBarra
    .left = ((n-1) * lnLargura) + 2
    .Top = lnAltura - This.&lcObj..Height - 17
    .Tag = TRANSFORM(lnValor)
    .Caption = TRANSFORM(lnValor)
    .FontSize = 8
    .FontBold = .T.
    .Alignment = 2
    .Visible = .T.
  ENDWITH
  WITH This.&lcLeg.
    .BackStyle = 1 && opaco
    .Backcolor = lnWhite
    .ForeColor = lnBlack
    .Width = lnLargura - 2
    IF NOT EMPTY(lcFldLegenda)
      .Caption = ALLTRIM(EVALUATE(lcFldLegenda))
    ENDIF 
    .left = ((n-1) * lnLargura) + 3
    .Top = This.Height - 17
    .Height = 17
    .FontSize = 8
    .Alignment = 2
    .Visible = .T.
  ENDWITH
ENDSCAN
This.Width = ((n) * lnLargura) + 3
Puede utilizar esta técnica para crear gráficas de barras horizontales, con un ligera adaptación del código.

En el fichero adjunto, bargraphics.zip encontrará bargraphics.scx/sct para este ejemplo, y otros tres archivos, callbar.prg que llama a barras.scx/sct que crea un formulario modal con bargraphics que puede ser redimensionado.

15 de agosto de 2006

No hacer RETURN dentro de WITH

Artículo original: Don't RETURN Inside WITH
http://doughennig.blogspot.com/2006/04/dont-return-inside-with.html
Autor: Doug Hennig
Traducido por: Pablo Roca Rozas


En la conferencia GLGDW 2006, y durante la excelente sesión de Marcia Akins sobre mejores prácticas sobre diseño de clases, mencioné que una de las causas principales de los errores C5 es utilizar RETURN dentro de estructuras WITH.

Dada la cantidad de gente que vino hacia mí después de la sesión, esta claro que esto no es muy conocido, así que aquí esta la explicación.

No estoy seguro que sucede exactamente cuando se utiliza una estructura WITH, pero claramente VFP almacena una referencia al objeto especificado por la sentencia WITH en algún lugar. Obviamente, la referencia debe ser eliminada en algún punto o sino el objeto no se puede liberar, pero sospecho que hay un fallo/agujero de memoria (memory leak) en esas condiciones, y que cuando suceden un numero suficiente de estos fallos, pues obtienes un error C5. Lo molesto sobre los fallos de memoria es que el error C5 puede suceder en zonas lejanas de código y bastante tiempo después, así es casi imposible hacer un seguimiento para los mortales como yo que no hacemos depuración de código en C.

Empecé a ver esto hace unos 18 meses. Teníamos informes regulares sobre errores C5 de gente que iban al Diseñador de Informes con nuestro producto Stonefield Query. El problema es que no era reproducible, nunca pude conseguirlo cuando lo intenté (lo conseguí alguna vez cuando no quería, como por ejemplo en demos!). Fui a través del código relacionado con el Diseñador de Informes investigando con mucho detalle, pero no pude encontrar el motivo. Entonces recordé algún extraño comportamiento años atrás:

Si utilizaba el RETURN dentro de una sentencia WITH y bajo ciertas condiciones entonces el objeto no se podía liberar. Ese problema fue arreglado en una versión posterior de VFP, así que me olvidé del asunto, pero se me ocurrió que yo lo había utilizado mucho en mi código, a pesar de que no es una buena practica. Así que gaste un día o dos haciendo refactoring (recodificando) cada RETURN que tuviera dentro de un WITH, funcionara o no, pero nunca volvimos a tener ningún error C5 desde que liberamos esa versión del Stonefield Query. Y pensando que esto puede quedar escondido detrás de los titulares, tiene sentido que esto sea la culpa del problema.

Así que atención a todo el mundo: Si estas teniendo errores C5 y te estas tirando de los pelos para ver donde está el problema, mira a todas tus estructuras WITH y mueve cualquier instrucción RETURN para debajo del ENDWITH. No solo es una buena práctica de programación, sino que podrá eliminar este problema que te puede volver loco.

9 de agosto de 2006

SQL Server Express - Instalación y Configuración

Artículo publicado en la revista MTJ.NET OnLine (Revista en línea de la Comunidad de Desarrolladores de Microsoft en Español) y escrito por José Ricardo Ribeiro (MS Brasil), Nilton Pinheiro (Brasil) y Gustavo Larriera (Uruguay), que tiene como objetivo describir paso a paso el proceso de instalación de SQL Server Express, un producto gratuito basado en la tecnología de SQL Server 2005.
"... SQL Server Express - sucesor de MSDE - es un sistema de base de datos gratuito y fácil de usar, basado en la tecnología de SQL Server 2005. Fue diseñado para brindar una plataforma de base de datos que ofrezca gran simpleza de uso, posibilitando una distribución rápida en sus escenarios de uso. Su facilidad de uso empieza con una interfaz gráfica simple y robusta que guía al usuario durante el proceso de instalación ... "

Para leer el artículo SQL Server Express - Instalación y Configuración completo haga clic aquí.

8 de agosto de 2006

Conociendo Zip Component

En este artículo vamos a conocer un componente ActiveX freeware que puede comprimir / descomprimir fácilmente un archivo o carpeta con una sola línea de código. Su nombre es "Zip Component" de Belus Technology Inc.

Introducción

Con esta utilidad se puede comprimir y descomprimir archivos y carpetas muy facilmente desde Visual FoxPro. A continuación vamos a conocer los métodos del componente y algunos ejemplos de uso con código VFP.

El enlace para descargar este componente es el siguiente:

https://web.archive.org/web/20200214062545/http://xstandard.com/en/downloads/?product=zip

Instalación

Para su instalación de debe copiar el archivo "XZip.dll" descargado en una carpeta (Ej: "C:\ZipComponent\") y desde la consola de comandos (DOS), en el directorio creado, ejecutamos: "regsvr32 XZip.dll".

En el caso de querer desinstalar el componente, ejecutamos desde la consola de comandos: "regsvr32 -u XZip.dll"

Métodos

Estos son los métodos y sus sintaxis:

Pack: Agrega un archivo o carpeta a un archivo ZIP. El nivel de compresión puede ser de 1 a 9. El valor por omisión es 6.
Pack(cRutaArchivo, cArchivoZip, lAlmacenaRuta, cNuevaRuta, nNivelCompresión)
UnPack: Extrae el contenido de un archivo ZIP de una carpeta.
UnPack(cArchivoZip, cRutaCarpeta, cPatron)
Delete: Elimina un archivo de un archivo ZIP.
Delete(cArchivo, sArchivoZip)
Move: Mueve o renombra un archivo en el archivo ZIP.
Move(cDeArchivo, cAArchivo, cArzhivoZip)
Contents: Recibe en un objeto la lista de archivos y carpetas de un archivo ZIP.
Contents(cArchivoZip)
El objeto Items recibido contiene las siguientes propiedades:
  • Count: Retorna la cantidad de miembros de la colección
  • Item: Retorna un miembro específico de la colección.
La clase Item contiene las siguientes propiedades:
  • Name: Nombre del archivo
  • Date: Fecha última modificaión
  • Path: Ruta relativa del archivo
  • Size: Tamaño en bytes del archivo
  • Type: Tipo del item: 1=Carpeta y 2=Archivo

Propiedades

ErrorCode: Retorna el código de error de la última operación.
ErrorDescription: Retorna la descripción del código de error de la última operación.
Version: Retorna la versión del producto.

Ejemplos en VFP

Veremos algunos ejemplos en código de Visual FoxPro, y lo fácil de su uso:

Comprimir archivos:
loZip = CREATEOBJECT("XStandard.Zip")
loZip.Pack("C:\Prgs\Prog1.prg", "C:\Zips\Programas.zip")
loZip.Pack("C:\Prgs\Prog2.prg", "C:\Zips\Programas.zip")
loZip.Pack("C:\Prgs\Prog3.prg", "C:\Zips\Programas.zip")
loZip = NULL
Comprimir archivos con la ruta por omisión:
loZip = CREATEOBJECT("XStandard.Zip")
loZip.Pack("C:\Prgs\Prog1.prg", "C:\Zips\Programas.zip", .T.)
loZip = NULL
Comprimir archivos con una ruta específica:
loZip = CREATEOBJECT("XStandard.Zip")
loZip.Pack("C:\Prgs\Prog1.prg", "C:\Zips\Programas.zip", .T., "VFP\Original")
loZip.Pack("C:\Prgs\Prog1.prg", "C:\Zips\Programas.zip", .T., "VFP\Copia")
loZip = NULL
Comprimir multiples archivos usando comodines:
loZip = CREATEOBJECT("XStandard.Zip")
loZip.Pack("C:\Prgs\*.prg", "C:\Zips\Programas.zip")
loZip = NULL

7 de agosto de 2006

Como enviar un email desde VFP sin MAPI

Este es siempre un tema recurrente en el grupo, y como he respondido varias consultas privadas sobre este mismo tema, creo que es hora de hacerlo un poco mas públicamente.

Una forma de enviar un email desde VFP sin lidiar con los problemas de MAPI, Outlook, OE, etc, es usar un componente de 3ros. Existe uno sumamente funcional y gratuito llamado w3JMail, de la empresa DIMAC (http://www.dimac.net/), el cual funciona perfecto en VFP y no requiere de ningún otro componente instalado.

El componente puede ser descargado desde esta dirección:

http://www.dimac.net/FreeDownloads/v3DlStart.asp?ProductID=5

La ayuda la encontrarán aquí:

http://www.dimac.net/default2.asp?M=Products/MenuCOM.asp&P=Products/w3JMail/start.htm

Y adicionalmente les anexo un pequeño ejemplo de como enviar un email con attachments desde VFP usando el w3JMail.

* Ejemplo de como enviar un email con
* adjuntos usando el componente
* w3JMail de DIMAC
*
* Por: Victor Espina
*
CLOSE ALL
CLEAR ALL
CLEAR
*
*-- Se instancia el componente
*
LOCAL oEmail
oEmail = CREATEOBJECT("JMail.Message")
*
*-- Se activa el logging interno del componente
*   y se desactiva la notificacion de errores
*
oEmail.Logging = .T.
oEmail.Silent = .T.
*
*-- Remitente
*
oEmail.From = "remitente@server.com"
oEmail.FromName = "Nombre del Remitente"
*
*-- Destinatario(s). El 2do parametro es opcional. Se puede
*   invocar el metodo AddRecipient las veces que sea necesario.
*
oEmail.AddRecipient("destinatario@server.com","Nombre del Destinatario")
*
*-- Asunto
*
oEmail.Subject = "Email de prueba con w3JMail"
*
*-- Texto. La propiedad Body es de lectura/escritura. Adicionalmente
*   se puede usar el metodo AppendText() para anadir texto al final
*   del mensaje.
*
*   Para enviar un mensaje en formato HTML, use la propiedad HTMLBody
*   y/o el metodo AppendHTML()
*
oEmail.Body = "Este es un email de prueba enviado programáticamente " + ;
  "usando el componente w3JMail de DIMAC."
*
*-- Adjuntos. Se puede invocar el metodo AddAttachment() tantas veces
*   como sea necesario. El 2do parámetro indica si el archivo adjunto
*   sera incluido dentro del mensaje (in-line Attachment) o no.
*
oEmail.AddAttachment(FULLPATH("mail1.prg"),.F.)
*
*-- Se envia el mensaje. El metodo Send() devuelve .T. si se envio
*   el mensaje correctamente o .F. en caso de un error. La propiedad
*   Log contiene el log del problema ocurrio (si Logging = .T.)
*
*   El metodo Send() acepta como parametro una lista de uno o mas
*   servidores SMTP separados por coma. Es posible indicar un
*   usuario/pwd para cada servidor, usando la sintaxis:
*
*   user:pwd@server
*
LOCAL lOk
lOk = oEmail.SEND("smtp.server.com")
IF lOk
  MESSAGEBOX("Mensaje enviado!")
ELSE
  MESSAGEBOX(eMail.Log)
ENDIF
*

Saludos.

Victor Espina