Imprimir un gráfico creado con SimpleChart

SimpleChart es una clase creada por Mike Lewis (http://www.ml-consult.co.uk) quien logra, mediante un grupo de propiedades, facilitar el trabajo con MSChart y posibilitar que se obtengan gráficos con mucha rapidez y sin complejidades.

Para ver todos los detalles relativos a esta clase ver:

SimpleChart revisado (Mike Lewis) Traducción
https://comunidadvfp.blogspot.com/2003/10/simplechart-revisitado.html

Nos había quedado pendiente aclarar cómo se pueden imprimir estos gráficos. Pues bien, la pregunta es ¿Se puede copiar un gráfico creado con SimpleChart en un informe de VFP?

¡¡Sí se puede!! Tal y como se indica en el segundo artículo, hay que invocar el método EditCopy del gráfico.

Aquí dejo un ejemplo concreto

* Copiar al Clipboard
THISFORM.Grafico.EditCopy
* Copiar a un bmp
THISFORM.cRutaGrafico = GETENV("Temp")+SYS(2015)+".bmp"
DO Graficos WITH (THISFORM.cRutaGrafico),""

Pego directamente el código del programa gráficos escrito por el compañero J. Enrique Ramos Menchaca, quien lo publicó en PortalFox y nos autorizó a modificarlo dadas las nuevas necesidades que yo tenía.

Cambios que hicimos:

1. Incluir 2 parámetros: tcArchivo, tcreporte
   • tcArchivo - nombre del .bmp que se va a cargar en el objeto imagen del informe
   • tcreporte - nombre del reporte a llamar
2. No emplear campo general y sí campo de caracteres con la ruta de la imagen a mostrar, mira donde dice código nuevo.

Lo único que necesitamos es copiar y pegar el programa gráfico en nuestra aplicación e invocarlo con los parámetros adecuados.

***********************************************
* Programa Graficos
* Autor: J. Enrique Ramos Menchaca
* Modificado por Jorge Mota y Ana María Bisbé York
***********************************************
LPARAMETERS tcArchivo, tcreporte
#DEFINE CF_BITMAP 2
#DEFINE OBJ_BITMAP 7
DO decl
LOCAL hClipBmp, lcTargetFile
*lcTargetFile = "C:\clipboard.bmp"
lcTargetFile = tcArchivo && "grafime.bmp"
= OpenClipboard (0)
hClipBmp = GetClipboardData (CF_BITMAP)
= CloseClipboard()
IF hClipBmp = 0 Or GetObjectType(hClipBmp) <> OBJ_BITMAP
  = MessageBox("No se encontro imagen bitmap en el Portapapeles.",;
    64, "Clipboard to BMP")
  RETURN .F.
ENDIF
= bitmap2file (hClipBmp, lcTargetFile)
= DeleteObject (hClipBmp)
***
* crear las referencias para los arreglos
* external array laAspecto, lavalor, laporci,;
* lavalor1, lavalor2, lavalor3, lavalor4
* Código original
*!* CREATE CURSOR GRAFICO (GRAFICA G)
*!* APPEND BLANK
*!* APPEND GENERAL GRAFICO.GRAFICA FROM "c:\clipboard.bmp"
*!* REPORT FORM GRAFICA preview
*!* USE IN grafico
*!* RETURN
* Código modificado
CREATE CURSOR GRAFICO (cRuta c(250))
APPEND BLANK
REPLACE GRAFICO.cRuta WITH tcArchivo
IF !empty(tcreporte)
  REPORT FORM (tcreporte) to print prompt noconso
ENDIF
USE IN GRAFICO
RETURN
***********************************************
* InitBitsArray()
***********************************************
PROCEDURE InitBitsArray()
  #DEFINE GMEM_FIXED 0
  LOCAL lnPtr
  pnBitsSize = pnHeight * pnBytesPerScan
  lnPtr = GlobalAlloc (GMEM_FIXED, pnBitsSize)
  = ZeroMemory (lnPtr, pnBitsSize)
  RETURN lnPtr
ENDPROC

***********************************************
* String2file
***********************************************
PROCEDURE String2File (hFile, lcBuffer)
  DECLARE INTEGER WriteFile IN kernel32;
    INTEGER hFile, STRING @lpBuffer, INTEGER nBt2Write,;
    INTEGER @lpBtWritten, INTEGER lpOverlapped
  = WriteFile (hFile, @lcBuffer, Len(lcBuffer), 0, 0)
  RETURN
ENDPROC

***********************************************
* Bitmap2file
***********************************************
PROCEDURE Bitmap2file (hBitmap, lcTargetFile)
  #DEFINE DIB_RGB_COLORS 0
  PRIVATE pnWidth, pnHeight, pnBitsSize, pnRgbQuadSize, pnBytesPerScan
  STORE 0 TO pnWidth, pnHeight, pnBytesPerScan, pnBitsSize, pnRgbQuadSize
  = GetBitmapDimensions(hBitmap, @pnWidth, @pnHeight)
  LOCAL lpBitsArray, lcBInfo
  lcBInfo = InitBitmapInfo()
  lpBitsArray = InitBitsArray()
  LOCAL hwnd, hdc, hMemDC
  hwnd = GetActiveWindow()
  hdc = GetWindowDC(hwnd)
  hMemDC = CreateCompatibleDC (hdc)
  = ReleaseDC (hwnd, hdc)
  = GetDIBits (hMemDC, hBitmap, 0, pnHeight, lpBitsArray,;
    @lcBInfo, DIB_RGB_COLORS)
  #DEFINE BFHDR_SIZE 14 && BITMAPFILEHEADER
  #DEFINE BHDR_SIZE 40 && BITMAPINFOHEADER
  LOCAL hFile, lnFileSize, lnOffBits, lcBFileHdr
  lnFileSize = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize + pnBitsSize
  lnOffBits = BFHDR_SIZE + BHDR_SIZE + pnRgbQuadSize
  lcBFileHdr = "BM" + num2dword(lnFileSize) +;
    num2dword(0) + num2dword(lnOffBits)
  #DEFINE GENERIC_WRITE 1073741824 && 0x40000000
  #DEFINE FILE_SHARE_WRITE 2
  #DEFINE CREATE_ALWAYS 2
  #DEFINE FILE_ATTRIBUTE_NORMAL 128
  #DEFINE INVALID_HANDLE_VALUE -1
  hFile = CreateFile (lcTargetFile,;
    GENERIC_WRITE,;
    FILE_SHARE_WRITE, 0,;
    CREATE_ALWAYS,;
    FILE_ATTRIBUTE_NORMAL, 0)
  IF hFile <> INVALID_HANDLE_VALUE
    WAIT WINDOW "Storing to file..." NOWAIT
    = String2File (hFile, @lcBFileHdr)
    = String2File (hFile, @lcBInfo)
    = Ptr2File (hFile, lpBitsArray, pnBitsSize)
    = CloseHandle (hFile)
  ELSE
    = MessageBox("Unable to create file: " + lcTargetFile)
  ENDIF
  = GlobalFree(lpBitsArray)
  = DeleteDC (hMemDC)
  RETURN
ENDPROC

***********************************************
* Ptr2File
***********************************************
PROCEDURE Ptr2File (hFile, lnPointer, lnBt2Write)
  DECLARE INTEGER WriteFile IN kernel32;
    INTEGER hFile, INTEGER lpBuffer, INTEGER nBt2Write,;
    INTEGER @lpBtWritten, INTEGER lpOverlapped
  = WriteFile (hFile, lnPointer, lnBt2Write, 0, 0)
  RETURN
ENDPROC

***********************************************
* InitBitmapInfo
***********************************************
PROCEDURE InitBitmapInfo(lcBIHdr)
  #DEFINE BI_RGB 0
  #DEFINE RGBQUAD_SIZE 4
  #DEFINE BHDR_SIZE 40
  LOCAL lnBitsPerPixel, lcBIHdr, lcRgbQuad
  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) + num2word(1) + num2word(lnBitsPerPixel) +;
  num2dword(BI_RGB) + Repli(Chr(0), 20)
  IF lnBitsPerPixel <= 8
    pnRgbQuadSize = (2^lnBitsPerPixel) * RGBQUAD_SIZE
    lcRgbQuad = Repli(Chr(0), pnRgbQuadSize)
  ELSE
    lcRgbQuad = ""
  ENDIF
  RETURN lcBIHdr + lcRgbQuad
ENDPROC

***********************************************
* num2dword
***********************************************
FUNCTION num2dword (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)
ENDFUNC

***********************************************
* GetBitmapDimensions
***********************************************
PROCEDURE GetBitmapDimensions(hBitmap, lnWidth, lnHeight)
  #DEFINE BITMAP_STRU_SIZE 24
  LOCAL lcBuffer
  lcBuffer = Repli(Chr(0), BITMAP_STRU_SIZE)
  IF GetObjectA (hBitmap, BITMAP_STRU_SIZE, @lcBuffer) <> 0
    lnWidth = buf2dword (SUBSTR(lcBuffer, 5,4))
    lnHeight = buf2dword (SUBSTR(lcBuffer, 9,4))
  ENDIF
  RETURN
ENDPROC

***********************************************
* buf2dword
***********************************************
FUNCTION buf2dword (lcBuffer)
  RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
    Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
    Asc(SUBSTR(lcBuffer, 4,1)) * 16777216
ENDFUNC

***********************************************
* num2word
***********************************************
FUNCTION num2word (lnValue)
  RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
ENDFUNC

***********************************************
* decl
***********************************************
PROCEDURE decl
  DECLARE INTEGER GetActiveWindow IN user32
  DECLARE INTEGER GetClipboardData IN user32 INTEGER uFormat
  DECLARE INTEGER OpenClipboard IN user32 INTEGER hwnd
  DECLARE INTEGER CloseClipboard IN user32
  DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
  DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
  DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd, INTEGER hdc
  DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
  DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
  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
ENDPROC

***********************************************

Espero que sirva como complemento a la información que ya teníamos para trabajar con esta clase SimpleChart

Saludos,

Ana María Bisbé York
www.amby.net

---