Skip to Content
Last modified by Jean-Claude ALLETRU on 2024/08/09 10:50
Show last authors
1 (% style="text-align: left;" %)
2 //**Note préalable : A partir de la 14.11.0 Adélia fournit la fonction [[VaToolBxGenerateBarCode>>doc:ADELIA1036V1411.693274651.693275040.693276339.693276479.WebHome]]**////** qui permet de générer un code barre ou un QR code directement dans une variable IMAGE.**//
3
4
5
6
7 Cette fonction VBScript retourne une chaîne de caractère calculée pour être utilisée avec la police CODE128.TTF.
8
9 Pour utiliser cette fonction, partez du code Adelia du modulo 97 d'un IBAN et adaptez le.
10 (((
11 == Codes à barres de symbologie Code 128 ==
12 )))
13
14 Les polices de codes à barres QuartetBar Code 128 répondent à la norme française et européenne NF EN 799 qui définit la symbologie de codes à barres connue sous le nom Code 128. Elles mettent à disposition les trois jeux A, B et C du standard de codes à barres Code 128 pour fournir des symboles soit mono-jeu soit multi-jeux de largeur optimisée.
15 (((
16 == Information à coder ==
17 )))
18
19 L’information à coder peut être de longueur quelconque, composée de chiffres, majuscules, minuscules, signes et caractères de contrôle d'ordre ASCII compris entre 0 et 127 (dont tabulation d'ordre 9 et changements de ligne d'ordre 10 et/ou 13), ainsi que de quatre caractères spécifiques au Code 128, appelés FNC1, FNC2, FNC3 et FNC4, qui n'ont pas de représentation graphique mais dont l'usage standardisé précise le sens de l'information qui les suit.
20
21
22
23
24
25
26
27 {{code title="Code128.vbs" language="none"}}
28 '*********************************************************************
29 ' Calcul la chaine de caractère pour utiliser
30 ' la police code barre 128
31 '
32 '*********************************************************************
33 '
34 ' HARDIS - Code128 - 2009
35 '
36 '*********************************************************************
37 Option Explicit 'All variables have to be declared before use
38
39 Dim chaine
40 Dim Machaine
41 Dim i, checksum, mini, dummy
42 Dim tableB
43
44 Public Function Code128(chaine)
45 ' Paramètre : une chaine
46 ' Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
47 ' * une chaine vide si paramètre fourni incorrect
48 Code128 = ""
49 If Len(chaine) > 0 Then
50 ' Vérifier si caractères valides
51 For i = 1 To Len(chaine)
52 IF (Asc(Mid(chaine, i, 1)) >= 32 and Asc(Mid(chaine, i, 1))<= 126) or (Asc(Mid(chaine, i, 1)) = 203) then
53 ' rien
54 ELSE
55 i = 0
56 Exit FOR
57 END IF
58 Next
59 ' Calculer la chaine de code en optimisant l'usage des tables B et C
60 Code128 = ""
61 tableB = True
62 If i > 0 Then
63 i = 1 'i% devient l'index sur la chaine / i% become the string index
64 Do While i <= Len(chaine)
65 If tableB Then
66 ' Voir si intéressant de passer en table C
67 ' Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres
68 IF i = 1 Or i + 3 = Len(chaine) THEN
69 mini = 4
70 ELSE
71 mini = 6
72 END IF
73 Testnum mini, chaine, i
74 If mini < 0 Then ' Choix table C
75 If i = 1 Then ' Débuter sur table C
76 Code128 = Chr(210)
77 Else ' Commuter sur table C
78 Code128 = Code128 & Chr(204)
79 End If
80 tableB = False
81 Else
82 If i = 1 Then Code128 = Chr(209) ' Débuter sur table B
83 End If
84 End If
85 If Not tableB Then
86 ' On est sur la table C, essayer de traiter 2 chiffres
87 mini = 2
88 Testnum mini, chaine, i
89 If mini < 0 Then ' OK pour 2 chiffres, les traiter
90 dummy = Cint(Mid(chaine, i, 2))
91 if dummy < 95 then
92 dummy = dummy + 32
93 else
94 dummy = dummy + 105
95 end if
96 Code128 = Code128 & Chr(dummy)
97 i = i + 2
98 Else ' On n'a pas 2 chiffres, repasser en table B
99 Code128 = Code128 & Chr(205)
100 tableB = True
101 End If
102 End If
103 If tableB Then
104 ' Traiter 1 caractère en table B
105 Code128 = Code128 & Mid(chaine, i, 1)
106 i = i + 1
107 End If
108 Loop
109 ' Calcul de la clé de contrôle
110 For i = 1 To Len(Code128)
111 dummy = Asc(Mid(Code128, i, 1))
112 If dummy < 127 then
113 dummy = dummy - 32
114 else
115 dummy = dummy - 105
116 end if
117 If i = 1 Then checksum = dummy
118 checksum = (checksum + (i - 1) * dummy) Mod 103
119 Next
120 ' Calcul du code ASCII de la clé
121 IF checksum < 95 then
122 checksum = checksum + 32
123 else
124 checksum = checksum + 105
125 end if
126 ' Ajout de la clé et du STOP
127 Code128 = Code128 & Chr(checksum) & Chr(211)
128 End If
129 End If
130 Exit Function
131 End Function
132
133 SUB TESTNUM(mini, chaine, i)
134 ' si les mini% caractères à partir de i% sont numériques, alors mini%=0
135 mini = mini - 1
136 If i + mini <= Len(chaine) Then
137 Do While mini >= 0
138 If Asc(Mid(chaine, i + mini, 1)) < 48 Or Asc(Mid(chaine, i + mini, 1)) > 57 Then Exit Do
139 mini = mini - 1
140 Loop
141 End If
142 End Sub
143 {{/code}}
144
145