PC Toledo

Enviado: **24 Jul 2014 02:19**

Amiguinhos,

Depois de ver o problema no tópico Função Valores em Extenso em Inglês e buscar uma solução me veio a idéia de verificar minha função de extenso.

Após alguns testes verifiquei que ela precisava de mais uma manutenção para correção e adendos e o resultado final esta logo abaixo:

Código: Selecionar todos

* Arquivo...: EXTENSOBR.PRG 
* Autor.....: Jose Carlos da Rocha
* 
* O codigo original reside como parte integrante do livro de Jose Ramalho
* 
* Proposito: Mostrar valores em extenso em inglês

Function Main()

   ? EXTENSOBR( 275.49 )
   ? EXTENSOBR( 100 )
   ? EXTENSOBR( 999 )
   ? EXTENSOBR( 1000 )
   ? EXTENSOBR( 1000000 )
   ? EXTENSOBR( 1000000000 )
   ? EXTENSOBR( 1000000000000 )
   ? EXTENSOBR( 1000000000000.52 )
   ? EXTENSOBR( 1000000000000000 )
   ? EXTENSOBR( 3101256786765.45 )
   ? EXTENSOBR( 1000000.01 )
   ? EXTENSOBR( 6000000000.01 )
   ? EXTENSOBR( 2000000000000.00 )
   
Return Nil

FUNCTION EXTENSOBR( PVALOR )
   LOCAL TSTR   := STRZERO(ABS(PVALOR),21,2)
   LOCAL ACIFRA := {{'Quatrilhao' ,'Quatrilhoes'},;
                    {'Trilhao'    ,'Trilhoes'},;
                    {'Bilhao'     ,'Bilhoes'},;
                    {'Milhao'     ,'Milhoes'},;
                    {'Mil'        ,'Mil'},;
                    {'   '        ,'   '},;
                    {'Centavo'    ,'Centavos'}}
   LOCAL TX
   LOCAL TEXTENSO := ' '
   LOCAL TSUBS    := ' '
   LOCAL TCENTAVOS:= (PVALOR-int(PVALOR))*100 // VAL(SUBSTR(TSTR,17))
   IF (PVALOR>0)
      IF (TCENTAVOS>0) .or. ("." $ STR(PVALOR))
         IF (TCENTAVOS>0)
            TEXTENSO:=" Reais e " + EXTCEM(STRZERO(TCENTAVOS,3)) + ACIFRA[7][IIF(TCENTAVOS=1,1,2)]
         ELSE   
            TEXTENSO:=" Reais "
         ENDIF
      ENDIF
      FOR TX := 6 TO 1 STEP -1
          IF (VAL(TSUBS:=SUBSTR(TSTR,(TX*3)-2,3))>0)
             TEXTENSO:=EXTCEM(TSUBS)+ACIFRA[TX][IIF(VAL(TSUBS)=1,1,2)]+' '+TEXTENSO
          ENDIF
      NEXT TX
   ENDIF
   if "." $ STR(PVALOR)
      if ("ILHAO" $ upper(TEXTENSO) .OR. "ILHOES" $ upper(TEXTENSO))
         TEXTENSO:=strtran(TEXTENSO," Reais"," de Reais")
      endif 
   endif 
   RETURN(STRIPDOUBLE(TEXTENSO,' '))

FUNCTION EXTCEM(PCEM)
LOCAL AVAL := {VAL(SUBSTR(PCEM,1,1)),;
               VAL(SUBSTR(PCEM,2,1)),;
               VAL(SUBSTR(PCEM,3,1))}
LOCAL TTAM,TEXT := ''
LOCAL ACENT := { 'Cento','Duzentos','Trezentos','Quatrocentos','Quinhentos','Seiscentos','Setecentos','Oitocentos','Novecentos'}
LOCAL AVINT := { 'Onze','Doze','Treze','Quatorze','Quinze','Dezesseis','Dezessete','Dezoito','Dezenove' }
LOCAL ADEZ  := { 'Dez','Vinte','Trinta','Quarenta','Cinquenta','Sessenta','Setenta','Oitenta','Noventa' }
LOCAL AUNIT := { 'Um','Dois','Tres','Quatro','Cinco','Seis','Sete','Oito','Nove' }
IF (VAL(PCEM)>0)
   IF (VAL(PCEM)==100)
      TEXT := 'Cem '
   ELSE
      IF (AVAL[1]>0)
         TEXT := ACENT[AVAL[1]]+IIF((AVAL[2]+AVAL[3]>0),' e ',' ')
      ENDIF
      IF (AVAL[2]=1).AND.(AVAL[3]>0)
         TEXT := TEXT + ' '+AVINT[AVAL[3]]
      ELSE
         IF (AVAL[2]>0)
            TEXT := TEXT+' '+ADEZ[AVAL[2]]+IIF(AVAL[3]>0,' e ','')
         ENDIF
         TEXT := TEXT+IIF(AVAL[3]>0,' '+AUNIT[AVAL[3]],' ')
      ENDIF
   ENDIF
ENDIF
RETURN(TEXT := TEXT+' ')

FUNCTION STRIPDOUBLE(PSTRING,PCHAR)
WHILE (PCHAR+PCHAR$(PSTRING:=STRTRAN(PSTRING,PCHAR+PCHAR,PCHAR)))
ENDDO
RETURN(PSTRING)

PC Toledo

FUNÇÃO: Valores extensos até quatrilhão.

FUNÇÃO: Valores extensos até quatrilhão.