<VFPData> <reportdata name="" type="R" script="" execute="" execwhen="" class="" classlib="" declass="" declasslib=""/> <rptctrl class="RTFHandler" expr="c_message.msgcontent"/> </VFPData>here is an example call:
loRTFListener = NEWOBJECT("CtrlListener", "CtrlListener.prg") REPORT FORM DonationReceipts.frx NOCONSOLE OBJECT loRTFListener PREVIEWBelow is the code for the class:
*********************************************************** * Classes contained in this PRG: * CtrlListener - Custom report listener to handle custom controls * RTFHandler - Handler object for the RTF control used in reports * Formatrange - Custom class wrapper for the API FORMATRANGE structure *********************************************************** #DEFINE CHRG_ALL -1 #DEFINE WM_USER 0x0400 #DEFINE EM_FORMATRANGE (WM_USER+57) *********************************************************** *********************************************************** *********************************************************** DEFINE CLASS CtrlListener AS ReportListener oFRX = NULL ListenerType = 1 ******************************************************** PROCEDURE BeforeReport() LOCAL oData AS Object ** Load the entire FRX into a collection object for ** easy access This.oFRX = CREATEOBJECT("Collection") SET DATASESSION TO (This.FRXDataSession) SELECT frx SCAN SCATTER MEMO NAME oData ** Set the DataSession back to the current. If ** not, any obects created in LoadObject( ) ** will be scoped to the FRX DataSession SET DATASESSION TO (This.CurrentDataSession) This.LoadObject(oData) This.oFRX.Add(oData) SET DATASESSION TO (This.FRXDataSession) ENDSCAN SET DATASESSION TO (This.CurrentDataSession) ENDPROC ******************************************************** PROCEDURE LoadObject(oData) LOCAL oXML AS MSXML2.DomDocument LOCAL oNode, cClass ** Add a custom handler property to hold handler object ADDPROPERTY(oData, "oHandler", NULL) ** Read custom metadata to determine if a custom ** handler object is needed IF NOT EMPTY(oData.style) oXML = CREATEOBJECT("MSXML.DomDocument") IF oXML.loadXML(oData.style) oNode = oXML.selectSingleNode("*/rptctrl") IF NOT ISNULL(oNode) ** <rptctrl class="RTFHandler" expr="rtfsample.rtf"/> cClass = LOWER(oNode.getAttribute("class")) oData.oHandler = CREATEOBJECT(cClass, This, oData, oNode) ENDIF ENDIF ENDIF oXML = NULL ENDPROC ******************************************************** PROCEDURE AdjustObjectSize(nFRXRecno, oObjProperties) LOCAL oData AS Object oData = This.oFRX(nFRXRecno) ** Check to see if there is a custom handler for this ** object and let it handle the size adjustment IF VARTYPE(oData.oHandler) = "O" oData.oHandler.HandleObjectSize(This, oData, oObjProperties) ENDIF ENDPROC ******************************************************** PROCEDURE Render(nFRXRecno, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) LOCAL oData AS Object oData = This.oFRX(nFRXRecno) ** Check to see if there is a custom handler for this ** object and let it handle the Render. ** If it returns .T. bypass the default behavior IF VARTYPE(oData.oHandler) = "O" IF oData.oHandler.HandleRender(This, oData, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) NODEFAULT ENDIF ENDIF ENDPROC ******************************************************** PROCEDURE AfterReport() ** Clear out all of the objects or the FRX DataSession ** will not be able to go out of scope This.oFRX.Remove(-1) This.oFRX = NULL ENDPROC ENDDEFINE *********************************************************** *********************************************************** *********************************************************** DEFINE CLASS RTFHandler AS Custom oForm = NULL oFR = NULL nTopMargin = 0 nLeftMargin = 0 ******************************************************** PROCEDURE Init(oRL, oData, oNode) DECLARE LONG GdipGetDC IN GDIPLUS LONG graphics, LONG @hdc DECLARE LONG GdipReleaseDC IN GDIPLUS LONG graphics, LONG hdc DECLARE LONG SendMessage IN WIN32API AS SendMessage_String LONG hWnd, INTEGER Msg, INTEGER wParam, STRING @lParam ** NOTE: Prior to SP1 the Top and Left positions in ** AdjustObjectSize do not include the offset for the ** printer margins. Determine them now for use later. IF VERSION(4) < "09.00.0000.3307" This.SetPageMargins() ENDIF IF PCOUNT() >= 3 This.SetUp(oRL, oData, oNode) ENDIF RETURN ENDPROC *********************************************************** PROCEDURE SetPageMargins() #DEFINE LOGPIXELSX 88 #DEFINE LOGPIXELSY 90 #DEFINE PHYSICALOFFSETX 112 #DEFINE PHYSICALOFFSETY 113 DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER, INTEGER DECLARE LONG CreateDC IN WIN32API STRING lpszDriver, STRING lpszDevice, STRING lpszOutput, STRING @lpInitData DECLARE INTEGER DeleteDC IN WIN32API LONG hDC ** The Top and Left positions we get in AdjustObjectSize ** do not include the offset for the printer margins. LOCAL hDC LOCAL nLogOffsetX, nLogOffsetY LOCAL nLogPixelsX, nLogPixelsY hDC = CreateDC("WINSPOOL", SET("Printer", 3), NULL, NULL) IF hDC <> 0 nLogPixelsX = GetDeviceCaps(hDC, LOGPIXELSX) nLogPixelsY = GetDeviceCaps(hDC, LOGPIXELSY) nLogOffsetX = GetDeviceCaps(hDC, PHYSICALOFFSETX) nLogOffsetY = GetDeviceCaps(hDC, PHYSICALOFFSETY) This.nLeftMargin = nLogOffsetX*960/nLogPixelsX This.nTopMargin = nLogOffsetY*960/nLogPixelsY ENDIF DeleteDC(hDC) ENDPROC *********************************************************** PROCEDURE SetUp(oRL, oData, oNode) ** oRL - Reference to the ReportListener object ** oData - Reference to this controls FRX record ** oNode - Reference to this controls MetaData LOCAL cExpr ** Create an instance of the RichText control in a form This.oForm = CREATEOBJECT("Form") This.oForm.AddObject("oRTF", "OLEControl", "RichText.RichTextCtrl") ** Create an instance of the FORMATRANGE wrapper class This.oFR = CREATEOBJECT("formatrange") ** These properties keep track of how much text has been ** rendered between pages ADDPROPERTY(oData, "nCharPos", 0) ADDPROPERTY(oData, "nCharLen", 0) ** Get the expression value from the metadata cExpr = oNode.getAttribute("expr") IF NOT EMPTY(cExpr) oData.expr = cExpr ENDIF RETURN ENDPROC ******************************************************** PROCEDURE HandleObjectSize(oRL, oData, oProp) ** oRL - Reference to ReportListener object ** oData - Reference to controls FRX record ** oProp - Reference to oObjProperties from AdjustObjectSize LOCAL hDC, nLeft, nTop, nRight, nBottom, cFR ** If this is the first time for this record, initialize ** the TextRTF and reset our position pointers IF NOT oProp.reattempt This.oForm.oRTF.TextRTF = EVALUATE(oData.expr) oData.nCharPos = 0 oData.nCharLen = LEN(This.oForm.oRTF.Text) ENDIF hDC = 0 GdipGetDC(oRL.GDIPlusGraphics, @hDC) ** Set both HDC attributes to the Graphics object This.oFR.SetHDC(hDC, hDC) ** Set the render rectangle to the maximum available height ** Make sure it includes the page margins ** Note TWIPS/Pixels = 1440/960 WITH oProp IF VERSION(4) < "09.00.0000.3307" ** Prior to SP1 you need to add the page margins ** to the .Top and .Left properties nLeft = (.left + This.nLeftMargin)*1440/960 nTop = (.top + This.nTopMargin)*1440/960 nRight = (.left + .width + This.nLeftMargin)*1440/960 nBottom = (.top + .maxheightavailable + This.nTopMargin)*1440/960 ELSE nLeft = (.left)*1440/960 nTop = (.top)*1440/960 nRight = (.left + .width)*1440/960 nBottom = (.top + .maxheightavailable)*1440/960 ENDIF ENDWITH This.oFR.SetRC(nLeft, nTop, nRight, nBottom) ** Set the Page size This.oFR.SetRCPage(0, 0, oRL.GetPageWidth()*1440/960, oRL.GetPageHeight()*1440/960) ** Set the character range. This.oFR.SetCHRG(oData.nCharPos, CHRG_ALL) cFR = This.oFR.data oData.nCharPos = SendMessage_String(This.oForm.oRTF.HWnd, EM_FORMATRANGE, -1, @cFR) This.oFR.data = cFR ** Grab the updated rectangle bottom. This is the physical ** position the RichText control stopped drawing. nBottom = 0 This.oFR.GetRC(0, 0, 0, @nBottom) ** Was all the RTF Text rendered? IF oData.nCharPos < oData.nCharLen ** If not, force a new page by setting the object height to ** a value higher than the max available height oProp.height = oProp.maxheightavailable+1 ELSE ** If so, update the height to the position the RichText ** control finished drawing. oProp.height = (nBottom*960/1440)-(oProp.top+This.nTopMargin) ** The control requires that the cache is cleared when ** finished rendering. Pass a NULL to lParam. SendMessage_String(This.oForm.oRTF.HWnd, EM_FORMATRANGE, -1, NULL) ENDIF ** Tell the report engine to read the updated values oProp.reload = .T. ** Release the Graphics device context created earlier GdipReleaseDC(oRL.GDIPlusGraphics, hDC) RETURN ENDPROC ******************************************************** PROCEDURE HandleRender(oRL, oData, nLeft, nTop, nWidth, nHeight, nObjectContinuationType, cContentsToBeRendered, GDIPlusImage) ** Do nothing. We already rendered. RETURN .T. ENDPROC ENDDEFINE *********************************************************** *********************************************************** *********************************************************** DEFINE CLASS formatrange AS Custom #DEFINE FR_SIZEOF 0x0030 #DEFINE FR_HDC (0x0000 + 1) #DEFINE FR_HDCTARGET (0x0004 + 1) #DEFINE FR_RC_LEFT (0x0008 + 1) #DEFINE FR_RC_TOP (0x000C + 1) #DEFINE FR_RC_RIGHT (0x0010 + 1) #DEFINE FR_RC_BOTTOM (0x0014 + 1) #DEFINE FR_RCPAGE_LEFT (0x0018 + 1) #DEFINE FR_RCPAGE_TOP (0x001C + 1) #DEFINE FR_RCPAGE_RIGHT (0x0020 + 1) #DEFINE FR_RCPAGE_BOTTOM (0x0024 + 1) #DEFINE FR_CHRG_CPMIN (0x0028 + 1) #DEFINE FR_CHRG_CPMAX (0x002C + 1) data = 0h00 ******************************************************** PROCEDURE Init() This.data = REPLICATE(0h00, FR_SIZEOF) ENDPROC ******************************************************** PROCEDURE SetHDC(nHDC, nHDCTarget) WITH This .data = STUFF(.data, FR_HDC, 4, BINTOC(nHDC, "4SR")) .data = STUFF(.data, FR_HDCTARGET, 4, BINTOC(nHDCTarget, "4SR")) ENDWITH ENDPROC ******************************************************** PROCEDURE SetRC(nLeft, nTop, nRight, nBottom) WITH This .data = STUFF(.data, FR_RC_LEFT, 4, BINTOC(nLeft, "4SR")) .data = STUFF(.data, FR_RC_TOP, 4, BINTOC(nTop, "4SR")) .data = STUFF(.data, FR_RC_RIGHT, 4, BINTOC(nRight, "4SR")) .data = STUFF(.data, FR_RC_BOTTOM, 4, BINTOC(nBottom, "4SR")) ENDWITH ENDPROC ******************************************************** PROCEDURE GetRC(nLeft, nTop, nRight, nBottom) WITH This nLeft = CTOBIN(SUBSTR(.data, FR_RC_LEFT, 4), "4SR") nTop = CTOBIN(SUBSTR(.data, FR_RC_TOP, 4), "4SR") nRight = CTOBIN(SUBSTR(.data, FR_RC_RIGHT, 4), "4SR") nBottom= CTOBIN(SUBSTR(.data, FR_RC_BOTTOM, 4), "4SR") ENDWITH ENDPROC ******************************************************** PROCEDURE SetRCPage(nLeft, nTop, nRight, nBottom) WITH This .data = STUFF(.data, FR_RCPAGE_LEFT, 4, BINTOC(nLeft, "4SR")) .data = STUFF(.data, FR_RCPAGE_TOP, 4, BINTOC(nTop, "4SR")) .data = STUFF(.data, FR_RCPAGE_RIGHT, 4, BINTOC(nRight, "4SR")) .data = STUFF(.data, FR_RCPAGE_BOTTOM, 4, BINTOC(nBottom, "4SR")) ENDWITH ENDPROC ******************************************************** PROCEDURE SetCHRG(nCPMin, nCPMax) WITH This .data = STUFF(.data, FR_CHRG_CPMIN, 4, BINTOC(nCPMin, "4SR")) .data = STUFF(.data, FR_CHRG_CPMAX, 4, BINTOC(nCPMax, "4SR")) ENDWITH ENDPROC ENDDEFINE