Campo Senha

[clodoaldomonteiro]

Fiz alterações na função do Quintas para que o BackSpace venha e diminuir o tamanho da senha no monitor, e também que se possa passar a senha anterior:

Código: Selecionar todos

FUNCTION GetSecret( cSenha, nRow, nCol, nLen )

   LOCAL cText, nKey, cSetColor

   DEFAULT nLen To 20

   cSetColor := SetColor("7/0,/0")
   @ nRow, nCol SAY Replicate( " ", nLen ) //COLOR SetColorFocus()
   @ nRow, nCol SAY Replicate( "*", Len(Alltrim(cSenha)) ) //COLOR SetColorFocus()
   cText := cSenha
   DO WHILE .T.
      @ nRow, nCol + Len( cText ) SAY ""
      nKey := Inkey( 600, INKEY_ALL - INKEY_MOVE + 1024) //HB_INKEY_GTEVENT )
      DO CASE
      CASE nKey == 0
         QUIT // KEYBOARD Chr( K_ESC ) + "S"
      CASE nKey == K_RBUTTONDOWN
         KEYBOARD Chr( K_ESC )
      CASE nKey < 1 .OR. nKey > 126
         LOOP
      CASE nKey == K_ENTER
         cText := Pad( cText, 20 )
         EXIT
      CASE nKey = K_ESC
         EXIT
      CASE nKey == K_BS .OR. nKey == K_LEFT
         IF Len( cText ) > 0
            cText := Substr( cText, 1, Len( cText ) - 1 )
            @ nRow, nCol SAY Replicate( " ", nLen )
            @ nRow, nCol SAY Replicate( "*", Len(Alltrim(cText)) )
         ENDIF
      CASE Len( cText ) == nLen
      OTHERWISE
         cText += Upper( Chr( nKey ) )
         @ nRow, nCol SAY Replicate( "*", Len(Alltrim(cText)) )
      ENDCASE
   ENDDO
   SetColor( cSetColor )

   RETURN cText

[clodoaldomonteiro]

Vou testar essa também Jânio.
Muito obrigado.

[clodoaldomonteiro]

Parabéns Hazael, são muito boas as suas modificações.
Vou começar a modificar meu GetSys hj mesmo.
Muito obrigado.

[alxsts]

Olá!

Este código postado pelo Clodoaldo e pelo Jânio tem origem no código que posto abaixo, completo, incluído o arquivo de cabeçalho. O mesmo foi publicado no livro do Rick Spence faz muito tempo. Não precisa alterar GetSys. Pode manter como função independente. O campo password pode estar entre os demais gets, sem problema.

Código: Selecionar todos

/***
* Getpass.prg
*
* Password GET - echoing asterisks
*/

#include "Getexit.ch"
#include "Inkey.ch"

//#include "Getpass.ch"

/***
* Getpass.ch
*
* Definition of GET PASSWORD command.
*/

#command @ <row>, <col> GET <var>                                ;
                        [<clauses,...>]                          ;
                        PASSWORD                                 ;
                        [<moreClauses,...>]                      ;
                                                                 ;
      => @ <row>, <col> GET <var>                                ;
                        [<clauses>]                              ;
                        SEND reader := {|oGet|                   ;
                                        GetPassword(oGet) }      ;
                        [<moreClauses>]



FUNCTION Getpass

LOCAL cVar1 := Space(10), ;
      cVar2 := Space(15), ;
      cVar3 := Space(12)

LOCAL GetList := {}

  CLEAR SCREEN
  @ 10, 10 SAY "Usuário    " GET cVar1          
  @ 11, 10 SAY "Senha      " GET cVar2 PASSWORD 
  @ 12, 10 SAY "Empresa    " GET cVar3
  READ

RETURN NIL
//------------------------------------------------------------------------------

proc GetPassword( oGet )

LOCAL nKey,              ;
      nChar,             ;
      cKey

  // read the GET if the WHEN condition is satisfied
  IF ( GetPreValidate(oGet) )
    // activate the GET for reading
    oGet:SetFocus()

    oGet:cargo := ""
    DO WHILE ( oGet:exitState == GE_NOEXIT )
      // check for initial typeout (no editable positions)
      IF ( oGet:typeOut )
        oGet:exitState := GE_ENTER
      ENDIF

      // apply keystrokes until exit
      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)
        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 oGet:exitState != GE_ESCAPE
    oGet:varPut(oGet:cargo)
  ENDIF

RETURN
//------------------------------------------------------------------------------

senhapasswordsecret