Per ottenere il barcode EAN-13
ecco gli ingredienti :
- un container control con il componente canvas
- calcolo del check digit
- algoritmo di creazione del codice EAN
Preparazione :
Creare il container control ed inserire il componente canvas (io lo ho chiamato ‘barcode’).
Nell’evento paint di barcode inserire :
paintinto(g)Creare il metodo EAN2BIN
Function EAN2Bin(strEANCode As String) As string
Dim K As Integer
Dim strAux As String
Dim strExit As String
Dim strCode As String
strEANCode = Trim(strEANCode)
strAux = strEANCode
' verifico che sia un ean13 o un ean8 in base alla lunghezza della stringa strEANCode
If (strAux.len <> 13) And (strAux.Len <> 8) Then
msgbox("Errore, il codice non sembra essere un codice EAN13 o EAN8")
Return ""
End If
For K = 1 To strEANCode.len
Select Case mid(strAux,K,1)
Case "0","1","2","3","4","5","6","7","8","9"
' ok il codice non contiene caratteri non validi
case else
MsgBox("Errore il codice EAN contiene caratteri non ammessi")
'Return ""
End Select
Next
If (strAux.len = 13) Then
' verifico che sia un EAN 13
' per prima cosa scarto la prima cifra che lo stato di emissione (fare riferimento ad INDICOD) '
strAux = Mid(strAux, 2)
Select Case CInt(Left(strEANCode, 1))
Case 0
strCode = "000000"
Case 1
strCode = "001011"
Case 2
strCode = "001101"
Case 3
strCode = "001110"
Case 4
strCode = "010011"
Case 5
strCode = "011001"
Case 6
strCode = "011100"
Case 7
strCode = "010101"
Case 8
strCode = "010110"
Case 9
strCode = "011010"
End Select
Else
strCode = "0000"
End If
'*
'* Il codice EAN inizia con un carattere iniziale
'*
strExit = "000101"
'*
'* Prima met del codice
'
For K = 1 To Len(strAux) \\ 2
Select Case CInt(Mid(strAux, K, 1))
Case 0
dim temptext as string
if Mid(strCode, K, 1) = "0" then temptext = "0001101" else temptext = "0100111"
strExit = strExit + temptext
Case 1
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0011001" else temptext = "0110011"
strExit = strExit + temptext
Case 2
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0010011" else temptext = "0011011"
strExit = strExit + temptext
Case 3
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0111101" else temptext = "0100001"
strExit = strExit + temptext
Case 4
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0100011" else temptext = "0011101"
strExit = strExit + temptext
Case 5
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0110001" else temptext = "0111001"
strExit = strExit + temptext
Case 6
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0101111" else temptext = "0000101"
strExit = strExit + temptext
Case 7
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0111011" else temptext = "0010001"
strExit = strExit + temptext
Case 8
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0110111" else temptext = "0001001"
strExit = strExit + temptext
Case 9
dim temptext as string
If Mid(strCode, K, 1) = "0" then temptext = "0001011" else temptext = "0010111"
strExit = strExit + temptext
End Select
Next K
'*
'* Prosegue poi con un separatore di mezzo
'*
strExit = strExit + "01010"
'*
'* Seconda met del codice
'*
For K = Len(strAux) \\ 2 + 1 To Len(strAux)
Select Case CInt(Mid(strAux, K, 1))
Case 0
strExit = strExit + "1110010"
Case 1
strExit = strExit + "1100110"
Case 2
strExit = strExit + "1101100"
Case 3
strExit = strExit + "1000010"
Case 4
strExit = strExit + "1011100"
Case 5
strExit = strExit + "1001110"
Case 6
strExit = strExit + "1010000"
Case 7
strExit = strExit + "1000100"
Case 8
strExit = strExit + "1001000"
Case 9
strExit = strExit + "1110100"
End Select
Next K
' Il Codice EAN finisce con un separatore finale
strExit = strExit + "101000"
return strExit
End FunctionCreiamo ora il modulo paintinto
Sub paintinto(g as Graphics)
Dim K As Single
Dim sngPosX As Single
Dim sngPosY As Single
dim sngX1, sngY1, sngX2, sngY2 as single
Dim sngScaleX As Single
Dim strEANBin As String
sngX1 = -1
sngX2 = -1
sngY1 = -1
sngY2 = -1
' Converto il codice EAN nella sua rappresentazione binaria.
strEANBin = EAN2Bin(self.strEANCode)
If sngX1 = (-1) Then sngX1 = 0
If sngY1 = (-1) Then sngY1 = 0
If sngX2 = (-1) Then sngX2 = barcode.Width
If sngY2 = (-1) Then sngY2 = barcode.Height - 15
sngScaleX = floor((sngX2 - sngX1) / strEANBin.Len)
' definisco l'altezza del barcode tenendo conto del testo
sngPosX = sngX1 ' spigolo in alto
sngPosY = sngY2 - 14
'disegno il barcode
For K = 1 To Len(strEANBin)
If Mid(strEANBin, K, 1) = "1" Then
g.ForeColor = &c000000
g.FillRect(sngPosX, sngY1, sngScaleX, sngPosY)
End If
sngPosX = sngX1 + (K * sngScaleX)
Next K
g.DrawString(self.strEANCode,sngX1,sngPosY + 15,sngX1 - sngX2 - 5,false)
End SubAggiungiamo la propriet
strEANCode As String = "8004830296406"Una funzione necessaria per far lievitare il codice :
Function cint(s as String) As integer
Return CType(Val(s), Integer)
End FunctionPer utilizzare il barcode :
impostare il valore strEANCode con un codice EAN Valido.
Eseguire il refresh del canvas
E la ciliegina sulla torta : il calcolo del check digit per l’utilizzo dei codici bilancia.
Il codice bilancia un codice EAN con il formato “0-000000-123456-X”
Dove le prime 7 cifre sono sostituite il codice del prodotto ad esempio :
“0-000001-” = Prosciutto Cotto di Parma, prezzo 3,15 al hg.
“0-000002-” = Formaggio di alta montagna, prezzo 6,20 al hg.
Le altre 6 cifre sono il peso del prodotto
quindi 0-000001-000123-X, 0-000002-000254-X
occorre calcolare il check digit del codice (la lettera X del codice)
devo passare alla funzione solo i primi 12 caratteri del codice per ottenere il codice EAN completo di 13 caratteri.
Function EAN13checkdigit(stringpart as string) As string
Dim strParts() As String
dim eancompleto as string
Dim lngIndex As integer
Dim intTotal As Integer
Dim intCount As Integer
Dim intUp As Integer
if len(stringpart) <> 12 then
if len(string part) <> 8 then
return ""
end if
end if
stringpart = stringpart + "C"
strParts = Split(stringpart, "")
For lngIndex = UBound(strParts) - 1 To 0 Step -2
For intCount = 1 To 3
intTotal = intTotal + cint(strParts(lngIndex))
Next
Next
For lngIndex = UBound(strParts) To 0 Step -2
intTotal = intTotal + cint(strParts(lngIndex))
Next
intUp = intTotal
Do Until intUp Mod 10 = 0
intUp = intUp + 1
Loop
strParts(UBound(strParts)) = str(intUp - intTotal)
return join(strParts(),"")
End FunctionEcco il barcode servito buon appetito!.