contar caracteres em uma string que está sendo digitada

[cjp]

Meus caros,

Alguém saberia me dizer como contar, “em tempo real”, o número de caracteres digitados em uma string que está sendo digitada no momento, num get? Quero dizer: informar ao usuário, enquanto ele digita num get, quantos caracteres ele já digitou.

Nem precisa ser realmente em tempo real, nem precisa ser tão exato, mas algo aproximado já resolveria.

Tentei fazer isso usando uma rotina que recebi de alguém do grupo, como consta abaixo. Ocorre, entretanto, que a rotina não lê a string que está sendo digitada, ela está em branco quando entra nessa rotina, mesmo tendo sido digitado alguma coisa.

Estou usando o xHarbour e a máquina está com Windows XP.

Alguém poderia me ajudar?

Código: Selecionar todos

function RotIdle()
if fAtiva
   if (seconds() - nSec) >= tmax //---- ve se já passou o tempo
      if nSec > 0
         nrcar=at("     ",cmp)-1
         nSec = seconds()
         @ 26,5 say "Caracteres digitados:"+alltrim(str(nrcar))
         inkey(1)
         nSec=0
      else
         nSec = seconds()
      endif
   endif
endif
return

[Pablo César]

Faltou você dizer se quer uma solução em modo console ou em GUI. Pelo exemplo que você postou, imagino que deva ser no modo console. Nesse seu exemplo, tem um temporizador, isto é, ele não espera o usuário digitar, alias espera apenas 1 segundo e sai. Você teria que fazer um laço de repetição e substituir o inkey(1) por inkey(0) e concatenar armazenando o que foi digitado numa variável e remover todo esse negócio de seconds...
Algo assim...

Código: Selecionar todos

cString:=""
Do While .t.
   nChar:=Inkey(0)
   Do Case
      Case nChar=13  // Enter
           Exit
      Case nChar=27  // Esc
           cString:=""
           Exit
      Case nChar=25  // Ctrl Y
           cString:=""
      Case nChar=8 .AND. Len(cString)>1
           cString:=Substr(cString,1,Len(cString)-1)
      Case nChar=8 .AND. Len(cString)=1
           Loop
      Case nChar= ... e assim por diante, colocando todas as teclas q deseja controlar
      Otherwise
           cString:=cString+Chr(nChar)
   Endcase
   @ say... mostrar cString
Enddo

Existe outro exemplo aqui na seção de Downloads que adaptado pode vir a servir: https://pctoledo.org/forum/fileba ... t=s&page=1

[cjp]

Talvez eu não tenha entendido bem o que vc disse e esteja fazendo algo errado.
Copiei o teu exemplo no meu programa e fiz vários testes. Não está contando os dígitos, nem aparecendo a cString no get enquanto está sendo digitado.
Segue abaixo a função. Não sei se segui corretamente o que vc me recomendou:

Código: Selecionar todos

function main()
         clear
         pnIdle := HB_IdleAdd( {|| RotIdle() } )
         cString=space(200)
         @ 5,5 say "Compromisso:"get cString
         read
return

function RotIdle()
         do while .t.
            nChar:=inkey(0)
            do case
               case nChar=13
                    Exit
               case nChar=27
                    cString:=""
                    Exit
               case nChar=25
                    cString:=""
               case nChar=8 .and. Len(cString)>1
                    cString:=Substr(cStrin,1,Len(cString)-1)
               otherwise
                    cString:=cString+chr(nChar)
                    nrcar=at("     ",cString)
                    @ 26,5 say "Caracteres digitados:"+alltrim(str(nrcar))
            endcase
         enddo
return

[Pablo César]

Bom no inicio você não tinha mencionado que você queria dentro de um GET. Mas a idéia que passei não é para GET e sim é "simular" que é um GET. Agora se você faz questão de que seja num GET, você vai ter que ter um GETSYS.PRG alterado, disponível na pasta onde está seu sistema e colocado junto para compilar.

Falando do seu exemplo:
- Na 3ª linha a função que está sendo executado não tem vinculo algum com o seu GET
- Está certo que o seu exemplo é apenas um exemplo, ms atente que você deve elaborá-lo mais pois qualquer outra tela irá concatenar à variável cString, até mesmo F2, F3, TAB, DEL...
- Na linha 24, você deveria utilizar outra função para obter quantos caracteres estão sendo considerados. Basta apenas utilizar o nrcar:=Len(cString)
- Faltou no seu código, mostrar a cString após o DO CASE, como eu recomendei (linha 20 do meu exemplo, mensagem anterior)

Olha como a principio iria ficar se fizesse não através do GET sim simulando:

Código: Selecionar todos

Function Main()
Cls
cCompromisso:="Ja tinha algo escrito"
@ 05,05 Say "Compromisso: " COLOR "W/N"
@ 05,18 Say cCompromisso COLOR "N/W"
cCompromisso:=Digita(cCompromisso)
Alert("Resultado: "+Chr(34)+cCompromisso+Chr(34))
Return nil

Function Digita(cString)
Do While .t.
   nChar:=Inkey(0)
   Do Case
      Case nChar=13  // Enter
           Exit
      Case nChar=27  // Esc
           cString:=""
           Exit
      Case nChar=25  // Ctrl Y
           cString:=""
      Case nChar=8 .AND. Len(cString)>1
           cString:=Substr(cString,1,Len(cString)-1)
           @ 05,18 Say Space(62) Color "W/n" // serve para limpar a linha com cor de fundo diferente
      Case nChar=8 .AND. Len(cString)=1
           Loop
      // Case nChar= ... e assim por diante, colocando todas as teclas q deseja controlar
      Otherwise
           cString:=cString+Chr(nChar)
   Endcase
   @ 24,00 Say PadC("Caracteres digitados: "+Alltrim(Str(Len(cString))),80) Color "R/W"
   @ 05,18 Say cString Color "N/W"
Enddo
Return cString

[Pablo César]

Agora com um GETSYS.PRG alterado, você pode compilá-lo como é feito no Clipper.

Código: Selecionar todos

/* Programa TESTE.PRG
   Compile com o novo Getsys.prg
*/

Function Main()
Cls
cCompromisso:="Ja tinha algo escrito"+Space(178)
Keyboard Chr(6) // posiciona ao final do get
@ 05,05 Say "Compromisso: " COLOR "W/N" GET cCompromisso Picture "@S60" COLOR "N/W"
Read
Alert("Resultado: "+Chr(34)+cCompromisso+Chr(34))
Return nil

O seguinte GetSys tem algumas alterações:

Código: Selecionar todos

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

#include "Inkey.ch"
#include "Getexit.ch"
// #include "loca.ch"

/***
*  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

   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 )
   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 )

   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 )

   // 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
	 WHILE ( oGet:exitState == GE_NOEXIT )
            * GetApplyKey( oGet, inkey( 0 ) )
              If Upper(ReadVar())="CCOMPROMISSO"
                 GetApplyKey( oGet, inkey( 0 ) )
                 VG := AllTrim(oGet:buffer)
                 Exibe(VG,Row(),Col())
              Else
                  VG=ALLTRIM(oGet:buffer)
                  GetApplyKey( oGet, inkey( 0 ) )
              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

   RETURN



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

   LOCAL cKey
   LOCAL bKeyBlock

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

   DO CASE
   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:exitState := GE_ENTER

   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()

   CASE ( nKey == K_LEFT )
      oGet:left()

   CASE ( nKey == K_CTRL_RIGHT )
      oGet:wordRight()

   CASE ( nKey == K_CTRL_LEFT )
      oGet:wordLeft()

   CASE ( nKey == K_BS )
      oGet:backSpace()

   CASE ( nKey == K_DEL )
      oGet:delete()

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

   CASE ( nKey == K_CTRL_Y )
      oGet:delEnd()

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

   OTHERWISE

      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

   ENDCASE

   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,nCol,teladt

TONE( 250, 4 )
TELADT:=SAVESCREEN(24,00,24,79)
// MENSAGEM("Data incorreta !",5)
RESTSCREEN(24,00,24,79,TELADT)
WHILE ( NEXTKEY() == 0 )
END
IF ( SET( _SET_SCOREBOARD ) )
   nRow := ROW()
   nCol := COL()
   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 Exibe(VG,nLin,nCol)
@ 24,00 Say PadC("Caracteres digitados: "+Alltrim(Str(Len(Vg))),80) Color "R/W"
@ nLin,nCol Say ""
RETURN nil

Eu testei em Clipper, mas acho que não terá problemas em Harbour. Anexei o executável pra você ver.

[cjp]

Eu não tinha entendido que era uma simulação de um get. Agora sim, funcionou perfeitamente. Muitíssimo obrigado, meu caro.

[Pablo César]

Faltou você mencionar qual dos dois exemplos você utilizou, meu caro.

[cjp]

Ah, sim, achei que vc tinha entendido. Usei o da simulação do get, o primeiro que vc tinha passado.

Obrigado mais uma vez.

[Pablo César]

Ahhh ok. Mas você viu que alterando o GETSYS você também pode fazer dessa outra forma. Inclusive eu compilei com Harbour na IDE HMG em modo console e não deu erro algum. Eu acho que funciona até melhor pelo GETSYS alterado, porque daí você pode utilizar o picture "S50" que isso ajuda a exibir parte do GET, porque você tinha dimensionado para 200 e isso não cabe na tela...

[cjp]

Vi sim. Mas como já tinha começado a fazer da forma que vc tinha sugerido (com o get simulado), achei melhor manter aquela forma mesmo, que funcionou bem. Muito obrigado.