224 lines
6.6 KiB
Plaintext
224 lines
6.6 KiB
Plaintext
* 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
|