|
Iniciado por Danilo Valim, jan., 27 2016 6:58 PM - Sem resposta |
| |
| | | |
|
| |
Membro registado 13 mensagems Popularité : +9 (9 votes) |
|
Publicado em janeiro, 27 2016 - 6:58 PM |
Segue Procedure que escreve a data por extenso.. Ex: 01/01/2016 => Primeiro Dia do mês de Janeiro do Ano de Dois mil e dezesseis. 27/01/1900 => Vigésimo Sétimo dia do mês de Janeiro do Ano de Mil e Novecentos.
** Utilizo essa procedure na geração da Nota Promissória!
Procedure ExtensoData(pData)
dData is Date = pData xDia is numeric = dData..Day xAno is numeric = dData..Year
Unidade is array of 50 strings Unidade[1]="Primeiro " Unidade[2]="Segundo " Unidade[3]="Terceiro " Unidade[4]="Quarto " Unidade[5]="Quinto " Unidade[6]="Sexto " Unidade[7]="Sétimo " Unidade[8]="Oitavo " Unidade[9]="Nono " Unidade[10]="Décimo " Unidade[20]="Vigésimo " Unidade[30]="Trigésimo "
sDiaextenso is string = "" IF xDia > 31 THEN NextTitle("Verifique..") Error("Não existe dia do Mês maior que 31!!") RESULT "" ELSE IF xDia < 10 OR xDia = 10 OR xDia = 20 OR xDia = 30 THEN sDiaextenso = Unidade[xDia] ELSE IF xDia > 10 AND xDia <= 19 sDiaextenso = Unidade[10]+" "+Unidade[Middle(xDia,2)] ELSE IF xDia > 20 AND xDia <= 29 sDiaextenso = Unidade[20]+" "+Unidade[Middle(xDia,2)] ELSE IF xDia > 30 sDiaextenso = Unidade[30]+" "+Unidade[Middle(xDia,2)] END END
sMesextenso is string = DateToMonthInAlpha(dData)
sAnoextenso is string = "" IF xAno >= 1000 AND xAno <= 9999 IF Left(xAno,1) = 1 THEN sAnoextenso = "Mil " ELSE sAnoextenso = ExtCent(Left(xAno,1))+" Mil " END IF Middle(xAno,3,2) = "00" THEN sAnoextenso += "e " END IF Middle(xAno,2,1) = "0" THEN IF Middle(xAno,3,2) <> "00" THEN sAnoextenso += "e " END IF Middle(xAno,3,1) = "0" THEN sAnoextenso += ExtCent(Middle(xAno,4,1)) ELSE sAnoextenso += ExtCent(Middle(xAno,3,2)) END ELSE sAnoextenso += ExtCent(Middle(xAno,2,3)) END ELSE NextTitle("Aviso..") Warning("Não é possível escrever por Extenso o Ano Informado!!") END
sDataPorExtenso is string = sDiaextenso +" Dia do Mês de "+sMesextenso+" do Ano de "+sAnoextenso
RESULT sDataPorExtenso
**Observação: Procedure abaixo encontrei na net, não me recordo o autor, mais agradeço, desde já, pois me ajudou bastante!
Procedure ExtCent(pNumero) Txt is string IF pNumero < 1 OR pNumero > 999 THEN RESULT "" Nro is int = pNumero
SWITCH Nro CASE >= 900: Txt = "novecentos" CASE >= 800: Txt = "oitocentos" CASE >= 700: Txt = "setecentos" CASE >= 600: Txt = "seiscentos" CASE >= 500: Txt = "quinhentos" CASE >= 400: Txt = "quatrocentos" CASE >= 300: Txt = "trezentos" CASE >= 200: Txt = "duzentos" CASE > 100: Txt = "cento" CASE = 100: RESULT "cem" END
Nro = Modulo(Nro,100) IF Nro = 0 THEN RESULT Txt IF Txt<>"" THEN Txt+=" e "
SWITCH Nro CASE >= 90 : Txt+= "noventa" CASE >= 80 : Txt+= "oitenta" CASE >= 70 : Txt+= "setenta" CASE >= 60 : Txt+= "sessenta" CASE >= 50 : Txt+= "cinquenta" CASE >= 40 : Txt+= "quarenta" CASE >= 30 : Txt+= "trinta" CASE >= 20 : Txt+= "vinte" CASE = 19 : RESULT Txt + "dezenove" CASE = 18 : RESULT Txt + "dezoito" CASE = 17 : RESULT Txt + "dezessete" CASE = 16 : RESULT Txt + "dezesseis" CASE = 15 : RESULT Txt + "quinze" CASE = 14 : RESULT Txt + "quatorze" CASE = 13 : RESULT Txt + "treze" CASE = 12 : RESULT Txt + "doze" CASE = 11 : RESULT Txt + "onze" CASE = 10 : RESULT Txt + "dez" OTHER CASE : IF Txt<>"" THEN Txt = Txt[[ TO Length(Txt)-3]] END
Nro = Modulo(Nro,10) IF Nro = 0 THEN RESULT Txt IF Txt<>"" THEN Txt+=" e "
SWITCH Nro CASE 1 : RESULT Txt + "um" CASE 2 : RESULT Txt + "dois" CASE 3 : RESULT Txt + "três" CASE 4 : RESULT Txt + "quatro" CASE 5 : RESULT Txt + "cinco" CASE 6 : RESULT Txt + "seis" CASE 7 : RESULT Txt + "sete" CASE 8 : RESULT Txt + "oito" CASE 9 : RESULT Txt + "nove" OTHER CASE : RESULT "" END |
| |
| |
| | | |
|
| | | | |
| | |
|