Funcao - extenso

// Otimizada

function Extenso(const Valor: Double): string;

var

  Centavos, Centena, Milhar, Texto: string;

const

  Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco',

                                     'Seis', 'Sete', 'Oito', 'Nove');

  Dez     : array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze',

                                     'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');

  Dezenas : array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta',

                                     'Sessenta', 'Setenta', 'Oitenta', 'Noventa');

  Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos',

                                     'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');

  function IfS(const Expressao: Boolean; const CasoVerdadeiro, CasoFalso: string): string;

  begin

    if Expressao then Result:= CasoVerdadeiro else Result:= CasoFalso;

  end;

  function MiniExtenso(const Trio: string): string;

  var

    Unidade, Dezena, Centena: string;

  begin

    Unidade := '';

    Dezena  := '';

    Centena := '';

    if (Trio[2] = '1') and (Trio[3] <> '0') then

    begin

      Unidade := Dez[StrToInt(Trio[3])];

      Dezena  := '';

    end

    else

    begin

      if Trio[2] <> '0' then Dezena  := Dezenas [StrToInt(Trio[2])];

      if Trio[3] <> '0' then Unidade := Unidades[StrToInt(Trio[3])];

    end;

    if (Trio[1] = '1') and (Unidade = '') and (Dezena = '')

     then Centena := 'Cem'

    else

      if Trio[1] <> '0' then

        Centena := Centenas[StrToInt(Trio[1])]

      else

        Centena := '';

    Result:= Centena + IfS((Centena <> '') and ((Dezena <> '') or (Unidade <> '')), ' e ', '') +

             Dezena  + IfS((Dezena  <> '') and (Unidade <> ''),' e ', '') + Unidade;

  end;

begin

  if (valor > 999999.99) or (valor < 0) then

  begin

    ShowMessage( 'O valor está fora do intervalo permitido.' + #13 +

                 'O número deve ser maior ou igual a zero e menor que 999.999,99.' + #13 +

                 'Se não for corrigido o número não será escrito por extenso.' );

    Result :='';

    Exit;

  end;

  if Valor = 0 then

  begin

    Result := 'Zero';

    Exit;

  end;

  Texto    := FormatFloat('000000.00',Valor);

  Milhar   := MiniExtenso(Copy(Texto,1,3));

  Centena  := MiniExtenso(Copy(Texto,4,3));

  Centavos := MiniExtenso('0' + Copy(Texto,8,2));

  Result   := Milhar;

  if Milhar <> '' then

    if Copy(Texto,4,3) = '000' then

      Result := Result + ' Mil Reais'

    else

      Result := Result + ' Mil, ';

  if (((Copy(Texto,4,2) = '00') and (Milhar <> '') and

     (Copy(Texto,6,1) <> '0')) or (Centavos = '')) and

     (Centena <> '') then Result := Result + ' e ';

  if (Milhar + Centena <> '') then Result := Result + Centena;

  if (Milhar = '') and (Copy(texto,4,3) = '001') then

    Result:= Result + ' Real'

  else

    if (Copy(Texto,4,3) <> '000') then Result:= Result + ' Reais';

  if Centavos = '' then

  begin

    if Copy(Result,1,3) = ' e ' then Delete(Result,1,3);

    Exit;

  end

  else

  begin

    if Milhar + Centena = '' then

      Result := Centavos

    else

      Result := Result + ' e ' + Centavos;

    Result:= Result + ' Centavo';

    if (Copy(Texto,8,2) <> '01') then Result := Result + 's';

  end;

  if Copy(Result,1,3) = ' e ' then Delete(Result,1,3);

end;