Usando -e3 -es2

Mensagem por **JoséQuintas** » 29 Mai 2019 12:58

Pronto.
Poderia usar o HB_SYMBOL_UNUSED, ou HB_UNUSED_SYMBOL, mas sempre me confundo.
IF .F. resolve, porque faz uso da variável e não faz nada.
Porque não retirei? Teria que analisar isso, talvez até comparar a GETSYS com a original pra ver se isso existe....
Assim resolve.

Mensagem por **JoséQuintas** » 29 Mai 2019 12:59

A getsys após correções.

Código: Selecionar todos

/***
*
*  Getsys.prg
*
*  Standard Clipper 5.2 GET/READ Subsystem
*
*  Copyright (c) 1991-1993, Computer Associates International, Inc.
*  All rights reserved.
*
*  This version adds the following public functions:
*
*	 ReadKill( [<lKill>] )	    --> lKill
*	 ReadUpdated( [<lUpdated>] ) --> lUpdated
*	 ReadFormat( [<bFormat>] )   --> bFormat | NIL
*
*  NOTE: compile with /m /n /w
*
*/

#include "Inkey.ch"
#include "Getexit.ch"

STATIC snMRow, snMCol
STATIC  nMRow,  nMCol

/***
*  Nation Message Constants
*  These constants are used with the NationMsg(<msg>) function.
*  The <msg> parameter can range from 1-12 and returns the national
*  version of the system message.
*/
#define _GET_INSERT_ON	7	 // "Ins"
#define _GET_INSERT_OFF	8	 // "   "
#define _GET_INVD_DATE	9	 // "Invalid Date"
#define _GET_RANGE_FROM	10	 // "Range: "
#define _GET_RANGE_TO	11	 // " - "

#define K_UNDO		    K_CTRL_U


//
// State variables for active READ
//
STATIC sbFormat
STATIC slUpdated := .F.
STATIC slKillRead
STATIC slBumpTop
STATIC slBumpBot
STATIC snLastExitState
STATIC snLastPos
STATIC soActiveGet
STATIC scReadProcName
STATIC snReadProcLine
STATIC nKey2
STATIC GetMsg
STATIC PosMsg

//
// Format of array used to preserve state variables
//
#define GSV_KILLREAD	  1
#define GSV_BUMPTOP		  2
#define GSV_BUMPBOT		  3
#define GSV_LASTEXIT	  4
#define GSV_LASTPOS		  5
#define GSV_ACTIVEGET	  6
#define GSV_READVAR		  7
#define GSV_READPROCNAME   8
#define GSV_READPROCLINE   9

#define GSV_COUNT		  9



/***
*
*  ReadModal()
*
*  Standard modal READ on an array of GETs
*
*/
FUNCTION ReadModal( GetList, nPos )
LOCAL oGet, nI
LOCAL aSavGetSysVars

GetMsg := {}
PosMsg := nPos
nKey2  := SPACE(0)

FOR nI := 1 TO LEN(GetList)
   IF VALTYPE(GetList[nI])<>"O"
	 AADD(GetMsg ,GetList[nI,2])
	 GetList[nI] := GetList[nI,1]
   ELSE
	 AADD(GetMsg ,)
   ENDIF
NEXT

   IF ( VALTYPE( sbFormat ) == "B" )
	 EVAL( sbFormat )
   ENDIF

   IF ( EMPTY( GetList ) )

	 // S'87 compatibility
	 SETPOS( MAXROW() - 1, 0 )
	 RETURN (.F.)				 // NOTE

   ENDIF

   // Preserve state variables
   aSavGetSysVars := ClearGetSysVars()

   // Set these for use in SET KEYs
   scReadProcName := PROCNAME( 1 )
   snReadProcLine := PROCLINE( 1 )

   // Set initial GET to be read
   IF !( VALTYPE( nPos ) == "N" .AND. nPos > 0 )
	 nPos := Settle( Getlist, 0 )
	 PosMsg:=nPos
   ENDIF

   WHILE !( nPos == 0 )

	 // Get next GET from list and post it as the active GET
	 PostActiveGet( oGet := GetList[ nPos ] )

	 // Read the GET
	 IF ( VALTYPE( oGet:reader ) == "B" )
	    EVAL( oGet:reader, oGet )    // Use custom reader block
	 ELSE
	    GetReader( oGet )		   // Use standard reader
	 ENDIF

	 // Move to next GET based on exit condition
	 nPos := Settle( GetList, nPos )
	 PosMsg:=nPos

   ENDDO


   // Restore state variables
   RestoreGetSysVars( aSavGetSysVars )

   // S'87 compatibility
   SETPOS( MAXROW() - 1, 0 )

   RETURN ( slUpdated )



/***
*
*  GetReader()
*
*  Standard modal read of a single GET
*
*/
PROCEDURE GetReader( oGet )
LOCAL lRestaura := .F.
PRIVATE cGetMsg, nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2
   // Read the GET if the WHEN condition is satisfied

   IF ( GetPreValidate( oGet ) )

	 // Activate the GET for reading
	 oGet:setFocus()

	 WHILE ( oGet:exitState == GE_NOEXIT )

	    // Check for initial typeout (no editable positions)
	    IF ( oGet:typeOut )
		  oGet:exitState := GE_ENTER
	    ENDIF

	    // Apply keystrokes until exit
	    IF ( oGet:type == "N" )
		  oGet:pos    := oGet:decPos()-1
		  oGet:display()
	    ENDIF
	    SETPOS(oGet:row,oGet:col)
	    WHILE ( oGet:exitState == GE_NOEXIT )
		  IF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos )
			oGet:pos	  := oGet:decPos()-1
			oGet:display()
		  ENDIF
			GetApplyKey( oGet, INKEY(0)) // minkey( 0, @snMrow, @snMCol ) )
	    ENDDO

	    // Disallow exit if the VALID condition is not satisfied
	    IF ( !GetPostValidate( oGet ) )
		  oGet:exitState := GE_NOEXIT
	    ENDIF
	 ENDDO

	 // De-activate the GET
	 oGet:killFocus()

   ENDIF
   IF lRestaura
   ENDIF

   RETURN



/***
*
*  GetApplyKey()
*
*  Apply a single INKEY() keystroke to a GET
*
*  NOTE: GET must have focus.
*
*/
PROCEDURE GetApplyKey( oGet, nKey )

   LOCAL cKey, nTmp, lIns
   LOCAL bKeyBlock
   LOCAL nTemp
   LOCAL lTmp, lDec, lDec0

   // Check for SET KEY first
   IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
	 GetDoSetKey( bKeyBlock, oGet )
	 RETURN					    // NOTE
   ENDIF

   DO CASE
// CASE ( nKey == 45 ) .AND. SUBSTR(oGet:buffer,oGet:decPos()-1,1) == "0"
//	    oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-2)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-1)
//	    oGet:display()
   CASE ( nKey == K_UP )
	 oGet:exitState := GE_UP

   CASE ( nKey == K_SH_TAB )
	 oGet:exitState := GE_UP

   CASE ( nKey == K_DOWN )
	 oGet:exitState := GE_DOWN

   CASE ( nKey == K_TAB )
	 oGet:exitState := GE_DOWN

   CASE ( nKey == K_ENTER )
	 oGet:changed := .T.
	 oGet:exitState := GE_ENTER
	 nKey2 := SPACE(0)

   CASE ( nKey == K_ESC )
	 IF ( SET( _SET_ESCAPE ) )
	    oGet:undo()
	    oGet:exitState := GE_ESCAPE

	 ENDIF

   CASE ( nKey == K_PGUP )
	 oGet:exitState := GE_WRITE

   CASE ( nKey == K_PGDN )
	 oGet:exitState := GE_WRITE

   CASE ( nKey == K_CTRL_HOME )
	 oGet:exitState := GE_TOP


#ifdef CTRL_END_SPECIAL

   // Both ^W and ^End go to the last GET
   CASE ( nKey == K_CTRL_END )
	 oGet:exitState := GE_BOTTOM

#else

   // Both ^W and ^End terminate the READ (the default)
   CASE ( nKey == K_CTRL_W )
	 oGet:exitState := GE_WRITE

#endif


   CASE ( nKey == K_INS )
	 SET( _SET_INSERT, !SET( _SET_INSERT ) )
	 ShowScoreboard()

   CASE ( nKey == K_UNDO )
	 oGet:undo()

   CASE ( nKey == K_HOME )
	 oGet:home()

   CASE ( nKey == K_END )
	 oGet:end()

   CASE ( nKey == K_RIGHT )
	 oGet:right()
	 nKey2 := SPACE(0)

   CASE ( nKey == K_LEFT )
	 oGet:left()
	 nKey2 := SPACE(0)

   CASE ( nKey == K_CTRL_RIGHT )
	 oGet:wordRight()
	 nKey2 := SPACE(0)

   CASE ( nKey == K_CTRL_LEFT )
	 oGet:wordLeft()
	 nKey2 := SPACE(0)

   CASE ( nKey == K_BS ) .OR. ((nKey == K_DEL) .AND. (oGet:type =="N"))
	 IF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos )
	    IF AT(".",oGet:buffer) <> 0 .OR. AT(",",oGet:buffer) <> 0
		  oGet:pos    := oGet:decPos()-1
		  nTemp := oGet:unTransform()
		  nTemp := (nTemp-INT(nTemp)) + INT(nTemp / 10)
	    ELSE
		  oGet:pos    := oGet:decPos()-1
		  oGet:delete()
		  nTemp := oGet:unTransform()
	    ENDIF
	    oGet:buffer := Transform(nTemp,oGet:picture)
	    oGet:pos	 := oGet:decPos()-1
	    oGet:display()
	 ELSE
	    IF (oGet:type="N").AND.(oGet:pos=oGet:decPos+1).AND.(nKey<>K_DEL)
		   oGet:pos := oGet:decPos()-1
		   KEYBOARD CHR( K_BS )
	    ELSE
		   IF ( nKey == K_DEL )
			 oGet:delete()
		   ELSE
			 oGet:backSpace()
		   ENDIF
		   oGet:display()
	   ENDIF
	 ENDIF
   CASE ( nKey == K_DEL )
	 oGet:delete()

   CASE ( nKey == K_CTRL_T )
	 oGet:delWordRight()

   CASE ( nKey == K_CTRL_Y )
	 IF oGet:type == "N"
	    nTmp := oGet:pos
	    oGet:pos	 := 01
	    oGet:delEnd()
	    oGet:pos	 := nTmp
	    oGet:display()
	 ELSE
	    oGet:delEnd()
	 ENDIF

   CASE ( nKey == K_CTRL_BS )
	 oGet:delWordLeft()


   OTHERWISE
	 lIns  := .T.

	 IF ( nKey >= 32 .AND. nKey <= 255 )

	    IF ! EMPTY(nKey2) .AND.  oGet:type == "C"
		   lIns := Acentos(oGet, nKey2, @nKey)
		   nKey2 := SPACE(0)
	    ENDIF

	    cKey := CHR( nKey )

	    IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
		  lTmp := AT("-",oGet:buffer) <> 0
		  IF oGet:Clear
			oGet:buffer := Transform(0,oGet:picture)
		  ENDIF
		  oGet:toDecPos()
		  IF lTmp .AND. AT("-",oGet:buffer) == 0
			oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-2)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-1)
			oGet:buffer := SUBSTR(oGet:buffer,2)
		  ENDIF
		  oGet:display()
	    ELSEIF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos ) .AND. ;
	    ((nKey >= ASC('0') .AND. nKey <= ASC('9')) .OR. UPPER(CHR(nKey))="C";
					   .OR.  nKey == ASC('+')  .OR.  nKey == ASC('-'))
		  nTemp := oGet:unTransform()
		  IF UPPER(cKey) == "C" .OR. oGet:clear
			oGet:clear := .F.
			nTemp = 0
			oGet:buffer := Transform(nTemp,oGet:picture)
			oGet:display()
		  ENDIF
		  lDec := AT(".",Transform(0,oGet:picture))
		  IF(lDec==0,lDec := AT(",",Transform(0,oGet:picture)),lDec)
		  lDec0 := IF(lDec<>0,IF(LEN(oGet:buffer) > (lDec+1),.T.,.F.),.T.)
		  lDec  := IF(lDec<>0,.T.,.F.)
		  IF(oGet:picture==NIL,lDec0:=.T.,)

		  IF LEN((oGet:buffer)) >= (LEN(ALLTRIM(oGet:buffer))+1)
			IF oGet:type == "N" .AND. cKey == "-"
			   nKey2 := ASC("-")
			ELSE
			   lTmp  := AT("-",oGet:buffer) <> 0
			   nTemp := (nTemp-INT(nTemp)) + INT(nTemp * 10)
			   oGet:buffer := Transform(nTemp,oGet:picture)
			   IF nTemp = 0 .AND. lTmp
				 IF LEN(oGet:buffer) < oGet:decPos() .and. 1 = 2
				    oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-3)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-2)
				    oGet:buffer := SUBSTR(oGet:buffer,2)
				 ELSE
				    oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-IF(lDec0,2,3))+"-"+SUBSTR(oGet:buffer,oGet:decPos()-IF(lDec0,1,2))
				    oGet:buffer := SUBSTR(oGet:buffer,2)
				 ENDIF
			   ENDIF																					 //2   1
			   oGet:pos	:= oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. LEN(oGet:buffer) < oGet:decPos(),2,1),0)
			   oGet:overstrike( cKey )																	 //2   1
			   oGet:pos	:= oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. LEN(oGet:buffer) < oGet:decPos(),2,1),0)
			ENDIF
			IF VALTYPE(nKey2) == "N" .AND. cKey == "-"
			   lTmp  := AT("-",oGet:buffer) == 0
			   nTemp := oGet:unTransform()
			   nTemp *= (-1)
			   oGet:buffer := Transform(nTemp,oGet:picture)
			   IF nTemp = 0 .AND. lTmp
				 IF LEN(oGet:buffer) < oGet:decPos() .and. 1 = 2
				    oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-3)+"-"+SUBSTR(oGet:buffer,oGet:decPos()-2)
				    oGet:buffer := SUBSTR(oGet:buffer,2)
				 ELSE
				    oGet:buffer := SUBSTR(oGet:buffer,1,oGet:decPos()-IF(lDec0,2,3))+"-"+SUBSTR(oGet:buffer,oGet:decPos()-IF(lDec0,1,2))
				    oGet:buffer := SUBSTR(oGet:buffer,2)
				 ENDIF
			   ENDIF
			ENDIF
			IF VALTYPE(nKey2) == "N"
			   nKey2 := SPACE(0)
			ENDIF
			oGet:display()
			IF LEN(SUBSTR(oGet:buffer,1,oGet:decpos-1))==LEN(ALLTRIM(SUBSTR(oGet:buffer,1,oGet:decpos-1))) .AND. (!SET(_SET_CONFIRM))
			   oGet:exitstate:=GE_ENTER
			ENDIF
		  ELSEIF LEN(SUBSTR(oGet:buffer,1,oGet:decpos-1)) == 1 .AND. (oGet:pos < oGet:decPos )
			oGet:overstrike(cKey)
			oGet:pos := oGet:decPos()
			oGet:display()
			IF LEN(SUBSTR(oGet:buffer,1,oGet:decpos-1))==1 .AND. (!SET(_SET_CONFIRM))
			   oGet:exitstate:=GE_ENTER
			ENDIF
		  ELSE
			IF ( !SET( _SET_CONFIRM ) )
			   oGet:exitState := GE_ENTER
			ELSE
			   ?? CHR(7)
			ENDIF

		  ENDIF
		  IF oGet:type == "N" .AND. cKey == "-"
			nKey2 := nKey
		  ENDIF
	    ELSE

		  IF ( SET( _SET_INSERT ) ) .AND. lIns
			oGet:insert( cKey )
		  ELSE
			oGet:overstrike( cKey )
		  ENDIF
		  IF ( oGet:type == "C")
			IF EMPTY(nKey2) .AND. (nKey=126 .OR. nKey=39 .OR. nKey=96 .OR. nKey=34 .OR. nKey=94 .OR. nKey=46)
			   nKey2 := nKey
			   oGet:left()
			ELSE
			   nKey2 := SPACE(0)
			ENDIF
		  ENDIF

		  IF ( oGet:typeOut )
			IF ( SET( _SET_BELL ) )
			   ?? CHR(7)
			ENDIF

			IF ( !SET( _SET_CONFIRM ) )
			   oGet:exitState := GE_ENTER
			ENDIF
		  ENDIF

	    ENDIF

	 ENDIF

   ENDCASE
   oGet:changed := .T.

   RETURN



/***
*
*  GetPreValidate()
*
*  Test entry condition (WHEN clause) for a GET
*
*/
FUNCTION GetPreValidate( oGet )

   LOCAL lSavUpdated
   LOCAL lWhen := .T.

   IF !( oGet:preBlock == NIL )

	 lSavUpdated := slUpdated

	 lWhen := EVAL( oGet:preBlock, oGet )

	 oGet:display()

	 ShowScoreBoard()
	 slUpdated := lSavUpdated

   ENDIF

   IF ( slKillRead )

	 lWhen := .F.
	 oGet:exitState := GE_ESCAPE		// Provokes ReadModal() exit

   ELSEIF ( !lWhen )

	 oGet:exitState := GE_WHEN		// Indicates failure

   ELSE

	 oGet:exitState := GE_NOEXIT		// Prepares for editing

   END

   RETURN ( lWhen )



/***
*
*  GetPostValidate()
*
*  Test exit condition (VALID clause) for a GET
*
*  NOTE: Bad dates are rejected in such a way as to preserve edit buffer
*
*/
FUNCTION GetPostValidate( oGet )

   LOCAL lSavUpdated
   LOCAL lValid := .T.


   IF ( oGet:exitState == GE_ESCAPE )
	 RETURN ( .T. )			    // NOTE
   ENDIF

   IF ( oGet:badDate() )
	 oGet:home()
	 DateMsg()
	 ShowScoreboard()
	 RETURN ( .F. )			    // NOTE
   ENDIF

   // If editing occurred, assign the new value to the variable
   IF ( oGet:changed )
	 oGet:assign()
	 slUpdated := .T.
   ENDIF

   // Reform edit buffer, set cursor to home position, redisplay
   oGet:reset()

   // Check VALID condition if specified
   IF !( oGet:postBlock == NIL )

	 lSavUpdated := slUpdated

	 // S'87 compatibility
	 SETPOS( oGet:row, oGet:col + LEN( oGet:buffer ) )

	 lValid := EVAL( oGet:postBlock, oGet )

	 // Reset S'87 compatibility cursor position
	 SETPOS( oGet:row, oGet:col )

	 ShowScoreBoard()
	 oGet:updateBuffer()

	 slUpdated := lSavUpdated

	 IF ( slKillRead )
	    oGet:exitState := GE_ESCAPE	  // Provokes ReadModal() exit
	    lValid := .T.

	 ENDIF
   ENDIF

   RETURN ( lValid )



/***
*
*  GetDoSetKey()
*
*  Process SET KEY during editing
*
*/
PROCEDURE GetDoSetKey( keyBlock, oGet )

   LOCAL lSavUpdated

   // If editing has occurred, assign variable
   IF ( oGet:changed )
	 oGet:assign()
	 slUpdated := .T.
   ENDIF

   lSavUpdated := slUpdated

   EVAL( keyBlock, scReadProcName, snReadProcLine, ReadVar() )

   ShowScoreboard()
   oGet:updateBuffer()

   slUpdated := lSavUpdated

   IF ( slKillRead )
	 oGet:exitState := GE_ESCAPE	    // provokes ReadModal() exit
   ENDIF

   RETURN





/***
*			READ services
*/



/***
*
*  Settle()
*
*  Returns new position in array of Get objects, based on:
*	 - current position
*	 - exitState of Get object at current position
*
*  NOTES: return value of 0 indicates termination of READ
*		exitState of old Get is transferred to new Get
*
*/
STATIC FUNCTION Settle( GetList, nPos )

   LOCAL nExitState

   IF ( nPos == 0 )
	 nExitState := GE_DOWN
   ELSE
	 nExitState := GetList[ nPos ]:exitState
   ENDIF

   IF ( nExitState == GE_ESCAPE .or. nExitState == GE_WRITE )
	 RETURN ( 0 )			   // NOTE
   ENDIF

   IF !( nExitState == GE_WHEN )
	 // Reset state info
	 snLastPos := nPos
	 slBumpTop := .F.
	 slBumpBot := .F.
   ELSE
	 // Re-use last exitState, do not disturb state info
	 nExitState := snLastExitState
   ENDIF

   //
   // Move
   //
   DO CASE
   CASE ( nExitState == GE_UP )
	 nPos--

   CASE ( nExitState == GE_DOWN )
	 nPos++

   CASE ( nExitState == GE_TOP )
	 nPos	  := 1
	 slBumpTop  := .T.
	 nExitState := GE_DOWN

   CASE ( nExitState == GE_BOTTOM )
	 nPos	  := LEN( GetList )
	 slBumpBot  := .T.
	 nExitState := GE_UP

   CASE ( nExitState == GE_ENTER )
	 nPos++

   ENDCASE

   //
   // Bounce
   //
   IF ( nPos == 0 )					  // Bumped top
	 IF ( !ReadExit() .and. !slBumpBot )
	    slBumpTop	:= .T.
	    nPos		:= snLastPos
	    nExitState := GE_DOWN
	 ENDIF

   ELSEIF ( nPos == len( GetList ) + 1 )  // Bumped bottom
	 IF ( !ReadExit() .and. !( nExitState == GE_ENTER ) .and. !slBumpTop )
	    slBumpBot	:= .T.
	    nPos		:= snLastPos
	    nExitState := GE_UP
	 ELSE
	    nPos := 0
	 ENDIF
   ENDIF

   // Record exit state
   snLastExitState := nExitState

   IF !( nPos == 0 )
	 GetList[ nPos ]:exitState := nExitState
   ENDIF

   RETURN ( nPos )



/***
*
*  PostActiveGet()
*
*  Post active GET for ReadVar(), GetActive()
*
*/
STATIC PROCEDURE PostActiveGet( oGet )

   GetActive( oGet )
   ReadVar( GetReadVar( oGet ) )

   ShowScoreBoard()

   RETURN



/***
*
*  ClearGetSysVars()
*
*  Save and clear READ state variables. Return array of saved values
*
*  NOTE: 'Updated' status is cleared but not saved (S'87 compatibility)
*/
STATIC FUNCTION ClearGetSysVars()

   LOCAL aSavSysVars[ GSV_COUNT ]

   // Save current sys vars
   aSavSysVars[ GSV_KILLREAD ]	:= slKillRead
   aSavSysVars[ GSV_BUMPTOP ]		:= slBumpTop
   aSavSysVars[ GSV_BUMPBOT ]		:= slBumpBot
   aSavSysVars[ GSV_LASTEXIT ]	:= snLastExitState
   aSavSysVars[ GSV_LASTPOS ]		:= snLastPos
   aSavSysVars[ GSV_ACTIVEGET ]	:= GetActive( NIL )
   aSavSysVars[ GSV_READVAR ]		:= ReadVar( "" )
   aSavSysVars[ GSV_READPROCNAME ] := scReadProcName
   aSavSysVars[ GSV_READPROCLINE ] := snReadProcLine

   // Re-init old ones
   slKillRead	    := .F.
   slBumpTop	    := .F.
   slBumpBot	    := .F.
   snLastExitState := 0
   snLastPos	    := 0
   scReadProcName  := ""
   snReadProcLine  := 0
   slUpdated	    := .F.

   RETURN ( aSavSysVars )



/***
*
*  RestoreGetSysVars()
*
*  Restore READ state variables from array of saved values
*
*  NOTE: 'Updated' status is not restored (S'87 compatibility)
*
*/
STATIC PROCEDURE RestoreGetSysVars( aSavSysVars )

   slKillRead	    := aSavSysVars[ GSV_KILLREAD ]
   slBumpTop	    := aSavSysVars[ GSV_BUMPTOP ]
   slBumpBot	    := aSavSysVars[ GSV_BUMPBOT ]
   snLastExitState := aSavSysVars[ GSV_LASTEXIT ]
   snLastPos	    := aSavSysVars[ GSV_LASTPOS ]

   GetActive( aSavSysVars[ GSV_ACTIVEGET ] )

   ReadVar( aSavSysVars[ GSV_READVAR ] )

   scReadProcName  := aSavSysVars[ GSV_READPROCNAME ]
   snReadProcLine  := aSavSysVars[ GSV_READPROCLINE ]

   RETURN



/***
*
*  GetReadVar()
*
*  Set READVAR() value from a GET
*
*/
STATIC FUNCTION GetReadVar( oGet )

   LOCAL cName := UPPER( oGet:name )
   LOCAL i

   // The following code includes subscripts in the name returned by
   // this FUNCTIONtion, if the get variable is an array element
   //
   // Subscripts are retrieved from the oGet:subscript instance variable
   //
   // NOTE: Incompatible with Summer 87
   //
   IF !( oGet:subscript == NIL )
	 FOR i := 1 TO LEN( oGet:subscript )
	    cName += "[" + LTRIM( STR( oGet:subscript[i] ) ) + "]"
	 NEXT
   END

   RETURN ( cName )





/***
*			System Services
*/



/***
*
*  __SetFormat()
*
*  SET FORMAT service
*
*/
PROCEDURE __SetFormat( b )
   sbFormat := IF( VALTYPE( b ) == "B", b, NIL )
   RETURN



/***
*
*  __KillRead()
*
*  CLEAR GETS service
*
*/
PROCEDURE __KillRead()
   slKillRead := .T.
   RETURN



/***
*
*  GetActive()
*
*  Retrieves currently active GET object
*/
FUNCTION GetActive( g )

   LOCAL oldActive := soActiveGet

   IF ( PCOUNT() > 0 )
	 soActiveGet := g
   ENDIF

   RETURN ( oldActive )



/***
*
*  Updated()
*
*/
FUNCTION Updated()
   RETURN slUpdated



/***
*
*  ReadExit()
*
*/
FUNCTION ReadExit( lNew )
   RETURN ( SET( _SET_EXIT, lNew ) )



/***
*
*  ReadInsert()
*
*/
FUNCTION ReadInsert( lNew )
   RETURN ( SET( _SET_INSERT, lNew ) )



/***
*			Wacky Compatibility Services
*/


// Display coordinates for SCOREBOARD
#define SCORE_ROW	   0
#define SCORE_COL	   60


/***
*
*  ShowScoreboard()
*
*/
STATIC PROCEDURE ShowScoreboard()

   LOCAL nRow
   LOCAL nCol

   IF ( SET( _SET_SCOREBOARD ) )
	 nRow := ROW()
	 nCol := COL()

	 SETPOS( SCORE_ROW, SCORE_COL )
	 DISPOUT( IF( SET( _SET_INSERT ), NationMsg(_GET_INSERT_ON),;
							NationMsg(_GET_INSERT_OFF)) )
	 SETPOS( nRow, nCol )
   ENDIF

   RETURN



/***
*
*  DateMsg()
*
*/
STATIC PROCEDURE DateMsg()

   LOCAL nRow
   LOCAL nCol

   IF ( SET( _SET_SCOREBOARD ) )

	 nRow := ROW()
	 nCol := COL()

	 SETPOS( SCORE_ROW, SCORE_COL )
	 DISPOUT( NationMsg(_GET_INVD_DATE) )
	 SETPOS( nRow, nCol )

	 WHILE ( NEXTKEY() == 0 )
	 END

	 SETPOS( SCORE_ROW, SCORE_COL )
	 DISPOUT( SPACE( LEN( NationMsg(_GET_INVD_DATE) ) ) )
	 SETPOS( nRow, nCol )

   ENDIF

   RETURN



/***
*
*  RangeCheck()
*
*  NOTE: Unused second param for 5.00 compatibility.
*
*/
FUNCTION RangeCheck( oGet, junk, lo, hi )

   LOCAL cMsg, nRow, nCol
   LOCAL xValue

   IF .F.
      ? Junk
   ENDIF

   IF ( !oGet:changed )
	 RETURN ( .T. )		// NOTE
   ENDIF

   xValue := oGet:varGet()

   IF ( xValue >= lo .and. xValue <= hi )
	 RETURN ( .T. )		// NOTE
   ENDIF

   IF ( SET(_SET_SCOREBOARD) )

	 cMsg := NationMsg(_GET_RANGE_FROM) + LTRIM( TRANSFORM( lo, "" ) ) + ;
		    NationMsg(_GET_RANGE_TO) + LTRIM( TRANSFORM( hi, "" ) )

	 IF ( LEN( cMsg ) > MAXCOL() )
	    cMsg := SUBSTR( cMsg, 1, MAXCOL() )
	 ENDIF

	 nRow := ROW()
	 nCol := COL()

	 SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
	 DISPOUT( cMsg )
	 SETPOS( nRow, nCol )

	 WHILE ( NEXTKEY() == 0 )
	 END

	 SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
	 DISPOUT( SPACE( LEN( cMsg ) ) )
	 SETPOS( nRow, nCol )

   ENDIF

   RETURN ( .F. )



/***
*
*  ReadKill()
*
*/
FUNCTION ReadKill( lKill )

   LOCAL lSavKill := slKillRead

   IF ( PCOUNT() > 0 )
	 slKillRead := lKill
   ENDIF

   RETURN ( lSavKill )



/***
*
*  ReadUpdated()
*
*/
FUNCTION ReadUpdated( lUpdated )

   LOCAL lSavUpdated := slUpdated

   IF ( PCOUNT() > 0 )
	 slUpdated := lUpdated
   ENDIF

   RETURN ( lSavUpdated )



/***
*
*  ReadFormat()
*
*/
FUNCTION ReadFormat( b )

   LOCAL bSavFormat := sbFormat

   IF ( PCOUNT() > 0 )
	 sbFormat := b
   ENDIF

   RETURN ( bSavFormat )

**********************************************************************
FUNCTION Mensagem1(nLinh,cTexto,cCor)
LOCAL nCol,nLargJan
    nLargJan := LEN(cTexto)
 IF nLargJan < 10
    nLargJan := 10
 ENDIF
nCol := (80 -nLargJan)/2
  @ nLinh,nCol CLEAR TO nLinh,nCol + nLargJan
  @ nLinh,nCol SAY cTexto COLOR cCor
RETURN NIL
**********************************************************************


// "Ž„ …†ƒ€‡‚ˆ‰Š¡‹Œ“¢™”•£š–¦§"

FUNCTION Acentos(oGet,nKey2,nKey)
LOCAL lIns := .F., nKey3
nKey2 := CHR(nKey2)
nKey3 := nKey
nKey  := CHR(nKey )
IF nKey2 == "~"
   IF	nKey=="A" ; nKey:="Ž"
   ELSEIF nKey=="O" ; nKey:="™"
   ELSEIF nKey=="a" ; nKey:="„"
   ELSEIF nKey=="o" ; nKey:="”"
   ELSE  ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "'"
   IF	nKey=="A" ; nKey:=""
   ELSEIF nKey=="E" ; nKey:=""
   ELSEIF nKey=="a" ; nKey:=" "
   ELSEIF nKey=="e" ; nKey:="‚"
   ELSEIF nKey=="i" ; nKey:="¡"
   ELSEIF nKey=="o" ; nKey:="¢"
   ELSEIF nKey=="u" ; nKey:="£"
   ELSEIF nKey=="C" ; nKey:="€"
   ELSEIF nKey=="c" ; nKey:="‡"
   ELSE  ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "`"
   IF	nKey=="a" ; nKey:="…"
   ELSEIF nKey=="e" ; nKey:="Š"
   ELSEIF nKey=="i" ; nKey:=""
   ELSEIF nKey=="o" ; nKey:="•"
   ELSE  ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "^"
   IF	nKey=="a" ; nKey:="ƒ"
   ELSEIF nKey=="e" ; nKey:="ˆ"
   ELSEIF nKey=="i" ; nKey:="Œ"
   ELSEIF nKey=="o" ; nKey:="“"
   ELSEIF nKey=="u" ; nKey:="–"
   ELSE  ; lIns := .T. ; ENDIF
ELSEIF nKey2 == "."
   IF	nKey=="a" ; nKey:="¦"
   ELSEIF nKey=="o" ; nKey:="§"
   ELSE  ; lIns := .T. ; ENDIF
ENDIF
nKey2 := ASC(nKey2)
nKey  := ASC(nKey )
IF nKey3 == nKey
   oGet:right()
ENDIF
RETURN lIns

***************************************************************************

FUNCTION _INKEY(nTempo,lTrava)
LOCAL nKey, nTime := SECONDS()
lTrava:=IF(lTrava==NIL,.F.,.T.)
IF lTrava .AND. nTempo <> NIL .AND. nTempo <> 0
   WHILE IF (nTempo > 0, (SECONDS() - nTime) < nTempo, .T.)
   ENDDO
   nKey := LASTKEY()
ELSE
   nKey :=  INKEY(0) // Minkey(nTempo, @nMRow, @nMCol, .T.)
ENDIF
RETURN (nKey)


***************************************************************************

FUNCTION AJUDADECAMPOATIVA( oGet )
LOCAL nROW := ROW(), nCOL := COL(), nCURSOR := SETCURSOR(), cCOR := SETCOLOR()
LOCAL GetMensg := GetMsg[PosMsg], nCALCULO, nPOSOGET
LOCAL nPOS1 := AT("|",GetMensg), nPOS2, cVAR[3], nTAMAJU
LOCAL nColAju1, nColAju2, nLinAju1, nLinAju2
IF nPOS1 # 0
   cVAR[1] := SUBSTR(GetMensg,1,nPOS1-1)
   GetMensg := SUBSTR(GetMensg,nPOS1+1,LEN(GetMensg))
ELSE
   cVAR[1] := GetMensg
   GetMensg := SPACE(0)
ENDIF
nPOS2 := AT("|",GetMensg)
IF nPOS2 # 0
   cVAR[2] := SUBSTR(GetMensg,1,nPOS2-1)
   GetMensg := SUBSTR(GetMensg,nPOS2+1,LEN(GetMensg))
   cVAR[3] := GetMensg
ELSEIF nPOS2 == 0 .AND. !EMPTY(GetMensg)
   cVAR[2] := GetMensg
ENDIF
IF cVAR[3] # NIL
   nCALCULO := 4
ELSEIF cVAR[3] == NIL .AND. cVAR[2] # NIL
   nCALCULO := 3
ELSE
   nCALCULO := 2
ENDIF
nTAMAJU := LenLargura( cVAR )
nPOSOGET := oGet:col + 4
IF nPOSOGET+4+nTAMAJU > 79
   DO WHIL .T.
	 nPOSOGET--
	 IF nPOSOGET+4+nTAMAJU <= 79
	    EXIT
	 ENDIF
   ENDDO
ENDIF
nCOLAJU1 := nPOSOGET
nCOLAJU2 := nPOSOGET+nTAMAJU
IF oGet:row+1+nCALCULO > 24
   nLINAJU1 := oGet:row-1-nCALCULO
   nLINAJU2 := oGet:row-1
ELSE
   nLINAJU1 := oGet:row+1
   nLINAJU2 := oGet:row+1+nCALCULO
ENDIF
//cGetMsg := SAVESCREEN(nLINAJU1,nCOLAJU1-2,nLINAJU2+1,nCOLAJU2+3)
@ nLINAJU1,nCOLAJU1 TO nLINAJU2,nCOLAJU2+3
@ nLINAJU1+1,nCOLAJU1+1 SAY " "+PAD( cVAR[1], nTAMAJU)+" "
IF cVAR[2] # NIL
   @ nLINAJU1+2,nCOLAJU1+1 SAY " "+PAD( cVAR[2], nTAMAJU)+" "
ENDIF
IF cVAR[3] # NIL
   @ nLINAJU1+3,nCOLAJU1+1 SAY " "+PAD( cVAR[3], nTAMAJU)+" "
ENDIF
SETPOS(nROW,nCOL)
SETCOLOR(cCOR)
SETCURSOR(nCURSOR)
RETURN NIL
***************************************************************************
STATIC FUNCTION LenLargura( aMenu2 )
LOCAL nLargura, i
nLargura := aMenu2[1]
FOR i = 1 TO LEN(aMenu2)
   IF aMenu2[i] # NIL
	 IF LEN(nLargura) < LEN(aMenu2[i])
	    nLargura := aMenu2[i]
	 ENDIF
   ENDIF
NEXT
RETURN LEN(nLargura)
***************************************************************************
FUNCTION _ROUND(nValor,nDecimals)
Hb_Default( @nDecimals,2)
RETURN (ROUND(val(str(nValor)),nDecimals))

***************************************************************************

FUNCTION GetPassword(oGet)
LOCAL nKey
LOCAL lRestaura := .F.
PRIVATE nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2
IF (GetPreValidate(oGet))

	 // Activate the GET for reading
	 oGet:setFocus()
	 IF GetMsg[PosMsg] <> NIL
	 ENDIF

   oGet:SetFocus()
   oGet:cargo := ""
   Do While(oGet:exitState == GE_NOEXIT)
	 IF (oGet:typeOut)
	    oGet:exitState := GE_ENTER
	 ENDIF
	 Do While (oGet:exitState == GE_NOEXIT)
	    nKey := INKEY(0)
	    IF nKey >= 32 .AND. nKey <= 255
		  oGet:cargo += Chr(nKey)
		  GetApplyKey(oGet,Asc("þ"))
	    ELSEIF nKey == K_BS
		  oGet:cargo := Substr(oGet:cargo,1,Len(oGet:cargo)-1)
		  GetApplyKey(oGet,nKey)
	    ELSEIF nKey == K_ENTER
		  GetApplyKey(oGet,nKey)
	    ELSEIF nKey == K_ESC
		  GetApplyKey(oGet,nKey)
	    ENDIF
	 ENDDO
	 IF (!GetPostValidate(oGet))
	    oGet:exitState := GE_NOEXIT
	 ENDIF
   ENDDO
   oGet:KillFocus()
   IF lRestaura
   ENDIF
ENDIF
IF oGet:exitState != GE_ESCAPE
   oGet:varPut(oGet:cargo)
ENDIF
RETURN NIL

Mas, porque parar aqui... usar meu formatador de fonte.

Mensagem por **JoséQuintas** » 29 Mai 2019 13:05

Pronto.
Precisei alterar alguns DO WHILE(
O formatador NÃO considerou que era DO WHILE
E também ELSE ; xxxxx; ENDIF
O formatador também se perdeu nisso.
Rotina final

Código: Selecionar todos

/***
*  Getsys.prg
*  Standard Clipper 5.2 GET/READ Subsystem
*  Copyright (c) 1991-1993, Computer Associates International, Inc.
*  All rights reserved.
*  This version adds the following public functions:
*    ReadKill( [<lKill>] )       --> lKill
*    ReadUpdated( [<lUpdated>] ) --> lUpdated
*    ReadFormat( [<bFormat>] )   --> bFormat | NIL
*  NOTE: compile with /m /n /w
*/

#include "Inkey.ch"
#include "Getexit.ch"

STATIC snMRow, snMCol
STATIC  nMRow,  nMCol

/***
*  Nation Message Constants
*  These constants are used with the NationMsg(<msg>) function.
*  The <msg> parameter can range from 1-12 and returns the national
*  version of the system message.
*/
#define _GET_INSERT_ON   7    // "Ins"
#define _GET_INSERT_OFF   8    // "   "
#define _GET_INVD_DATE   9    // "Invalid Date"
#define _GET_RANGE_FROM   10    // "Range: "
#define _GET_RANGE_TO   11    // " - "

#define K_UNDO          K_CTRL_U

// State variables for active READ
STATIC sbFormat
STATIC slUpdated := .F.
STATIC slKillRead
STATIC slBumpTop
STATIC slBumpBot
STATIC snLastExitState
STATIC snLastPos
STATIC soActiveGet
STATIC scReadProcName
STATIC snReadProcLine
STATIC nKey2
STATIC GetMsg
STATIC PosMsg

// Format of array used to preserve state variables
#define GSV_KILLREAD     1
#define GSV_BUMPTOP        2
#define GSV_BUMPBOT        3
#define GSV_LASTEXIT     4
#define GSV_LASTPOS        5
#define GSV_ACTIVEGET     6
#define GSV_READVAR        7
#define GSV_READPROCNAME   8
#define GSV_READPROCLINE   9

#define GSV_COUNT        9

/***
*  ReadModal()
*  Standard modal READ on an array of GETs
*/

FUNCTION ReadModal( GetList, nPos )

   LOCAL oGet, nI
   LOCAL aSavGetSysVars

   GetMsg := {}
   PosMsg := nPos
   nKey2  := Space(0)

   FOR nI := 1 TO Len(GetList)
      IF VALTYPE(GetList[nI])<>"O"
         AAdd(GetMsg ,GetList[nI,2])
         GetList[nI] := GetList[nI,1]
      ELSE
         AAdd(GetMsg ,)
      ENDIF
   NEXT

   IF ( VALTYPE( sbFormat ) == "B" )
      EVAL( sbFormat )
   ENDIF

   IF ( Empty( GetList ) )

      // S'87 compatibility
      SETPOS( MAXROW() - 1, 0 )
      RETURN (.F.)             // NOTE

   ENDIF

   // Preserve state variables
   aSavGetSysVars := ClearGetSysVars()

   // Set these for use in SET KEYs
   scReadProcName := PROCNAME( 1 )
   snReadProcLine := PROCLINE( 1 )

   // Set initial GET to be read
   IF !( VALTYPE( nPos ) == "N" .AND. nPos > 0 )
      nPos := Settle( Getlist, 0 )
      PosMsg:=nPos
   ENDIF

   DO WHILE !( nPos == 0 )

      // GET next GET from list and post it as the active GET
      PostActiveGet( oGet := GetList[ nPos ] )

      // Read the GET
      IF ( VALTYPE( oGet:reader ) == "B" )
         EVAL( oGet:reader, oGet )    // Use custom reader block
      ELSE
         GetReader( oGet )         // Use standard reader
      ENDIF

      // Move to next GET based on exit condition
      nPos := Settle( GetList, nPos )
      PosMsg:=nPos

   ENDDO

   // Restore state variables
   RestoreGetSysVars( aSavGetSysVars )

   // S'87 compatibility
   SETPOS( MAXROW() - 1, 0 )

   RETURN ( slUpdated )

   /***
   *  GetReader()
   *  Standard modal read of a single GET
   */

PROCEDURE GetReader( oGet )

   LOCAL lRestaura := .F.
   PRIVATE cGetMsg, nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2

   // Read the GET IF the WHEN condition is satisfied

   IF ( GetPreValidate( oGet ) )

      // Activate the GET for reading
      oGet:setFocus()

      DO WHILE ( oGet:exitState == GE_NOEXIT )

         // Check for initial typeout (no editable positions)
         IF ( oGet:typeOut )
            oGet:exitState := GE_ENTER
         ENDIF

         // Apply keystrokes until exit
         IF ( oGet:type == "N" )
            oGet:pos    := oGet:decPos()-1
            oGet:display()
         ENDIF
         SETPOS(oGet:row,oGet:col)
         DO WHILE ( oGet:exitState == GE_NOEXIT )
            IF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos )
               oGet:pos     := oGet:decPos()-1
               oGet:display()
            ENDIF
            GetApplyKey( oGet, Inkey(0)) // minkey( 0, @snMrow, @snMCol ) )
         ENDDO

         // Disallow exit IF the VALID condition is not satisfied
         IF ( !GetPostValidate( oGet ) )
            oGet:exitState := GE_NOEXIT
         ENDIF
      ENDDO

      // De-activate the GET
      oGet:killFocus()

   ENDIF
   IF lRestaura
   ENDIF

   RETURN

   /***
   *  GetApplyKey()
   *  Apply a single Inkey() keystroke to a GET
   *  NOTE: GET must have focus.
   */

PROCEDURE GetApplyKey( oGet, nKey )

   LOCAL cKey, nTmp, lIns
   LOCAL bKeyBlock
   LOCAL nTemp
   LOCAL lTmp, lDec, lDec0

   // Check for SET KEY first
   IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
      GetDoSetKey( bKeyBlock, oGet )
      RETURN                   // NOTE
   ENDIF

   DO CASE
      // CASE ( nKey == 45 ) .AND. Substr(oGet:buffer,oGet:decPos()-1,1) == "0"
      //       oGet:buffer := Substr(oGet:buffer,1,oGet:decPos()-2)+"-"+Substr(oGet:buffer,oGet:decPos()-1)
      //       oGet:display()
   CASE ( nKey == K_UP )
      oGet:exitState := GE_UP

   CASE ( nKey == K_SH_TAB )
      oGet:exitState := GE_UP

   CASE ( nKey == K_DOWN )
      oGet:exitState := GE_DOWN

   CASE ( nKey == K_TAB )
      oGet:exitState := GE_DOWN

   CASE ( nKey == K_ENTER )
      oGet:changed := .T.
      oGet:exitState := GE_ENTER
      nKey2 := Space(0)

   CASE ( nKey == K_ESC )
      IF ( SET( _SET_ESCAPE ) )
         oGet:undo()
         oGet:exitState := GE_ESCAPE

      ENDIF

   CASE ( nKey == K_PGUP )
      oGet:exitState := GE_WRITE

   CASE ( nKey == K_PGDN )
      oGet:exitState := GE_WRITE

   CASE ( nKey == K_CTRL_HOME )
      oGet:exitState := GE_TOP

#ifdef CTRL_END_SPECIAL

      // Both ^W and ^End go to the last GET
   CASE ( nKey == K_CTRL_END )
      oGet:exitState := GE_BOTTOM

#else

      // Both ^W and ^End terminate the READ (the default)
   CASE ( nKey == K_CTRL_W )
      oGet:exitState := GE_WRITE

#endif

   CASE ( nKey == K_INS )
      SET( _SET_INSERT, !SET( _SET_INSERT ) )
      ShowScoreboard()

   CASE ( nKey == K_UNDO )
      oGet:undo()

   CASE ( nKey == K_HOME )
      oGet:home()

   CASE ( nKey == K_END )
      oGet:end()

   CASE ( nKey == K_RIGHT )
      oGet:right()
      nKey2 := Space(0)

   CASE ( nKey == K_LEFT )
      oGet:left()
      nKey2 := Space(0)

   CASE ( nKey == K_CTRL_RIGHT )
      oGet:wordRight()
      nKey2 := Space(0)

   CASE ( nKey == K_CTRL_LEFT )
      oGet:wordLeft()
      nKey2 := Space(0)

   CASE ( nKey == K_BS ) .OR. ((nKey == K_DEL) .AND. (oGet:type =="N"))
      IF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos )
         IF AT(".",oGet:buffer) <> 0 .OR. AT(",",oGet:buffer) <> 0
            oGet:pos    := oGet:decPos()-1
            nTemp := oGet:unTransform()
            nTemp := (nTemp-INT(nTemp)) + Int(nTemp / 10)
         ELSE
            oGet:pos    := oGet:decPos()-1
            oGet:delete()
            nTemp := oGet:unTransform()
         ENDIF
         oGet:buffer := Transform(nTemp,oGet:picture)
         oGet:pos    := oGet:decPos()-1
         oGet:display()
      ELSE
         IF (oGet:type="N").AND.(oGet:pos=oGet:decPos+1).AND.(nKey<>K_DEL)
            oGet:pos := oGet:decPos()-1
            KEYBOARD Chr( K_BS )
         ELSE
            IF ( nKey == K_DEL )
               oGet:delete()
            ELSE
               oGet:backSpace()
            ENDIF
            oGet:display()
         ENDIF
      ENDIF
   CASE ( nKey == K_DEL )
      oGet:delete()

   CASE ( nKey == K_CTRL_T )
      oGet:delWordRight()

   CASE ( nKey == K_CTRL_Y )
      IF oGet:type == "N"
         nTmp := oGet:pos
         oGet:pos    := 01
         oGet:delEnd()
         oGet:pos    := nTmp
         oGet:display()
      ELSE
         oGet:delEnd()
      ENDIF

   CASE ( nKey == K_CTRL_BS )
      oGet:delWordLeft()

   OTHERWISE
      lIns  := .T.

      IF ( nKey >= 32 .AND. nKey <= 255 )

         IF ! Empty(nKey2) .AND.  oGet:type == "C"
            lIns := Acentos(oGet, nKey2, @nKey)
            nKey2 := Space(0)
         ENDIF

         cKey := Chr( nKey )

         IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
            lTmp := AT("-",oGet:buffer) <> 0
            IF oGet:Clear
               oGet:buffer := Transform(0,oGet:picture)
            ENDIF
            oGet:toDecPos()
            IF lTmp .AND. AT("-",oGet:buffer) == 0
               oGet:buffer := Substr(oGet:buffer,1,oGet:decPos()-2)+"-"+Substr(oGet:buffer,oGet:decPos()-1)
               oGet:buffer := Substr(oGet:buffer,2)
            ENDIF
            oGet:display()
         ELSEIF ( oGet:type == "N" ) .AND. (oGet:pos < oGet:decPos ) .AND. ;
               ((nKey >= Asc('0') .AND. nKey <= Asc('9')) .OR. Upper(CHR(nKey))="C" ;
               .OR.  nKey == Asc('+')  .OR.  nKey == Asc('-'))
            nTemp := oGet:unTransform()
            IF Upper(cKey) == "C" .OR. oGet:clear
               oGet:clear := .F.
               nTemp = 0
               oGet:buffer := Transform(nTemp,oGet:picture)
               oGet:display()
            ENDIF
            lDec := AT(".",Transform(0,oGet:picture))
            IF(lDec==0,lDec := AT(",",Transform(0,oGet:picture)),lDec)
            lDec0 := IF(lDec<>0,IF(Len(oGet:buffer) > (lDec+1),.T.,.F.),.T.)
            lDec  := IF(lDec<>0,.T.,.F.)
            IF(oGet:picture==NIL,lDec0:=.T.,)

            IF Len((oGet:buffer)) >= (Len(AllTrim(oGet:buffer))+1)
               IF oGet:type == "N" .AND. cKey == "-"
                  nKey2 := Asc("-")
               ELSE
                  lTmp  := AT("-",oGet:buffer) <> 0
                  nTemp := (nTemp-INT(nTemp)) + Int(nTemp * 10)
                  oGet:buffer := Transform(nTemp,oGet:picture)
                  IF nTemp = 0 .AND. lTmp
                     IF Len(oGet:buffer) < oGet:decPos() .AND. 1 = 2
                        oGet:buffer := Substr(oGet:buffer,1,oGet:decPos()-3)+"-"+Substr(oGet:buffer,oGet:decPos()-2)
                        oGet:buffer := Substr(oGet:buffer,2)
                     ELSE
                        oGet:buffer := Substr(oGet:buffer,1,oGet:decPos()-IF(lDec0,2,3))+"-"+Substr(oGet:buffer,oGet:decPos()-IF(lDec0,1,2))
                        oGet:buffer := Substr(oGet:buffer,2)
                     ENDIF
                  ENDIF                                                                //2   1
                  oGet:pos   := oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. Len(oGet:buffer) < oGet:decPos(),2,1),0)
                  oGet:overstrike( cKey )                                                    //2   1
                  oGet:pos   := oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. Len(oGet:buffer) < oGet:decPos(),2,1),0)
               ENDIF
               IF VALTYPE(nKey2) == "N" .AND. cKey == "-"
                  lTmp  := AT("-",oGet:buffer) == 0
                  nTemp := oGet:unTransform()
                  nTemp *= (-1)
                  oGet:buffer := Transform(nTemp,oGet:picture)
                  IF nTemp = 0 .AND. lTmp
                     IF Len(oGet:buffer) < oGet:decPos() .AND. 1 = 2
                        oGet:buffer := Substr(oGet:buffer,1,oGet:decPos()-3)+"-"+Substr(oGet:buffer,oGet:decPos()-2)
                        oGet:buffer := Substr(oGet:buffer,2)
                     ELSE
                        oGet:buffer := Substr(oGet:buffer,1,oGet:decPos()-IF(lDec0,2,3))+"-"+Substr(oGet:buffer,oGet:decPos()-IF(lDec0,1,2))
                        oGet:buffer := Substr(oGet:buffer,2)
                     ENDIF
                  ENDIF
               ENDIF
               IF VALTYPE(nKey2) == "N"
                  nKey2 := Space(0)
               ENDIF
               oGet:display()
               IF Len(Substr(oGet:buffer,1,oGet:decpos-1))==LEN(AllTrim(Substr(oGet:buffer,1,oGet:decpos-1))) .AND. (!SET(_SET_CONFIRM))
                  oGet:exitstate:=GE_ENTER
               ENDIF
            ELSEIF Len(Substr(oGet:buffer,1,oGet:decpos-1)) == 1 .AND. (oGet:pos < oGet:decPos )
               oGet:overstrike(cKey)
               oGet:pos := oGet:decPos()
               oGet:display()
               IF Len(Substr(oGet:buffer,1,oGet:decpos-1))==1 .AND. (!SET(_SET_CONFIRM))
                  oGet:exitstate:=GE_ENTER
               ENDIF
            ELSE
               IF ( !SET( _SET_CONFIRM ) )
                  oGet:exitState := GE_ENTER
               ELSE
                  ?? Chr(7)
               ENDIF

            ENDIF
            IF oGet:type == "N" .AND. cKey == "-"
               nKey2 := nKey
            ENDIF
         ELSE

            IF ( SET( _SET_INSERT ) ) .AND. lIns
               oGet:insert( cKey )
            ELSE
               oGet:overstrike( cKey )
            ENDIF
            IF ( oGet:type == "C")
               IF Empty(nKey2) .AND. (nKey=126 .OR. nKey=39 .OR. nKey=96 .OR. nKey=34 .OR. nKey=94 .OR. nKey=46)
                  nKey2 := nKey
                  oGet:left()
               ELSE
                  nKey2 := Space(0)
               ENDIF
            ENDIF

            IF ( oGet:typeOut )
               IF ( SET( _SET_BELL ) )
                  ?? Chr(7)
               ENDIF

               IF ( !SET( _SET_CONFIRM ) )
                  oGet:exitState := GE_ENTER
               ENDIF
            ENDIF

         ENDIF

      ENDIF

   ENDCASE
   oGet:changed := .T.

   RETURN

   /***
   *  GetPreValidate()
   *  Test entry condition (WHEN clause) for a GET
   */

FUNCTION GetPreValidate( oGet )

   LOCAL lSavUpdated
   LOCAL lWhen := .T.

   IF !( oGet:preBlock == NIL )

      lSavUpdated := slUpdated

      lWhen := EVAL( oGet:preBlock, oGet )

      oGet:display()

      ShowScoreBoard()
      slUpdated := lSavUpdated

   ENDIF

   IF ( slKillRead )

      lWhen := .F.
      oGet:exitState := GE_ESCAPE      // Provokes ReadModal() exit

   ELSEIF ( !lWhen )

      oGet:exitState := GE_WHEN      // Indicates failure

   ELSE

      oGet:exitState := GE_NOEXIT      // Prepares for editing

   ENDIF

   RETURN ( lWhen )

   /***
   *  GetPostValidate()
   *  Test exit condition (VALID clause) for a GET
   *  NOTE: Bad dates are rejected in such a way as to preserve edit buffer
   */

FUNCTION GetPostValidate( oGet )

   LOCAL lSavUpdated
   LOCAL lValid := .T.

   IF ( oGet:exitState == GE_ESCAPE )
      RETURN ( .T. )             // NOTE
   ENDIF

   IF ( oGet:badDate() )
      oGet:home()
      DateMsg()
      ShowScoreboard()
      RETURN ( .F. )             // NOTE
   ENDIF

   // IF editing occurred, assign the new value to the variable
   IF ( oGet:changed )
      oGet:assign()
      slUpdated := .T.
   ENDIF

   // Reform edit buffer, set cursor to home position, redisplay
   oGet:reset()

   // Check VALID condition IF specified
   IF !( oGet:postBlock == NIL )

      lSavUpdated := slUpdated

      // S'87 compatibility
      SETPOS( oGet:row, oGet:col + Len( oGet:buffer ) )

      lValid := EVAL( oGet:postBlock, oGet )

      // Reset S'87 compatibility cursor position
      SETPOS( oGet:row, oGet:col )

      ShowScoreBoard()
      oGet:updateBuffer()

      slUpdated := lSavUpdated

      IF ( slKillRead )
         oGet:exitState := GE_ESCAPE     // Provokes ReadModal() exit
         lValid := .T.

      ENDIF
   ENDIF

   RETURN ( lValid )

   /***
   *  GetDoSetKey()
   *  Process SET KEY during editing
   */

PROCEDURE GetDoSetKey( keyBlock, oGet )

   LOCAL lSavUpdated

   // IF editing has occurred, assign variable
   IF ( oGet:changed )
      oGet:assign()
      slUpdated := .T.
   ENDIF

   lSavUpdated := slUpdated

   EVAL( keyBlock, scReadProcName, snReadProcLine, ReadVar() )

   ShowScoreboard()
   oGet:updateBuffer()

   slUpdated := lSavUpdated

   IF ( slKillRead )
      oGet:exitState := GE_ESCAPE       // provokes ReadModal() exit
   ENDIF

   RETURN

   /***
   *         READ services
   */

   /***
   *  Settle()
   *  Returns new position in array of GET objects, based on:
   *    - current position
   *    - exitState of GET object at current position
   *  NOTES: return value of 0 indicates termination of READ
   *      exitState of old GET is transferred to new Get
   */

STATIC FUNCTION Settle( GetList, nPos )

   LOCAL nExitState

   IF ( nPos == 0 )
      nExitState := GE_DOWN
   ELSE
      nExitState := GetList[ nPos ]:exitState
   ENDIF

   IF ( nExitState == GE_ESCAPE .OR. nExitState == GE_WRITE )
      RETURN ( 0 )            // NOTE
   ENDIF

   IF !( nExitState == GE_WHEN )
      // Reset state info
      snLastPos := nPos
      slBumpTop := .F.
      slBumpBot := .F.
   ELSE
      // Re-use last exitState, do not disturb state info
      nExitState := snLastExitState
   ENDIF

   // Move
   DO CASE
   CASE ( nExitState == GE_UP )
      nPos--

   CASE ( nExitState == GE_DOWN )
      nPos++

   CASE ( nExitState == GE_TOP )
      nPos     := 1
      slBumpTop  := .T.
      nExitState := GE_DOWN

   CASE ( nExitState == GE_BOTTOM )
      nPos     := Len( GetList )
      slBumpBot  := .T.
      nExitState := GE_UP

   CASE ( nExitState == GE_ENTER )
      nPos++

   ENDCASE

   // Bounce
   IF ( nPos == 0 )                 // Bumped top
      IF ( !ReadExit() .AND. !slBumpBot )
         slBumpTop   := .T.
         nPos      := snLastPos
         nExitState := GE_DOWN
      ENDIF

   ELSEIF ( nPos == Len( GetList ) + 1 )  // Bumped bottom
      IF ( !ReadExit() .AND. !( nExitState == GE_ENTER ) .AND. !slBumpTop )
         slBumpBot   := .T.
         nPos      := snLastPos
         nExitState := GE_UP
      ELSE
         nPos := 0
      ENDIF
   ENDIF

   // Record exit state
   snLastExitState := nExitState

   IF !( nPos == 0 )
      GetList[ nPos ]:exitState := nExitState
   ENDIF

   RETURN ( nPos )

   /***
   *  PostActiveGet()
   *  Post active GET for ReadVar(), GetActive()
   */

STATIC PROCEDURE PostActiveGet( oGet )

   GetActive( oGet )
   ReadVar( GetReadVar( oGet ) )

   ShowScoreBoard()

   RETURN

   /***
   *  ClearGetSysVars()
   *  Save and clear READ state variables. Return array of saved values
   *  NOTE: 'Updated' status is cleared but not saved (S'87 compatibility)
   */

STATIC FUNCTION ClearGetSysVars()

   LOCAL aSavSysVars[ GSV_COUNT ]

   // Save current sys vars
   aSavSysVars[ GSV_KILLREAD ]   := slKillRead
   aSavSysVars[ GSV_BUMPTOP ]      := slBumpTop
   aSavSysVars[ GSV_BUMPBOT ]      := slBumpBot
   aSavSysVars[ GSV_LASTEXIT ]   := snLastExitState
   aSavSysVars[ GSV_LASTPOS ]      := snLastPos
   aSavSysVars[ GSV_ACTIVEGET ]   := GetActive( NIL )
   aSavSysVars[ GSV_READVAR ]      := ReadVar( "" )
   aSavSysVars[ GSV_READPROCNAME ] := scReadProcName
   aSavSysVars[ GSV_READPROCLINE ] := snReadProcLine

   // Re-init old ones
   slKillRead       := .F.
   slBumpTop       := .F.
   slBumpBot       := .F.
   snLastExitState := 0
   snLastPos       := 0
   scReadProcName  := ""
   snReadProcLine  := 0
   slUpdated       := .F.

   RETURN ( aSavSysVars )

   /***
   *  RestoreGetSysVars()
   *  Restore READ state variables from array of saved values
   *  NOTE: 'Updated' status is not restored (S'87 compatibility)
   */

STATIC PROCEDURE RestoreGetSysVars( aSavSysVars )

   slKillRead       := aSavSysVars[ GSV_KILLREAD ]
   slBumpTop       := aSavSysVars[ GSV_BUMPTOP ]
   slBumpBot       := aSavSysVars[ GSV_BUMPBOT ]
   snLastExitState := aSavSysVars[ GSV_LASTEXIT ]
   snLastPos       := aSavSysVars[ GSV_LASTPOS ]

   GetActive( aSavSysVars[ GSV_ACTIVEGET ] )

   ReadVar( aSavSysVars[ GSV_READVAR ] )

   scReadProcName  := aSavSysVars[ GSV_READPROCNAME ]
   snReadProcLine  := aSavSysVars[ GSV_READPROCLINE ]

   RETURN

   /***
   *  GetReadVar()
   *  Set READVAR() value from a GET
   */

STATIC FUNCTION GetReadVar( oGet )

   LOCAL cName := Upper( oGet:name )
   LOCAL i

   // The following code includes subscripts in the name returned by
   // this FUNCTIONtion, IF the GET variable is an array element
   // Subscripts are retrieved from the oGet:subscript instance variable
   // NOTE: Incompatible with Summer 87
   IF !( oGet:subscript == NIL )
      FOR i := 1 TO Len( oGet:subscript )
         cName += "[" + LTRIM( Str( oGet:subscript[i] ) ) + "]"
      NEXT
   END

   RETURN ( cName )

   /***
   *         System Services
   */

   /***
   *  __SetFormat()
   *  SET FORMAT service
   */

PROCEDURE __SetFormat( b )

   sbFormat := IF( VALTYPE( b ) == "B", b, NIL )

   RETURN

   /***
   *  __KillRead()
   *  CLEAR GETS service
   */

PROCEDURE __KillRead()

   slKillRead := .T.

   RETURN

   /***
   *  GetActive()
   *  Retrieves currently active GET object
   */

FUNCTION GetActive( g )

   LOCAL oldActive := soActiveGet

   IF ( PCOUNT() > 0 )
      soActiveGet := g
   ENDIF

   RETURN ( oldActive )

   /***
   *  Updated()
   */

FUNCTION Updated()

   RETURN slUpdated

   /***
   *  ReadExit()
   */

FUNCTION ReadExit( lNew )

   RETURN ( SET( _SET_EXIT, lNew ) )

   /***
   *  ReadInsert()
   */

FUNCTION ReadInsert( lNew )

   RETURN ( SET( _SET_INSERT, lNew ) )

   /***
   *         Wacky Compatibility Services
   */

   // Display coordinates for SCOREBOARD
#define SCORE_ROW      0
#define SCORE_COL      60

   /***
   *  ShowScoreboard()
   */

STATIC PROCEDURE ShowScoreboard()

   LOCAL nRow
   LOCAL nCol

   IF ( SET( _SET_SCOREBOARD ) )
      nRow := Row()
      nCol := Col()

      SETPOS( SCORE_ROW, SCORE_COL )
      DISPOUT( IF( SET( _SET_INSERT ), NationMsg(_GET_INSERT_ON), ;
         NationMsg(_GET_INSERT_OFF)) )
      SETPOS( nRow, nCol )
   ENDIF

   RETURN

   /***
   *  DateMsg()
   */

STATIC PROCEDURE DateMsg()

   LOCAL nRow
   LOCAL nCol

   IF ( SET( _SET_SCOREBOARD ) )

      nRow := Row()
      nCol := Col()

      SETPOS( SCORE_ROW, SCORE_COL )
      DISPOUT( NationMsg(_GET_INVD_DATE) )
      SETPOS( nRow, nCol )

      WHILE ( NEXTKEY() == 0 )
      END

      SETPOS( SCORE_ROW, SCORE_COL )
      DISPOUT( Space( Len( NationMsg(_GET_INVD_DATE) ) ) )
      SETPOS( nRow, nCol )

   ENDIF

   RETURN

   /***
   *  RangeCheck()
   *  NOTE: Unused second param for 5.00 compatibility.
   */

FUNCTION RangeCheck( oGet, junk, lo, hi )

   LOCAL cMsg, nRow, nCol
   LOCAL xValue

   IF .F.
      ? Junk
   ENDIF

   IF ( !oGet:changed )
      RETURN ( .T. )      // NOTE
   ENDIF

   xValue := oGet:varGet()

   IF ( xValue >= lo .AND. xValue <= hi )
      RETURN ( .T. )      // NOTE
   ENDIF

   IF ( SET(_SET_SCOREBOARD) )

      cMsg := NationMsg(_GET_RANGE_FROM) + LTRIM( Transform( lo, "" ) ) + ;
         NationMsg(_GET_RANGE_TO) + LTRIM( Transform( hi, "" ) )

      IF ( Len( cMsg ) > MAXCOL() )
         cMsg := Substr( cMsg, 1, MAXCOL() )
      ENDIF

      nRow := Row()
      nCol := Col()

      SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - Len( cMsg ) ) )
      DISPOUT( cMsg )
      SETPOS( nRow, nCol )

      WHILE ( NEXTKEY() == 0 )
      END

      SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - Len( cMsg ) ) )
      DISPOUT( Space( Len( cMsg ) ) )
      SETPOS( nRow, nCol )

   ENDIF

   RETURN ( .F. )

   /***
   *  ReadKill()
   */

FUNCTION ReadKill( lKill )

   LOCAL lSavKill := slKillRead

   IF ( PCOUNT() > 0 )
      slKillRead := lKill
   ENDIF

   RETURN ( lSavKill )

   /***
   *  ReadUpdated()
   */

FUNCTION ReadUpdated( lUpdated )

   LOCAL lSavUpdated := slUpdated

   IF ( PCOUNT() > 0 )
      slUpdated := lUpdated
   ENDIF

   RETURN ( lSavUpdated )

   /***
   *  ReadFormat()
   */

FUNCTION ReadFormat( b )

   LOCAL bSavFormat := sbFormat

   IF ( PCOUNT() > 0 )
      sbFormat := b
   ENDIF

   RETURN ( bSavFormat )

FUNCTION Mensagem1(nLinh,cTexto,cCor)

   LOCAL nCol,nLargJan

   nLargJan := Len(cTexto)
   IF nLargJan < 10
      nLargJan := 10
   ENDIF
   nCol := (80 -nLargJan)/2
   @ nLinh,nCol CLEAR TO nLinh,nCol + nLargJan
   @ nLinh,nCol SAY cTexto COLOR cCor

   RETURN NIL

   // "Ž„ …†ƒ€‡‚ˆ‰Š¡‹Œ“¢™”•£š–¦§"

FUNCTION Acentos(oGet,nKey2,nKey)

   LOCAL lIns := .F., nKey3

   nKey2 := Chr(nKey2)
   nKey3 := nKey
   nKey  := Chr(nKey )
   IF nKey2 == "~"
      IF   nKey=="A" ; nKey:="Ž"
      ELSEIF nKey=="O" ; nKey:="™"
      ELSEIF nKey=="a" ; nKey:="„"
      ELSEIF nKey=="o" ; nKey:="”"
      ELSE  ; lIns := .T.
      ENDIF
   ELSEIF nKey2 == "'"
      IF   nKey=="A" ; nKey:=""
      ELSEIF nKey=="E" ; nKey:=""
      ELSEIF nKey=="a" ; nKey:=" "
      ELSEIF nKey=="e" ; nKey:="‚"
      ELSEIF nKey=="i" ; nKey:="¡"
      ELSEIF nKey=="o" ; nKey:="¢"
      ELSEIF nKey=="u" ; nKey:="£"
      ELSEIF nKey=="C" ; nKey:="€"
      ELSEIF nKey=="c" ; nKey:="‡"
      ELSE  ; lIns := .T.
      ENDIF
   ELSEIF nKey2 == "`"
      IF   nKey=="a" ; nKey:="…"
      ELSEIF nKey=="e" ; nKey:="Š"
      ELSEIF nKey=="i" ; nKey:=""
      ELSEIF nKey=="o" ; nKey:="•"
      ELSE  ; lIns := .T.
      ENDIF
   ELSEIF nKey2 == "^"
      IF   nKey=="a" ; nKey:="ƒ"
      ELSEIF nKey=="e" ; nKey:="ˆ"
      ELSEIF nKey=="i" ; nKey:="Œ"
      ELSEIF nKey=="o" ; nKey:="“"
      ELSEIF nKey=="u" ; nKey:="–"
      ELSE  ; lIns := .T.
      ENDIF
   ELSEIF nKey2 == "."
      IF   nKey=="a" ; nKey:="¦"
      ELSEIF nKey=="o" ; nKey:="§"
      ELSE  ; lIns := .T.
      ENDIF
   ENDIF
   nKey2 := Asc(nKey2)
   nKey  := Asc(nKey )
   IF nKey3 == nKey
      oGet:right()
   ENDIF

   RETURN lIns

FUNCTION _INKEY(nTempo,lTrava)

   LOCAL nKey, nTime := SECONDS()

   lTrava:=IF(lTrava==NIL,.F.,.T.)
   IF lTrava .AND. nTempo <> NIL .AND. nTempo <> 0
      WHILE IF (nTempo > 0, (SECONDS() - nTime) < nTempo, .T.)
      ENDDO
      nKey := LastKey()
   ELSE
      nKey :=  Inkey(0) // Minkey(nTempo, @nMRow, @nMCol, .T.)
   ENDIF

   RETURN (nKey)

FUNCTION AJUDADECAMPOATIVA( oGet )

   LOCAL nROW := Row(), nCOL := Col(), nCURSOR := SetCursor(), cCOR := SetColor()
   LOCAL GetMensg := GetMsg[PosMsg], nCALCULO, nPOSOGET
   LOCAL nPOS1 := AT("|",GetMensg), nPOS2, cVAR[3], nTAMAJU
   LOCAL nColAju1, nColAju2, nLinAju1, nLinAju2

   IF nPOS1 # 0
      cVAR[1] := Substr(GetMensg,1,nPOS1-1)
      GetMensg := Substr(GetMensg,nPOS1+1,Len(GetMensg))
   ELSE
      cVAR[1] := GetMensg
      GetMensg := Space(0)
   ENDIF
   nPOS2 := AT("|",GetMensg)
   IF nPOS2 # 0
      cVAR[2] := Substr(GetMensg,1,nPOS2-1)
      GetMensg := Substr(GetMensg,nPOS2+1,Len(GetMensg))
      cVAR[3] := GetMensg
   ELSEIF nPOS2 == 0 .AND. !Empty(GetMensg)
      cVAR[2] := GetMensg
   ENDIF
   IF cVAR[3] # NIL
      nCALCULO := 4
   ELSEIF cVAR[3] == NIL .AND. cVAR[2] # NIL
      nCALCULO := 3
   ELSE
      nCALCULO := 2
   ENDIF
   nTAMAJU := LenLargura( cVAR )
   nPOSOGET := oGet:col + 4
   IF nPOSOGET+4+nTAMAJU > 79
      DO WHILE .T.
         nPOSOGET--
         IF nPOSOGET+4+nTAMAJU <= 79
            EXIT
         ENDIF
      ENDDO
   ENDIF
   nCOLAJU1 := nPOSOGET
   nCOLAJU2 := nPOSOGET+nTAMAJU
   IF oGet:row+1+nCALCULO > 24
      nLINAJU1 := oGet:row-1-nCALCULO
      nLINAJU2 := oGet:row-1
   ELSE
      nLINAJU1 := oGet:row+1
      nLINAJU2 := oGet:row+1+nCALCULO
   ENDIF
   //cGetMsg := SaveScreen(nLINAJU1,nCOLAJU1-2,nLINAJU2+1,nCOLAJU2+3)
   @ nLINAJU1,nCOLAJU1 TO nLINAJU2,nCOLAJU2+3
   @ nLINAJU1+1,nCOLAJU1+1 SAY " "+PAD( cVAR[1], nTAMAJU)+" "
   IF cVAR[2] # NIL
      @ nLINAJU1+2,nCOLAJU1+1 SAY " "+PAD( cVAR[2], nTAMAJU)+" "
   ENDIF
   IF cVAR[3] # NIL
      @ nLINAJU1+3,nCOLAJU1+1 SAY " "+PAD( cVAR[3], nTAMAJU)+" "
   ENDIF
   SETPOS(nROW,nCOL)
   SetColor(cCOR)
   SetCursor(nCURSOR)

   RETURN NIL

STATIC FUNCTION LenLargura( aMenu2 )

   LOCAL nLargura, i

   nLargura := aMenu2[1]
   FOR i = 1 TO Len(aMenu2)
      IF aMenu2[i] # NIL
         IF Len(nLargura) < Len(aMenu2[i])
            nLargura := aMenu2[i]
         ENDIF
      ENDIF
   NEXT

   RETURN Len(nLargura)

FUNCTION _ROUND(nValor,nDecimals)

   Hb_Default( @nDecimals,2)

   RETURN (Round(Val(Str(nValor)),nDecimals))

FUNCTION GetPassword(oGet)

   LOCAL nKey
   LOCAL lRestaura := .F.
   PRIVATE nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2

   IF (GetPreValidate(oGet))

      // Activate the GET for reading
      oGet:setFocus()
      IF GetMsg[PosMsg] <> NIL
      ENDIF

      oGet:SetFocus()
      oGet:cargo := ""
      DO WHILE oGet:exitState == GE_NOEXIT
         IF (oGet:typeOut)
            oGet:exitState := GE_ENTER
         ENDIF
         DO WHILE oGet:exitState == GE_NOEXIT
            nKey := Inkey(0)
            IF nKey >= 32 .AND. nKey <= 255
               oGet:cargo += Chr(nKey)
               GetApplyKey(oGet,Asc("þ"))
            ELSEIF nKey == K_BS
               oGet:cargo := Substr(oGet:cargo,1,Len(oGet:cargo)-1)
               GetApplyKey(oGet,nKey)
            ELSEIF nKey == K_ENTER
               GetApplyKey(oGet,nKey)
            ELSEIF nKey == K_ESC
               GetApplyKey(oGet,nKey)
            ENDIF
         ENDDO
         IF (!GetPostValidate(oGet))
            oGet:exitState := GE_NOEXIT
         ENDIF
      ENDDO
      oGet:KillFocus()
      IF lRestaura
      ENDIF
   ENDIF
   IF oGet:exitState != GE_ESCAPE
      oGet:varPut(oGet:cargo)
   ENDIF

   RETURN NIL

Mensagem por **JoséQuintas** » 29 Mai 2019 13:11

E lembram do git?
Pois é... fui salvando...
Agora dá pra ver o histórico de cada conjunto, inclusive o que foi mexido em cada conjunto.

Mensagem por **JoséQuintas** » 29 Mai 2019 13:18

E tem outra: posso cancelar alguma das alterações. - revert commit
cancelar, cancelar o cancelamento....
E até isso fica registrado pelo git.

Aquilo de fazer backup, voltar backup se deu problema, pegar backup de dias atrás....
Tudo simplificado.
Como pelo git enxerga o que mexeu, pode até corrigir a alteração mal feita, ao invés de cancelar.
Mas pode cancelar também, sem precisar pegar backup - o próprio git já é um backup

Agora imagine tudo isso com bakcup nas nuvens....
aí é criar conta no bitbucket que é grátis pra uso pessoal, ou pagar no GitHub.

E o Harbour, ao baixar usando git, é assim também.
Temos toda história, com CADA alteração que é feita, desde os primeiros arquivos.
Anos e anos de trabalho, controlados pelo git, e com o backup centralizado nas nuvens, que é de onde baixamos tudo.

Então... coisas legais aqui:
- Compilar usando -w3 -es2
- Usar o GIT pra controlar versão
- usando o mesmo programa git, salvar nas nuvens, e ter um super-backup além do controle de versão

Mensagem por **JoséQuintas** » 29 Mai 2019 14:08

Complemento:

Se temos controle das variáveis (-w3 -es2), de qualquer alteração (git), backup (git), podemos reverter (git), etc. etc. etc....

Poderíamos até melhorar todo fonte, afinal, tá tudo sob controle, não tem perigo de mexer.
No pior dos casos.... se estragar tudo... é acionar o git e pedir pra "reverter commit".

Entenderam?
É como ter funcionários/ajudantes conferindo o que fazemos.
Podemos fazer manutenção tranquilamente - e isto representa 90% de nossas tarefas.
Se 90% de nosso trabalho fica melhor e mais tranquilo.... NÓS também ficamos melhores e mais tranquilos !!!!

Essa getsys:
Como o Rubens disse, foram anos e anos juntando pedaços e ajustando recursos.
Eu fiz melhor que ele? NÃO. Foi o Harbour que mostrou aonde ajustar.
Uma compilação -w3 -es2 resolveu anos de pipino.

Outra coisa que comento aqui:
dá uma geral nos fontes antes de quebrar a cabeça com LIB gráfica
Isso teria resolvido um problema que o Rubens teve no passado com LIB gráfica, teria reduzido o tempo perdido.
Então... revisar fontes NÃO é perder tempo, é ganhar tempo.
Na correria do dia a dia, a gente não percebe isso....

Fonte do Rubens dando problema...
Eu apenas compilei usando -w3 -es2, mais nada.
Nem sequer tentei entender o fonte, não analisei, não melhorei, não conferi, nada.
O Harbour mostrou aonde ajustar, e eu ajustei.

Fiz o que qualquer um poderia fazer: olhar o que o Harbour estava reclamando, e resolver pra ele não reclamar.
A única diferença é que comecei a fazer isso há mais tempo, então estou "mais craque".

Mensagem por **JoséQuintas** » 02 Jun 2019 21:41

Faltou chamar a atenção numa coisa muito importante:

Parece que em console, essa getsys nunca causou problema, só apareceu ao misturar HMG com GTWVG.

Em GUI, e em multithread, não há ordem de execução de rotinas como em console, o usuário pode fazer a ordem que quiser, clicando em qualquer lugar.
Com muitas rotinas sendo executadas a qualquer momento, a chance de problemas com variáveis "fora de controle" aumenta.
Isso pode explicar muitos problemas que alguns tem ao testar libs gráficas.

NÃO precisa parar de usar variável PUBLIC e PRIVATE, mas elas precisam de muito mais atenção, pra não ficarem "fora de controle".

Mensagem por **JoséQuintas** » 11 Jun 2019 23:51

Acabei de pegar um erro no meu aplicativo.
Ainda uso variável PRIVATE em relatórios.... com isso, o -w3 -es2 não avisa tudo.

Error BASE/1068 Argument error: array access
Called from LJPFORPAG(39)
Called from DO(0)
Called from DOPRG(116)
Called from (b)RUNMODULE(85)

Usando variável local, e compilando com -w3 -es2, teriam aparecido dois erros - que são um só

mostraria essa linha 24 como inútil, porque a 25 anula o conteúdo
e... mostraria que a variável nOpcTipo não foi inicializada

É um erro só, porque errei no nome da variável nessa linha 24.

Ainda não encontrei uma forma melhor de refazer o fonte dos relatórios.....

Isso se refere às diversas opções do relatório, que além de ter o menu de seleção, ainda pode aparecer no título do relatório, por isso variável PRIVATE.

Mensagem por **JoséQuintas** » 12 Jun 2019 00:05

Aproveitando pra mostrar três coisas:

1. O debug do Harbour, igual do Clipper, pra acompanhar o fonte em questão, do relatório
Dá pra ver até o ícone do aplicativo na janela de debug

2. Multithread
Estou fazendo debug no relatório...
Como é multithread, o debug "parou" o relatório, e não o menu, que pode até chamar outros módulos, porque somente uma thread está sendo controlada pelo debug, e não o aplicativo inteiro.
Acaba tendo um efeito parecido com GUI e multijanelas, cada janela é totalmente independente.

3. Acaba parecendo um ambiente com IDE, no lado esquerdo é o programmers notepad.
Acho que nenhuma IDE do Harbour deixa alterar durante a execução, só mesmo a do VB6 fazia isso, então... fica igual IDE.

Nota: o que me refiro a alterar durante a execução, é alterar e continuar a execução, sem interromper ou recompilar. É que a IDE do VB6 interpreta linha a linha, então, se alterar a linha já continua executando a linha alterada.