|
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/ |
| |
| |
| | | |
|
| | | | |
| | |
|