Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Bullet list in VFP Report
Message
De
02/02/2016 17:01:43
 
 
À
02/02/2016 07:43:48
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire de rapports & Rapports
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Windows 10
Divers
Thread ID:
01630437
Message ID:
01630608
Vues:
94
I have long since lost the link... Not sure where the original documentation is -- if you have problems below I will have to 'dig' for it.

But, add a rectangular shape to the report where you want the RTF text to appear -- the shape will be replaced and the RTF text flowed as necessary. In the comments for the shape add:

*:RTF

See the attached screenshot. Store the RTF text into a memo field; I am using the following cursor:

CREATE CURSOR c_message (memberid C(6), msgcontent M, msgadded L)

I use msgadded for a PrintWhen clause if there is not any content to display on the shape. The above cursor is set to the main print cursor via a SET RELATION command. The field that contains the RTF text is defined in a XML structure that is stored into the style memo field for the report object as shown in the attached screen shot and is below:
<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 PREVIEW
Below 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
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform