Private Const N As String = &H0&
Private Const A As String = “A”
Private Const B As String = “B”
Private Const C As String = “C”

Private Function ColorLinea(Digito As Integer, Numero As Integer, Posicion As Integer, NumeroLinea As Integer)
Dim Sequencia As Variant, SequenciaColor As Variant, Tipo As String

Select Case Digito
Case 0
Sequencia = Array(12, A, A, A, A, A, A, C, C, C, C, C, C)
Case 1
Sequencia = Array(12, A, A, B, A, B, B, C, C, C, C, C, C)
Case 2
Sequencia = Array(12, A, A, B, B, A, B, C, C, C, C, C, C)
Case 3
Sequencia = Array(12, A, A, B, B, B, A, C, C, C, C, C, C)
Case 4
Sequencia = Array(12, A, B, A, A, B, B, C, C, C, C, C, C)
Case 5
Sequencia = Array(12, A, B, B, A, A, B, C, C, C, C, C, C)
Case 6
Sequencia = Array(12, A, B, B, B, A, A, C, C, C, C, C, C)
Case 7
Sequencia = Array(12, A, B, A, B, A, B, C, C, C, C, C, C)
Case 8
Sequencia = Array(12, A, B, A, B, B, A, C, C, C, C, C, C)
Case 9
Sequencia = Array(12, A, B, B, A, B, A, C, C, C, C, C, C)
End Select

Tipo = Sequencia(Posicion)

Select Case Numero
Case 0
Select Case Tipo
Case A

SequenciaColor = Array(7, W, W, W, N, N, W, N)
Case B
SequenciaColor = Array(7, W, N, W, W, N, N, N)
Case C
SequenciaColor = Array(7, N, N, N, W, W, N, W)
End Select
Case 1
Select Case Tipo
Case A
SequenciaColor = Array(7, W, W, N, N, W, W, N)
Case B
SequenciaColor = Array(7, W, N, N, W, W, N, N)
Case C
SequenciaColor = Array(7, N, N, W, W, N, N, W)
End Select
Case 2
Select Case Tipo
Case A
SequenciaColor = Array(7, W, W, N, W, W, N, N)
Case B
SequenciaColor = Array(7, W, W, N, N, W, N, N)
Case C
SequenciaColor = Array(7, N, N, W, N, N, W, W)
End Select
Case 3
Select Case Tipo
Case A
SequenciaColor = Array(7, W, N, N, N, N, W, N)
Case B
SequenciaColor = Array(7, W, N, W, W, W, W, N)
Case C
SequenciaColor = Array(7, N, W, W, W, W, N, W)
End Select
Case 4
Select Case Tipo
Case A
SequenciaColor = Array(7, W, N, W, W, W, N, N)
Case B
SequenciaColor = Array(7, W, W, N, N, N, W, N)
Case C
SequenciaColor = Array(7, N, W, N, N, N, W, W)
End Select
Case 5
Select Case Tipo
Case A
SequenciaColor = Array(7, W, N, N, W, W, W, N)
Case B
SequenciaColor = Array(7, W, W, N, N, W, W, N)
Case C
SequenciaColor = Array(7, N, W, W, N, N, N, W)
End Select
Case 6
Select Case Tipo
Case A
SequenciaColor = Array(7, W, N, W, N, N, N, N)
Case B
SequenciaColor = Array(7, W, W, W, W, N, W, N)
Case C
SequenciaColor = Array(7, N, W, N, W, W, W, W)
End Select
Case 7
Select Case Tipo
Case A
SequenciaColor = Array(7, W, N, N, N, W, N, N)
Case B
SequenciaColor = Array(7, W, W, N, W, W, W, N)
Case C
SequenciaColor = Array(7, N, W, W, W, N, W, W)
End Select
Case 8
Select Case Tipo
Case A
SequenciaColor = Array(7, W, N, N, W, N, N, N)
Case B
SequenciaColor = Array(7, W, W, W, N, W, W, N)
Case C
SequenciaColor = Array(7, N, W, W, N, W, W, W)
End Select
Case 9
Select Case Tipo
Case A
SequenciaColor = Array(7, W, W, W, N, W, N, N)
Case B
SequenciaColor = Array(7, W, W, N, W, N, N, N)
Case C
SequenciaColor = Array(7, N, N, N, W, N, W, W)
End Select

End Select
ColorLinea = SequenciaColor(NumeroLinea)
End Function
Dim X As Integer, x1 As Integer, Columna As Integer, NumeroDeGrupo As Integer, Grupo As Integer
Dim Inicial As Integer, Resto As String, NNumero As Integer, PPosicion As Integer

PEan.Cls
If IsNumeric(TxtEan.Text) Then

W = PEan.BackColor
Inicial = Mid(TxtEan, 1, 1)
Resto = Mid(TxtEan, 2, 12)
PEan.Line (135, 90)-(135, 840), &H0&
PEan.Line (165, 90)-(165, 840), &H0&
If Inicial <> “0″ Then
PEan.CurrentX = -20
PEan.CurrentY = 700
PEan.Print Inicial
End If
For Grupo = 1 To 2
Select Case Grupo
Case 1
X = 165
x1 = 165
Case 2
X = 870
x1 = 870
End Select
For NumeroDeGrupo = 1 To 6
PPosicion = IIf(Grupo = 1, NumeroDeGrupo, NumeroDeGrupo + 6)
NNumero = IIf(Grupo = 1, Mid(Resto, NumeroDeGrupo, 1), Mid(Resto, NumeroDeGrupo + 6, 1))
For Columna = 1 To 7
If Columna = 1 Then
PEan.CurrentY = 700
If Grupo = 1 Then PEan.CurrentX = X - 15 Else PEan.CurrentX = X - 30
PEan.Print NNumero
End If

PEan.Line (X + (15 * Columna), 90)-(x1 + (15 * Columna), 690), ColorLinea(Inicial, NNumero, PPosicion, Columna), BF
Next Columna
X = (X + (7 * 15))
x1 = (x1 + (7 * 15))
Next NumeroDeGrupo
Select Case Grupo
Case 1
PEan.Line (X + 30, 90)-(X + 30, 765), &H0&
PEan.Line (X + 60, 90)-(X + 60, 765), &H0&
Case 2
PEan.Line (X + 15, 90)-(X + 15, 840), &H0&
PEan.Line (X + 45, 90)-(X + 45, 840), &H0&
End Select
Next Grupo
End If
SavePicture PEan.Image, App.Path & TxtEan & “.bmp”