Preencher Get da direita para esquerda

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Heitor.Souza
Usuário Nível 1
Usuário Nível 1
Mensagens: 9
Registrado em: 05 Dez 2012 09:33
Localização: Rio de Janeiro

Preencher Get da direita para esquerda

Mensagem por Heitor.Souza »

Pls.

Alguém tem um getsys.prg que alimente gets numéricos da direita para a esquerda? Ou uma solução para o caso.

Uso xHarbour build 1.2.1 Intl. (SimpLex) (Rev. 9382)

Grato.
Heitor Souza
Rio de Janeiro - RJ
Linux- Xharbour-Mysql
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Preencher Get da direita para esquerda

Mensagem por Pablo César »

Veja se este GetSys, resolve o caso: https://pctoledo.org/forum/viewto ... 282#p73282
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Heitor.Souza
Usuário Nível 1
Usuário Nível 1
Mensagens: 9
Registrado em: 05 Dez 2012 09:33
Localização: Rio de Janeiro

Preencher Get da direita para esquerda

Mensagem por Heitor.Souza »

Já tentei esse. Dá erro em tempo de execução quando usa-se "get listbox".
Heitor Souza
Rio de Janeiro - RJ
Linux- Xharbour-Mysql
Avatar do usuário
janio
Colaborador
Colaborador
Mensagens: 1846
Registrado em: 06 Jul 2004 07:43
Localização: UBAJARA - CE

Preencher Get da direita para esquerda

Mensagem por janio »

Ta na conta!
Anexos
getsys.prg
(32.29 KiB) Baixado 81 vezes
fui...
e-mail:janioaguiar@yahoo.com.br
msn: janio_aguiar@hotmail.com
xHarbour1.2.1/Harbour3.2 + wvg + hwgui + Mediator + MySql
Heitor.Souza
Usuário Nível 1
Usuário Nível 1
Mensagens: 9
Registrado em: 05 Dez 2012 09:33
Localização: Rio de Janeiro

Preencher Get da direita para esquerda

Mensagem por Heitor.Souza »

Esse prg, dá erro de em tempo de execução quando usa-se get com listbox. Exemplo abaixo.
Li há tempos atrás que algum alterou o tgetlist.prg , mas não consigo achar referências sobreo o assunto.

Código: Selecionar todos

@  06, 11          Say HB_AnsiToOem("Condição Pgto") 
@  07, 10,  14, 25 GET nforma ;
                           LISTBOX aForma ;
		           CAPTION "" ;
		           COLOR cColor
         
READ // Forma de pgto 1
Avatar do usuário
billy1943
Usuário Nível 4
Usuário Nível 4
Mensagens: 570
Registrado em: 12 Mai 2009 17:33
Localização: Bauru-SP

Preencher Get da direita para esquerda

Mensagem por billy1943 »

Não sei se os colegas querem um get similar à entrada em calculadoras.

Caso seja isso o desejado junto abaixo uma rotina que fiz há muito tempo, mas bem funcional.
Não a testei em Harbour, somente em Clipper 52E.

Código: Selecionar todos

***********************************************************************************************************************
*** FUNCAO = ENTRADA NUMERICA para valores MONETARIOS ===>                                                            *
*** 7 parametros: 1)linha, 2)coluna,3)aceita-zero,4)quantidade de digitos,5)valor anterior,6)mascara,7)casas decimais *
*** EXEMPLO: entr_val(10,27,.t.,8,0,"@z ###,###,##",2)                                                                *
*** 10  = linha onde comeca a edicao do valor                                                                         *
*** 27  = coluna onde comeca a edicao do valor                                                                        *
*** .t. = nao aceitar  zero   ou .f.= aceitar  o campo com valor zerado                                               *     *
*** 8   = quantidade de algarismos - maximo de 13 inclusive os apos a virgula                                          *
*** 0   = valor anterior fornecido (pode ser uma variavel numerica)                                                   *
*** "@z ###,###.##" = mascara de edicao para 8 caracteres                                                             *         *
*** 2   = casas decimais (campo opcional com default = 2)                                                             *               *
*** a funcao retorna um valor numerico denominado  vrdig                                                              *
***********************************************************************************************************************

FUNCTION entr_val
local getlist := {}
parameters lin,col,testezero,qtde,vrant,formato,cdec
local c,aa
local i := divisor := contador := cv := varcontr := qtdedig := 0
local v[13]
afill(v,0)
public vrdig := vrant
set exact on

if (qtde > 13 .or. lennum(vrant) > 13)
    return nil
endif

if (pcount() > 6)
   set decimals to cdec

   do case

      case cdec == 1
         c := "               , "
         divisor := 10
      case cdec == 3
         c := "             ,   "
         divisor := 1000
      case cdec == 4
         c := "            ,    "
         divisor := 10000
      otherwise
         c := "              ,  "
         divisor := 100

   endcase

else

   set decimals to 2
   c       := "              ,  "
   divisor := 100
   cdec    := 2

endif

if (cdec == 2)
   if (qtde > 2 .and. qtde < 6)       &&  3 a  5              x,xx            xxx,xx
      qtdedig := qtde + 1
   elseif (qtde > 5 .and. qtde < 9)   &&  6 a  8          x.xxx,xx         xxx.xxx,xx
      qtdedig := qtde + 2
   elseif (qtde > 8 .and. qtde < 12)  &&  9 a 11      x.xxx.xxx,xx     xxx.xxx.xxx,xx
      qtdedig := qtde + 3
   elseif (qtde > 11 .and. qtde < 14) && 12 e 13  x.xxx.xxx.xxx,xx  xx.xxx.xxx.xxx,xx
      qtdedig := qtde + 4
   endif
endif

if (cdec == 1)
   if (qtde > 1 .and. qtde < 5)       &&  2 a  4              xx,x              xxx,x
      qtdedig := qtde + 1
   elseif (qtde > 4 .and. qtde < 8)   &&  5 a  7           x.xxx,x          xxx.xxx,x
      qtdedig := qtde + 2
   elseif (qtde > 7 .and. qtde < 11)  &&  8 a 10       x.xxx.xxx,x      xxx.xxx.xxx,x
      qtdedig := qtde + 3
   elseif (qtde > 10 .and. qtde < 14) && 11 a 13   x.xxx.xxx.xxx,x  xxx.xxx.xxx.xxx,x
      qtdedig := qtde + 4
   endif
endif

if (cdec == 3)
   if (qtde > 3 .and. qtde < 7)      && 4 a  6               x,xxx         xxx,xxx       xxx,x
      qtdedig := qtde + 1
   elseif (qtde > 6 .and. qtde < 10) && 7 a  9           x.xxx,xxx     xxx.xxx,xxx
      qtdedig := qtde + 2
   elseif (qtde > 9 .and. qtde < 13) && 10 a 12      x.xxx.xxx,xxx xxx.xxx.xxx,xxx
      qtdedig := qtde + 3
   elseif (qtde == 13)               && 13       x.xxx.xxx.xxx,xxx
      qtdedig := qtde + 4
   endif
endif

if (cdec == 4)
   if (qtde > 4 .and. qtde < 8)       &&  5 a  7          x,xxxx         xxx,xxxx       xxx,x
      qtdedig := qtde + 1
   elseif (qtde > 7 .and. qtde < 11)  &&  8 a 10      x.xxx,xxxx     xxx.xxx,xxxx
      qtdedig := qtde + 2
   elseif (qtde > 10 .and. qtde < 14) && 11 a 13  x.xxx.xxx,xxxx xxx.xxx.xxx,xxxx
      qtdedig := qtde + 3
   endif
endif

do while .t.

   aa := transform(vrdig,"&formato.")
   @ lin,col say right(c,qtdedig)
   @ lin,col+(qtdedig - len(ltrim(aa))) say ltrim(aa)
   @ lin,col+(qtdedig-1) say space(0)

   if (varcontr == 1)
      exit
   endif

   tk := inkey(0)

   if tk == 5 // seta para cima
      vrdig := 0
      exit
   endif

   if (tk == 27)                   && tecla ESC
      vrdig := 0 
      exit
   endif

   do case

      case (tk == 13)              && tecla ENTER

        if (vrdig # 0)
           exit
        endif

        if (! testezero)
           exit
        endif

      case (tk == 7 .or. tk == 8)  && tecla "Del"  ou Back Space

         if (contador > 0)
            contador --
         endif

         for i := 1 to 12
             v[i] := v[i+1]
         next

         v[13] := 0

      case (tk < 48 .or. tk > 57)  && nÆo ‚ algarismo

         loop

      otherwise                    && ‚ algarismo

         if (cv == 0)
            if (vrdig > 0)
               vrdig := 0
               cv    := 1
            endif
         endif

         for i := 13 to 2 step -1
             v[i] := v[i-1]
         next

         v[01] := val(chr(tk))
         contador ++

   endcase

   if (contador >= qtde)
       varcontr := 1
    endif

    vrdig := ( v[01] * 1 ) + ;
             ( v[02] * 10 ) + ;
             ( v[03] * 100 ) + ;
             ( v[04] * 1000 ) + ;
             ( v[05] * 10000 ) + ;
             ( v[06] * 100000 ) + ;
             ( v[07] * 1000000 ) + ;
             ( v[08] * 10000000 ) + ;
             ( v[09] * 100000000 ) + ;
             ( v[10] * 1000000000 ) + ;
             ( v[11] * 10000000000 ) + ;
             ( v[12] * 100000000000 ) + ;
             ( v[13] * 1000000000000 )
    vrdig := vrdig/divisor
    cv    := 1

enddo

@ lin, col get vrdig pict "&formato."
clear gets
return(vrdig)
O bom do computador é que ele resolve os problemas, sem nunca levantar nenhum.
Hoje atuo mais com Clipper 52E, e um pouquinho com XHarbour.
Responder