Número por Extenso
Autor: Geversom Sousa | Publicado: 2010-09-01T10:26:00-07:00







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 &lt;&gt; '') 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 &lt;&gt; 0) then
  begin
    while (cValorInt &lt;&gt; '') do
    begin
      cValor = '';
      i = 1;
      while (i &lt;= 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 &gt; '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 &gt; '0') then
      begin
        if ((cDig3 &gt; '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 &gt; '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 &lt;&gt; '') then
        extensoconj = extensounidade;
      else
        extensoconj = '';
 
      if (extensodezena &lt;&gt; '') then
      begin
        if (extensoconj &lt;&gt; '') then
          extensoconj = extensodezena || ' E ' || extensoconj;
        else
          extensoconj = extensodezena;
      end
 
      if (extensocentena &lt;&gt; '') then
      begin
        if (extensoconj &lt;&gt; '') then
          extensoconj = extensocentena || ' E ' || extensoconj;
        else
          extensoconj = extensocentena;
      end
 
      -- adiciono os devidos sufixos de cada conjunto
      if (nValor &gt; 0) then
      begin
        if (nConj = 1) then -- centavos
        begin
          if (nValor &gt; 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 &gt; 1) then
            extensoconj = extensoconj || ' ' || cMils;
          else
            extensoconj = extensoconj || ' ' || cMil;
        end
        else
        if (nConj = 4) then -- milhoes
        begin
        if (nValor &gt; 1) then
            extensoconj = extensoconj || ' ' || cMilhoes;
          else
            extensoconj = extensoconj || ' ' || cMilhao;
        end
        else
        if (nConj = 5) then -- bilhoes
        begin
          if (nValor &gt; 1) then
            extensoconj = extensoconj || ' ' || cBilhoes;
          else
            extensoconj = extensoconj || ' ' || cBilhao;
        end
        else
        if (nConj = 6) then -- trilhoes
        begin
          if (nValor &gt; 1) then
            extensoconj = extensoconj || ' ' || cTrilhoes;
          else
            extensoconj = extensoconj || ' ' || cTrilhao;
        end
        else
        if (nConj = 7) then -- quatrilhoes
        begin
          if (nValor &gt; 1) then
            extensoconj = extensoconj || ' ' || cQuatrilhoes;
          else
            extensoconj = extensoconj || ' ' || cQuatrilhao;
        end
 
        if ((vlrextenso = '') and (nConj &gt; 3)) then
          extensoconj = extensoconj || ' DE ';
      end
 
      -- avalio qual será o separador de conjuntos
      if (nConj &lt; 4) then
        Separador = ' E ';
      else
        Separador = ', ';
 
      -- gero o extenso dos 'inteiros' e dos centavos
      if (nConj = 1) then -- centavos
        extensocentavos = extensoconj;
      else
      if (extensoconj &lt;&gt; '') then
      begin
        if (vlrextenso &lt;&gt; '') then
          vlrextenso = extensoconj || Separador || vlrextenso;
        else
          vlrextenso = extensoconj;
      end
 
      nConj = nConj + 1;
    end
 
    -- depois de tudo avaliado...
    -- acrescento a moeda
    if (nvalorint &gt; 0) then
    begin
      if (nvalorint &gt; 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 &lt;&gt; '') and (cents = 'S')) then
    begin
      if (vlrextenso &lt;&gt; '') 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 &lt;&gt; '') do
    begin
      cLetra = Substring(vlrextenso from 1 for 1);
      vlrextenso = Substring(vlrextenso from 2 for 250);
      if ((cLetra &lt;&gt; ' ') or ((cLetra = ' ') and (cAux &lt;&gt; ' ')))  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