Getsys Clipper no xHarbour Erro

[MarcosV]

Olá Pessoal

Graças ao forum estou (quase) migrando um dos meus programas em Clipper para xharbour ... depois de muita luta e insistência consegui gerar o executavel ... apresentou alguns erros na hora de rodar ... mas com muita paciencia fui eliminando erro por erro ate o programa rodar sem erros visiveis (e por sinal virou uma bala!) ... mas surgiu um problema que não consegui resolver de maneira alguma ... uso um getsys (alterado) nesse programa em clipper, e preciso usar esse mesmo getsys no xharbour por causa da estrutura desse programa (foi feito pra rodar com esse getsys). O Erro é o seguinte: em qualquer campo numerico sem casas decimais o get não aceita nenhum numero, fica parado no campo, mas no clipper funciona normalmente... do resto esse getsys ta normal no xharbour ... ahh... também não consegui fazer rodar o mouse nos gets (ativei o mouse com "Set EventMask To INKEY_ALL").

Uso xharbour + gtwvw

Link: Getsys.prg Alterado

Obrigado

[sygecom]

Olá Marcos,
Seu link está dando aviso de virus aqui no Google Chrome

[MarcosV]

Oi Leonardo, tudo bem?

estranho... aqui pra mim não ta acusando nada ... mas pode ser pq um tempo atras tinham invadido meu site ... deve ser por isso.

Obs: esse getsys é o mesmo daquele exemplo xClub que um tempo atras voce deu uma olhada pra mim.

Link do getsys: http://www.megaupload.com/?d=QXT8HEBI

ou codigo (abaixo):

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"

#include "mouse.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


//
// 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
LOCAL aSavGetSysVars
PUBLIC nKey2 := SPACE(0)

PRIVATE GetMsg := {},PosMsg:=nPos
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 nTempo, nTemp, nCursor1, nCursor2, 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()
      IF GetMsg[PosMsg] <> NIL
         IF Conf_Cfg("AJUDA")
            AJUDADECAMPOATIVA(oGet)
         ENDIF
         lRestaura := .T.
      ENDIF

      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
            IF nTempo <> 0
               GetApplyKey( oGet, minkey( 0, @snMrow, @snMCol ) )
            ELSE
               SET CURSOR ON
               oGet:display()
            ENDIF
         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
      IF Conf_Cfg("ajuda")
         RESTSCREEN(nLINAJU1,nCOLAJU1-2,nLINAJU2+1,nCOLAJU2+3,cGetMsg)
      ENDIF
   ENDIF

   RETURN



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

   LOCAL cKey
   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 ) .OR. nKey == M_RIGHT
      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()

   // Mouse handling code
   CASE ( nKey == M_LEFT)
      oGet:exitState := nKey


   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 ) .OR. nExitState == M_RIGHT
      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++

   // Mouse handling code
   CASE (nExitState == M_LEFT)
      nPos := MouseGet( GetList, nPos, snMRow, snMCol)

   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 ( !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.
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 := 0 , 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 := 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
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)
COR("MENU")
@ nLINAJU1,nCOLAJU1 TO nLINAJU2,nCOLAJU2+3
SOMBRA(nLINAJU1,nCOLAJU1,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)
RETURN (ROUND(val(str(nValor)),nDecimals))

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

FUNCTION GetPassword(oGet)
LOCAL nKey,nChar,cKey
LOCAL nTempo, nTemp, nCursor1, nCursor2, lRestaura := .F.
PRIVATE cGetMsg, nLINAJU1, nLINAJU2, nCOLAJU1, nCOLAJU2
IF (GetPreValidaTe(oGet))

      // Activate the GET for reading
      oGet:setFocus()
      IF GetMsg[PosMsg] <> NIL
         IF Conf_Cfg("AJUDA")
            AJUDADECAMPOATIVA(oGet)
         ENDIF
         lRestaura := .T.
      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
      IF Conf_Cfg("ajuda")
         RESTSCREEN(nLINAJU1,nCOLAJU1-2,nLINAJU2+1,nCOLAJU2+3,cGetMsg)
      ENDIF
   ENDIF
ENDIF
IF oGet:exitState != GE_ESCAPE
   oGet:varPut(oGet:cargo)
ENDIF
RETURN


#include "common.ch"
#include "hbsetup.ch"
#include "setcurs.ch"

#ifdef HB_COMPAT_C53
FUNCTION ReadModal2( GetList, nPos,;
                    oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )

   LOCAL oGetMsg, cColor
#else
FUNCTION ReadModal2( GetList, nPos )
#endif

   LOCAL oGetList, oSaveGetList

   IF Empty( GetList )
      SetPos( MaxRow() - 1, 0 )
      RETURN .F.
   ENDIF

   nPos := IF( ISNUMBER( nPos ), nPos, 0 )

   oGetList := HBGetList():New( GetList )
   oGetList:cReadProcName := ProcName( 1 )
   oGetList:nReadProcLine := ProcLine( 1 )
   #ifdef HB_COMPAT_C53
   oGetList:nSaveCursor   := SetCursor( SC_NONE )
   oGetList:nNextGet      := nPos
   #endif

   oSaveGetList := __GetListActive( )
   __GetListSetActive( oGetList )
   __GetListLast( oGetList )

#ifdef HB_COMPAT_C53

   oGetList:nPos := oGetList:Settle( nPos, TRUE )

   oGetMsg := GetMssgLine():new( nMsgRow, nMsgLeft, nMsgRight, cMsgColor )

   if oGetMsg:Flag
      cColor := setColor( oGetMsg:Color )
      @ oGetMsg:row, oGetMsg:left CLEAR TO oGetMsg:row, oGetMsg:right
      setColor( cColor )
      oGetMsg:saveScreen()
   endif

   oGetList:nHitCode := 0
   oGetList:nMenuID  := 0

#else

   IF ! nPos > 0
      oGetList:nPos := oGetList:Settle( 0 )
   ENDIF

#endif

   WHILE oGetList:nPos != 0

      oGetList:oGet := oGetList:aGetList[ oGetList:nPos ]
      oGetList:PostActiveGet()

/*
#ifdef HB_COMPAT_C53
      if oGetMsg:Flag
         oGet := oGetList:aGetList[ oGetList:nPos ]
         oGetMsg:Show( oGet )
      endif
#endif
*/

      IF ISBLOCK( oGetList:oGet:Reader )

#ifdef HB_COMPAT_C53
         Eval( oGetList:oGet:Reader, oGetList:oGet ,oGetlist, oMenu, oGetMsg )
      ELSE
         oGetList:Reader( oMenu, oGetMsg )
      ENDIF

      oGetList:nPos := oGetList:Settle( , FALSE )
#else
         Eval( oGetList:oGet:Reader, oGetList:oGet )
      ELSE
         oGetList:Reader()
      ENDIF

      oGetList:nPos := oGetList:Settle()
#endif

   ENDDO

/*
#ifdef HB_COMPAT_C53
   if oGetMsg:Flag
      oGetMsg:restScreen()
   endif
#endif
*/

   __GetListSetActive( oSaveGetList )

   SetPos( MaxRow() - 1, 0 )

#ifdef HB_COMPAT_C53
   SetCursor(oGetList:nSaveCursor)
#endif

   RETURN oGetList:lUpdated

PROCEDURE GetReader2( oGet )
   oGet:Reader()

   RETURN

FUNCTION GetActive2( oGet )

   STATIC oDefaultGet

   LOCAL oGetList := __GetListActive()

   IF oGetList == NIL
      IF PCount() >= 1
         oDefaultGet := oGet
      ENDIF

      RETURN oDefaultGet
   ELSE
      IF PCount() >= 1
         RETURN oGetList:GetActive( oGet )
      ELSE
         RETURN oGetList:GetActive()
      ENDIF
   ENDIF

RETURN NIL

PROCEDURE GetDoSetKey2( keyBlock, oGet )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF
      oGetList:GetDoSetKey( keyBlock )
   ENDIF

   RETURN

PROCEDURE GetApplyKey2( oGet, nKey )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF
      oGetList:GetApplyKey( nKey )
   ENDIF

   RETURN

FUNCTION GetPreValidate2( oGet )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF

      RETURN oGetList:GetPreValidate()
   ENDIF

   RETURN .F.

FUNCTION GetPostValidate2( oGet )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF

      RETURN oGetList:GetPostValidate()
   ENDIF

   RETURN .F.

FUNCTION ReadUpdated2( lUpdated )
/*   LOCAL oGetList := __GetListActive() */
   LOCAL oGetList := __GetListLast()

   IF oGetList != NIL
      IF PCount() >= 1
         RETURN oGetList:ReadUpdated( lUpdated )
      ELSE
         RETURN oGetList:ReadUpdated()
      ENDIF
   ENDIF

   RETURN .F.

FUNCTION Updated2()
/*   LOCAL oGetList := __GetListActive() */
   LOCAL oGetList := __GetListLast()

   IF oGetList != NIL
      RETURN oGetList:lUpdated
   ENDIF

   RETURN .F.

FUNCTION ReadKill2( lKill )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF PCount() >= 1
         RETURN oGetList:KillRead( lKill )
      ELSE
         RETURN oGetList:KillRead()
      ENDIF
   ENDIF

   RETURN .F.

PROCEDURE __KillRead2()
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      oGetList:KillRead( .T. )
   ENDIF

   RETURN

PROCEDURE __SetFormat2( bFormat )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF ISBLOCK( bFormat )
         oGetList:SetFormat( bFormat, TRUE )
      ELSE
         oGetList:SetFormat( , TRUE )
      ENDIF
   ENDIF

   RETURN

FUNCTION ReadFormat2( bFormat )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF PCount() >= 1
         RETURN oGetList:SetFormat( bFormat, TRUE )
      ELSE
         RETURN oGetList:SetFormat( , FALSE )
      ENDIF
   ENDIF

   RETURN NIL

#define SCORE_ROW       0
#define SCORE_COL       60

#define _GET_RANGE_FROM 10
#define _GET_RANGE_TO   11

FUNCTION RangeCheck2( oGet, xDummy, xLow, xHigh )
   LOCAL xValue
   LOCAL cMessage
   LOCAL nOldRow, nOldCol

   IF !oGet:changed
      RETURN .T.
   ENDIF

   xValue := oGet:varGet()

   IF xValue >= xLow .AND. xValue <= xHigh
      RETURN .T.
   ENDIF

   IF Set( _SET_SCOREBOARD )

      cMessage := Left( NationMsg( _GET_RANGE_FROM ) + LTrim( Transform( xLow, "" ) ) + ;
                        NationMsg( _GET_RANGE_TO ) + LTrim( Transform( xHigh, "" ) ), MaxCol() )

      HBConsoleLock()
      nOldRow := Row()
      nOldCol := Col()

      DispOutAt( SCORE_ROW, Min( 60, MaxCol() - Len( cMessage ) ), cMessage )
      SetPos( nOldRow, nOldCol )
      HBConsoleUnlock()

      DO WHILE NextKey() == 0
      ENDDO

      HBConsoleLock()
      DispOutAt( SCORE_ROW, Min( 60, MaxCol() - Len( cMessage ) ), Space( Len( cMessage ) ) )
      SetPos( nOldRow, nOldCol )
      HBConsoleUnlock()

   ENDIF

   RETURN .F.

#ifdef HB_COMPAT_C53

PROCEDURE GUIReader( oGet, oGetlist, oMenu, oGetMsg )

   oGetlist:GuiReader( oGet, oMenu, oGetMsg )

   RETURN

PROCEDURE GuiApplyKey( oGet, nKey, oMenu, oGetMsg )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF
      oGetList:GUIApplyKey( oGet:control, nKey, oMenu, oGetMsg )
   ENDIF

   RETURN

FUNCTION GuiGetPreValidate2( oGet, oGui, oGetMsg )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF

      RETURN oGetList:GetPreValidate2( oGui, oGetMsg )
   ENDIF

   RETURN .F.

FUNCTION GuiGetPostValidate( oGet, oGui, oGetMsg )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF

      RETURN oGetList:GuiGetPostValidate( oGui, oGetMsg )
   ENDIF

   RETURN .F.


PROCEDURE TBReader( oGet, oGetList, oMenu, oGetMsg )

   oGetList:TBReader( oGet, oMenu, oGetMsg )

   RETURN

PROCEDURE TBApplyKey( oGet, oTB, GetList, nKey,  oGetMsg )
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      IF oGet != NIL
         oGetList:oGet := oGet
      ENDIF
      oGetList:Tbapplykey( oGet, oTB, nKey, oGetMsg )
   ENDIF
   RETURN

/* bdj notes: aGetList is not really used by this function.
              should we remove it?
 */
FUNCTION HitTest( aGetList, MouseRow, MouseCol, aMsg ) // Removed STATIC
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      RETURN oGetlist:Hittest( MouseRow, MouseCol, aMsg ) // Removed STATIC
   ENDIF
   RETURN 0

/***
*
*  Accelerator( <aGetList>, <nKey>, <aMsg> ) --> 0
*
*  Identify the Accelerator key
*
***/
FUNCTION Accelerator( aGetList, nKey, aMsg ) // Removed STATIC
   LOCAL oGetList := __GetListActive()

   IF oGetList != NIL
      RETURN oGetlist:Accelerator( aGetList, nKey, aMsg ) // Removed STATIC
   ENDIF
   RETURN 0

#endif

[Toledo]

uso um getsys (alterado)

Marcos, as alterações feitas neste GETSYS é muito grande, fica complicado analisar as alterações e saber o que pode estar causando este problema. Segue abaixo uma parte do seu GETSYS (alterado), onde eu acho que está o problema, e também a mesma parte do GETSYS Original.

Parte do GETSYS Original

Código: Selecionar todos

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

	 cKey := CHR( nKey )

	 IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
	    oGet:toDecPos()
	 ELSE
	    
	    IF ( SET( _SET_INSERT ) )
	       oGet:insert( cKey )
	    ELSE
	       oGet:overstrike( cKey )
	    ENDIF

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

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

	 ENDIF

      ENDIF

A mesma parte do seu GETSYS Alterado

Código: Selecionar todos

      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

Compare o tamanho dos dois códigos acima, por ai dá para notar a quantidade de modificações feita.

Estas modificações foram feitas por você?

Eu acho que só quem fez estas modificações poderá lhe ajudar, pois é muito complicado estudar o código de outro programador e principalmente um GETSYS tão modificado como este.

Abraços,

[MarcosV]

Oi Toledo, obrigado por responder.

Marcos, as alterações feitas neste GETSYS é muito grande, fica complicado analisar as alterações e saber o que pode estar causando este problema.
Compare o tamanho dos dois códigos acima, por ai dá para notar a quantidade de modificações feita.

Realmente a modificação é grande mesmo, ja tentei de tudo aqui, mas além de estar muito confuso, eu nao manjo nada de getsys.

Estas modificações foram feitas por você?
Eu acho que só quem fez estas modificações poderá lhe ajudar, pois é muito complicado estudar o código de outro programador e principalmente um GETSYS tão modificado como este.

Não, esse exemplo é da antiga "Clipper's Club", os caras (infelizmente) nem mexem mais com xBase.

O curioso é que esse getsys no xharbour funciona normalmente... so da problema quando o campo é numerico sem casas decimais... mas no clipper funciona 100%, minha esperança é que uma linha de codigo resolva o problema, e eu possa continuar a migração para xHarbour.

Aqui ta os fontes, e o executavel compilado com Debug --> http://www.megaupload.com/?d=R18NTBDW

Se puder dar uma olhada, agradeço muito.

[Toledo]

Marcos, o download não está ativo... veja a mensagem que dá quando se clica no link:

O arquivo que você tenta acessar está temporariamente indisponível.

Abraços

[MarcosV]

Agora já está ativo: http://www.megaupload.com/?d=R18NTBDW

Valew

[sygecom]

No fim de semana vou tentar dar uma olhada sem compromisso, lembro que tinha feito alguns ajuste na época mas nem lembro onde paramos, veremos...

[sygecom]

Marcos,
Fui compilar e nem compila, está faltando algumas funções do DBEDIT.PRG , tente fazer um exemplo simples de preferência em um único .PRG que demonstre o problema, assim outros colegas podem tentar ajudar nesse problema.

[MarcosV]

No fim de semana vou tentar dar uma olhada sem compromisso, lembro que tinha feito alguns ajuste na época mas nem lembro onde paramos, veremos...

Oi Leonardo, agradeço muito, estou ancioso em colocar meu programa convertido em xHarbour pra testes. Continuo tentando aqui resolver esse detalhe do getsys, mas por enquanto não consegui, se conseguir te dou um toque.

Marcos,
Fui compilar e nem compila, está faltando algumas funções do DBEDIT.PRG , tente fazer um exemplo simples de preferência em um único .PRG que demonstre o problema, assim outros colegas podem tentar ajudar nesse problema.

Estou usando o hbmake ... de uma olhada no club.bc ... nao inclua o dbedit.prg, ai compila sem erros.
A primeira tela do club.exe fiz um exemplo do erro.
Estou usando a ultima versão do xHarbour

Obrigado

[sygecom]

Olá Marcos,
Estou tentando compilar com hbmk2 do Harbour, se poder deixe uma pasta com apenas o básico para compilar o seu exemplo e que simule o erro para eu e outros colegas tentar achar uma solução para o seu problema.

[MarcosV]

Olá Marcos,
Estou tentando compilar com hbmk2 do Harbour, se poder deixe uma pasta com apenas o básico para compilar o seu exemplo e que simule o erro para eu e outros colegas tentar achar uma solução para o seu problema.

Oi Leonardo, antes de mais nada, obrigado pela força.

Ta ai um exemplo bem simples: xClubWvWBasico

Espero muito que consiga encontrar uma solução, eu aqui continuo tentando.

Obrigado

[Toledo]

Olá Marcos, faça o seguinte:

Procure por:

Código: Selecionar todos

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)

e troque por:

Código: Selecionar todos

oGet:pos    := oGet:decPos() -IF(oGet:picture<>NIL .AND. lDec, IF(lTmp .AND. LEN(oGet:buffer) < oGet:decPos(),2,1),1)
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),1)

Abraços,

[MarcosV]

Olá Toledo,

acabei de testar aqui ... ficou 100% ... problema resolvido.

Agora posso dar continuidade a migração para xHarbour

Obrigado pela força

[rubens]

Boa tarde...

O Tópico é muito antigo mas o problema é exatamente o que venho enfrentando.
Estou com o seguintes problemas.
Em qualquer campo numérico sem casas decimais o get não aceita nenhum numero.
Depois que digita um número negativo e tenta digitar um número inteiro não aceita mais.. qualquer número digitado se transforma em negativo
Quando vai digitar um data não aceita digitar a barra que separa mês e ano... se usar a seta pra movimentar para a direita ele ignora a barra, mas se tentar digitar a barra ele não aceita...

Tentei a solução do toledo mas não tenho estas linhas no meu getsys.prg.

Algo mais que eu poderia tentar..

Segue getsys.prg

GETSYS.PRG

(27.17 KiB) Baixado 100 vezes

Obrigado
Rubens