PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Picture q impeça Ç e letras acentuadas, existe?

https://pctoledo.org/viewtopic.php?t=9895

Página 1 de 1

Picture q impeça Ç e letras acentuadas, existe?

Enviado: 09 Nov 2009 05:57
por lugab
Boa noite a todos,

Eu gostaria que o meu GET e READ só permitisse a digitação de letras e números, sem Ç, nem letras acentuadas.

Se não existir nenhum PICTURE específica , deve haver ao menos alguma função pronta, pra gente colocar no VALID.

Alguém pode ajudar ?

Grato,

Gabriel

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 09 Nov 2009 07:47
por Toledo
Gabriel, dê uma olhada neste tópico que encontrei usando a busca do fórum:

viewtopic.php?f=43&t=9605

Abraços,

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 09 Nov 2009 08:22
por Maurício Elias
Bom dia colega.

Não conheço uma rotina pronta não. Deve até existir.
Mas acho q se vc fizer pelo Valid, uma padrão, não vai ser complicada não hein.

Abraços.

Maurício

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 09 Nov 2009 15:27
por lugab
Toledo e Maurício, obrigado...

Vou ter q fazer via valid, mesmo...

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 10 Nov 2009 00:58
por alxsts
Olá!

Outra opção seria usar um Reader alternativo para o GET. Por favor, veja nos exemplos abaixo.

- Teste.Prg - Monta uma tela com 3 GETs, sendo que o segundo vai usar o Reader alternativo:

Código: Selecionar todos

*  Compilar: Clipper Teste /N /W
*  Link    : 

#include "box.ch"
#include "inkey.ch"

FUNCTION Main()

   LOCAL nMode := 1, GetList := {}

   LOCAL nCod, cNome, cEmail, cColor

   SetBlink( .F. )
   cColor := SetColor( "B/W, B/W*" )

   WHILE nMode > 0

      CLS

      DispBox( 04, 10, 07, 45, B_SINGLE )

      @ 05, 11 Prompt " Substituir caracteres acentuados "
      @ 06, 11 Prompt " Rejeitar caracteres acentuados   "
      Menu To nMode

      // O primeiro e o terceiro GET's usam o READER default 
      // O segundo usa o CharReader() para selecionar caracteres

      nCod := 0
      cNome := Space(40)
      cEmail := Space(50)
      
      @ 10, 10 Say "C¢digo    " GET nCod Pict "9999"
      @ 11, 10 Say "Nome      " GET cNome SEND READER := { |oGet| CharReader( oGet, nMode ) }
      @ 12, 10 Say "e-mail    " GET cEmail

      READ
      
      IF LastKey() == K_ESC
         EXIT
      ENDIF
   ENDDO
   
   RETURN (NIL)

//------------------------------------------------------------------------------
- CharRead.Prg - Reader Alternativo.

Código: Selecionar todos

/***
*
*  Baseado em GetReader() - Adaptação: Alexandre Santos
*
*  Standard modal read of a single GET
*
*  Compilar: Clipper CharReader /N /W
*  Link    : 
*/

#include "set.ch"
#include "inkey.ch"
#include "getexit.Ch"

#define K_UNDO          K_CTRL_U

#define CTRL_END_SPECIAL

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

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

FUNCTION CharReader( oGet, nMode )
         
   LOCAL aSavGetSysVars

   nMode := If( nMode == NIL, 1, nMode )
   
   // Preserve state variables
   aSavGetSysVars := ClearGetSysVars()

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

   // 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 ), nMode )
         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 (NIL)
//------------------------------------------------------------------------------
/***
*
*  GetApplyKey()
*
*  Apply a single INKEY() keystroke to a GET
*
*  NOTE: GET must have focus.
*
*/
STATIC PROCEDURE GetApplyKey( oGet, nKey,  nMode )

   LOCAL cKey, cNewKey, 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 ( oGet:type != "C" ) .OR. ( oGet:type == "C" .AND. ( ( cNewKey := ValidateKey( cKey, nMode ) ) != NIL ) )
               cKey := cNewKey
               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
            ELSE
               IF ( SET( _SET_BELL ) )
                  QQOUT( CHR(7) )
               ENDIF
            ENDIF
         ENDIF

      ENDIF

   ENDCASE

   RETURN
//------------------------------------------------------------------------------
/***
*
*  GetPreValidate()
*
*  Test entry condition (WHEN clause) for a GET
*
*/
STATIC 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
*
*/
STATIC 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
*
*/
STATIC 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
//------------------------------------------------------------------------------

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

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 ), "Ins", "   " ) )
      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( " Data Inválida" )
      SETPOS( nRow, nCol )

      WHILE ( NEXTKEY() == 0 )
      END

      SETPOS( SCORE_ROW, SCORE_COL )
      DISPOUT( SPACE( 12 ) )
      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 := "Faixa: " + LTRIM( TRANSFORM( lo, "" ) ) + ;
            " - " + 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. )
//------------------------------------------------------------------------------
/***
*
*  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
//------------------------------------------------------------------------------
STATIC FUNCTION ValidateKey( cKey, nMode )

   LOCAL xVar, cRet, nPos

   DO CASE
      // Pesquisa caracter em uma lista de substitui‡äes
      // Caso encontre, devolve o caracter substituto
      // Caso nÆo encontre devolve o pr¢prio caracter.

      CASE nMode == 1

         xVar := ArrayInit()

         IF ( nPos := AScan( xVar, { |e| e[1] == ASC( cKey ) } ) ) == 0
            cRet := cKey
         ELSE
            cRet := xVar[ nPos, 2 ]         
         ENDIF   
         
      CASE nMode == 2
      
         // Rejeita caracter que nÆo perten‡a a uma lista de caracteres permitidos

         xVar := "abcdefghijklmnopqrstuvwxyz"
         xVar += "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
         xVar += "0123456789"
         xVar += ' ,.;/-=()*&%$#@"'

         IF At( cKey, xVar ) > 0
            cRet := cKey
         ENDIF

   END CASE

   RETURN cRet
//------------------------------------------------------------------------------
STATIC FUNCTION ArrayInit()

   LOCAL aCharSet := {}

   Aadd( aCharSet, { 128, "C" } )  //   Ç
   Aadd( aCharSet, { 129, "u" } )  //   ü
   Aadd( aCharSet, { 130, "e" } )  //   é
   Aadd( aCharSet, { 131, "a" } )  //   â
   Aadd( aCharSet, { 132, "a" } )  //   ä
   Aadd( aCharSet, { 133, "a" } )  //   à
   Aadd( aCharSet, { 134, "a" } )  //   å
   Aadd( aCharSet, { 135, "c" } )  //   ç
   Aadd( aCharSet, { 136, "e" } )  //   ê
   Aadd( aCharSet, { 137, "e" } )  //   ë
   Aadd( aCharSet, { 138, "e" } )  //   è
   Aadd( aCharSet, { 139, "i" } )  //   ï
   Aadd( aCharSet, { 140, "i" } )  //   î
   Aadd( aCharSet, { 141, "i" } )  //   ì
   Aadd( aCharSet, { 142, "A" } )  //   Ä
   Aadd( aCharSet, { 143, "A" } )  //   Å
   Aadd( aCharSet, { 144, "E" } )  //   É
   Aadd( aCharSet, { 145, "E" } )  //   æ
   Aadd( aCharSet, { 147, "o" } )  //   ô
   Aadd( aCharSet, { 148, "o" } )  //   ö
   Aadd( aCharSet, { 149, "o" } )  //   ò
   Aadd( aCharSet, { 150, "u" } )  //   û
   Aadd( aCharSet, { 151, "u" } )  //   ù
   Aadd( aCharSet, { 152, "y" } )  //   ÿ
   Aadd( aCharSet, { 153, "O" } )  //   Ö
   Aadd( aCharSet, { 154, "U" } )  //   Ü
   Aadd( aCharSet, { 160, "a" } )  //   á
   Aadd( aCharSet, { 161, "i" } )  //   í
   Aadd( aCharSet, { 162, "o" } )  //   ó
   Aadd( aCharSet, { 163, "u" } )  //   ú
   Aadd( aCharSet, { 164, "n" } )  //   ñ
   Aadd( aCharSet, { 165, "N" } )  //   Ñ
   Aadd( aCharSet, { 181, "A" } )  //   Á
   Aadd( aCharSet, { 182, "A" } )  //   Â
   Aadd( aCharSet, { 183, "A" } )  //   À
   Aadd( aCharSet, { 198, "a" } )  //   ã
   Aadd( aCharSet, { 199, "A" } )  //   Ã
   Aadd( aCharSet, { 210, "E" } )  //   Ê
   Aadd( aCharSet, { 211, "E" } )  //   Ë
   Aadd( aCharSet, { 212, "E" } )  //   Ë
   Aadd( aCharSet, { 213, "i" } )  //   
   Aadd( aCharSet, { 214, "i" } )  //   
   Aadd( aCharSet, { 215, "i" } )  //     
   Aadd( aCharSet, { 216, "i" } )  //     
   Aadd( aCharSet, { 224, "O" } )  //
   Aadd( aCharSet, { 226, "o" } )  //
   Aadd( aCharSet, { 227, "o" } )  //
   Aadd( aCharSet, { 228, "o" } )  //
   Aadd( aCharSet, { 229, "o" } )  //
   Aadd( aCharSet, { 233, "u" } )  //
   Aadd( aCharSet, { 234, "U" } )  //
   Aadd( aCharSet, { 235, "u" } )  //   

   RETURN aCharSet
//------------------------------------------------------------------------------
Para gerar o executável:
Clipper Teste /N
Clipper CharRead /N

Blinker File Teste, CharRead

Execução:
quando executado, apresenta menu com duas opções:
Substituir caracteres acentuados ==> troca caracteres acentuados por um correspondente de uma tabela interna de conversão
Rejeitar caracteres acentuados ==> pesquisa caracteres válidos em uma tabela interna e rejeita se não encontrar

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 23 Nov 2009 18:36
por lugab
Obrigado pessoal, Alxts...

Vou testar tudo e adotar o mais conveniente ao meu programa

Gabriel

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 23 Nov 2009 23:57
por alxsts
Olá!

Gabriel:

se você optar pela solução que postei, por favor faça uma verificação na tabela de caracteres que está na função ArrayInit(), em CharRead.Prg. Verifique se todos os caracteres acentuados estão nesta tabela. É que fiz este exemplo meio "na correria" e pode ser que existam erros ou omissões.

Re: Picture q impeça Ç e letras acentuadas, existe?

Enviado: 24 Nov 2009 18:32
por lugab
Certo, Alxsts.. farei isso.

Grato,

gabriel
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB