Vi posto un piccolo regalo …
Un modulo che ritorna 3 tipologie di barcode ( Ean13-Ean8, Interleave 2di5, Code 39) in formato picture (immagine)
Function ean138p(codice as string, larghezza as integer, altezza as integer) As Picture
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
Dim p As New Picture (larghezza, altezza, 32)
' Converto il codice EAN nella sua rappresentazione binaria.
strEANBin = EAN2Bin(codice)
sngX1 = 10
sngY1 = 0
sngX2 = larghezza
sngY2 = altezza -15
sngScaleX = round(larghezza / strEANBin.Len)
' definisco l'altezza del barcode tenendo conto del testo
sngPosX = sngX1 ' spigolo in alto
sngPosY = sngY2
'
'disegno il barcode
For K = 1 To Len(strEANBin)
If Mid(strEANBin, K, 1) = "1" Then
p.Graphics.ForeColor = &c000000
p.Graphics.FillRect(sngPosX, sngY1, sngScaleX, sngPosY)
End If
sngPosX = sngX1 + (K * sngScaleX)
Next K
p.Graphics.DrawString(codice,sngX1,sngPosY + 15,sngX1 - sngX2,false)
Return p
End Function
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 CType(Val(Left(strEANCode, 1)), Integer)
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 CType(Val(Mid(strAux, K, 1)), Integer)
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 CType(Val(Mid(strAux, K, 1)), Integer)
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 Function