Clipper On Line • Ver Tópico - Usando -e3 -es2

Usando -e3 -es2

Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.

Moderador: Moderadores

 

Usando -e3 -es2

Mensagempor JoséQuintas » 29 Mai 2019 12:58

getsys.png


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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor JoséQuintas » 29 Mai 2019 12:59

A getsys após correções.

/***
*
*  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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor 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

/***
*  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
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor 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.

getsys.png
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor 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.

getsys.png


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
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor 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".
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor 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".
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor 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.

w3es2.png


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.

relatorio.png
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Usando -e3 -es2

Mensagempor JoséQuintas » 12 Jun 2019 00:05

debug.png


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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18007
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Anterior



Retornar para Contribuições, Dicas e Tutoriais

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 15 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro