Segue a função...
Option Explicit
'1cm ~480 tiwps; A folha tem ~ 21cm de Largura e 30cm de comprimento
'logo 10080 de largura por 14400 de comprimento
Dim Barcodes(9) As String
Dim I, j, k, CoordX, CoordY As Integer
Const MargemDireita = 184
Const MargemEsquerda = 6
Const MargemSuperior = 3
Const Fino = 16 ' largura da barra fina
Const Largo = 41 ' largura da barra larga
Const Altura = 737 ' 2.5 vezes a fina
Private Function Zeros(Num, Zr)
Dim Znum
Znum = Num
For I = 1 To Zr - Len(Num)
Znum = "0" & Znum
Next
Zeros = Znum
End Function
Destino pode ser Form,Picturebox ou Printer...
'Desenha o código de barras
Public Sub DesenhaBarra(Valor As String, Destino As Object, Optional CoordX As Integer, Optional CoordY As Integer)
If IsEmpty(Valor) Or Valor = "" Then
MsgBox "O parâmetro valor não deve ser vazio ou nulo !", vbCritical, "Erro na entrada de valores"
Exit Sub
End If
If Len(Valor) > 44 Then
MsgBox "O parâmetro valor não deve exceder 44 posições!", vbCritical, "Erro na entrada de valores"
'Codificação de código de barras tem obrigatoriamente 44 posições...
Exit Sub
End If
If IsEmpty(CoordX) Then CoordX = 0
If IsEmpty(CoordY) Then CoordY = 0
DoEvents
Barcodes(0) = "00110" ' 0 indica barra fina e 1 larga
Barcodes(1) = "10001"
Barcodes(2) = "01001"
Barcodes(3) = "11000"
Barcodes(4) = "00101"
Barcodes(5) = "10100"
Barcodes(6) = "01100"
Barcodes(7) = "00011"
Barcodes(8) = "10010"
Barcodes(9) = "01010"
' Agora é desenhar
'Destino.Cls
Destino.ScaleMode = 1 ' usa pontos.
Destino.DrawWidth = 1 ' e traço fino.
' desenha guarda inicial
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
CoordX = CoordX + Fino
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
CoordX = CoordX + Fino
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
CoordX = CoordX + Fino
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
CoordX = CoordX + Fino
' desenha valor
If Len(Valor) Mod 2 <> 0 Then
Valor = "0" + Valor
End If
Valor = Zeros(Valor, Len(Valor))
While Len(Valor) > 0
I = Left$(Valor, 1)
Valor = Right$(Valor, Len(Valor) - 1)
j = Left$(Valor, 1)
Valor = Right$(Valor, Len(Valor) - 1)
For k = 1 To 5
If Mid$(Barcodes(I), k, 1) = "0" Then
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
CoordX = CoordX + Fino
Else
Destino.Line (CoordX, CoordY)-(CoordX + Largo, CoordY + Altura), QBColor(0), BF
CoordX = CoordX + Largo
End If
DoEvents
If Mid$(Barcodes(j), k, 1) = "0" Then
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
CoordX = CoordX + Fino
Else
Destino.Line (CoordX, CoordY)-(CoordX + Largo, CoordY + Altura), QBColor(15), BF
CoordX = CoordX + Largo
End If
Next
Wend
' desenha guarda final
Destino.Line (CoordX, CoordY)-(CoordX + Largo, CoordY + Altura), QBColor(0), BF
CoordX = CoordX + Largo
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(15), BF
CoordX = CoordX + Fino
Destino.Line (CoordX, CoordY)-(CoordX + Fino, CoordY + Altura), QBColor(0), BF
CoordX = CoordX + Fino
End Sub
