.
dicas show delphi

DICAS

Visite a biblioteca de dicas da comunidade.

Saiba mais
sombra
Artigos Show Delphi

ARTIGOS

Abordagens detalhadas sobre assuntos diversos.

Saiba mais
sombra
iniciantes show delphi

INICIANTES

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

Saiba mais
sombra
downloads show delphi

DOWNLOADS

Acesse os materiais exclusivos aos membros.

Saiba mais
sombra
voltar

PARA QUEM GOSTA DE DELPHI

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.

Post Views: 13.330
  • InfusTec
  • 2 comentários
  • 23 de março de 2015

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

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