Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
BindEvent() Why does it not work with the Error-event ?
Message
De
18/12/2007 15:34:09
 
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Divers
Thread ID:
00947460
Message ID:
01276505
Vues:
24
I thought that I had posted this yesterday, but I don't find it today...?

I am trying to establish BINDEVENT() on the error event when goApp.lDevMode = .T.
The aim is to toggle the binding in goApp.lDevMode_Assign

I can't seem to get the binding to take effect.
What am I missing?
I'm on VFP 8.0 SP1

Thank you for your attention and consideration.
Any worthwhile advice will be welcomed and appreciated.
	-	Frank
**************************************************
*-- Class:        oapp (c:\work\classes.vcx)
*-- ParentClass:  container
*-- BaseClass:    container
*-- Time Stamp:   12/18/07 01:21:02 PM
*-- goApp - Global Application Object
*
DEFINE CLASS oapp AS container

	Name = "oapp"
	TabStop = .F.
	*-- Toggles Errors to SET STEP ON
	ldevmode = .F.

	*-- ON("ERROR") in effect during Init - ReadWrite
	conerrorprior = ""

	PROCEDURE this_access
		LPARAMETERS cMember
		*To do: Modify this routine for the Access method
		IF INLIST(cMember,"display","errorist","rpc","sql","tools","variable","watchtime") AND !PEMSTATUS(THIS,cMember,5)
		  THIS.NEWOBJECT(cMember,cMember,THIS.CLASSLIBRARY)
		ENDIF
		RETURN THIS
	ENDPROC


	PROCEDURE ldevmode_assign
		LPARAMETERS vNewVal
		LOCAL lcOnErrorPrior AS STRING
		IF VARTYPE(goApp) <> [O] OR goApp != THIS
		  RELEASE goApp
		  PUBLIC goApp
		  goApp = THIS
		ENDIF

		IF VARTYPE(vNewVal) !=	[L]
		  vNewVal = (6 = MESSAGEBOX("Is it your intent to turn Developer's Error Handler ON?",4+32,"Data type mismatch."))
		ENDIF

		IF vNewVal AND VERSION(2) = 2
		&& Visual FoxPro recompiles the source program before it executes if it is more current than its compiled object program.
		  SET DEVELOPMENT ON
		  lcOnErrorPrior = ON("ERROR")
		  IF UPPER(LEFT(lcOnErrorPrior,14)) != "GOAPP.ERRORIST"
		    THIS.cOnErrorPrior = lcOnErrorPrior
		  ENDIF
		  ON ERROR goApp.Errorist.ErrorHandlerDevMode()
		  BINDEVENT(THIS,"Error",THIS.Errorist,"ErrorHandlerDevMode",2)
		  FOR EACH oObj IN THIS.OBJECTS
		    lcClassName = UPPER(oObj.CLASS)
		    IF lcClassName = "ERRORIST"
		      LOOP
		    ENDIF
		    BINDEVENT(oObj,"Error",THIS.Errorist,"ErrorHandlerDevMode",2)
		  NEXT
		  THIS.lDevMode = .T.
		ELSE
		  SET DEVELOPMENT OFF
		  FOR EACH oObj IN THIS.OBJECTS
		    lcClassName = UPPER(oObj.CLASS)
		    IF lcClassName = "ERRORIST"
		      LOOP
		    ENDIF
		    UNBINDEVENTS(oObj,"Error",THIS.Errorist,"ErrorHandlerDevMode")
		  NEXT
		  lcOnErrorPrior = .cOnErrorPrior
		  IF UPPER(LEFT(lcOnErrorPrior,14)) = "GOAPP.ERRORIST"
		    ON ERROR
		  ELSE
		    ON ERROR &lcOnErrorPrior
		  ENDIF
		  THIS.lDevMode =  .F.
		ENDIF
	ENDPROC


	PROCEDURE Error
		LPARAMETERS nError, cMethod, nLine
*--- A whole bunch of code!
	ENDPROC


	PROCEDURE Init
		IF VERSION(5) >= 800
			SYS(2450,1) 
		ENDIF
		THIS.Instantiated = DATETIME()
	ENDPROC

ENDDEFINE
*
*-- EndDefine: oapp
**************************************************
**************************************************
*-- Class:        tools (c:\work\classes.vcx)
*-- ParentClass:  _basecustom (c:\work\classes.vcx)
*-- BaseClass:    custom
*-- Time Stamp:   12/18/07 01:25:10 PM
*-- Contains various method called by other objects in the VCX.
*
DEFINE CLASS tools AS _basecustom

	Name = "tools"

	*-- Generates an 'Operator/operand type mismatch' (Error 107) - for testing only
	PROCEDURE error_107
		7=.T.
	ENDPROC
	
*-- Error Event
	PROCEDURE Error
		LPARAMETERS nError, cMethod, nLine
		LOCAL liEventCount AS INTEGER
		IF goApp.lDevMode	&& This should never get here!!! It should go to goApp.Errorist.ErrorHandlerDevMode(nError, cMethod, nLine)
		  lnEventCount = AEVENTS(laEvents,THIS)
	  	  _SCREEN.CLS()
		  IF lnEventCount > 0
		    FOR EACH vItem IN laEvents
		      _SCREEN.PRINT(TRANSFORM(vItem) + CHR(13) )
		    NEXT
*!*			Result is:
***********************************
*!*			.F.
*!*			(Object)	&& ... This is a reference to the Errorist object
*!*			ERROR
*!*			ERRORHANDLERDEVMODE
*!*			2
***********************************
*!*			But AEVENTS(laEvents,0) returns zero !!!!
***********************************
		  ELSE
		    _SCREEN.PRINT("'AEVENTS(laEvents,THIS)' Returned Zero" + CHR(13) )
		  ENDIF
		ELSE
		  DODEFAULT(nError, cMethod, nLine)
		ENDIF
		NODEFAULT
	ENDPROC

*-- Init Event
	PROCEDURE Init
		DODEFAULT()
	ENDPROC

ENDDEFINE
*
*-- EndDefine: tools
**************************************************
**************************************************
*-- Class:        errorist (c:\work\classes.vcx)
*-- ParentClass:  _basecustom (c:\work\classes.vcx)
*-- BaseClass:    custom
*-- Time Stamp:   12/17/07 04:26:03 PM
*
DEFINE CLASS errorist AS _basecustom

	Name = "errorist"

	*-- Action choosen by developer during ErrorHandlerDevMode
	idevaction = 0

	*-- ON ERROR routine for developers
	PROCEDURE ErrorHandlerDevMode
		*!*	ErrorHandlerDevMode
		LPARAMETERS nError, cMethod, nLine
*--- A whole bunch of code!
	ENDPROC

	PROCEDURE Error
		LPARAMETERS nError, cMethod, nLine
*--- A whole bunch of code!
	ENDPROC

ENDDEFINE
*
*-- EndDefine: Errorist
**************************************************
Thank you,
- Frank
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform