DICAS

Visite a biblioteca de dicas da comunidade.

Saiba mais

ARTIGOS

Abordagens detalhadas sobre assuntos diversos.

Saiba mais

INICIANTES

Aprenda a programar de um modo simples e fácil.

Saiba mais

DOWNLOADS

Acesse os materiais exclusivos aos membros.

Saiba mais
voltar

PARA QUEM GOSTA DE DELPHI

Show Delphi » Object Pascal e Strings » Função para converter qualquer número em extenso.

Função para converter qualquer número em extenso.

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

Exemplo de uma função que retorna uma string com o número
informado por extenso.

Está função ainda permite converter para valores monetários
como reais de dólares.

Para utilizar a função declare SysUtils na seção uses,
em versões unicode declare System.SysUtils.

Abaixo, segue o código fonte da função:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

function Extenso(Valor : Extended; Moeda: Boolean; Tipo : Integer = 0): String;
var
  Centavos, Centena, Milhar, Milhao, Bilhao, Texto : string;
const
  Unidades: array [1..9] of string = ('um', 'dois', 'três','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', 'cinqüenta', 'sessenta', 'setenta', 'oitenta', 'noventa');
  Centenas: array [1..9] of string = ('cento', 'duzentos', 'trezentos',
  'quatrocentos', 'quinhentos', 'seiscentos', 'setecentos', 'oitocentos',
  'novecentos');
  function ifs( Expressao: Boolean; CasoVerdadeiro, CasoFalso:String): String;
  begin
    if Expressao then
      Result := CasoVerdadeiro
    else
      Result :=CasoFalso;
  end;
  function MiniExtenso( Valor: ShortString ): string;
  var
    Unidade, Dezena, Centena: String;
  begin
    if (Valor[2] = '1') and (Valor[3] <> '0') then
    begin
      Unidade := Dez[StrToInt(Valor[3])];
      Dezena := '';
    end
    else
    begin
     if Valor[2] <> '0' then
       Dezena := Dezenas[StrToInt(Valor[2])];
     if Valor[3] <> '0' then
       unidade := Unidades[StrToInt(Valor[3])];
    end;
    if (Valor[1] = '1') and (Unidade = '') and (Dezena = '') then
      centena := 'cem'
    else
      if Valor[1] <> '0' then
        Centena := Centenas[StrToInt(Valor[1])]
      else
        Centena := '';
 
    Result := Centena + ifs( (Centena <> '') and ((Dezena <> '') or
    (Unidade <> '')),' e ', '') + Dezena + ifs( (Dezena <> '') and
    (Unidade <> ''), ' e ','') + Unidade;
  end;
begin
  if Valor = 0 then
  begin
    if Moeda then
      Result := ''
    else
      Result := 'zero';
 
    Exit;
  end;
 
  Texto := FormatFloat( '000000000000.00', Valor );
  Centavos := MiniExtenso( '0' + Copy( Texto, 14, 2 ) );
  Centena  := MiniExtenso( Copy( Texto, 10, 3 ) );
  Milhar   := MiniExtenso( Copy( Texto,  7, 3 ) );
 
  if Milhar <> '' then
    Milhar := Milhar + ' mil';
 
  Milhao   := MiniExtenso( Copy( Texto,  4, 3 ) );
 
  if Milhao <> '' then
  begin
    Milhao := Milhao
    + ifs( Copy( Texto, 4,
    3 ) = '001', ' milhão', ' milhões');
  end;
 
  Bilhao   := MiniExtenso( Copy( Texto,  1, 3 ) );
 
  if Bilhao <> '' then
  begin
    Bilhao := Bilhao + ifs( Copy( Texto, 1, 3 ) = '001', ' bilhão',
    ' bilhões');
  end;
 
  Result := Bilhao + ifs( (Bilhao <> '') and (Milhao + Milhar +
  Centena <> ''),
  ifs((Pos(' e ', Bilhao) > 0) or (Pos( ' e ',
  Milhao + Milhar + Centena ) > 0), ', ', ' e '), '') +
  Milhao + ifs( (Milhao <> '') and (Milhar + Centena <> ''),
  ifs((Pos(' e ', Milhao) > 0) or
  (Pos( ' e ', Milhar + Centena ) > 0 ),', ',    ' e '), '') +
  Milhar + ifs( (Milhar <> '') and
  (Centena <> ''), ifs(Pos( ' e ', Centena ) > 0, ', ', ' e '),'') +
  Centena;
 
  if Moeda then
  begin
    if Tipo=0 then
    begin
      if (Bilhao <> '') and (Milhao + Milhar + Centena = '') then
        Result := Bilhao + ' de reais'
      else
      if (Milhao <> '') and (Milhar + Centena = '') then
        Result := Milhao + ' de reais'
      else
        Result := Bilhao + ifs( (Bilhao <> '') and (Milhao + Milhar +
        Centena <> ''), ifs((Pos(' e ', Bilhao) > 0) or (Pos( ' e ',
        Milhao +Milhar + Centena ) > 0), ', ', ' e '), '') + Milhao + ifs(
        (Milhao <> '') and (Milhar + Centena <> ''), ifs((Pos(' e ',
        Milhao) > 0) or (Pos( ' e ', Milhar + Centena ) > 0 ),', ',
        ' e '), '') + Milhar + ifs( (Milhar <> '') and (Centena <> ''),
        ifs(Pos( ' e ', Centena ) > 0, ', ', ' e '),'') +
        Centena + ifs( Int(Valor) = 1, ' real', ' reais');
      if Centavos <> '' then
      begin
        if Valor > 1 then
          Result := Result + ' e ' + Centavos + ifs( Copy(
          Texto, 14, 2 )= '01', ' centavo', ' centavos' )
        else
          Result := Centavos + ifs( Copy( Texto, 14, 2 )= '01',
          ' centavo', ' centavos' );
      end;
    end
    else
    begin
      if (Bilhao <> '') and (Milhao + Milhar + Centena = '') then
        Result := Bilhao + ' de dolares americanos'
      else
      if (Milhao <> '') and (Milhar + Centena = '') then
        Result := Milhao + ' de dolares americanos'
      else
        Result := Bilhao + ifs( (Bilhao <> '') and (Milhao + Milhar +
        Centena <> ''), ifs((Pos(' e ', Bilhao) > 0) or (Pos( ' e ',
        Milhao + Milhar + Centena ) > 0),', ', ' e '), '') + Milhao +
        ifs( (Milhao <> '') and (Milhar + Centena <> ''), ifs((Pos(' e ',
        Milhao) > 0) or (Pos( ' e ', Milhar + Centena ) > 0 ),', ',
        ' e '), '') + Milhar + ifs( (Milhar <> '') and (Centena <> ''),
        ifs(Pos( ' e ', Centena ) > 0,', ', ' e '),'') + Centena + ifs(
        Int(Valor) = 1, ' dolar americano', ' dolares americanos');
 
      if Centavos <> '' then
      begin
        if Valor > 1 then
          Result := Result + ' e ' + Centavos + ifs( Copy( Texto, 14, 2 )=
          '01', ' cent', ' cents' )
        else
          Result := Centavos + ifs( Copy( Texto, 14, 2 )= '01', ' cent', ' ' +
          'cents' );
      end;
    end;
  end;
end;

Exemplos de uso:

1
2
3
4
5
6
7
8
9
10
11

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Número por extenso
  ShowMessage(Extenso(1456.36, False));
 
  // Número por extenso em reais
  ShowMessage(Extenso(2755.12, True));
 
  // Número por extenso com final em dólares
  ShowMessage(Extenso(5369.83, True, 2));
end;

Você pode aperfeiçoar a dica e criar um componente para seu uso.
Se preferir, pode se usado o componente TACBrExtenso da biblioteca do ACBr,
ele é Open Source e oferece várias opções para a conversão.

Dúvidas ou sugestões deixe nos comentários do post.

end.

Facebook Comments Box
  • InfusTec
  • 13.102 views
  • 2 comentários
  • 23 de março de 2015

Está gostando do conteúdo? Considere pagar um cafezinho para nossa equipe!

2 respostas para “Função para converter qualquer número em extenso.”

  1. Jose Raimundo dos Santos Neris disse:
    28 de junho de 2017 às 20:34

    Prezado coloquei esta função e está dando este erro: [dcc32 Error] U_Funcoes.pas(36): E2029 ‘)’ expected but identifier ‘lt’ found
    [dcc32 Warning] U_Funcoes.pas(38): W1057 Implicit string cast from ‘AnsiChar’ to ‘string’
    [dcc32 Error] U_Funcoes.pas(43): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(45): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(51): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(61): E2008 Incompatible types
    [dcc32 Error] U_Funcoes.pas(71): E2250 There is no overloaded version of ‘FormatFloat’ that can be called with these arguments
    [dcc32 Warning] U_Funcoes.pas(72): W1058 Implicit string cast with potential data loss from ‘string’ to ‘ShortString’
    [dcc32 Warning] U_Funcoes.pas(73): W1058 Implicit string cast with potential data loss from ‘string’ to ‘ShortString’
    [dcc32 Warning] U_Funcoes.pas(74): W1058 Implicit string cast with potential data loss from ‘string’ to ‘ShortString’
    [dcc32 Error] U_Funcoes.pas(76): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(81): E2012 Type of expression must be BOOLEAN
    [dcc32 Warning] U_Funcoes.pas(88): W1058 Implicit string cast with potential data loss from ‘string’ to ‘ShortString’
    [dcc32 Error] U_Funcoes.pas(90): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(96): E2029 ‘)’ expected but identifier ‘lt’ found
    [dcc32 Error] U_Funcoes.pas(107): E2066 Missing operator or semicolon
    [dcc32 Error] U_Funcoes.pas(111): E2029 ‘)’ expected but identifier ‘lt’ found
    [dcc32 Error] U_Funcoes.pas(114): E2029 ‘)’ expected but identifier ‘lt’ found
    [dcc32 Error] U_Funcoes.pas(125): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(127): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(137): E2029 ‘)’ expected but identifier ‘lt’ found
    [dcc32 Error] U_Funcoes.pas(140): E2029 ‘)’ expected but identifier ‘lt’ found
    [dcc32 Error] U_Funcoes.pas(152): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(154): E2012 Type of expression must be BOOLEAN
    [dcc32 Error] U_Funcoes.pas(166): E2029 Statement expected but end of file found
    [dcc32 Error] U_Funcoes.pas(166): E2029 ‘;’ expected but end of file found
    [dcc32 Error] U_Funcoes.pas(166): E2029 ‘;’ expected but end of file found
    [dcc32 Fatal Error] F2063 Could not compile used unit ‘U_Funcoes.pas’
    Failed

Deixe um comentário

    Patrocinado


    Patrocinado

    Patrocinado

Ir ao topo

© 2024 Infus Soluções em Tecnologia - Todos os Direitos Reservados