Valor monetário por extenso (NumberToWords)

procedure Form1_Button1_OnClick (Sender: TObject; var Cancel: boolean);
begin
   showmessage(valorPorExtenso(Form1.tb_valor.value));
end;

function valorPorExtenso(vlr: real): string;
var
  unidade: array[1..19] of string;
  centena: array[1..9] of string;
  dezena: array[2..9] of string;
  qualificaS: array[0..4] of string;
  qualificaP: array[0..4] of string;
  inteiro: integer; //Int64;
  resto: real;
  vlrS, s, saux, vlrP, centavos: string;
  n, unid, dez, cent, tam, i: integer;
  umReal, tem: boolean;
begin
   unidade[1] := 'um';
   unidade[2] := 'dois';
   unidade[3] := 'três';
   unidade[4] := 'quatro';
   unidade[5] := 'cinco';
   unidade[6] := 'seis';
   unidade[7] := 'sete';
   unidade[8] := 'oito';
   unidade[9] := 'nove';
   unidade[10] := 'dez';
   unidade[11] := 'onze';
   unidade[12] := 'doze';
   unidade[13] := 'treze';
   unidade[14] := 'quatorze';
   unidade[15] := 'quinze';
   unidade[16] := 'dezesseis';
   unidade[17] := 'dezessete';
   unidade[18] := 'dezoito';
   unidade[19] := 'dezenove';

   centena[1] := 'cento';
   centena[2] := 'duzentos';
   centena[3] := 'trezentos';
   centena[4] := 'quatrocentos';
   centena[5] := 'quinhentos';
   centena[6] := 'seiscentos';
   centena[7] := 'setecentos';
   centena[8] := 'oitocentos';
   centena[9] := 'novecentos';

   dezena[2] := 'vinte';
   dezena[3] := 'trinta';
   dezena[4] := 'quarenta';
   dezena[5] := 'cinquenta';
   dezena[6] := 'sessenta';
   dezena[7] := 'setenta';
   dezena[8] := 'oitenta';
   dezena[9] := 'noventa';

   qualificaS[0] := '';
   qualificaS[1] := 'mil';
   qualificaS[2] := 'milhão';
   qualificaS[3] := 'bilhão';
   qualificaS[4] := 'trilhão';

   qualificaP[0] := '';
   qualificaP[1] := 'mil';
   qualificaP[2] := 'milhões';
   qualificaP[3] := 'bilhões';
   qualificaP[4] := 'trilhões';


  if (vlr = 0)
     then begin
            Result := 'zero';
            exit;
          end;
 
  inteiro := trunc(vlr); // parte inteira do valor
  resto := vlr - inteiro; // parte fracionária do valor
  vlrS := inttostr(inteiro);
  if (length(vlrS) > 15)
     then begin
            Result := 'Erro: valor superior a 999 trilhões.';
            exit;
          end;
 
  s := '';
  centavos := inttostr(round(resto * 100));
 
// definindo o extenso da parte inteira do valor
  i := 0;
  umReal := false; tem := false;
  while (vlrS <> '0') do
  begin
    tam := length(vlrS);
// retira do valor a 1a. parte, 2a. parte, por exemplo, para 123456789:
// 1a. parte = 789 (centena)
// 2a. parte = 456 (mil)
// 3a. parte = 123 (milhões)
    if (tam > 3)
       then begin
              vlrP := copy(vlrS, tam-2, tam);
              vlrS := copy(vlrS, 1, tam-3);
            end
    else begin // última parte do valor
           vlrP := vlrS;
           vlrS := '0';
         end;
    if (vlrP <> '000')
       then begin
              saux := '';
              if (vlrP = '100')
                 then saux := 'cem'
              else begin
                     n := strtoint(vlrP);        // para n = 371, tem-se:
                     cent := n div 100;          // cent = 3 (centena trezentos)
                     dez := (n mod 100) div 10;  // dez  = 7 (dezena setenta)
                     unid := (n mod 100) mod 10; // unid = 1 (unidade um)
                     if (cent <> 0)
                        then saux := centena[cent];
                     if ((dez <> 0) or (unid <> 0))
                        then begin
                               if ((n mod 100) <= 19)
                                  then begin
                                         if (length(saux) <> 0)
                                            then saux := saux + ' e ' + unidade[n mod 100]
                                         else saux := unidade[n mod 100];
                                       end
                               else begin
                                      if (length(saux) <> 0)
                                         then saux := saux + ' e ' + dezena[dez]
                                      else saux := dezena[dez];
                                      if (unid <> 0)
                                         then if (length(saux) <> 0)
                                                 then saux := saux + ' e ' + unidade[unid]
                                              else saux := unidade[unid];
                                    end;
                             end;
                   end;
              if ((vlrP = '1') or (vlrP = '001'))
                 then begin
                        if (i = 0) // 1a. parte do valor (um real)
                           then umReal := true
                        else saux := saux + ' ' + qualificaS[i];
                      end
              else if (i <> 0)
                      then saux := saux + ' ' + qualificaP[i];
              if (length(s) <> 0)
                 then s := saux + ', ' + s
              else s := saux;
            end;
    if (((i = 0) or (i = 1)) and (length(s) <> 0))
       then tem := true; // tem centena ou mil no valor
    i := i + 1; // próximo qualificador: 1- mil, 2- milhão, 3- bilhão, ...
  end;
 
  if (length(s) <> 0)
     then begin
            if (umReal)
               then s := s + ' real'
            else if (tem)
                    then s := s + ' reais'
                 else s := s + ' de reais';
          end;
// definindo o extenso dos centavos do valor
  if (centavos <> '0') // valor com centavos
     then begin
            if (length(s) <> 0) // se não é valor somente com centavos
               then s := s + ' e ';
            if (centavos = '1')
               then s := s + 'um centavo'
            else begin
                   n := strtoint(centavos);
                   if (n <= 19)
                      then s := s + unidade[n]
                   else begin                 // para n = 37, tem-se:
                          unid := n mod 10;   // unid = 37 % 10 = 7 (unidade sete)
                          dez := n div 10;    // dez  = 37 / 10 = 3 (dezena trinta)
                          s := s + dezena[dez];
                          if (unid <> 0)
                             then s := s + ' e ' + unidade[unid];
                       end;
                   s := s + ' centavos';
                 end;
          end;
  Result := s;
end;
 

begin

end.