Buscar por:
Boleto - Codigo de Barras e Linha Digitavel - Delphi 7

Código
{

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

}