Printing RMChart graphs with the DCPRINT system

[rdonnay]

A customer of mine asked if I could give him an easy way to print Pie and Bar charts in a report that also contains text. The following code shows how to create any kind of chart using RMChart and then embed that chart into a print job using DCPRINT BITMAP.

Code: Select all

#INCLUDE "dcdialog.CH"
#INCLUDE "dcgraph.CH"
#INCLUDE "dcprint.CH"

FUNCTION Main()

LOCAL oClipBoard, cTitle, aSize, aData, aColor, aLegend, ;
      oPrinter, oBitmap, aData1, aData2, nColor1, nColor2, ;
      aLabel, aAxisLabel

IF !LoadRMChartControl()
  RETURN .f.
ENDIF

DCPRINT ON TO oPrinter
IF Valtype(oPrinter) # 'O' .OR. !oPrinter:lActive
  RETURN .f.
ENDIF

@ 1,5 DCPRINT SAY 'Here is my PIE chart' FONT '14.Arial Bold'

* --- Create and Print Pie Chart --- *

cTitle := 'My Pie'
aSize := { 400,400 }
aData := { 20,40,60,30 }
aColor := { Gold, Silver, SteelBlue, Red }
aLegend := { 'Apples', 'Peaches', 'Bananas', 'Plums' }

PieChartToClipBoard( cTitle, aSize, aData, aColor, aLegend )

oBitmap := GetBitmapFromClipBoard()

@ 3,5,20,40 DCPRINT BITMAP oBitmap

* --- Create and Print Bar Chart --- *

@ 22,5 DCPRINT SAY 'Here is my BAR chart' FONT '14.Arial Bold'

cTitle := 'My Bar'
aSize := { 400,400 }
aData1 := { 20,40,60,30 }
aData2 := { 10,30,90,40 }
nColor1 := CornflowerBlue
nColor2 := Gold
aLabel := { 'Apples', 'Peaches', 'Bananas', 'Plums' }
aAxisLabel := { '0', '50', '100' }
aLegend := { 'This Year', 'Last Year' }

BarChartToClipBoard( cTitle, aSize, aData1, aData2, nColor1, nColor2, ;
                     aLabel, aAxisLabel, aLegend )

oBitmap := GetBitmapFromClipBoard()

@ 24,5,44,60 DCPRINT BITMAP oBitmap

DCPRINT OFF

RETURN nil

* ------------

FUNCTION PieChartToClipBoard( cTitle, aSize, aData, aColor, aLegend )

LOCAL GetList[0], GetOptions, oRmChart, aPie[0], oRegion, oDlg

* --- RMChart ActiveX Control --
@ 0,0 DCRMCHART oRmChart SIZE aSize[1], aSize[2] PIXEL

* --- Pie ---
DcAddGridlessGroup TO aPie DATA aData ;
   COLOR aColor STYLE RMC_PIE_3D

@ 0,0 DcChartRegion oRegion ;
   PARENT oRMChart ;
   SIZE aSize[1], aSize[2] PIXEL ;
   CAPTION TITLE cTitle ;
   LEGEND TEXT aLegend ;
   GRIDLESSGROUP aPie

DCGETOPTIONS HIDE

DCREAD GUI FIT TITLE 'Pie Chart' ;
   EXIT ;
   OPTIONS GetOptions ;
   PARENT @oDlg ;
   EVAL {||oRMChart:draw(), ;
           oRMChart:draw2ClipBoard()}

oDlg:destroy()

RETURN nil

* -----------

FUNCTION BarChartToClipBoard( cTitle, aSize, aData1, aData2, nColor1, nColor2, ;
                              aLabel, aAxisLabel, aLegend )

LOCAL GetList[0], GetOptions, oRmChart, oRegion1, oRegion2, aBarGroup[0], ;
      aDataAxis[0], oDlg

* --- RMChart ActiveX Control --
@ 0,0 DCRMCHART oRmChart SIZE aSize[1], aSize[2] PIXEL

* --- Bar Group ---
DcAddBarGroup TO aBarGroup DATA aData1 TYPE RMC_BARGROUP COLOR nColor1
DcAddBarGroup TO aBarGroup DATA aData2 TYPE RMC_BARGROUP COLOR nColor2

DcAddDataAxis TO aDataAxis LABELTEXT aAxisLabel

@ 5,5 DcChartRegion oRegion1 ;
   PARENT oRMChart ;
   ;// FOOTER "(c) Copyright - Donnay Software Designs (2008)" ;
   SIZE aSize[1], aSize[2] PIXEL ;
   CAPTION TITLE cTitle ;
   GRID ;
   LEGEND TEXT aLegend ;
   DATAAXIS aDataAxis ;
   LABELAXIS LABELARRAY aLabel ;
   BARGROUP aBarGroup

DCGETOPTIONS HIDE

DCREAD GUI FIT TITLE 'Bar Chart' ;
   EXIT ;
   OPTIONS GetOptions ;
   PARENT @oDlg ;
   EVAL {||oRMChart:draw(), ;
           oRMChart:draw2ClipBoard()}

oDlg:destroy()

RETURN nil

* -----------

PROC appsys ; return

* -----------

STATIC FUNCTION GetBitmapFromClipBoard()

LOCAL oClipBoard, oBitmap

oClipBoard := XbpClipBoard():new():create()
oClipBoard:open()
oBitMap := oClipBoard:getBuffer( XBPCLPBRD_BITMAP )
oClipBoard:close()

RETURN oBitmap

* -----------

STATIC FUNCTION LoadRMChartControl()

LOCAL cRegSvr, cClsId, cRegQuery, lStatus := .t.

cRegSvr := 'regsvr32.exe'
cClsId := '\CLSID\{4D814D0F-7D71-4E7E-B51E-2885AD0ED9D7}'    // RMChart Version 4.xx

cRegQuery := DC_RegQuery(HKEY_CLASSES_ROOT,cClsId,'')
IF Valtype(cRegQuery) # 'C' .OR. Empty(cRegQuery)
  RunShell('rmchart.ocx /s',cRegSvr)
  cRegQuery := DC_RegQuery(HKEY_CLASSES_ROOT,cClsId,'')
  IF Valtype(cRegQuery) # 'C' .OR. Empty(cRegQuery)
    DC_WinAlert('Could not register RMChart OCX')
    lStatus := .f.
  ENDIF
ENDIF

RETURN lStatus

[bwolfsohn]

Nice..