Como Capturar Valor Moeda Em Extenso

[Vivendo&Aprendendo]

Olá galera

preciso pegar um valor monetário e transformar ele em extenso.

Como faço isso?

Alexandre

[Churc]

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

[Guest conecty]

Onde eu digito o valor monetário ?

Editado Setembro 20, 2007 por Micheus
Não observação do item 3.7 das regras do forum - NÃO digite em caixa alta (1º aviso)

[Micheus]

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

[Vivendo&Aprendendo]

Cara o código deve ser inserido no componente Edit.... ou em um Botão para capturar o valor do edit e transformar ele...

Alexandre