Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

sábado, 2 de junho de 2012

DELPHI - Boleto - Codigo de Barras e Linha Digitavel

Reações: 


// ATLabs - Postado no site planetadelphi.com.br + de 35.000  views - Gostaria da divisão de lucros dos ADSENSE da pagina que foi postada
{
Saudações queridos colegas programadores;
Já que não achei nenuma solução na web que funcionasse corretamente, decidi criar a minha baseada no componente de boletos da GBSoft
Creio que baixei este componente aqui da do site do planeta delphi...
Esta dica contém as funções/procedures abaixo:
Modulo10, Modulo11, Formatar, CalcularFatorVencimento, CorrigeSTR, GeraCodBarras, GeraLinhaDigitavel
Para explicar melhor para aqueles que vão ler esta mensagem:
Primeiro gera-se o código de barras depois gera-se a linha digitável, um depende do outro
}

///////////// Inicio - retirados do componente da GBSoft

function Modulo10(Valor: String) : string;
{
   Rotina usada para cálculo de alguns dígitos verificadores
   Pega-se cada um dos dígitos contidos no parâmetro VALOR, da direita para a
   esquerda e multiplica-se por 2121212...
   Soma-se cada um dos subprodutos. Caso algum dos subprodutos tenha mais de um
   dígito, deve-se somar cada um dos dígitos. (Exemplo: 7*2 = 14 >> 1+4 = 5)
   Divide-se a soma por 10.
   Faz-se a operação 10-Resto da divisão e devolve-se o resultado dessa operação
   como resultado da função Modulo10.
   Obs.: Caso o resultado seja maior que 9, deverá ser substituído por 0 (ZERO).
}

var

   Auxiliar : string;
   Contador, Peso : integer;
   Digito : integer;
begin
   Auxiliar := '';
   Peso := 2;
   for Contador := Length(Valor) downto 1 do
   begin
      Auxiliar := IntToStr(StrToInt(Valor[Contador]) * Peso) + Auxiliar;
      if Peso = 1 then
         Peso := 2
      else
         Peso := 1;
   end;
   Digito := 0;
   for Contador := 1 to Length(Auxiliar) do
   begin
      Digito := Digito + StrToInt(Auxiliar[Contador]);
   end;
   Digito := 10 - (Digito mod 10);
   if (Digito > 9) then
      Digito := 0;
   Result := IntToStr(Digito);
end;

function Modulo11(Valor: String; Base: Integer = 9; Resto : boolean = false) : string;
{
   Rotina muito usada para calcular dígitos verificadores
   Pega-se cada um dos dígitos contidos no parâmetro VALOR, da direita para a
   esquerda e multiplica-se pela seqüência de pesos 2, 3, 4 ... até BASE.
   Por exemplo: se a base for 9, os pesos serão 2,3,4,5,6,7,8,9,2,3,4,5...
   Se a base for 7, os pesos serão 2,3,4,5,6,7,2,3,4...
   Soma-se cada um dos subprodutos.
   Divide-se a soma por 11.
   Faz-se a operação 11-Resto da divisão e devolve-se o resultado dessa operação
   como resultado da função Modulo11.
   Obs.: Caso o resultado seja maior que 9, deverá ser substituído por 0 (ZERO).
}
var
   Soma : integer;
   Contador, Peso, Digito : integer;
begin
   Soma := 0;
   Peso := 2;
   for Contador := Length(Valor) downto 1 do
   begin
      Soma := Soma + (StrToInt(Valor[Contador]) * Peso);
      if Peso < Base then
         Peso := Peso + 1
      else
         Peso := 2;
   end;
   if Resto then
      Result := IntToStr(Soma mod 11)
   else
   begin
      Digito := 11 - (Soma mod 11);
      if (Digito > 9) then
         Digito := 0;
      Result := IntToStr(Digito);
   end
end;

function Formatar(Texto : string; TamanhoDesejado : integer; AcrescentarADireita : boolean = true; CaracterAcrescentar : char = ' ') : string;
{
   OBJETIVO: Eliminar caracteres inválidos e acrescentar caracteres à esquerda ou à direita do texto original para que a string resultante fique com o tamanho desejado
   Texto : Texto original
   TamanhoDesejado: Tamanho que a string resultante deverá ter
   AcrescentarADireita: Indica se o carácter será acrescentado à direita ou à esquerda
      TRUE - Se o tamanho do texto for MENOR que o desejado, acrescentar carácter à direita
             Se o tamanho do texto for MAIOR que o desejado, eliminar últimos caracteres do texto
      FALSE - Se o tamanho do texto for MENOR que o desejado, acrescentar carácter à esquerda
             Se o tamanho do texto for MAIOR que o desejado, eliminar primeiros caracteres do texto
   CaracterAcrescentar: Carácter que deverá ser acrescentado
}
var
   QuantidadeAcrescentar,
   TamanhoTexto,
   PosicaoInicial,
   i : integer;
begin
   case CaracterAcrescentar of
      '0'..'9','a'..'z','A'..'Z' : ;{Não faz nada}
      else
         CaracterAcrescentar := ' ';
   end;
   Texto := Trim(AnsiUpperCase(Texto));
   TamanhoTexto := Length(Texto);
   for i := 1 to (TamanhoTexto) do
   begin
      if Pos(Texto[i],' 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ`~''"!@#$%^&*()_-+=|/{}[]:;,.<>') = 0 then
      begin
         case Texto[i] of
            'Á','À','Â','Ä','Ã' : Texto[i] := 'A';
            'É','È','Ê','Ë' : Texto[i] := 'E';
            'Í','Ì','Î','Ï' : Texto[i] := 'I';
            'Ó','Ò','Ô','Ö','Õ' : Texto[i] := 'O';
            'Ú','Ù','Û','Ü' : Texto[i] := 'U';
            'Ç' : Texto[i] := 'C';
            'Ñ' : Texto[i] := 'N';
            else Texto[i] := ' ';
         end;
      end;
   end;
   QuantidadeAcrescentar := TamanhoDesejado - TamanhoTexto;
   if QuantidadeAcrescentar < 0 then
      QuantidadeAcrescentar := 0;
   if CaracterAcrescentar = '' then
      CaracterAcrescentar := ' ';
   if TamanhoTexto >= TamanhoDesejado then
      PosicaoInicial := TamanhoTexto - TamanhoDesejado + 1
   else
      PosicaoInicial := 1;
   if AcrescentarADireita then
      Texto := Copy(Texto,1,TamanhoDesejado) + StringOfChar(CaracterAcrescentar,QuantidadeAcrescentar)
   else
      Texto := StringOfChar(CaracterAcrescentar,QuantidadeAcrescentar) + Copy(Texto,PosicaoInicial,TamanhoDesejado);
   Result := AnsiUpperCase(Texto);
end;
function CalcularFatorVencimento(DataDesejada : TDateTime) : string;
{O fator de vencimento é a quantidade de dias entre 07/Nov/1997 e a data de vencimento do título}
begin
   Result := IntToStr( Trunc(DataDesejada - EncodeDate(1997,10,07)));
end;
///////////// Fim - retirados do componente da GBSoft

function CorrigeSTR(Str : string; CaracTroca : string; CaracNovo : string) : string;
var i, int : integer;
S : string;
begin
i := 0;
int := 0;
 while i <= length(str) do
 begin
  if copy(Str,i,1) = CaracTroca then
   begin
    Delete(Str,i,1);
    s := copy(Str,1,i-1) + CaracNovo + copy(Str,i , length(str) - i + 1);
    str := s;
    inc(i);
    inc(int);
   end;
 inc(i);
 end;
 if int <> 0 then
 result := s
 else
 result := str;
end;

Function StrZero(S: String; Tam: Integer): String;
var
   wZeros : String;
   wCont  : Integer;
begin
wCont := 0;
wZeros := '';
     for wCont := 1 to tam - length(s) do
         wZeros := '0' + wZeros;
   Result := wZeros + S;
end;
/////////////////Inicio - Função alterada do componente da GBSoft

function GeraCodBarras(Banco, Moeda, AG, Operacao, Carteira, NNumero, Valor, Vencto: String):String;
var
AFatorVencimento, ACampoLivre, ACodigoBarras, ADigitoCodigoBarras : string;
begin
   {Primeira parte do código de barras}
   AFatorVencimento := Formatar(CalcularFatorVencimento(StrToDate(Vencto)),4,false,'0');
   //Valor; {Formata o valor com 10 dígitos, incluindo as casas decimais, mas não mostra o ponto decimal}
   {Segunda parte do código de barras - Campo livre - Varia de acordo com o banco}
   ACampoLivre := StrZero(AG,4) +
                  StrZero(Carteira,3) +
                  StrZero(Operacao,7) +
                  StrZero(NNumero +  Modulo10(AG + Carteira + NNumero),11);
   {Calcula o dígito e completa o código de barras}
   ACodigoBarras := StrZero(Banco,3) +
                    StrZero(Moeda,1) +
                    StrZero(AFatorVencimento,4) +
                    StrZero(CorrigeSTR(Valor,',',''),10) +
                    ACampoLivre;
   ADigitoCodigoBarras := Modulo11(ACodigoBarras,9);
   if ADigitoCodigoBarras = '0' then
      ADigitoCodigoBarras := '1';
   Result := Copy(ACodigoBarras,1,4) + ADigitoCodigoBarras + Copy(ACodigoBarras,5,length(ACodigoBarras)-4);
// *)
end;

function GeraLinhaDigitavel(Banco, Moeda, AG, Operacao, Carteira, NNumero, Valor, Vencto : string):String;
var
   p1, p2, p3, p4, p5, p6,
   Campo1, Campo2, Campo3, Campo4, Campo5,
   Codigo : string;
begin
  Codigo := GeraCodBarras(Banco, Moeda, AG, Operacao, Carteira, NNumero, Valor, Vencto);
   p1 := Copy(Codigo,1,4);
   p2 := Copy(Codigo,20,5);
   p3 := Modulo10(p1+p2);
   p4 := p1+p2+p3;
   p5 := Copy(p4,1,5);
   p6 := Copy(p4,6,5);
   Campo1 := p5+'.'+p6;
   {
      Campo 2 - composto pelas posiçoes 6 a 15 do campo livre
      e DV (modulo10) deste campo
   }
   p1 := Copy(Codigo,25,10);
   p2 := Modulo10(p1);
   p3 := p1+p2;
   p4 := Copy(p3,1,5);
   p5 := Copy(p3,6,6);
   Campo2 := p4+'.'+p5;
   {
      Campo 3 - composto pelas posicoes 16 a 25 do campo livre
      e DV (modulo10) deste campo
   }
   p1 := Copy(Codigo,35,10);
   p2 := Modulo10(p1);
   p3 := p1+p2;
   p4 := Copy(p3,1,5);
   p5 := Copy(p3,6,6);
   Campo3 := p4+'.'+p5;
   {
      Campo 4 - digito verificador do codigo de barras
   }
   Campo4 := Copy(Codigo,5,1);
   {
      Campo 5 - composto pelo valor nominal do documento, sem indicacao
      de zeros a esquerda e sem edicao (sem ponto e virgula). Quando se
      tratar de valor zerado, a representacao deve ser 000 (tres zeros).
   }
   Campo5 := Copy(Codigo,6,14);
   Result := Campo1 + ' ' + Campo2 + ' ' + Campo3 + ' ' + Campo4 + ' ' + Campo5;
End;

/////////////////Fim - Função alterada do componente da GBSoft
{
Vou dar o resultado da linha digitavel com os seguintes parametros:
Banco = 623
Moeda = 9 // 9 para real (creio que seja para a moeda local), e 0 para outras
AG = 1
Operacao = 27
Carteira = 121
NNumero = 0260279393

Valor = 153,39
Vencto = 21/09/2009
Linha digitavel = 62390.00117 21000.002705 26027.939367 1 43670000015339
Cod de barras = 62391436700000153390001121000002702602793936
Obs.
No rave reports o código de barras de nome "I2of5BarCode" é o código de barras do boleto
ele está na guia "Bar Code" ele é o segundo item
bem, o resto agora é voce colocar os valores da variavél as funcoes:
GeraCodBarras e GeraLinhaDigitavel e exibi-las
Separei as funções pois fica a critério da pessoa enviar o boleto com o código de barras ou informar somente a linha digitável (via fone por ex)
Espero que tenham gostado.
Atte:
Felipe Leal
}
//-------------- 

Nenhum comentário:

Postar um comentário

Observação: somente um membro deste blog pode postar um comentário.

Max Gehringer