Olá! Wednesday, 26 de July de 2017.



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:
recado tradutor e-mail web cookies hotel vb login e senha comentário letreiro paginas cadastro calendarios catálogo media aniversario boletim pagina inicial pop-up caixa mura formail botão filtro livro calculadora formulário pizzaria player de radio telefone


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