1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
| Public Function EAN13$(chaine$)
'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
'This function is governed by the GNU Lesser General Public License (GNU LGPL)
'V 1.1.1
'Paramètres : une chaine de 12 chiffres
'Parameters : a 12 digits length string
'Retour : * une chaine qui, affichée avec la police EAN13.TTF, donne le code barre
' * une chaine vide si paramètre fourni incorrect
'Return : * a string which give the bar code when it is dispayed with EAN13.TTF font
' * an empty string if the supplied parameter is no good
Dim i%, checksum%, first%, codebarre$, tableA As Boolean
" EAN13$ = """""
'Vérifier qu'il y a 12 caractères
'Check for 12 characters
If Len(chaine$) = 12 Then
'Et que ce sont bien des chiffres
'And they are really digits
For i% = 1 To 12
If Asc(Mid$(chaine$, i%, 1)) < 48 Or Asc(Mid$(chaine$, i%, 1)) > 57 Then
i% = 0
Exit For
End If
Next
If i% = 13 Then
'Calcul de la clé de contrôle
'Calculation of the checksum
For i% = 12 To 1 Step -2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
checksum% = checksum% * 3
For i% = 11 To 1 Step -2
checksum% = checksum% + Val(Mid$(chaine$, i%, 1))
Next
chaine$ = chaine$ & (10 - checksum% Mod 10) Mod 10
'Le premier chiffre est pris tel quel, le deuxième vient de la table A
'The first digit is taken just as it is, the second one come from table A
codebarre$ = Left$(chaine$, 1) & Chr$(65 + Val(Mid$(chaine$, 2, 1)))
first% = Val(Left$(chaine$, 1))
For i% = 3 To 7
tableA = False
Select Case i%
Case 3
Select Case first%
Case 0 To 3
tableA = True
End Select
Case 4
Select Case first%
Case 0, 4, 7, 8
tableA = True
End Select
Case 5
Select Case first%
Case 0, 1, 4, 5, 9
tableA = True
End Select
Case 6
Select Case first%
Case 0, 2, 5, 6, 7
tableA = True
End Select
Case 7
Select Case first%
Case 0, 3, 6, 8, 9
tableA = True
End Select
End Select
If tableA Then
codebarre$ = codebarre$ & Chr$(65 + Val(Mid$(chaine$, i%, 1)))
Else
codebarre$ = codebarre$ & Chr$(75 + Val(Mid$(chaine$, i%, 1)))
End If
Next
" CodeBarre$ = CodeBarre$ & ""*"" 'Ajout séparateur central / Add middle separator"
For i% = 8 To 13
codebarre$ = codebarre$ & Chr$(97 + Val(Mid$(chaine$, i%, 1)))
Next
" CodeBarre$ = CodeBarre$ & ""+"" 'Ajout de la marque de fin / Add end mark"
EAN13$ = codebarre$
End If
End If
End Function |
Partager