Ir para conteúdo
Fórum Script Brasil
  • 0

Como Capturar Valor Moeda Em Extenso


Vivendo&Aprendendo

Pergunta

4 respostass a esta questão

Posts Recomendados

  • 0

pego em algum lugar que não lembro aonde

Function Extenso(xValor: Double;xSingular,xPlural: String): String;
  Function IFN(vCond:Boolean; rTrue,rFalse:LongInt):LongInt;
  Begin
     If vCond=True Then IFN := rTrue Else IFN := rFalse;
  End;

  function ReplaceStr(const S, OldPattern, NewPattern: string; ReplaceAll:Boolean=True; IgnoreCase:Boolean=True): string;
  var SearchStr, Patt, NewStr: string;
      Offset: Integer;
  begin
    if IgnoreCase then begin
      SearchStr := AnsiUpperCase(S);
      Patt := AnsiUpperCase(OldPattern);
    end else begin
      SearchStr := S;
      Patt := OldPattern;
    end;
    NewStr := S;
    Result := '';
    while SearchStr <> '' do begin
      Offset := AnsiPos(Patt, SearchStr);
      if Offset = 0 then begin
        Result := Result + NewStr;
        Break;
      end;
      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
      NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
      if not ReplaceAll then begin
        Result := Result + NewStr;
        Break;
      end;
      SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
    end;
  end;

  Function StrZero(xVal:LongInt;xTam:Integer):String;
  Var xRet : String;
  Begin
    xVal := Abs(xVal);
    Str(xVal,xRet);
    While Length(xRet) < xTam do Insert('0',xRet,1);
    StrZero := xRet;
    // Exemplo mais simples: StrZero := Format('%0.'+IntToStr(xTam)+'d',[xVal]);
  End;

  Function IFS(vCond:Boolean; rTrue,rFalse:String):String;
  Begin
     If vCond Then Result := rTrue Else Result := rFalse;
  End;

  Function ExtCem(xCem:String):String;
  Var Aval  : Array [1..3] Of Integer;
      xRet  : String;

  Const Acent    : Array[1..9] of String = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos','Quinhentos',
            'Seiscentos', 'Setecentos','Oitocentos', 'Novecentos');
        Avint    : Array[1..9] of String = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze','Dezesseis',
            'Dezessete', 'Dezoito', 'Dezenove');
        Adez     : Array[1..9] of String = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta','Sessenta',
            'Setenta', 'Oitenta', 'Noventa');
        Aunit    : Array[1..9] of String = ('Um', 'Dois', 'Três', 'Quatro', 'Cinco', 'Seis','Sete', 'Oito', 'Nove');
  Begin
     xRet := '';
     Aval[1] := StrToInt(xCem[1]);
     Aval[2] := StrToInt(xCem[2]);
     Aval[3] := StrToInt(xCem[3]);

     if StrToInt(xCem)>0 Then Begin
        if StrToInt(xCem) = 100 Then Begin
    xRet := 'Cem ';
        End else Begin
    if Aval[1] >0 Then Begin
       xRet := Acent[Aval[1]] + IFS( ( Aval[2] + Aval[3] > 0 ), ' e', '' );
    end;
    if ( Aval[2] = 1 ) and ( Aval[3] > 0 ) Then Begin
       xRet := xRet + ' ' + Avint[ Aval[3] ] + ' ';
    End else Begin
       if Aval[2]>0 Then Begin
          xRet := xRet + ' ' + Adez[ Aval[2] ] + IFS( Aval[3] > 0, ' e', '' );
       end;
       xRet := xRet + IFS(Aval[3] > 0, ' '+ Aunit[ Aval[ 3 ] ],'');
    end;
        end;
     end;
     ExtCem := xRet;
  End;

Var  Tstr    : String;
     xCifra  : Array [1..6,1..2] of String;
     Tx      : Integer;
     xExt    : String;
     Tsubs   : String;
     xCent   : Integer;
Begin
   xExt  := '';  TSubs := '';
   Tstr  := FormatFloat('0000000000000000.00',xValor);
   xCent := StrToInt(Copy(Tstr,18,2));
   Tstr  := Copy(Tstr,1,16);
   xValor:= StrToInt(Tstr);

   xCifra[1,1] := 'Trilhão'; xCifra[1,2] := 'Trilhões';
   xCifra[2,1] := 'Bilhão';  xCifra[2,2] := 'Bilhões';
   xCifra[3,1] := 'Milhão';  xCifra[3,2] := 'Milhões';
   xCifra[4,1] := 'Mil';     xCifra[4,2] := 'Mil';
   xCifra[5,1] := ' ';       xCifra[5,2] := ' ';
   xCifra[6,1] := 'Centavo'; xCifra[6,2] := 'Centavos';

   if xValor+xCent>0 Then Begin
      if xCent>0 Then Begin
     xExt := ExtCem( strzero( xCent, 3 ) ) + ' '+xCifra[6][ IFN( xCent = 1, 1, 2 ) ];
      end;
      if int(xValor)>0 Then Begin
     xExt := IFS( int(xValor)=1,' '+xSingular,' '+xPlural)+IFS( xCent > 0, ' e ','' ) + xExt;
      end;
      for Tx := 5 Downto 1 Do Begin
     Tsubs := Copy(Tstr,(Tx*3)-1,3);
     if StrToInt(Tsubs) > 0  Then  Begin
        xExt := ExtCem(Tsubs)+#32+xCifra[Tx,IFN(StrToInt(Tsubs)=1,1,2)]+' '+ xExt;
     end;
      End;
   End;
   xExt := Trim(xExt);
   Repeat
      xExt := ReplaceStr(xExt,#32#32,#32);
   Until Pos(#32#32,xExt)=0;
   Extenso := xExt;
End;

Function ExtensoReal(xValor: Double): String;
Begin
  Result := Extenso(xValor,'Real','Reais');
End;

ai você usa exemplo

Label1.Caption := Extensoreal(valor);

abraços

Link para o comentário
Compartilhar em outros sites

  • 0
Onde eu digito o valor monetário ?
Está falando sério?

Não seria em um componente TEdit colocado em um Form!?

Se não souber como criar uma aplicação Delphi básica, sugiro que utilize o botão "Novo Tópico" para criar um tópico e obter ajuda a este respeito.

Também, no link Apostilas Gratuitas, você pode encontrar alguma ajuda - Apostilas Delphi

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,2k
×
×
  • Criar Novo...