Gerando e Imprimindo código de barras padrão C39 ou 3 de 9 .

O código de barras padrão C39 ou 3 de 9 surgiu em 1974 e foi implantado na industria americana e hoje faz parte do CPF - Cadastro de Pessoa Física.

Vamos mostrar um exemplo em código Visual Basic que gera e imprime códigos de barra neste padrão.

Vale lembrar que este exemplo não esta ajustado para uso comercial.

1-) Inicie um novo projeto padrão no VB e no formulário padrão - frmcode39 - insira os seguintes controles:

Conforme o layout da figura abaixo:

2-) Na seção General Declarations defina as variáveis : pic , zz1 e zz2 :

Dim pic As PictureBox
Dim zz1 As Variant
Dim zz2 As Variant

3-) No evento Load do formulário - frmcode39 - inclua o código como abaixo:

Private Sub Form_Load()
Set pic = picBarCode
zz1 = Split("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,-,.,SP,$,/,+,%,*", ",")
zz2 = Split("111221211,211211112,112211112,212211111,111221112,211221111,112221111,111211212,211211211, _112211211,211112112,112112112,212112111,111122112,211122111,112122111,111112212,211112211,112112211, _
111122211,211111122,112111122,212111121,111121122,211121121,112121121,111111222,211111221,112111221, _
111121221,221111112,122111112,222111111,121121112,221121111,122121111,121111212,221111211,122111211, _
121212111,121211121,121112121,111212121,121121211", ",")
 GeraCodBar39 txtData, 20
End Sub

Obs: A linha da variável zz2 deve ser única.

4-) A função GeraCodBar39 que irá montar o código de barras tem o seguinte código:

Private Sub GeraCodBar39(x As String, Sclr As Integer)
Dim bc4(0 To 20) As String
Dim barchar As String
Dim barcolor As String
Dim bs As Single
Dim bwn As Single
Dim ac As Integer
Dim s As Integer
Dim bct As Integer
Dim bcl As Integer
ac = 1
pic.Cls
bc4(ac - 1) = "121121211"
For bct = 1 To Len(x)
    barchar = Mid(x, bct, 1)
    If barchar = " " Then barchar = "SP"
    For s = 0 To UBound(zz1)
        If UCase(barchar) = zz1(s) Then
            bc4(ac) = zz2(s)
            ac = ac + 1
            Exit For
        End If
    Next s
Next bct
bc4(ac) = "121121211"
bs = 200
pic.DrawWidth = 1
    For bct = 0 To ac
    x = bc4(bct)
    barcolor = vbBlack
        For s = 1 To Len(x)
            bwn = (Val(Mid(x, s, 1))) * Sclr
            For bcl = 1 To bwn
                pic.Line (bs + bcl, 100)-Step(0, 1200), barcolor
            Next bcl
            If barcolor = vbBlack Then barcolor = vbWhite Else barcolor = vbBlack
            bs = bs + bwn
        Next s
            For bcl = 1 To Sclr
                pic.Line (bs + bcl, 100)-Step(0, 1200), vbWhite
            Next bcl
            bs = bs + bcl
    Next bct
pic.FontSize = 16: pic.CurrentX = 200: pic.CurrentY = 1400: pic.Print UCase(txtData)
End Sub
Private Sub cmdPrint_Click()
Dim bc4(0 To 20) As String
Dim barchar As String
Dim barcolor As Boolean
Dim x As String
Dim Sclr As Single
Dim bs As Single
Dim bwn As Single
Dim ac As Integer
Dim s As Integer
Dim bct As Integer
Dim bcl As Integer
ac = 1
Sclr = 20
x = txtData
bc4(ac - 1) = "121121211"
For bct = 1 To Len(x)
    barchar = Mid(x, bct, 1)
    If barchar = " " Then barchar = "SP"
    For s = 0 To UBound(zz1)
        If UCase(barchar) = zz1(s) Then
            bc4(ac) = zz2(s)
            ac = ac + 1
            Exit For
        End If
    Next s
Next bct
bc4(ac) = "121121211"
bs = 400
    For bct = 0 To ac
    x = bc4(bct)
    barcolor = True
        For s = 1 To Len(x)
            bwn = (Val(Mid(x, s, 1))) * Sclr
            If barcolor = True Then Printer.Line (bs, 100)-Step(bwn, 1200), vbBlack, BF
            barcolor = IIf(barcolor = True, False, True)
            bs = bs + bwn
        Next s
        bs = bs + Sclr
    Next bct
    Printer.FontSize = 16: Printer.CurrentX = 400: Printer.CurrentY = 1400: Printer.Print UCase(txtData)
    Printer.EndDoc
End Sub

5-) O código do evento click do botão de comando - cmdOK - OK é o seguinte:

Private Sub cmdOK_Click()
  GeraCodBar39 txtData, 20
End Sub

6-) Para imprimir o código de barras usamos o objeto Printer com o seguinte código:

Private Sub cmdPrint_Click()
Dim bc4(0 To 20) As String
Dim barchar As String
Dim barcolor As Boolean
Dim x As String
Dim Sclr As Single
Dim bs As Single
Dim bwn As Single
Dim ac As Integer
Dim s As Integer
Dim bct As Integer
Dim bcl As Integer
ac = 1
Sclr = 20
x = txtData
bc4(ac - 1) = "121121211"
For bct = 1 To Len(x)
    barchar = Mid(x, bct, 1)
    If barchar = " " Then barchar = "SP"
    For s = 0 To UBound(zz1)
        If UCase(barchar) = zz1(s) Then
            bc4(ac) = zz2(s)
            ac = ac + 1
            Exit For
        End If
    Next s
Next bct
bc4(ac) = "121121211"
bs = 400
    For bct = 0 To ac
    x = bc4(bct)
    barcolor = True
        For s = 1 To Len(x)
            bwn = (Val(Mid(x, s, 1))) * Sclr
            If barcolor = True Then Printer.Line (bs, 100)-Step(bwn, 1200), vbBlack, BF
            barcolor = IIf(barcolor = True, False, True)
            bs = bs + bwn
        Next s
        bs = bs + Sclr
    Next bct
    Printer.FontSize = 16: Printer.CurrentX = 400: Printer.CurrentY = 1400: Printer.Print _
UCase(txtData)
    Printer.EndDoc
End Sub

Ao iniciar o projeto , informe na caixa de texto o número para o qual deseja gerar o código de barras e clique no botão OK. O resultado será exibido na picturebox , e, se você quiser imprimir basta clicar. Veja um exemplo a seguir:

Gostou ?... . Até a próxima...

Gostou ?   Compartilhe no Facebook   Compartilhe no Twitter

 

Referências:

José Carlos Macoratti