Import initial din SVN ROAAUTO/Trunk @HEAD
This commit is contained in:
223
COMUN/programe/Reports/DynamicFormatting.prg
Normal file
223
COMUN/programe/Reports/DynamicFormatting.prg
Normal file
@@ -0,0 +1,223 @@
|
||||
* 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
|
||||
Reference in New Issue
Block a user