FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.

Moderador: Moderadores

Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por rochinha »

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...: ExtensoEN.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()

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

Return Nil

FUNCTION EXTENSOEN( PVALOR )
   LOCAL TSTR   := STRZERO(ABS(PVALOR),21,2)
   LOCAL ACIFRA := {{'Quadrillion','Quadrillions'},;
                    {'Trillion'   ,'Trillions'},;
                    {'Billion'    ,'Billions'},;
                    {'Million'    ,'Millions'},;
                    {'Thousand'   ,'Thousand'},;
                    {' '          ,' '},;
                    {'Cent'       ,'Cents'}}
   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:=" Dollars and " + EXTCEMEN(STRZERO(TCENTAVOS,3)) + ACIFRA[7][IIF(TCENTAVOS=1,1,2)]
         ELSE   
            TEXTENSO:=" Dollars "
         ENDIF
      ENDIF
      FOR TX := 6 TO 1 STEP -1
          IF (VAL(TSUBS:=SUBSTR(TSTR,(TX*3)-2,3))>0)
             TEXTENSO:=EXTCEMEN(TSUBS)+ACIFRA[TX][IIF(VAL(TSUBS)=1,1,2)]+' '+TEXTENSO
          ENDIF
      NEXT TX
   ENDIF
   if "." $ STR(PVALOR)
      if ("ILHIO" $ upper(TEXTENSO))
         TEXTENSO:=strtran(TEXTENSO," Dollar"," Dollars")
      endif 
   endif 
   RETURN(STRIPDOUBLE(TEXTENSO,' '))

FUNCTION EXTCEMEN(PCEM)
LOCAL AVAL := {VAL(SUBSTR(PCEM,1,1)),;
               VAL(SUBSTR(PCEM,2,1)),;
               VAL(SUBSTR(PCEM,3,1))}
LOCAL TTAM,TEXT := ''
LOCAL ACENT := { 'One Hundred','Two Hundred','Three Hundred','Four Hundred','Five Hundred','Six Hundred','Seven Hundred','Eight Hundred','Nine Hundred'}
LOCAL AVINT := { 'Eleven','Twelve','Thirteen','Fourteen','Fifteen','Sixteen','Seventeen','Eighteen','Nineteen' }
LOCAL ADEZ  := { 'Ten','Twelve','Thirty','Forty','Fifty','Sixty','Seventy','Eighty','Ninety' }
LOCAL AUNIT := { 'One','Two','Three','Four','Five','Six','Seven','Eight','Nine' }
IF (VAL(PCEM)>0)
   IF (VAL(PCEM)==100)
      TEXT := 'One Hundred '
   ELSE
      IF (AVAL[1]>0)
         TEXT := ACENT[AVAL[1]]+IIF((AVAL[2]+AVAL[3]>0),' and ',' ')
      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,'-','')
         ENDIF
         TEXT := TEXT+IIF(AVAL[3]>0,' '+AUNIT[AVAL[3]],' ')
      ENDIF
   ENDIF
ENDIF
RETURN(TEXT := strtran(TEXT,'- ','-')+' ')

FUNCTION STRIPDOUBLE(PSTRING,PCHAR)
WHILE (PCHAR+PCHAR$(PSTRING:=STRTRAN(PSTRING,PCHAR+PCHAR,PCHAR)))
ENDDO
RETURN(PSTRING)
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
joaoalpande
Usuário Nível 2
Usuário Nível 2
Mensagens: 93
Registrado em: 24 Fev 2005 09:04
Localização: CAMPO GRANDE / MS

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por joaoalpande »

Bom dia,

Obrigado pela ajuda , verifico que tem erro quando é one dollar , ele mete one dollars, e não entendo o porquê deste código:

if "." $ STR(PVALOR)
if ("ILHIO" $ upper(TEXTENSO))
TEXTENSO:=strtran(TEXTENSO," Dollar"," Dollars")
endif
endif

Um abraço

João Apande
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por rochinha »

Amiguinho,

O codigo verifica se o valor passado possui centavos e neste caso ele imputa o tipo da moeda, caso não, ele entende se tratar apenas de um numeral e não colocar o tipo da moeda.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
joaoalpande
Usuário Nível 2
Usuário Nível 2
Mensagens: 93
Registrado em: 24 Fev 2005 09:04
Localização: CAMPO GRANDE / MS

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por joaoalpande »

boa tarde ,

Mas não entendi porque é "ILHIO" nao devia ser "ILLIO" ?

e quando é 1.00 devia ser Dollar mas esta a meter Dollars

um abraço
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por rochinha »

Amiguinho,
Mas não entendi porque é "ILHIO" nao devia ser "ILLIO" ?
Na tradução deixei passar o erro.

Mas e agora será que ficou melhor?:

Código: Selecionar todos

* Arquivo...: ExtensoEN.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()

   ? "EXTENSOEN( 275.49 )"          ,, EXTENSOEN( 275.49 )
   ? "EXTENSOEN( 100 )"             ,, EXTENSOEN( 100 )
   ? "EXTENSOEN( 999 )"             ,, EXTENSOEN( 999 )
   ? "EXTENSOEN( 1000 )"            ,, EXTENSOEN( 1000 )
   ? "EXTENSOEN( 1000000 )"         ,, EXTENSOEN( 1000000 )
   ? "EXTENSOEN( 1000000000 )"      ,, EXTENSOEN( 1000000000 )
   ? "EXTENSOEN( 1000000000000 )"   ,, EXTENSOEN( 1000000000000 )
   ? "EXTENSOEN( 1000000000000.52 )",, EXTENSOEN( 1000000000000.52 )
   ? "EXTENSOEN( 1000000000000000 )",, EXTENSOEN( 1000000000000000 )
   ? "EXTENSOEN( 3101256786765.45 )",, EXTENSOEN( 3101256786765.45 )
   ? "EXTENSOEN( 1000000.01 )"      ,, EXTENSOEN( 1000000.01 )
   ? "EXTENSOEN( 6000000000.01 )"   ,, EXTENSOEN( 6000000000.01 )
   ? "EXTENSOEN( 2000000000000.00 )",, EXTENSOEN( 2000000000000.00 )
   ? "EXTENSOEN( 2.00 )"            ,, EXTENSOEN( 2.00 )
   ? "EXTENSOEN( 1.99 )"            ,, EXTENSOEN( 1.99 )
   ? "EXTENSOEN( 0.23 )"            ,, EXTENSOEN( 0.23 )

Return Nil

FUNCTION EXTENSOEN( PVALOR )
   LOCAL TSTR   := STRZERO(ABS(PVALOR),21,2)
   LOCAL ACIFRA := {{'Quadrillion','Quadrillions'},;
                    {'Trillion'   ,'Trillions'},;
                    {'Billion'    ,'Billions'},;
                    {'Million'    ,'Millions'},;
                    {'Thousand'   ,'Thousand'},;
                    {' '          ,' '},;
                    {'Cent'       ,'Cents'}}
   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 (PVALOR<1)
            TEXTENSO:=EXTCEMEN(STRZERO(TCENTAVOS,3)) + ACIFRA[7][IIF(TCENTAVOS=1,1,2)]
         ELSE
            IF (TCENTAVOS>0)
               TEXTENSO:=" Dollar" + iif(PVALOR>=2,"s","") + " and " + EXTCEMEN(STRZERO(TCENTAVOS,3)) + ACIFRA[7][IIF(TCENTAVOS=1,1,2)]
            ELSE   
               TEXTENSO:=" Dollar" + iif(PVALOR>=2,"s","") + " "
            ENDIF
         ENDIF
      ENDIF
      FOR TX := 6 TO 1 STEP -1
          IF (VAL(TSUBS:=SUBSTR(TSTR,(TX*3)-2,3))>0)
             TEXTENSO:=EXTCEMEN(TSUBS)+ACIFRA[TX][IIF(VAL(TSUBS)=1,1,2)]+' '+TEXTENSO
          ENDIF
      NEXT TX
   ENDIF
   // Nao mais necessario, so mantive para posteridade
   //if "." $ STR(PVALOR)
   //   if ("ILLIO" $ upper(TEXTENSO))
   //      //TEXTENSO:=strtran(TEXTENSO," Dollar"," Dollars")
   //   endif 
   //endif 
   RETURN(STRIPDOUBLE(TEXTENSO,' '))

FUNCTION EXTCEMEN(PCEM)
LOCAL AVAL := {VAL(SUBSTR(PCEM,1,1)),;
               VAL(SUBSTR(PCEM,2,1)),;
               VAL(SUBSTR(PCEM,3,1))}
LOCAL TTAM,TEXT := ''
LOCAL ACENT := { 'One Hundred','Two Hundred','Three Hundred','Four Hundred','Five Hundred','Six Hundred','Seven Hundred','Eight Hundred','Nine Hundred'}
LOCAL AVINT := { 'Eleven','Twelve','Thirteen','Fourteen','Fifteen','Sixteen','Seventeen','Eighteen','Nineteen' }
LOCAL ADEZ  := { 'Ten','Twelve','Thirty','Forty','Fifty','Sixty','Seventy','Eighty','Ninety' }
LOCAL AUNIT := { 'One','Two','Three','Four','Five','Six','Seven','Eight','Nine' }
IF (VAL(PCEM)>0)
   IF (VAL(PCEM)==100)
      TEXT := 'One Hundred '
   ELSE
      IF (AVAL[1]>0)
         TEXT := ACENT[AVAL[1]]+IIF((AVAL[2]+AVAL[3]>0),' and ',' ')
      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,'-','')
         ENDIF
         TEXT := TEXT+IIF(AVAL[3]>0,' '+AUNIT[AVAL[3]],' ')
      ENDIF
   ENDIF
ENDIF
RETURN(TEXT := strtran(TEXT,'- ','-')+' ')

FUNCTION STRIPDOUBLE(PSTRING,PCHAR)
WHILE (PCHAR+PCHAR$(PSTRING:=STRTRAN(PSTRING,PCHAR+PCHAR,PCHAR)))
ENDDO
RETURN(PSTRING)
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Euclides
Usuário Nível 3
Usuário Nível 3
Mensagens: 154
Registrado em: 12 Mai 2007 14:07
Localização: São Paulo, Capital

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por Euclides »

Pois é... Rochinha.
Precisa mexer mais um pouquinho... Veja.

EXTENSOEN( 0.23 ) NIL Twelve-Three Cents

Fora isso, bom trabalho!
[]´s Euclides
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por rochinha »

Amiguinho,

Erro de digitação, basta corrigir na variavel ADEZ:

FUNCTION EXTCEMEN(PCEM)
LOCAL AVAL := {VAL(SUBSTR(PCEM,1,1)),;
VAL(SUBSTR(PCEM,2,1)),;
VAL(SUBSTR(PCEM,3,1))}
LOCAL TTAM,TEXT := ''
LOCAL ACENT := { 'One Hundred','Two Hundred','Three Hundred','Four Hundred','Five Hundred','Six Hundred','Seven Hundred','Eight Hundred','Nine Hundred'}
LOCAL AVINT := { 'Eleven','Twelve','Thirteen','Fourteen','Fifteen','Sixteen','Seventeen','Eighteen','Nineteen' }
LOCAL ADEZ := { 'Ten','Twenty','Thirty','Forty','Fifty','Sixty','Seventy','Eighty','Ninety' }
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar do usuário
Jairo Maia
Moderador
Moderador
Mensagens: 2785
Registrado em: 16 Ago 2010 13:46
Localização: Campinas-SP

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por Jairo Maia »

Certinho Rochinha. Sua função ficou Show de Bola! Valeu.
Abraços, Jairo
Harbour / Clipper 5.2e - Blinker 7
(Não respondo dúvidas por MP ou E-mail. Por favor, não encaminhe via mensagem privada ou e-mail, dúvidas que podem ser compartilhadas com todos no fórum)
joaoalpande
Usuário Nível 2
Usuário Nível 2
Mensagens: 93
Registrado em: 24 Fev 2005 09:04
Localização: CAMPO GRANDE / MS

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por joaoalpande »

Bom dia,

Fiz alguns testes e penso que está tudo bem, só alterei doláres para Euros , muito obrigado pela grande ajuda.

Já tem em Português , Inglês seria bom ter em Espanhol hehehe

Um Abraço

João Alpande
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

FUNÇÃO: Valores extensos até quatrilhão(ENglês).

Mensagem por rochinha »

OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url]. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Responder