Buscar por:

Escrevendo o valor por extenso (revisado)

Código

Unit Unit2;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs;

function extenso(valor: real): string;

implementation

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');

MoedaSigular = 'Real';

MoedaPlural = 'Reais';

CentSingular = 'Centavo';

CentPlural = 'Centavos';

Zero = 'Zero';

function extenso(valor: real): string;

var Texto,Milhar,Centena,Centavos,msg: string;

////////////////////////////////fucao auxiliar extenso////////////////////////////////

  function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;

    begin

      if Expressao then

      Result:=CasoVerdadeiro

      else

      Result:=CasoFalso;

  end;

////////////////////////////funcao auxiliar extenso/////////////////////////

  function MiniExtenso (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

      msg:='O valor está fora do intervalo permitido.';

      msg:=msg+'O número deve ser maior ou igual a zero e menor que 999.999,99.';

      msg:=msg+' Se não for corrigido o número não será escrito por extenso.';

      showmessage(msg);

      Result:='';

      exit;

    end;

  if valor=0 then

    begin

      Result:='';

      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

    begin

      if copy(texto,4,3)='000' then

        Result:=Result+' Mil Reais'

      else

        Result:=Result+' Mil, ';

  end;

  if (((copy(texto,4,2)='00') and (Milhar<>'') and (copy(texto,6,1)<>'0')))or (centavos='') and (milhar<>'')  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

      Result:=Result+'.';

      Exit;

  end

  else

    begin

      if Milhar+Centena='' then

        Result:=Centavos

      else

        Result:=Result+', e '+Centavos;

  end;

  if (copy(texto,8,2)='01') and (Centavos<>'') then

      Result:=Result+' Centavo.'

  else

      Result:=Result+' Centavos.';

end;

end.

/////////////////////////////////////////////

// Para chamar no formulário faça:  ///

///////////////////////////////////////////

v_extenso.Text:= extenso(strtofloat(edit1.Text));

//////////////////////////////////////////////////////////////////////

//   ESTE CÓDIGO FOI RETIRADO E REVISADO DO DELPHI.ETI.BR

/////////////////////////////////////////////////////////////////////