RESPUESTA A LA PREGUNTA 373 - FOXPRO/VISUAL FOXPRO


**************************************************
*-- Class:        _datanavbtns (c:\vfp98\ffc\_datanav.vcx)
*-- ParentClass:  _container (c:\vfp98\ffc\_base.vcx)
*-- BaseClass:    container
*-- VCR Buttons with Data Checker
*
#INCLUDE "c:\vfp98\ffc\_data.h"
*
DEFINE CLASS _datanavbtns AS _container


	Width = 104
	Height = 24
	BorderWidth = 1
	BackColor = RGB(192,192,192)
	*-- The table to move the record pointer in .
	skiptable = ""
	*-- Whether to enable/disable buttons when first loaded.
	enabledisableoninit = .T.
	Name = "_datanavbtns"


	ADD OBJECT cmdtop AS _commandbutton WITH ;
		Top = 0, ;
		Left = 0, ;
		Height = 24, ;
		Width = 26, ;
		FontBold = .T., ;
		FontName = "Courier New", ;
		FontSize = 11, ;
		Caption = "|<", ;
		TabIndex = 1, ;
		ToolTipText = "Top", ;
		Name = "cmdTop"


	ADD OBJECT cmdprior AS _commandbutton WITH ;
		Top = 0, ;
		Left = 26, ;
		Height = 24, ;
		Width = 26, ;
		FontBold = .T., ;
		FontName = "Courier New", ;
		FontSize = 11, ;
		Caption = "<", ;
		TabIndex = 2, ;
		ToolTipText = "Prior", ;
		Name = "cmdPrior"


	ADD OBJECT cmdnext AS _commandbutton WITH ;
		Top = 0, ;
		Left = 52, ;
		Height = 24, ;
		Width = 26, ;
		FontBold = .T., ;
		FontName = "Courier New", ;
		FontSize = 11, ;
		Caption = ">", ;
		TabIndex = 3, ;
		ToolTipText = "Next", ;
		Name = "cmdNext"


	ADD OBJECT cmdbottom AS _commandbutton WITH ;
		Top = 0, ;
		Left = 78, ;
		Height = 24, ;
		Width = 26, ;
		FontBold = .T., ;
		FontName = "Courier New", ;
		FontSize = 11, ;
		Caption = ">|", ;
		TabIndex = 4, ;
		ToolTipText = "Bottom", ;
		Name = "cmdBottom"


	ADD OBJECT datachecker1 AS _datachecker WITH ;
		Top = 6, ;
		Left = 44, ;
		Height = 15, ;
		Width = 23, ;
		Name = "Datachecker1"


	*-- Called each time the record pointer is moved, basically providing a new event for the class.
	PROCEDURE recordpointermoved
		IF TYPE('_VFP.ActiveForm') = 'O'
			_VFP.ActiveForm.Refresh
		ENDIF
	ENDPROC


	*-- Enables/disables buttons based on record pointer location.
	PROCEDURE enabledisablebuttons
		LOCAL nRec, nTop, nBottom
		IF EMPTY(ALIAS()) OR EOF() && Table empty or no records match a filter
			THIS.SetAll("Enabled", .F.)
			RETURN
		ENDIF

		nRec = RECNO()
		GO TOP
		nTop = RECNO()
		GO BOTTOM
		nBottom = RECNO()
		GO nRec

		DO CASE
			CASE nRec = nTop
				THIS.cmdTop.Enabled = .F.
				THIS.cmdPrior.Enabled = .F.
				THIS.cmdNext.Enabled = .T.
				THIS.cmdBottom.Enabled = .T.
			CASE nRec = nBottom
				THIS.cmdTop.Enabled = .T.
				THIS.cmdPrior.Enabled = .T.
				THIS.cmdNext.Enabled = .F.
				THIS.cmdBottom.Enabled = .F.
			OTHERWISE
				THIS.SetAll("Enabled", .T.)
		ENDCASE
	ENDPROC


	*-- Called before record pointer is moved.
	PROCEDURE beforerecordpointermoved
		IF !EMPTY(This.SkipTable)
			SELECT (This.SkipTable)
		ENDIF
	ENDPROC


	PROCEDURE Error
		Parameters nError, cMethod, nLine

		LOCAL cNewTable, nConflictStatus, lcMsg, lnAnswer 

		DO CASE
			CASE nError = 13 && Alias not found
			*-----------------------------------------------------------
			* If the user tries to move the record pointer when no
			* table is open or when an invalid SkipTable property has been
			* specified, prompt the user for a table to open.
			*-----------------------------------------------------------
				cNewTable = GETFILE('DBF', SELTABLE_LOC, OPEN_LOC)
				IF FILE(cNewTable)
					SELECT 0
					USE (cNewTable)
					This.SkipTable = ALIAS()
				ELSE
					This.SkipTable = ""
				ENDIF
			CASE nError = 1585 
			*-----------------------------------------------------------
			* Update conflict handled by datachecker class.
			*-----------------------------------------------------------
				nConflictStatus = THIS.DataChecker1.CheckConflicts()
				IF nConflictStatus = 2
					WAIT WINDOW CONFLICT_LOC
				ENDIF
			OTHERWISE
			*-----------------------------------------------------------
			* Display information about an unanticipated error.
			*-----------------------------------------------------------
				lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR_LOC + CR_LOC + ;
						MSG_LOC + MESSAGE( )+ CR_LOC + CR_LOC + ;
						PROG_LOC + PROGRAM(1)
				lnAnswer = MESSAGEBOX(lcMsg, 2+48+512)
				DO CASE
					CASE lnAnswer = 3 &&Abort
						CANCEL
					CASE lnAnswer = 4 &&Retry
						RETRY
					OTHERWISE
						RETURN
				ENDCASE
		ENDCASE
	ENDPROC


	PROCEDURE Init
		IF THIS.EnableDisableOnInit
			THIS.EnableDisableButtons
		ENDIF
	ENDPROC


	PROCEDURE cmdtop.Click
		THIS.Parent.BeforeRecordPointerMoved

		GO TOP

		THIS.Parent.RecordPointerMoved
		THIS.Parent.EnableDisableButtons
	ENDPROC


	PROCEDURE cmdtop.Error
		Parameters nError, cMethod, nLine
		This.Parent.Error(nError, cMethod, nLine)
	ENDPROC


	PROCEDURE cmdprior.Click
		THIS.Parent.BeforeRecordPointerMoved

		SKIP -1
		IF BOF()
			GO TOP
		ENDIF

		THIS.Parent.RecordPointerMoved
		THIS.Parent.EnableDisableButtons
	ENDPROC


	PROCEDURE cmdprior.Error
		Parameters nError, cMethod, nLine
		This.Parent.Error(nError, cMethod, nLine)
	ENDPROC


	PROCEDURE cmdnext.Click
		THIS.Parent.BeforeRecordPointerMoved

		SKIP 1
		IF EOF()
			GO BOTTOM
		ENDIF

		THIS.Parent.RecordPointerMoved
		THIS.Parent.EnableDisableButtons
	ENDPROC


	PROCEDURE cmdnext.Error
		Parameters nError, cMethod, nLine
		This.Parent.Error(nError, cMethod, nLine)
	ENDPROC


	PROCEDURE cmdbottom.Click
		THIS.Parent.BeforeRecordPointerMoved

		GO BOTTOM

		THIS.Parent.EnableDisableButtons
		THIS.Parent.RecordPointerMoved
	ENDPROC


	PROCEDURE cmdbottom.Error
		Parameters nError, cMethod, nLine
		This.Parent.Error(nError, cMethod, nLine)
	ENDPROC


ENDDEFINE
*
*-- EndDefine: _datanavbtns
**************************************************


Pedro Mateo Arias
pedromateoa@hotmail.com

http://www.lawebdelprogramador.com