Alinhar GET numérico à DIREITA

[Daniel]

nos campos numericos vc tem q usar a barra de espaço

[Daniel]

Jânio

eu olhei este defeito na verdade vc esta usando um get com valor numerico com separador caracter ai a funcao se perde, para arruma isto teria que mexer muito no codigo, tentei mais nao funcionou bem.

Mais vou ver se arrumo.

[TerraSoftware]

Encontrei aqui nuns fontes antigos um getsys onde o backspace e o delete funcionam perfeitamente nos campos numericos com decimais e ainda alinha inteiro a direita e decimal a esquerda. Quem puder favor testar.

Código: Selecionar todos

#include "inkey.ch"
#include "getexit.ch"

#translate :cValor      => :cargo\[1\]
#translate :nPos        => :cargo\[2\]
#translate :nLen        => :cargo\[3\]
#translate :nDec        => :cargo\[4\]
#translate :nPLen       => :cargo\[5\]
#translate :nPDec       => :cargo\[6\]

#define _GET_INSERT_ON   ""
#define _GET_INSERT_OFF  ""
#define _GET_INVD_DATE   9
#define _GET_RANGE_FROM  10
#define _GET_RANGE_TO    11
#define K_UNDO          K_CTRL_U

STATIC sbFormat
STATIC slUpdated := .F.
STATIC slKillRead
STATIC slBumpTop
STATIC slBumpBot
STATIC snLastExitState
STATIC snLastPos
STATIC soActiveGet
STATIC scReadProcName
STATIC snReadProcLine
STATIC Vinicio
STATIC Tecla

#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

********************************
FUNCTION ReadModal(GetList,nPos)
********************************
LOCAL oGet
LOCAL aSavGetSysVars
IF ( VALTYPE( sbFormat ) == "B" )
   EVAL( sbFormat )
ENDIF
IF (EMPTY(GetList))
   SETPOS( MAXROW() - 1, 0 )
   RETURN (.F.)
ENDIF
aSavGetSysVars := ClearGetSysVars()
scReadProcName := PROCNAME( 1 )
snReadProcLine := PROCLINE( 1 )
IF !( VALTYPE( nPos ) == "N" .AND. nPos > 0 )
   nPos := Settle( Getlist, 0 )
ENDIF
WHILE !( nPos == 0 )
   PostActiveGet( oGet := GetList[ nPos ] )
   IF ( VALTYPE( oGet:reader ) == "B" )
      EVAL( oGet:reader, oGet )
   ELSE
      GetReader( oGet )
   ENDIF
   nPos := Settle( GetList, nPos )
ENDDO
RestoreGetSysVars( aSavGetSysVars )
SETPOS( MAXROW() - 1, 0 )
RETURN ( slUpdated )

***************************
PROCEDURE GetReader( oGet )
***************************
LOCAL bApplyKey
IF ( GetPreValidate( oGet ) )
   oGet:setFocus()
   IF oGet:type == "N"
      IF EMPTY( oGet:picture )
        oGet:picture = "9999999999"
      ENDIF
      oGet:cargo = ARRAY( 6 )
      CalcLenNum( oGet )
      GetCalcImp( oGet )
      bApplyKey := { | oGet | GetCalcApplyKey( oGet, Test_ink() ) }
   ELSE
      bApplyKey := { | oGet | GetApplyKey( oGet, Test_ink() ) }
   ENDIF
   WHILE ( oGet:exitState == GE_NOEXIT )
      IF ( oGet:typeOut )
         oGet:exitState := GE_ENTER
      ENDIF
      WHILE ( oGet:exitState == GE_NOEXIT )
         EVAL( bApplyKey, oGet )
      ENDDO
      IF ( !GetPostValidate( oGet ) )
         oGet:exitState := GE_NOEXIT
         IF oGet:type == "N"
           GetCalcImp( oGet )
         ENDIF
      ENDIF
   ENDDO
   oGet:killFocus()
ENDIF
RETURN

**************************
static function test_ink()
**************************
local tecla:=0
tecla:=inkey(3)
Return(tecla)

***********************************
PROCEDURE GetApplyKey( oGet, nKey )
***********************************
LOCAL cKey
LOCAL bKeyBlock
LOCAL dData

IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
   GetDoSetKey( bKeyBlock, oGet )
   RETURN
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
   CASE ( nKey == K_CTRL_END )
      oGet:exitState := GE_BOTTOM
   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()
         ELSEIF ( oGet:type == "D" .AND. ( cKey == "+" .OR. cKey == "-" ) )
            dData := oGet:varGet()
            IF EMPTY( dData )
               dData = DATE()
            ENDIF
            IF cKey == "+"
               oGet:varPut( dData+1 )
            ELSE
               oGet:varPut( dData-1 )
            ENDIF
            oGet:updateBuffer()
         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

*****************************
FUNCTION GetPreValidate(oGet)
*****************************
LOCAL lSavUpdated,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
ELSEIF ( !lWhen )
   oGet:exitState := GE_WHEN
ELSE
   oGet:exitState := GE_NOEXIT
END
RETURN ( lWhen )


******************************
FUNCTION GetPostValidate(oGet)
******************************
LOCAL lSavUpdated
LOCAL lValid := .T.
IF ( oGet:exitState == GE_ESCAPE )
   RETURN ( .T. )
ENDIF
IF ( oGet:badDate() )
   oGet:home()
   DateMsg()
   ShowScoreboard()
   RETURN ( .F. )
ENDIF
IF ( oGet:changed )
   oGet:assign()
   slUpdated := .T.
ENDIF
oGet:reset()
IF !( oGet:postBlock == NIL )
   lSavUpdated := slUpdated
   SETPOS( oGet:row, oGet:col + LEN( oGet:buffer ) )
   lValid := EVAL( oGet:postBlock, oGet )
   SETPOS( oGet:row, oGet:col )
   ShowScoreBoard()
   oGet:updateBuffer()
   slUpdated := lSavUpdated
   IF ( slKillRead )
       oGet:exitState := GE_ESCAPE
       lValid := .T.
   ENDIF
ENDIF
RETURN ( lValid )

************************************
PROCEDURE GetDoSetKey(keyBlock,oGet)
************************************
LOCAL lSavUpdated
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
ENDIF
RETURN

***************************************
STATIC FUNCTION Settle( GetList, nPos )
***************************************
LOCAL nExitState
IF ( nPos == 0 )
			IF LASTKEY()=K_UP
						nExitState := GE_UP
						nPos = LEN( GetList ) + 1
			ELSE
						nExitState := GE_DOWN
			ENDIF
ELSE
			nExitState := GetList[ nPos ]:exitState
ENDIF
IF ( nExitState == GE_ESCAPE .or. nExitState == GE_WRITE )
			RETURN ( 0 )
ENDIF
IF !( nExitState == GE_WHEN )
			snLastPos := nPos
			slBumpTop := .F.
			slBumpBot := .F.
ELSE
			nExitState := snLastExitState
ENDIF
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
IF ( nPos == 0 )
			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
snLastExitState := nExitState
IF !( nPos == 0 )
			GetList[ nPos ]:exitState := nExitState
ENDIF
RETURN ( nPos )

**************************************
STATIC PROCEDURE PostActiveGet( oGet )
**************************************
GetActive( oGet )
ReadVar( GetReadVar( oGet ) )
ShowScoreBoard()
RETURN

*********************************
STATIC FUNCTION ClearGetSysVars()
*********************************
LOCAL aSavSysVars[ GSV_COUNT ]
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
slKillRead      := .F.
slBumpTop       := .F.
slBumpBot       := .F.
snLastExitState := 0
snLastPos       := 0
scReadProcName  := ""
snReadProcLine  := 0
slUpdated       := .F.
RETURN ( aSavSysVars )

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

**********************************
STATIC FUNCTION GetReadVar( oGet )
**********************************
LOCAL cName := UPPER( oGet:name )
LOCAL i
IF !( oGet:subscript == NIL )
			FOR i := 1 TO LEN( oGet:subscript )
							cName += "[" + LTRIM( STR( oGet:subscript[i] ) ) + "]"
			NEXT
END
RETURN ( cName )

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

**********************
PROCEDURE __KillRead()
**********************
slKillRead := .T.
RETURN

***********************
FUNCTION GetActive( g )
***********************
LOCAL oldActive := soActiveGet
IF ( PCOUNT() > 0 )
			soActiveGet := g
ENDIF
RETURN ( oldActive )

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

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

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

#define SCORE_ROW 1
#define SCORE_COL 66
*********************************
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

**************************
STATIC PROCEDURE DateMsg()
**************************
LOCAL nRow
LOCAL nCol
IF ( SET( _SET_SCOREBOARD ) )
			nRow := ROW()
			nCol := COL()
			SETPOS( SCORE_ROW, SCORE_COL )
			SETPOS( nRow, nCol )
			WHILE ( NEXTKEY() == 0 )
			END
			SETPOS( SCORE_ROW, SCORE_COL )
			SETPOS( nRow, nCol )
ENDIF
RETURN

*****************************************
FUNCTION RangeCheck( oGet, junk, lo, hi )
*****************************************
LOCAL cMsg, nRow, nCol
LOCAL xValue
IF ( !oGet:changed )
			RETURN ( .T. )
ENDIF
xValue := oGet:varGet()
IF ( xValue >= lo .and. xValue <= hi )
			RETURN ( .T. )
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. )

**************************
FUNCTION ReadKill( lKill )
**************************
LOCAL lSavKill := slKillRead
IF ( PCOUNT() > 0 )
			slKillRead := lKill
ENDIF
RETURN ( lSavKill )

********************************
FUNCTION ReadUpdated( lUpdated )
********************************
LOCAL lSavUpdated := slUpdated
IF ( PCOUNT() > 0 )
			slUpdated := lUpdated
ENDIF
RETURN ( lSavUpdated )

************************
FUNCTION ReadFormat( b )
************************
LOCAL bSavFormat := sbFormat
IF ( PCOUNT() > 0 )
			sbFormat := b
ENDIF
RETURN ( bSavFormat )

*************************************
procedure GetCalcApplyKey(oGet, nKey)
*************************************
local cKey
local bKeyBlock
local cTemp
local nTemp
IF (bKeyBlock := SetKey(nKey)) <> NIL
	GetDoSetKey(bKeyBlock, oGet)
	RETURN
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()
					GetCalcImp( oGet )
					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
	CASE nKey == K_CTRL_W
			oGet:exitState := GE_WRITE
	CASE nKey == K_UNDO
			oGet:undo()
			GetCalcImp( oGet )
	CASE nKey == K_BS .OR. nKey == K_DEL .OR. nKey == K_LEFT
			IF LEN( oGet:cValor ) > 1
					IF At( '.', oGet:cValor ) > 0
							oGet:nPos--
							IF oGet:nPDec > 0
									oGet:nPDec--
							ENDIF
					ELSE
							oGet:nPLen--
					ENDIF
					oGet:clear  = .F.
					oGet:cValor = LEFT( oGet:cValor, LEN( oGet:cValor ) - 1 )
					oGet:varPut( VAL( oGet:cValor ) )
					oGet:buffer := Transform( oGet:varGet(), oGet:picture )
					oGet:display()
					SETPOS( oGet:row,oGet:nPos )
			ENDIF
	CASE nKey == ASC('-')
			oGet:clear = .F.
			IF oGet:minus
					oGet:minus = .F.
					oGet:nPLen--
			ELSE
					IF oGet:nPLen = oGet:nLen
							RETURN
					ENDIF
					oGet:minus = .T.
					oGet:nPLen++
			ENDIF
			oGet:varPut( IF( oGet:minus, -VAL( oGet:cValor ), VAL( oGet:cValor ) ) )
			oGet:buffer := Transform( oGet:varGet(), oGet:picture )
			oGet:display()
			SETPOS( oGet:row,oGet:nPos )
	CASE nKey == ASC('.') .OR. nKey == ASC(',')
			IF oGet:nDec > 0 .AND. At( '.', oGet:cValor ) == 0
					IF oGet:clear
							oGet:clear  = .F.
							oGet:varPut( 0 )
							GetCalcImp( oGet )
					ENDIF
					oGet:cValor += "."
					oGet:nPos++
					oGet:display()
					SETPOS( oGet:row,oGet:nPos )
			ENDIF
	OTHERWISE
			IF nKey >= Asc('0') .AND. nKey <= Asc('9')
					IF oGet:clear
							oGet:clear = .F.
							oGet:varPut( 0 )
							GetCalcImp( oGet )
					ENDIF
					IF At( '.', oGet:cValor ) > 0
							IF oGet:nPDec = oGet:nDec
										RETURN
							ENDIF
							oGet:nPos++
							oGet:nPDec++
					ELSE
							IF oGet:nPLen = oGet:nLen
									RETURN
							ELSEIF nKey == ASC('0') .AND. oGet:varGet()==0
									RETURN
							ENDIF
							oGet:nPLen++
					ENDIF
					oGet:cValor += CHR( nKey )
					oGet:varPut( IF( oGet:minus, -VAL( oGet:cValor ), VAL( oGet:cValor ) ) )
					oGet:buffer := Transform( oGet:varGet(), oGet:picture )
					oGet:display()
					SETPOS( oGet:row,oGet:nPos )
			ENDIF
ENDCASE
RETURN

*********************************
STATIC procedure CalcLenNum(oGet)
*********************************
LOCAL x,nLen:=LEN( oGet:picture)
oGet:nLen := 0
oGet:nDec := 0
IF AT( '.', oGet:picture ) > 0
   DO WHILE (x:=SUBSTR( oGet:picture, nLen, 1 )) != '.'
      IF x == '9' .OR. x =="#" .OR. x == "*"
         oGet:nDec++
      ENDIF
      nLen--
   ENDDO
   nLen--
ENDIF
DO WHILE nLen > 0
   IF (x:=SUBSTR( oGet:picture, nLen, 1)) == '9' .OR. x == "#" .OR. x == "*"
      oGet:nLen++
   ENDIF
   nLen--
ENDDO
RETURN

*********************************
STATIC procedure GetCalcImp(oGet)
*********************************
LOCAL nLen:=18
oGet:nPos = oGet:col + oGet:decPos - 2
oGet:cValor = STR( oGet:varGet(), nLen, 5 )
IF (oGet:minus := AT( '-', oGet:cValor ) > 0 )
  oGet:cValor = STRTRAN( oGet:cValor, '-', ' ' )
ENDIF
DO WHILE ( nLen > 13 .AND. SUBSTR( oGet:cValor, nLen, 1 ) == '0' )
  nLen--
ENDDO
IF nLen >= 13
  oGet:nPDec = ( nLen - 13 )
  IF nLen = 13
    nLen--
  ENDIF
  oGet:nPos += ( nLen - 12 )
ELSE
  oGet:nPDec = - 1
ENDIF
oGet:cValor = " " + LTRIM( LEFT( oGet:cValor, nLen ) )
IF AT( '.', oGet:cValor) == 0
   oGet:nPLen = LEN( oGet:cValor ) - 2
ELSE
   oGet:nPLen = LEN( oGet:cValor ) - oGet:nPDec - 2
ENDIF
IF oGet:minus
   oGet:nPLen++
ENDIF
oGet:display()
oGet:buffer := Transform( oGet:varGet(), oGet:picture )
SETPOS( oGet:row,oGet:nPos )
RETURN

[Daniel]

Este e joia mesmo.

testei ele da erro no Backspace quanto apaga tudo e digita de novo ele estora o tamanho do get, e nao pula o get quanto esta cheio.

unindo os dois acho que vai ficar joia

Valeu )

[janio]

Outra coisa: usando o fonte em questão a tecla Backspace naum funcionou nos get´s numéricos com decimais. Alguem pode me ajudar com relacao a isso?

TerraSoftware.

Na função GetApplyKey, substitua a linha

CASE ( nKey == K_LEFT )

por

CASE ( nKey == K_LEFT ) .or. ( nKey == K_BS )


Daniel,

Essa sua função alterada do getsys é ótima. Há muito tempo procurava essa alteração. Se não fosse esse pequeno problema que relatei... mas aguardo o seu retorno.

Jânio

[janio]

Digite: 123456 e pressione <ENTER>. Vc vai ver que ficou assim: 1234-6, ou seja, 'comeu' o 5.

Comigo saiu tudo normal: 12345-6

Funcionou!?

Fez conforme exemplifiquei??? ou seja, linkou o getsys.prg postado pelo Daniel testou o exemplo abaixo...

x2:= 0
@ 12, 12 say "Teste" Get x2 Picture "@R 999999-9"
Read

Digite: 123456 e pressione <ENTER>. Vc vai ver que ficou assim: 1234-6, ou seja, 'comeu' o 5.


Alguém mais pode fazer esse teste pra ver o q acontece??

Jânio

[clodoaldomonteiro]

Olá Jânio!

Depois de muito testar no Getsys que o Daniel postou, achei o lugar correto onde fazer a alteração que você queria, ou seja, quando getar um campo numéco com '@R 99999-9', ele avança da direita para a esquerda e conserva o sinal de menos.

Veja as alterações na procedure MOSTRAVALOR():

Código: Selecionar todos

For ind1 := Len(valor1)  to 1 Step -1
    If Empty(Substr(valor1,ind1,1))
       Exit
    Endif
    If Substr(mascara,ind,1) = '.'
       valor := ',' + valor
    ElseIf Substr(mascara,ind,1) = ','
       valor := '.' + valor
       ind --
    ElseIf Substr(mascara,ind,1) = '-' //clodoaldo
       valor := '-' + valor
    Endif
    If !Substr(valor1,ind1,1) $ ',.-'   //clodoaldo
       valor := Substr(valor1,ind1,1) + valor
    Endif
    ind --
Next

... veja, onde tem meu nome, que eu inclui um elseif para tratar o sinal ' - ' , e depois inclui o ' - ' onde tinha ',.'

Espero que dê certo com você, pois aqui deu certo.

Até mais.

[Daniel]

Clodoaldo
eu tinha arrumado assim tambem, mais como ele esta usando codigo caracter ele pode usar qualquer caracter, teria que por mais opcoes

Esta funcao tem mais um erro que estou arrumando, quando vc declara uma funcao numerica e usa o get sem mascara
ex:
x:= 0

@ 10,10 say "teste:" get x
read

ai da erro

[TerraSoftware]

Ola Daniel. O trabalho em equipe é um negócio fantastico mesmo né.

Vc tem razão nos comentários sobre o meu getsys. Realmente acho que a junçao dos 2 será o melhor. Mas na minha opnião nuam acho viavel o get pular sozinho quando estiver cheio. Penso que o usuário deve tecla enter para proceguir. Afinal este é um principio basico da informática: digito uma informação e teclo enter pra ela ser processada. Pelo menos é esse o padrao que adoto nos meus programas, tanto em clipper como em harbour. Observo tambem que a maioria dos programadores fazem assim. Se possível, gostaria que vc naum fizesse isso no novo getsys que esta surgindo nesta postagem. Ou seja, prefiro enter para continuar. Ou talvez seja melhor entaum deixar esta questaum configurável.

[clodoaldomonteiro]

Daniel!

Eu tava testando a correção no seu getsys e tava vendo se usar um if '@R'$oget:picture - testar se a mascara comtem @R.
Daí vi que pro caso do Jânio a solução seria bem simples, como postei acima.

Quanto ao get numério sem mascara, pode ser colocado um teste mascara:=if(empty(oget:picture),'999999999999.99',oget:picture).

Quanto a colocação do TerraSoft, em que o usuário deve teclar enter para pular o campo, eu acho que deve ser levado em consideração o SET CONFIRM ON|OFF, assim pode-se fazer uma rotina e deixar o próprio usuário escolher o que lhe convier.

Vou continuar testando para ver se faço mais correções.

[janio]

Olá Jânio!

Depois de muito testar no Getsys que o Daniel postou, achei o lugar correto onde fazer a alteração que você queria, ou seja, quando getar um campo numéco com '@R 99999-9', ele avança da direita para a esquerda e conserva o sinal de menos.
...
...

Espero que dê certo com você, pois aqui deu certo.

Até mais.

Olá Clodoaldo,

Em testes preliminares tem funcionado PERFEITO essas alterações sugerida por vc.

:{ :xau ) :*

Obrigado.

Vou continuar testando...

Jânio

[Stanis Luksys]

Ou talvez seja melhor entaum deixar esta questaum configurável.

Mas isso já é configurável por padrão, através do SET CONFIRM ON/OFF.

Ou as alterações do GETSYS mudaram isso?

[clodoaldomonteiro]

Olá amigos!

Foi questionado a possibilidade de se colocar no getsys campos tipo senha, pois depois de muito trabalho consegui fazer isso.

Para dizer ao getsys que o campo é uma senha é necessário informar o picture '@P'.

Fiz a modificação no getsys postado pelo Daniel, mesclando um exemplo de campo senha que foi postado aqui no forum.

O bom é que ficou tudo junto: campo senha '@R', minusculo '@M', AJUDA a cada campo e números rolando para a direita.

A função do getsys a alterar foi a GETREADER e eu tirei os tratamentos de acentos somente para ficar menor.

Código: Selecionar todos

PROCEDURE GetReader( oGet )

   LOCAL   nKey,cKey,cRet,original
   PRIVATE lPrimKey := .T.

   // Read the GET if the WHEN condition is satisfied
   IF ( GetPreValidate( oGet ) )

      // Activate the GET for reading
      oGet:setFocus()
      oGet:CARGO := "" //senha

      WHILE ( oGet:exitState == GE_NOEXIT )

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

         // Tratamento para entrada Direita -> Esquerda
         IF ( oGet:type == "N" )   .And. ( Len( oGet:buffer ) > oGet:DecPos )
            oGet:Pos := Len( oGet:buffer ) + 1
            oGet:End()
            oGet:ToDecPos()
            oGet:Left()
         ELSEIF ( oGet:type == "N" )
            oGet:Pos := Len( oGet:buffer ) + 1
            oGet:End()
         ENDIF

         cKey := ''
         nKey := 0

         // Apply keystrokes until exit

         original := oGet:buffer

         WHILE ( oGet:exitState == GE_NOEXIT )

            // Armazena a tecla que foi pressionada anteriormente
            cKey := Chr(nKey)

            // Le a Pr¢xima tecla
            nKey := inkey( 0 )

            // Ajusta Caract‚r de Retorno
            IF !READINSERT()
               cRet := CHR(19)
            ELSE
               cRet := CHR(08)
            ENDIF

            //tratamento de campo senha senha
            if '@P' $ oget:picture
               IF     nKey >= 32 .AND. nKey <= 255
                  oGet:CARGO := oGet:CARGO() + CHR(nKey)
                  GetApplyKey(oGet, 42, original)  // NOME COMPLETO
               ELSEIF nKey = 8
                  oGet:CARGO := SUBSTR(oGet:CARGO(), 1, LEN(oGet:CARGO()) - 1)
                  GetApplyKey(oGet, nKey, original)  // NOME COMPLETO
               ELSEIF nKey = 13 // Sai com tecla ENTER e retorna a
                  // senha digitada
                  GetApplyKey(oGet, nkey, original)  // NOME COMPLETO
               ELSEIF nKey = 27 // Sai com Tecla ESC e retorna vazio
                  GetApplyKey(oGet, nkey, original)  // NOME COMPLETO
               ELSEIF nKey = 5           // Volta para o get anterior
                  oGet:CARGO := space(15)//preenche o get com espa‡os
                  GetApplyKey(oGet, nKey, original) // NOME COMPLETO
               ENDIF
            endif
            // Verifica tecla pressionada
            if !('@P' $ oget:picture)  //se nÆo for campo senha
               GetApplyKey( oGet, nkey, original )
            endif
            *
            lPrimKey := .F.
            *
         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

   //tratamento de campo senha senha
   if '@P' $ oget:picture
      IF oGet:EXITSTATE() <> 7
         oGet:VARPUT(oGet:CARGO())
      ENDIF
   endif
   
   RETURN

Espero ter ajudado.

[Stanis Luksys]

Impressionante como as coisas podem evoluir.

Ficou realmente muito bom com todas estas alterações implementadas.

[clodoaldomonteiro]

Infelizmente ainda não consegui colocar no meu getsys, que é original da GAS.
Mas tô tentando.