Valor por extenso

hhmelina · Julho 26, 2005

Oi galera e aí td bom???

Ontem eu vi um componente q válida cpf, cnpj e escreve o valor por extenso...

Gostaria de saber se alguém conhece? e onde posso fazer o download...

Obrigada http://forum.imasters.com.br/public/style_emoticons/default/blush.gif

Mel

@beto · Julho 26, 2005

Oi Mel..

olha ai..

unit Funcoes;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls;

type Tnumeros = array[1..10] of string[15];

Tmoeda = array[1..3,1..2] of string[10];

procedure ValorExtenso(var VExt: array of string; nValor:Real ; cTextoIni,cTextoFim: string;

nLinhas,nLargura: integer; cResto: Char; nMoeda: Integer);

function VerCPF(sCIC : string) : boolean;

function VerCGC(sCGC : string) : boolean;

var

cTexto,cValor1,cPosicao1,cPosicao2,cPosicao3,cPosicao4 : string;

cTipoMoeda: Byte;

const

aUnidade : Tnumeros = ('UM ','DOIS ',' TRES ',' QUATRO ',' CINCO ',' SEIS ',' SETE ',' OITO ',' NOVE ','');

aDezena : Tnumeros = ('DEZ ','VINTE ','TRINTA ','QUARENTA ','CINQUENTA ','SESSENTA ','SETENTA ','OITENTA ','NOVENTA ','');

aDezena2 : Tnumeros = ('DEZ ','ONZE ',' DOZE ','TREZE ','QUATORZE ','QUINZE ','DEZESSEIS ',

'DEZESSETE ','DEZOITO ','DEZENOVE ');

aCentena : Tnumeros = ('CENTO ','DUZENTOS ','TREZENTOS ','QUATROCENTOS ','QUINHENTOS ','SEISCENTOS ',

'SETECENTOS ','OITOCENTOS ','NOVECENTOS ','');

aMilhar : Tnumeros = ('MIL ','MILHAO ','MILHOES ','','','','','','','');

aMoeda : Tmoeda = (('CRUZEIRO ','CRUZEIROS '),('DOLAR ','DOLARES '),('REAL ','REAIS '));

aCentavo : Tnumeros = ('CENTAVO','CENTAVOS','','','','','','','','');

procedure Converte(cNumero: string ; nCasas: byte);

var cNumero1,cNumero2,cNumero3,cNumero4 : string;

begin

if cNumero = '000' then exit;

cNumero1 := Copy(cNumero,1,1);

cNumero2 := Copy(cNumero,2,1);

cNumero3 := Copy(cNumero,length(cNumero),1);

cNumero4 := Copy(cNumero,length(cNumero)-1,2);

if nCasas = 4 then

begin

if StrToInt(cPosicao1+cPosicao2+cPosicao3) <> 0 then

cTexto := cTexto + ' E ';

end;

if cNumero1 <> '0' then

begin

if (cNumero4 = '00') and (cNumero1 = '1') then

cTexto := cTexto + 'CEM '

else

cTexto := cTexto + aCentena[strToInt(cNumero1)];

end;

if (cNumero4 >= '10') and (cNumero4 <= '19') then

begin

if (cNumero1 <> '0') then

cTexto := cTexto + 'E '+aDezena2[strToInt(cNumero4)-9]

else

cTexto := cTexto + aDezena2[strToInt(cNumero4)-9];

end;

if cNumero2 >= '2' then

begin

if cNumero1 <> '0' then

cTexto := cTexto + 'E '+aDezena[strToInt(cNumero2)]

else

cTexto := cTexto + aDezena[strToInt(cNumero2)];

end;

if (cNumero3 <> '0') and ((cNumero4 < '10') or (cNumero4 > '19')) then

begin

if (cNumero1 <> '0') or (cNumero2 <> '0') then

cTexto := cTexto + 'E '+aUnidade[strToInt(cNumero3)]

else

cTexto := cTexto + aUnidade[strToInt(cNumero3)];

end;

Case nCasas of

1: begin

if StrToInt(cNumero) = 1 then

cTexto := cTexto + aMilhar[2]

else

cTexto := cTexto + aMilhar[3];

end;

2: begin

if StrToInt(cNumero) > 0 then

cTexto := cTexto + aMilhar[1];

end;

3: begin

if StrToInt(cPosicao1+cPosicao2+cPosicao3) = 1 then

cTexto := cTexto + aMoeda[cTipoMoeda,1]

else

cTexto := cTexto + aMoeda[cTipoMoeda,2];

end;

4: begin

if StrToInt(cNumero) = 1 then

cTexto := cTexto + aCentavo[1]

else

cTexto := cTexto + aCentavo[2];

end;

function Formata(Text: string; nLinhas,nTamanho : integer; cResto : Char): string;

var nTotLin,n1,n2,nInicio,nFalta,nAcha : integer; cTextoAux,cLinha : string;

begin

nTotLin := nLinhas; {length(cTexto) div nTamanho;}

nInicio := 1;

if nTotLin > nLinhas then

nTotLin := nLinhas;

cTextoAux := '';

for n1 := 1 to nTotLin do

begin

cLinha := Rtrim(Copy(Text,nInicio,nTamanho));

while True do

begin

nFalta := nTamanho - length(cLinha);

if (nFalta > 20) or (Copy(cLinha,length(cLinha),1) = '.') then

break;

if length(cLinha) < nTamanho then

begin

cLinha := BuscaTroca(cLinha,' ','|');

for n2 := 1 to nFalta do

begin

nAcha := BuscaDireita('|',cLinha);

if nAcha = 0 then break;

Delete(cLinha,nAcha,1);

Insert(' ',cLinha,nAcha);

end;

cLinha := BuscaTroca(cLinha,'|',' ');

end;

if length(Rtrim(cLinha)) = nTamanho then break;

end;

cTextoAux := cTextoAux + cLinha;

nInicio := nInicio + nTamanho;

end;

cTextoAux := Copy(Rtrim(cTextoAux)+Repete(cResto,nTamanho * nLinhas),1,nTamanho * nLInhas);

Result := cTextoAux

end;

procedure ValorExtenso(var VExt: array of string; nValor:Real ; cTextoIni,cTextoFim: string;

nLinhas,nLargura: integer; cResto: Char; nMoeda: Integer);

var n1,nInicio : integer;

begin

cTexto := '';

if nMoeda = 0 then

cTipoMoeda := 3

else

cTipoMoeda := nMoeda;

cValor1 := StrZero(nValor,13,2);

cPosicao1 := Copy(cValor1,2,3);

cPosicao2 := Copy(cValor1,5,3);

cPosicao3 := Copy(cValor1,8,3);

cPosicao4 := '0'+Copy(cValor1,(length(cValor1)-1),2);

Converte(cPosicao1,1);

cTexto := cTextoIni + ' ' + cTexto;

Converte(cPosicao2,2);

if (StrToInt(cPosicao2) <> 0) and (StrToInt(cPosicao3) <> 0) and (StrToInt(cPosicao4) = 0) then

cTexto := cTexto + 'E ';

Converte(cPosicao3,3);

if (StrToInt(cPosicao3) = 0) and (StrToInt(cPosicao1+cPosicao2) <> 0) then

cTexto := cTexto + aMoeda[cTipoMoeda,2];

Converte(cPosicao4,4);

cTexto := cTexto + ' '+cTextoFim;

cTexto := Formata(cTexto,nLinhas,nLargura,cResto);

nInicio := 1;

for n1 := 0 to nLinhas-1 do

begin

VExt[n1] := Copy(cTexto,nInicio,nLargura);

nInicio := nInicio + nLargura;

end;

function vercpf(sCIC : string) : boolean;

VAR

WCPFCALC : STRING;

WSOMACPF : INTEGER;

WSX1 : SHORTINT;

WCPFDIGT : INTEGER;

begin

if (sCIC = '11111111111') or (sCIC = '22222222222') or (sCIC = '33333333333') or (sCIC = '44444444444') or (sCIC = '55555555555') or

(sCIC = '66666666666') or (sCIC = '77777777777') or (sCIC = '88888888888') or (sCIC = '99999999999') or (sCIC = '00000000000') or

(sCIC = '111.111.111-11') or (sCIC = '222.222.222-22') or (sCIC = '333.333.333-33') or (sCIC = '444.444.444-44') or (sCIC = '555.555.555-55') or

(sCIC = '666.666.666-66') or (sCIC = '777.777.777-77') or (sCIC = '888.888.888-88') or (sCIC = '999.999.999-99') or (sCIC = '000.000.000-00') then

begin

application.messagebox('C.P.F. Inválido !','Atenção!',mb_iconstop+mb_ok);

vercpf := false;

end

else if (sCIC <> ' . . - ') and (sCIC <> '') then

BEGIN

try

if (Length(sCIC) > 11) then

begin

sCIC := Copy(sCIC,1,3)+Copy(sCIC,5,3)+

Copy(sCIC,9,3)+Copy(sCIC,13,2);

wcpfcalc := copy(sCIC, 1, 9);

end

else

begin

wcpfcalc := copy(sCIC, 1, 9);

end;

//

wsomacpf := 0;

for wsx1:= 1 to 9 DO

wsomacpf := wsomacpf + strtoint(copy(wcpfcalc, wsx1, 1)) * (11 - wsx1);

wcpfdigt:= 11 - wsomacpf mod 11;

if wcpfdigt in [10,11] then

BEGIN

wcpfcalc:= wcpfcalc + '0';

END

else

BEGIN

wcpfcalc := wcpfcalc + inttoStr(wcpfdigt);

END;

wsomacpf:= 0;

for wsx1:= 1 to 10 DO

wsomacpf := wsomacpf + strtoint(copy(wcpfcalc, wsx1, 1)) * (12 - wsx1);

wcpfdigt:= 11 - wsomacpf mod 11;

if wcpfdigt in [10,11] then

BEGIN

wcpfcalc:= wcpfcalc + '0';

END

else

BEGIN

wcpfcalc := wcpfcalc + inttoStr(wcpfdigt);

END;

if sCIC <> wcpfcalc then

begin

application.messagebox('C.P.F. Inválido !','Atenção!',mb_iconstop+mb_ok);

vercpf := false;

end

else

vercpf := true;

except on econverterror do

begin

application.messagebox('Valor informado não é válido !','Atenção!',mb_iconstop+mb_ok);

vercpf := false;

end;

END;

end;

function vercgc(sCGC : string) : boolean;

VAR

WCGCCALC : STRING;

WSOMACGC : INTEGER;

WSX1 : SHORTINT;

WCGCDIGT : INTEGER;

begin

if (sCGC = '11111111111111') or (sCGC = '22222222222222') or (sCGC = '33333333333333') or (sCGC = '44444444444444') or (sCGC = '55555555555555') or

(sCGC = '66666666666666') or (sCGC = '77777777777777') or (sCGC = '88888888888888') or (sCGC = '99999999999999') or (sCGC = '00000000000000') or

(sCGC = '11.111.111/1111-11') or (sCGC = '22.222.222/2222-22') or (sCGC = '33.333.333/3333-33') or (sCGC = '44.444.444/4444-44') or (sCGC = '55.555.555/5555-55') or

(sCGC = '66.666.666/6666-66') or (sCGC = '77.777.777/7777-77') or (sCGC = '88.888.888/8888-88') or (sCGC = '99.999.999/9999-99') or (sCGC = '00.000.000/0000-00') then

begin

application.messagebox('C.N.P.J. Inválido !','Atenção!',mb_iconstop+mb_ok);

vercgc := false;

end

else if (sCGC <> ' . . / - ') and (sCGC <> '') then

BEGIN

try

if (length(sCGC) > 14) then

begin

sCGC := Copy(sCGC,1,2)+Copy(sCGC,4,3)+

Copy(sCGC,8,3)+Copy(sCGC,12,4)+Copy(sCGC,17,2);

wCgcCalc := Copy(sCGC,1,12);

end

else

wCgcCalc := Copy(sCGC,1,12);

//

WSOMACGC := 0;

{-----------------------------}

for wsx1:= 1 to 4 do

wsomacgc:= wsomacgc + strtoint(copy(wcgccalc, wsx1, 1)) * (6 - wsx1);

for wsx1:= 1 to 8 do

wsomacgc:= wsomacgc + strtoint(copy(wcgccalc, wsx1 + 4, 1)) * (10 - wsx1);

wcgcdigt:= 11 - wsomacgc mod 11;

if wcgcdigt in [10,11] then

BEGIN

wcgccalc:= wcgccalc + '0';

END

else

BEGIN

wcgccalc := wcgccalc + inttoStr(wcgcdigt);

END;

{---------------------------------}

wsomacgc:= 0;

for wsx1:= 1 to 5 do

wsomacgc:= wsomacgc + strtoint(copy(wcgccalc, wsx1, 1)) * (7 - wsx1);

for wsx1:= 1 to 8 do

wsomacgc:= wsomacgc + strtoint(copy(wcgccalc, wsx1 + 5, 1)) * (10 - wsx1);

wcgcdigt:= 11 - wsomacgc mod 11;

if wcgcdigt in [10,11] then

BEGIN

wcgccalc:= wcgccalc + '0';

END

else

BEGIN

wcgccalc := wcgccalc + inttoStr(wcgcdigt);

END;

if sCGC <> wcgccalc then

begin

application.messagebox('C.G.C. Inválido !','Atenção!',mb_iconstop+mb_ok);

vercgc := false ;

end

else

vercgc := true ;

except on econverterror do

begin

application.messagebox('Valor informado não é válido !','Atenção!',mb_iconstop+mb_ok);

vercgc := false;

end

END

end;

http://forum.imasters.com.br/public/style_emoticons/default/joia.gif

bastard2003 · Julho 26, 2005

MT boa @Beto.... so esqueceu de fala pro hhmelina que se ele for copiar tudo isso ai.. tu deve cria um unit nova...e salvar ela com o nome de "Funcoes" (sem aspas) se não vai da pau!!! heehe... era isso...Show o codigo!

hhmelina · Julho 27, 2005

http://forum.imasters.com.br/public/style_emoticons/default/clap.gif Olá Beto, brigadinha de novo viu....

Sumi da net, pq estou no meu novo emprego, mas prometo voltar logo logo... Até eu me adaptar...

Beijos...

Mel

@beto · Julho 27, 2005

Fala ai..

Descupa a falha tecnica..

mas e isso ai..

http://forum.imasters.com.br/public/style_emoticons/default/joia.gif

Entrar

Arquivado

Valor por extenso

Recommended Posts

hhmelina 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

@beto 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

bastard2003 4

Compartilhar este post

Link para o post

Compartilhar em outros sites

hhmelina 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

@beto 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

PHP+Codeigniter - Implementar o Input CÓDIGO ou ID do Produto

recuperando parametros simplexml_load_file

PHP+Codeigniter - Adicionar Registro Plano de Contas

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante