Funcao - extenso

Top  Previous  Next

// Otimizada

 

function Extenso(const Valor: Double): string;

var

  Centavos, Centena, Milhar, Texto: string;

const

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

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

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

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

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

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

  Centenas: array[1..9of 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.99or (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;