Diante da necessidade de gerar valores por extenso, pesquisando na web, deparei-me com a excelente procedure abaixo, para Firebird.
Ela não usa UDF´s e consegue gerar extenso para valores de até 8 (oito) quatrilhões.
Ela pode ignorar a geração do extenso dos centavos, para o caso de um extenso para cheques (basta atribuir 'N' ao segundo parâmetro).
Parabéns ao Emersom, o autor dessa "belezura" !!!
CREATE PROCEDURE EXTENSO (
valor numeric(18,2),
cents char(1))
returns (
valorextenso varchar(250))
as
declare variable cmoeda varchar(10);
declare variable cmoedas varchar(10);
declare variable ccentavo varchar(10);
declare variable ccentavos varchar(10);
declare variable cmil varchar(12);
declare variable cmils varchar(12);
declare variable cmilhao varchar(12);
declare variable cmilhoes varchar(12);
declare variable cbilhao varchar(12);
declare variable cbilhoes varchar(12);
declare variable ctrilhao varchar(12);
declare variable ctrilhoes varchar(12);
declare variable cquatrilhao varchar(12);
declare variable cquatrilhoes varchar(12);
declare variable cvalor varchar(100);
declare variable nvalor smallint;
declare variable cvalorint varchar(100);
declare variable nvalorint integer;
declare variable nvalordec numeric(6,3);
declare variable i smallint;
declare variable nconj integer;
declare variable cletra varchar(1);
declare variable caux varchar(200);
declare variable extensocentavos varchar(100);
declare variable separador varchar(3);
declare variable extensoconj varchar(150);
declare variable cdig1 varchar(10);
declare variable cdig2 varchar(10);
declare variable cdig3 varchar(10);
declare variable centenas char(108) = 'CENTO DUZENTOS TREZENTOS QUATROCENTOSQUINHENTOS SEISCENTOS SETECENTOS OITOCENTOS NOVECENTOS ';
declare variable dezenas char(79) = 'DEZ VINTE TRINTA QUARENTA CINQUENTASESSENTA SETENTA OITENTA NOVENTA ';
declare variable unidades char(54) = 'UM DOIS TRES QUATROCINCO SEIS SETE OITO NOVE ';
declare variable unid10 char(81) = 'ONZE DOZE TREZE QUATORZE QUINZE DEZESSEISDEZESSETEDEZOITO DEZENOVE ';
declare variable extensounidade varchar(12);
declare variable extensodezena varchar(12);
declare variable extensocentena varchar(12);
declare variable vlrextenso varchar(250);
begin
if (cents is null) then cents = 'S';
cents = UPPER(cents);
-- poderia ter deixado esses valores fixos,
-- mas preferi em variáveis
cMil = 'MIL'; cMils = 'MIL';
cMilhao = 'MILHÃO'; cMilhoes = 'MILHÕES';
cBilhao = 'BILHÃO'; cBilhoes = 'BILHÕES';
cTrilhao = 'TRILHÃO'; cTrilhoes = 'TRILHÕES';
cQuatrilhao = 'QUATRILHÃO'; cQuatrilhoes = 'QUATRILHÕES';
cMoeda = 'REAL'; cMoedas = 'REAIS';
cCentavo = 'CENTAVO'; cCentavos = 'CENTAVOS';
Separador = ' ';
-- valores a serem utilizados para geração do extenso
nValorInt = cast(valor/100*100 as integer);
nValorDec = (Valor - Cast(nValorInt as numeric(18,3))) / 10;
cAux = Cast(nValorDec as varchar(100));
cValorInt = Cast(nValorInt as varchar(100)) || Substring(cAux from 3 for 3);
-- inverto o número. assim fica mais fácil trabalhar
-- pois não haverá necessidade de UDF's
cLetra = Substring(cValorInt from 1 for 1);
cAux = cValorInt;
cValorInt = '';
while (cAux <> '') do
begin
cValorInt = (cLetra || cValorInt);
cAux = Substring(cAux from 2 for 100);
cLetra = Substring(cAux from 1 for 1);
if (cLetra = '') then cLetra = ' ';
end
-- obtenho os subconjuntos de números, de 3 em 3,
-- para formar o extenso, que poderá chegar aos quatrilhões
nConj = 1;
extensocentavos = '';
vlrextenso = '';
if (Valor <> 0) then
begin
while (cValorInt <> '') do
begin
cValor = '';
i = 1;
while (i <= 3) do
begin
cLetra = Substring(cValorInt from 1 for 1);
if (cLetra = '') then cLetra = ' ';
cValor = (cLetra || cValor);
cValorInt = Substring(cValorInt from 2 for 100);
i = (i + 1);
end
nValor = Cast(cValor as smallint);
cDig1 = Substring(cValor from 1 for 1);
cDig2 = Substring(cValor from 2 for 1);
cDig3 = Substring(cValor from 3 for 1);
extensounidade = '';
extensodezena = '';
extensocentena = '';
-- obtenho o extenso da unidade
if (cDig3 > '0') then
begin
cAux = cast((cast(cDig3 as integer) * 6 - 5) as varchar(3));
cAux = 'select cast(Substring(''' || unidades || ''' from ' || cAux || ' for 6) as varchar(12)) from rdb$database';
execute statement cAux into :extensounidade;
end
-- obtenho o extenso da dezena
if (cDig2 > '0') then
begin
if ((cDig3 > '0') and (cDig2 = '1')) then
begin
extensounidade = '';
cAux = unid10 || ''' from ' || cast((cast(cDig3 as integer) * 9 - 8) as varchar(3));
end
else
cAux = dezenas || ''' from ' || cast((cast(cDig2 as integer) * 9 - 8) as varchar(3));
cAux = 'select cast(Substring(''' || cAux || ' for 9) as varchar(12)) from rdb$database';
execute statement cAux into :extensodezena;
end
-- obtenho o extenso da centena
if (cDig1 > '0') then
begin
if (nValor = 100) then
extensocentena = 'CEM';
else
begin
cAux = cast((cast(cDig1 as integer) * 12 - 11) as varchar(3));
cAux = 'select cast(Substring(''' || centenas || ''' from ' || cAux || ' for 12) as varchar(12)) from rdb$database';
execute statement cAux into :extensocentena;
end
end
-- faço a montagem do extenso do conjunto
if (extensounidade <> '') then
extensoconj = extensounidade;
else
extensoconj = '';
if (extensodezena <> '') then
begin
if (extensoconj <> '') then
extensoconj = extensodezena || ' E ' || extensoconj;
else
extensoconj = extensodezena;
end
if (extensocentena <> '') then
begin
if (extensoconj <> '') then
extensoconj = extensocentena || ' E ' || extensoconj;
else
extensoconj = extensocentena;
end
-- adiciono os devidos sufixos de cada conjunto
if (nValor > 0) then
begin
if (nConj = 1) then -- centavos
begin
if (nValor > 1) then
extensoconj = extensoconj || ' ' ||ccentavos;
else
extensoconj = extensoconj || ' ' || ccentavo;
end
-- obs.: o conjunto 2 não precisa ser avaliado, pois
-- nele NÃO há necessidade de acrescentar sufixo
if (nConj = 3) then -- milhares
begin
if (nValor > 1) then
extensoconj = extensoconj || ' ' || cMils;
else
extensoconj = extensoconj || ' ' || cMil;
end
else
if (nConj = 4) then -- milhoes
begin
if (nValor > 1) then
extensoconj = extensoconj || ' ' || cMilhoes;
else
extensoconj = extensoconj || ' ' || cMilhao;
end
else
if (nConj = 5) then -- bilhoes
begin
if (nValor > 1) then
extensoconj = extensoconj || ' ' || cBilhoes;
else
extensoconj = extensoconj || ' ' || cBilhao;
end
else
if (nConj = 6) then -- trilhoes
begin
if (nValor > 1) then
extensoconj = extensoconj || ' ' || cTrilhoes;
else
extensoconj = extensoconj || ' ' || cTrilhao;
end
else
if (nConj = 7) then -- quatrilhoes
begin
if (nValor > 1) then
extensoconj = extensoconj || ' ' || cQuatrilhoes;
else
extensoconj = extensoconj || ' ' || cQuatrilhao;
end
if ((vlrextenso = '') and (nConj > 3)) then
extensoconj = extensoconj || ' DE ';
end
-- avalio qual será o separador de conjuntos
if (nConj < 4) then
Separador = ' E ';
else
Separador = ', ';
-- gero o extenso dos 'inteiros' e dos centavos
if (nConj = 1) then -- centavos
extensocentavos = extensoconj;
else
if (extensoconj <> '') then
begin
if (vlrextenso <> '') then
vlrextenso = extensoconj || Separador || vlrextenso;
else
vlrextenso = extensoconj;
end
nConj = nConj + 1;
end
-- depois de tudo avaliado...
-- acrescento a moeda
if (nvalorint > 0) then
begin
if (nvalorint > 1) then
vlrextenso = vlrextenso || ' ' || cmoedas;
else
vlrextenso = vlrextenso || ' ' || cmoeda;
end
-- monto o extenso completo: inteiros mais os centavos.
-- obs.: a inclusão dos centavos é controlada pela variável
-- 'cents'. fiz assim pois pode ser uma geração de extenso
-- para cheques, que não destacam os centavos no extenso
if ((extensocentavos <> '') and (cents = 'S')) then
begin
if (vlrextenso <> '') then
vlrextenso = vlrextenso || ' E ' || extensocentavos;
else
vlrextenso = extensocentavos;
end
-- limpo a variavel de retorno, pois ainda preciso trabalhar os 'espaços'
valorextenso = '';
-- retiro os espacos desnecessários e populo a variável de retorno.
-- obs.: fiz com while pra não precisar de UDF's
cLetra = Substring(vlrextenso from 1 for 1);
cAux = '';
while (vlrextenso <> '') do
begin
cLetra = Substring(vlrextenso from 1 for 1);
vlrextenso = Substring(vlrextenso from 2 for 250);
if ((cLetra <> ' ') or ((cLetra = ' ') and (cAux <> ' '))) then
valorextenso = valorextenso || cLetra;
cAux = cLetra;
end
end
else
valorextenso = 'ZERO';
-- exibe o resultado
suspend;
end
-----
Veja o Post Original em http://www.firebase.com.br/fb/artigo.php?id=2078
Nenhum comentário:
Postar um comentário