Olá! Wednesday, 20 de June de 2018.



Dicas CódigoFonte.net
Sunday, 23 de July de 2006

Código de Barras EAN 13 e EAN 8

Nesse artigo mostrarei como desenhar dois tipos de código de barras EAN 13 e EAN 8, em um PictureBox, não enfocarei nesse artigo a explicação de como construir o algaritimo de desenho do Código de Barra, é necessário um estudo especifico no Padrão EAN para entender como é construído um Código de Barra, estaria disponibilizando as funções necessárias e explicando o processo para a confecção de um aplicativo simples.

Em outro artigo estarei demonstrando como imprimir esse Código de barra usando o componente PrintDocument.

Vamos iniciar uma novo Projeto Windows Forms, coloque um Label altere o Text para Código de Barra, um TextBox, um PictureBox altere a BackColor para Window, um Button altere o Text para Desenhar, seu formulário deve ficar parecido com a Figura 1.

Clique para ver a imagem em seu tamanho real
Figura 1. Como deve ficar os componentes no Formulário

Declare a Função EANCodeBin, ela transforma o Código EAN em Binário essa função é usada pela função PrintEanBarcode, acompanhe a Listagem 1.

Listagem 1. Função EANCodeBIN

  1. function EANCodeBIN(strEANCode: string): string;
  2. var
  3.   I : Integer;
  4.   str, strAux, StrBinCode, StrCodigo : String;
  5. begin
  6.   strEANCode := Trim(strEANCode);
  7.   strAux := strEANCode;
  8.   If (strAux.Length <> 13) And (strAux.Length <> 8) Then
  9.     Exception.Create('Código EAN Inválido');
  10.  
  11.   for  I := 0 to strEANCode.Length - 1 do
  12.     if (strAux.Chars[I].ToString < '0') or (strAux.Chars[I].ToString > '9') then
  13.       Exception.Create('Caracter Inválidos no EAN');
  14.  
  15.   If (strAux.Length = 13) Then
  16.   begin
  17.     strAux := Copy(strAux,2,Length(StrAux));
  18.  
  19.     Case Convert.ToInt32(Copy(strEANCode,1,1)) of
  20.       0: StrCodigo := '000000';
  21.       1: StrCodigo := '001011';
  22.       2: StrCodigo := '001101';
  23.       3: StrCodigo := '001110';
  24.       4: StrCodigo := '010011';
  25.       5: StrCodigo := '011001';
  26.       6: StrCodigo := '011100';
  27.       7: StrCodigo := '010101';
  28.       8: StrCodigo := '010110';
  29.       9: StrCodigo := '011010';
  30.     end;
  31.   end
  32.   else
  33.       StrCodigo := '0000';
  34.  
  35.   StrBinCode := '000101';
  36.   For I := 1 To (Length(strAux) div 2) do
  37.     Case Convert.ToInt32(Copy(strAux, I, 1)) of
  38.       0:
  39.         begin
  40.           if Copy(StrCodigo, I, 1) = '0' then
  41.             StrBinCode := StrBinCode + '0001101'
  42.           else
  43.             StrBinCode := StrBinCode + '0100111';
  44.         end;
  45.       1:
  46.         begin
  47.           if Copy(StrCodigo, I, 1) = '0' then
  48.             StrBinCode := StrBinCode + '0011001'
  49.           else
  50.             StrBinCode := StrBinCode + '0110011';
  51.         end;
  52.       2:
  53.         begin
  54.           if Copy(StrCodigo, I, 1) = '0' then
  55.             StrBinCode := StrBinCode + '0010011'
  56.           else
  57.             StrBinCode := StrBinCode + '0011011';
  58.         end;
  59.       3:
  60.         begin
  61.           if Copy(StrCodigo, I, 1) = '0' then
  62.             StrBinCode := StrBinCode + '0111101'
  63.           else
  64.             StrBinCode := StrBinCode + '0100001';
  65.         end;
  66.       4:
  67.         begin
  68.           if Copy(StrCodigo, I, 1) = '0' then
  69.             StrBinCode := StrBinCode + '0100011'
  70.           else
  71.             StrBinCode := StrBinCode + '0011101';
  72.         end;
  73.       5:
  74.         begin
  75.           if Copy(StrCodigo, I, 1) = '0' then
  76.             StrBinCode := StrBinCode + '0110001'
  77.           else
  78.             StrBinCode := StrBinCode + '0111001';
  79.         end;
  80.       6:
  81.         begin
  82.           if Copy(StrCodigo, I, 1) = '0' then
  83.             StrBinCode := StrBinCode + '0101111'
  84.           else
  85.             StrBinCode := StrBinCode + '0000101';
  86.         end;
  87.       7:
  88.         begin
  89.           if Copy(StrCodigo, I, 1) = '0' then
  90.             StrBinCode := StrBinCode + '0111011'
  91.           else
  92.             StrBinCode := StrBinCode + '0010001';
  93.         end;
  94.       8:
  95.         begin
  96.           if Copy(StrCodigo, I, 1) = '0' then
  97.             StrBinCode := StrBinCode + '0110111'
  98.           else
  99.             StrBinCode := StrBinCode + '0001001';
  100.         end;
  101.       9:
  102.         begin
  103.           if Copy(StrCodigo, I, 1) = '0' then
  104.             StrBinCode := StrBinCode + '0001011'
  105.           else
  106.             StrBinCode := StrBinCode + '0010111';
  107.         end;
  108.     end;
  109.     StrBinCode := StrBinCode + '01010';
  110.  
  111.     for I := (Length(strAux) div 2 + 1) To Length(strAux) do
  112.       case Convert.ToInt32(Copy(strAux, I, 1)) of
  113.         0 : StrBinCode := StrBinCode + '1110010';
  114.         1 : StrBinCode := StrBinCode + '1100110';
  115.         2 : StrBinCode := StrBinCode + '1101100';
  116.         3 : StrBinCode := StrBinCode + '1000010';
  117.         4 : StrBinCode := StrBinCode + '1011100';
  118.         5 : StrBinCode := StrBinCode + '1001110';
  119.         6 : StrBinCode := StrBinCode + '1010000';
  120.         7 : StrBinCode := StrBinCode + '1000100';
  121.         8 : StrBinCode := StrBinCode + '1001000';
  122.         9 : StrBinCode := StrBinCode + '1110100';
  123.       end;
  124.       StrBinCode := StrBinCode + '101000';
  125.       EANCodeBIN := StrBinCode;
  126.     end;


Agora vamos a declarar a função PrintEANBarCode, é necessário passar os seguintes parâmetros, o Código de Barra e o Objeto PictureBox aonde será desenhado as Brras do Código de Barra, os outros parâmetros são opcionais, os quatro parâmetros seguintes são as posições e tamanho do desenho e o ultimo é a fonte da linha que imprimirá o código de barra, acompanhe a Listagem 2.

Listagem 2. Função PrintEANCode

  1. procedure PrintEANBarCode(strEANCode : String; objPicBox : PictureBox;
  2.   const sngX1 : Single = -1; const sngY1 : Single = -1;
  3.   const sngX2 : Single = -1; const sngY2 : Single = -1;
  4.   const FontForText: Font = nil);
  5. var
  6.   I : Integer;
  7.   sngPosX : Single;
  8.   sngPosY : Single;
  9.   sngScaleX : Single;
  10.   strEANBin : String;
  11.   strFormat : StringFormat;
  12.   FontText : Font;
  13.   sngXX1, sngYY1, sngXX2, sngYY2 : Single;
  14.   BrushX : Brush;
  15. begin
  16.   StrFormat := StringFormat.Create;
  17.   strEANBin := EANCodeBIN(strEANCode);
  18.  
  19.   If (FontForText = nil) Then
  20.     FontText := Font.Create('Courier New', 10)
  21.   else
  22.     FontText := FontForText;
  23.  
  24.   If sngX1 = (-1) Then
  25.     sngXX1 := 0
  26.   else
  27.     sngXX1 := sngX1;
  28.  
  29.   If sngY1 = (-1) Then
  30.     sngYY1 := 0
  31.   else
  32.     sngYY1 := sngY1;
  33.  
  34.   If sngX2 = (-1) Then
  35.     sngXX2 := objPicBox.Width
  36.   else
  37.     sngXX2 := sngX2;
  38.  
  39.   If sngY2 = (-1) Then
  40.     sngYY2 := objPicBox.Height
  41.   else
  42.     sngYY2 := sngY2;
  43.  
  44.   sngPosX := sngXX1;
  45.   sngPosY := sngYY2 - (1.5 * FontText.Height);
  46.  
  47.   BrushX := SolidBrush.Create(objPicBox.BackColor);
  48.   objPicBox.CreateGraphics.FillRectangle(BrushX, sngXX1, sngYY1, sngXX2 - sngXX1, sngYY2 - sngYY1);
  49.  
  50.   sngScaleX := (sngXX2 - sngXX1) / strEANBin.Length;
  51.  
  52.   for I := 1 To Length(strEANBin) do
  53.   begin
  54.     If Copy(strEANBin, I, 1) = '1' Then
  55.     begin
  56.       BrushX := SolidBrush.Create(objPicBox.ForeColor);
  57.       objPicBox.CreateGraphics.FillRectangle(BrushX, sngPosX, sngYY1, sngScaleX, sngPosY);
  58.     end;
  59.     sngPosX := sngXX1 + (I * sngScaleX);
  60.  end;
  61.  strFormat.Alignment := StringAlignment.Center;
  62.  strFormat.FormatFlags := StringFormatFlags.NoWrap;
  63.  BrushX := SolidBrush.Create(objPicBox.ForeColor);
  64.  objPicBox.CreateGraphics.DrawString(strEANCode, FontText, BrushX, Convert.ToSingle((sngXX2 - sngXX1) / 2), Convert.ToSingle(sngYY2 - FontText.Height), strFormat);
  65.  
  66. end;


No evento Click do Button1 coloque o seguinte código para executar a Função de desenhar as barras do código de barra, Listagem 3.

Listagem 3. Executando a Função para Desenhar Barra

  1. PrintEANBarCode(TextBox1.Text, PictureBox1, 10, 10, PictureBox1.Width - 20, PictureBox1.Height - 20);


Não esqueça de colocar no uses SysUtils, agora basta você digitar um Código de Barra e clicar em desenhar que ele desenhará as barras no PictureBox veja a Figura 2 e Figura 3.

Clique para ver a imagem em seu tamanho real
Figura 2. Código de Barra EAN 13

Clique para ver a imagem em seu tamanho real
Figura 3. Código de Barra EAN 8

Abraços a Todos.


Conheça nosso parceiro:





Comentários do artigo [Novo comentário]

carlos escudeiro - 11 de October de 2008 - 17:46
Só faltou o codigo do botão desenhar
Edilson Alves de Oliveira - 18 de November de 2008 - 17:23
onde encontro esse tal de pictueBox no delphi?
ELIAS PAULINO - 26 de October de 2009 - 12:59
tambem gostaria de saber onde eu encontro esse componente picturebox no delphi 7 , utilizo o quickreport 4.5
Everton Eberhardt - 24 de April de 2011 - 12:54
Não funciona?
o código do botão desenhar gera um erro!
Vicente Miras - 27 de May de 2011 - 11:06
Bom Dia,
Sei que já foi perguntado abaixo, mas não encontrei a resposta, gostaria de saber onde encontro o componente PictureBox, no Delphi 7 não tem.
antonio celio - 05 de June de 2016 - 19:01
muito bom
Para adicionar um comentário você deve efetuar o login


Gostou do CódigoFonte.net? Quer indicar a um amigo?
Preencha os campos a seguir.
Seu Nome:
Seu E-mail:
E-mail de seu Amigo:
sms -1' downloads txt preloader pop up livro iframe botão direito votação impressão imagen tabelas search bot busc upload de imagens sistema de login acesso ordem de serviço sorteio sistema visita encriptar cnpj usuário barra de pesquisa mural e-commerce afiliados


CodigoFonte.net » Meu Mural » Competiva - Criação de Sites » Todos os Direitos Reservados © 2002/2010