* Define a class that knows how to apply effects to objects in a report.

DEFINE CLASS EffectsListener AS _ReportListener OF ;
		HOME() + 'ffc\_ReportListener.vcx'

	oEffectHandlers = .NULL.
&& a collection of effect handlers
	DIMENSION aRecords[1]
&& an array of information for each record in the FRX

* Create a collection of effect handler objects and fill it with the handlers
* we know about. A subclass or instance could be filled with additional ones.

	FUNCTION INIT
		DODEFAULT()
		WITH THIS
			.oEffectHandlers = CREATEOBJECT('Collection')
			.oEffectHandlers.ADD(CREATEOBJECT('DynamicForeColorEffect'))
			.oEffectHandlers.ADD(CREATEOBJECT('DynamicStyleEffect'))
		ENDWITH
	ENDFUNC

* Dimension aRecords to as many records as there are in the FRX so we don't
* have to redimension it as the report runs. The first column indicates if
* we've processed that record in the FRX yet and the second column contains
* a collection of effect handlers used to process the record.

	FUNCTION BEFOREREPORT
		DODEFAULT()
		WITH THIS
			.SetFRXDataSession()
			DIMENSION .aRecords[reccount(), 2]
			.ResetDataSession()
		ENDWITH
	ENDFUNC

	PROCEDURE ONPREVIEWCLOSE
		PARAMETERS lPrint
		LOCAL liRange

		THIS.COMMANDCLAUSES.PROMPT = .T.
		DODEFAULT(lPrint)
	ENDPROC && OnPrevieClose
	
* Apply any effects that were requested to the field about to be rendered.

	FUNCTION EVALUATECONTENTS(tnFRXRecno, toObjProperties)
		LOCAL loEffectObject, ;
			loEffectHandler, ;
			lcExpression
		WITH THIS

* If we haven't already checked if this field needs any effects, do so and
* flag that we have checked it so we don't do it again.

			IF NOT .aRecords[tnFRXRecno, 1]
				.aRecords[tnFRXRecno, 1] = .T.
				.aRecords[tnFRXRecno, 2] = .SetupEffectsForObject(tnFRXRecno)
			ENDIF NOT .aRecords[tnFRXRecno, 1]

* Go through the collection of effect handlers for the field (the collection
* may be empty if the field doesn't need any effects), letting each one do its
* thing.

			FOR EACH loEffectObject IN .aRecords[tnFRXRecno, 2]
				loEffectHandler = loEffectObject.oEffectHandler
				lcExpression    = loEffectObject.cExpression
				loEffectHandler.Execute(toObjProperties, lcExpression)
			NEXT loEffect
		ENDWITH

* Do the normal behavior.

		DODEFAULT(tnFRXRecno, toObjProperties)
	ENDFUNC

* Go through each effect handler to see if it'll handle the current report
* object. If so, add it to a collection of handlers for the object, and return
* that collection.

	FUNCTION SetupEffectsForObject(tnFRXRecno)
		LOCAL loFRX, ;
			loHandlers, ;
			loObject
		WITH THIS
			loFRX      = .GetReportObject(tnFRXRecno)
			loHandlers = CREATEOBJECT('Collection')
			FOR EACH loEffectHandler IN .oEffectHandlers
				loObject = loEffectHandler.GetEffect(loFRX)
				IF VARTYPE(loObject) = 'O'
					loHandlers.ADD(loObject)
				ENDIF VARTYPE(loObject) = 'O'
			NEXT loEffectHandler
		ENDWITH
		RETURN loHandlers
	ENDFUNC

* Return a SCATTER NAME object for the specified record in the FRX.

	PROCEDURE GetReportObject(tnFRXRecno)
		LOCAL loObject
		THIS.SetFRXDataSession()
		GO tnFRXRecno
		SCATTER MEMO NAME loObject
		THIS.ResetDataSession()
		RETURN loObject
	ENDPROC
ENDDEFINE

* Create a class that holds a reference to an effect handler and the expression
* the effect handler is supposed to act on for a particular record in the FRX.

DEFINE CLASS EffectObject AS CUSTOM
	oEffectHandler = .NULL.
	cExpression    = ''
ENDDEFINE

* Define an abstract class for effect handler objects.

DEFINE CLASS EffectHandler AS CUSTOM

* Execute is called by the EvaluateContents method of EffectsListener to
* perform an effect.

	FUNCTION Execute(toObjProperties, tcExpression)
	ENDFUNC

* GetEffects is called to return an object containing a reference to the
* handler and the expression it's supposed to work on if the specified report
* object needs this effect, or return null if not.

	FUNCTION GetEffect(toFRX)
		LOCAL loObject
		loObject = .NULL.
		RETURN loObject
	ENDFUNC

* EvaluateExpression may be called by Execute to evaluate the specified
* expression.

	FUNCTION EvaluateExpression(tcExpression)
		RETURN EVALUATE(tcExpression)
	ENDFUNC
ENDDEFINE

* Define an abstract class for effect handlers that look for
* "*:EFFECTS <effectname> = <effectexpression>" in the USER memo.

DEFINE CLASS UserEffectHandler AS EffectHandler
	cEffectsDirective = '*:EFFECTS'
&& the directive that indicates an effect is needed
	cEffectName       = ''
&& the effect name to look for (filled in in a subclass)

	FUNCTION GetEffect(toFRX)
		LOCAL lcEffect, ;
			loObject
		lcEffect = THIS.cEffectsDirective + ' ' + THIS.cEffectName
		IF ATC(lcEffect, toFRX.USER) > 0
			loObject = CREATEOBJECT('EffectObject')
			loObject.oEffectHandler = THIS
			loObject.cExpression = STREXTRACT(toFRX.USER, lcEffect + ' = ', ;
				CHR(13), 1, 3)
		ELSE
			loObject = .NULL.
		ENDIF ATC(lcEffect, toFRX.USER) > 0
		RETURN loObject
	ENDFUNC
ENDDEFINE

* Define a class to provide dynamic forecolor effects.

DEFINE CLASS DynamicForeColorEffect AS UserEffectHandler
	cEffectName = 'FORECOLOR'

* Evaluate the expression. If the result is a numeric value and doesn't match
* the existing color of the object, change the object's color and set the
* Reload flag to .T.

	FUNCTION Execute(toObjProperties, tcExpression)
		LOCAL lnColor, ;
			lnPenRed, ;
			lnPenGreen, ;
			lnPenBlue
		lnColor = THIS.EvaluateExpression(tcExpression)
		IF VARTYPE(lnColor) = 'N'
			lnPenRed   = BITAND(lnColor, 0x0000FF)
			lnPenGreen = BITRSHIFT(BITAND(lnColor, 0x00FF00),  8)
			lnPenBlue  = BITRSHIFT(BITAND(lnColor, 0xFF0000), 16)
			WITH toObjProperties
				IF .PenRed <> lnPenRed OR ;
						.PenGreen <> lnPenGreen OR ;
						.PenBlue <> lnPenBlue
					.PenRed   = lnPenRed
					.PenGreen = lnPenGreen
					.PenBlue  = lnPenBlue
					.Reload   = .T.
				ENDIF .PenRed <> lnPenRed ...
			ENDWITH
		ENDIF VARTYPE(lnColor) = 'N'
	ENDFUNC
ENDDEFINE

* Define a class to provide dynamic style effects.

DEFINE CLASS DynamicStyleEffect AS UserEffectHandler
	cEffectName = 'STYLE'

* Evaluate the expression. If the result is a numeric value and doesn't match
* the existing style of the object, change the object's style and set the
* Reload flag to .T.

	FUNCTION Execute(toObjProperties, tcExpression)
		LOCAL lnStyle
		lnStyle = THIS.EvaluateExpression(tcExpression)
		WITH toObjProperties
			IF VARTYPE(lnStyle) = 'N' AND .FontStyle <> lnStyle
				.FontStyle = lnStyle
				.Reload    = .T.
			ENDIF VARTYPE(lnStyle) = 'N' ...
		ENDWITH
	ENDFUNC
ENDDEFINE