PC SOFT

FORUMS PROFESSIONNELS
WINDEVWEBDEV et WINDEV Mobile

Accueil → WINDEV Mobile 2024 → Extensive procedure of a Number (Procedure Extenso de um Numero)
Extensive procedure of a Number (Procedure Extenso de um Numero)
Débuté par adrianoboller, 28 jan. 2015 17:18 - 1 réponse
Membre enregistré
3 651 messages
Popularité : +175 (223 votes)
Posté le 28 janvier 2015 - 17:18
Procedure PorExtenso(Valor, Moeda_Singular is string ="real", Moeda_Plural is string = "reais", Fracao_Singularis string = "centavo", Fracao_Plural is string ="centavos")
Unidade isarray of 100 strings
Dezena,Centenaare arrays of 100 strings
C1,C2,C3,sValorare strings
Extenso is string

SWITCH Valor
CASE 0: RESULT "zero " + Moeda_Singular
CASE> 999999999999.99 : RESULT "* Número muito Grande *"
END

Moeda_Plural = NoSpace(Moeda_Plural)+" "
Moeda_Singular = NoSpace(Moeda_Singular)+" "

sValor = NumToString(Valor,"015.2f")
Unidade[1]=""
Unidade[2]="um "
Unidade[3]="dois "
Unidade[4]="três "
Unidade[5]="quatro "
Unidade[6]="cinco "
Unidade[7]="seis "
Unidade[8]="sete "
Unidade[9]="oito "
Unidade[10]="nove "
Unidade[11]="dez "
Unidade[12]="onze "
Unidade[13]="doze "
Unidade[14]="treze "
Unidade[15]="quatorze "
Unidade[16]="quinze "
Unidade[17]="dezesseis "
Unidade[18]="dezessete "
Unidade[19]="dezoito "
Unidade[20]="dezenove "
Dezena[1]=""
Dezena[2]="dez "
Dezena[3]="vinte "
Dezena[4]="trinta "
Dezena[5]="quarenta "
Dezena[6]="cinquenta "
Dezena[7]="sessenta "
Dezena[8]="setenta "
Dezena[9]="oitenta "
Dezena[10]="noventa "
Centena[1]=""
Centena[2]="cento "
Centena[3]="duzentos "
Centena[4]="trezentos "
Centena[5]="quatrocentos "
Centena[6]="quinhentos "
Centena[7]="seiscentos "
Centena[8]="setecentos "
Centena[9]="oitocentos "
Centena[10]="novecentos "
Extenso=""

IFVal(Middle(sValor,1,3))>0 THEN
C1=Middle(sValor,1,1)
C2=Middle(sValor,2,1)
C3=Middle(sValor,3,1)
Extenso=Extenso+IIF(Val(C2+C3)=0AND c1="1","cem ",Centena[Val(C1)+1])+IIF(Val(C1)>0 ANDVal(C2+C3)>0,"e","")+IIF(Val(C2)=1,Unidade[Val(C2+C3)+1],Dezena[Val(C2)+1]+IIF(Val(C2)>0AND Val(C3)>0,"e ","")+Unidade[Val(C3)+1])
Extenso=Extenso+"bilh"+IIF(Val(C1+C2+C3)>1,"ões,","ão, ")
END
IFVal(Middle(sValor,4,3))>0 THEN
C1=Middle(sValor,4,1)
C2=Middle(sValor,5,1)
C3=Middle(sValor,6,1)
Extenso=Extenso+IIF(Val(C2+C3)=0AND c1="1","cem ",Centena[Val(C1)+1])+IIF(Val(C1)>0 ANDVal(C2+C3)>0,"e ","")+IIF(Val(C2)=1,Unidade[Val(C2+C3)+1],Dezena[Val(C2)+1]+IIF(Val(C2)>0AND Val(C3)>0,"e ","")+Unidade[Val(C3)+1])
Extenso=Extenso+"milh"+IIF(Val(C1+C2+C3)>1,"ões,","ão, ")
END
IFVal(Middle(sValor,7,3))>0 THEN
C1=Middle(sValor,7,1)
C2=Middle(sValor,8,1)
C3=Middle(sValor,9,1)
Extenso=Extenso+IIF(Val(C2+C3)=0AND c1="1","cem ",Centena[Val(C1)+1])+IIF(Val(C1)>0 ANDVal(C2+C3)>0,"e","")+IIF(Val(C2)=1,Unidade[Val(C2+C3)+1],Dezena[Val(C2)+1]+IIF(Val(C2)>0AND Val(C3)>0,"e ","")+Unidade[Val(C3)+1])
Extenso=Extenso+"mil, "
END
IFVal(Middle(sValor,10,3))>0 THEN
C1=Middle(sValor,10,1)
C2=Middle(sValor,11,1)
C3=Middle(sValor,12,1)
Extenso=Extenso+IIF(Val(C2+C3)=0AND c1="1","cem ",Centena[Val(C1)+1])+IIF(Val(C1)>0 ANDVal(C2+C3)>0,"e","")+IIF(Val(C2)=1,Unidade[Val(C2+C3)+1],Dezena[Val(C2)+1]+IIF(Val(C2)>0AND Val(C3)>0,"e ","")+Unidade[Val(C3)+1])
END
Extenso=Extenso+IIF(Valor >0.99,IIF(Valor>1.99,Moeda_Plural , Moeda_Singular),"")
IFVal(Middle(sValor,14,2))>0 THEN
C2=Middle(sValor,14,1)
C3=Middle(sValor,15,1)
Extenso=Extenso+IIF(Extenso= "","","e")+IIF(Val(C2)=1,Unidade[Val(C2+C3)+1],Dezena[Val(C2)+1]+IIF(Val(C2)>0AND Val(C3)>0,"e","")+Unidade[Val(C3)+1])+IIF(Val(C2+C3)>1,Fracao_Plural,Fracao_Singular)
END
RESULT NoSpace(Extenso)
Membre enregistré
3 651 messages
Popularité : +175 (223 votes)
Posté le 25 août 2016 - 18:00
Outro Exemplo

Procedure Extenso(pValor)

sValor is string = NumToString(pValor,"13,2F")
nWx is numeric = 0
sExt is string = ""
wPos1 is numeric = 0
wPos2 is numeric = 0
wPos3 is numeric = 0
sGer is string = ""

arrCent is array 9 string = ["CENTO ","DUZENTOS ","TREZENTOS ","QUATROCENTOS","QUINHENTOS ","SEISCENTOS ","SETECENTOS ","OITOCENTOS ","NOVECENTOS "]
arrDez is array 9 string = ["DEZ ","VINTE ","TRINTA ","QUARENTA ","CINQUENTA","SESSENTA ","SETENTA ","OITENTA ","NOVENTA "]
arrUnid is array 9 string = ["UM ","DOIS ","TRES ","QUATRO","CINCO ","SEIS ","SETE ","OITO ","NOVE "]
arrEsp is array 9 string = ["ONZE ","DOZE ","TREZE ","QUATORZE ","QUINZE ","DEZESSEIS","DEZESSETE","DEZOITO ","DEZENOVE "]
arrPart is array 4 string

arrPart[1] = Middle(sValor,2,3)
arrPart[2] = Middle(sValor,5,3)
arrPart[3] = Middle(sValor,8,3)
arrPart[4] = Middle(sValor,12,2)

WHILE nWx <> 3

nWx++
IF NoSpace(arrPart[nWx]) <> "" THEN

wPos1 = Val(Middle(arrPart[nWx],1,1))
wPos2 = Val(Middle(arrPart[nWx],2,1))
wPos3 = Val(Middle(arrPart[nWx],3,1))

IF wPos1 > 0 THEN
IF wPos1 = 1 AND wPos2 = 0 AND wPos3 = 0 THEN
sExt = sExt+"CEM"
ELSE
sExt = sExt + NoSpace(arrCent[wPos1])
IF wPos2 > 0 _OR_ wPos3 > 0 THEN
sExt = sExt + " E "
END
END
END

IF wPos2 > 0 THEN
IF wPos2 > 1 _OR_ wPos3 = 0 THEN
sExt = sExt + NoSpace(arrDez[wPos2])
IF wPos3 > 0 THEN
sExt = sExt + " E "
END
ELSE
sExt = sExt + NoSpace(arrEsp[wPos3])
END
END

IF wPos3 > 0 AND wPos2 <> 1 THEN
sExt = sExt + NoSpace(arrUnid[wPos3])
END

IF nWx = 1 THEN
IF Val(arrPart[nWx]) = 1 THEN
sExt = sExt + " MILHAO "
ELSE
sExt = sExt + " MILHOES "
END
ELSE IF nWx = 2 THEN
sExt = sExt + " MIL "
END
END
END

IF Val(arrPart[3]) > 0 THEN
IF Val(arrPart[3]) > 1 THEN
sExt = sExt + " REAIS"
ELSE
IF Val(arrPart[2]) > 0 _OR_ Val(arrPart[1]) > 0 THEN
sExt = sExt + " REAIS"
ELSE
sExt = sExt + " REAL"
END
END
ELSE IF Val(arrPart[2]) > 0 THEN
sExt = sExt + "REAIS"
ELSE IF Val(arrPart[1]) > 0 THEN
sExt = sExt + "DE REAIS"
END

IF Val(arrPart[4]) > 0 THEN
wPos2 = Val(Middle(arrPart[4],1,1))
wPos3 = Val(Middle(arrPart[4],2,1))
IF wPos2 > 0 THEN
IF wPos2 > 1 _OR_ wPos3 = 0 THEN
sExt = sExt+" E "+NoSpace(arrDez[wPos2])
ELSE
sExt = sExt+" E "+NoSpace(arrDez[wPos3])
END
END
IF wPos3 > 0 AND wPos2 <> 1 THEN
sExt = sExt+" E "+ NoSpace(arrUnid[wPos3])
END
IF Val(arrPart[4]) > 1 THEN
sExt = sExt + " CENTAVOS"
ELSE
sExt = sExt + " CENTAVO"
END
END
nWx = 150 - Length(sExt)
sGer = sExt+" "+RepeatString("* ",nWx)

RESULT sGer


--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 9949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.com.br/