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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
| // V 2.0.0
// Paramètres : une chaine : remplacer {TEXTE_A_CODER} par la chaîne voulue
// Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
// * une chaine vide si paramètre fourni incorrect
// Déclaration des variables
Local StringVar code128 := '';
Local StringVar chaine :="V"+chr(9)+"O";
Local NumberVar index;
Local NumberVar cleControle;
Local NumberVar minIndex;
Local NumberVar dummy;
Local BooleanVar tableB := True;
Local NumberVar longChaine := Length (chaine);
If longChaine > 0 Then
(
// Vérifier si caractères valides
For index := 1 To longChaine Do
(
// Condition Case OK en VB = impossible en Crystal, remplacée un If
If Not (AscW (Mid (chaine, index, 1)) In [32 To 126]) Then
(index := 0; Exit For)
);
code128 :='';
If index > 0 Then
(
index := 1; // index devient l'index sur la chaîne
While index <= longChaine Do
(
If tableB = True Then
(
// Voir si intéressant de passer en table C
// Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres
minIndex := IIf (index = 1 Or index + 3 = longChaine, 4, 6);
// Pas de GoTo, donc on duplique testnum:
minIndex := minIndex - 1;
If (index + minIndex) <= longChaine Then
(
While minIndex >= 0 Do
(
If AscW (Mid (chaine, (index + minIndex), 1)) < 48 Or AscW (Mid (chaine, (index + minIndex), 1)) > 57 Then Exit While;
minIndex := minIndex - 1
)
);
// Fin de testnum
If minIndex < 0 Then // Choix table C
(
If index = 1 Then // Débuter sur table C
(
code128 := ChrW (210);
tableB := False;
)
Else // Commuter sur table C
(
code128 := code128 + ChrW(204);
tableB := False;
)
)
Else
If index = 1 Then
(
code128 := ChrW (209);
tableB := True;
); // Débuter sur table B
);
If tableB = False Then
(
// On est sur la table C, essayer de traiter 2 chiffres
minIndex := 2;
// Pas de GoTo, donc on duplique testnum:
minIndex := minIndex - 1;
If (index + minIndex) <= longChaine Then
(
While minIndex >= 0 Do
(
If AscW (Mid (chaine, (index + minIndex), 1)) < 48 Or AscW (Mid (chaine, (index + minIndex), 1)) > 57 Then Exit While;
minIndex := minIndex - 1
)
);
// Fin de testnum
If minIndex < 0 Then // OK pour 2 chiffres, les traiter
(
dummy := Val (Mid (chaine, index, 2));
dummy := IIf (dummy < 95, dummy + 32, dummy + 105);
code128 := code128 + ChrW (dummy);
index := index + 2;
tableB := False
)
Else // On n'a pas 2 chiffres, rapasser en table B
(
dummy := dummy;
code128 := code128 + ChrW (205);
index := index;
tableB := True);
);
If tableB = True Then
// traiter 1 caractère en table B
(
code128 := code128 + Mid (chaine, index, 1);
index := index + 1
)
);
// Calcul de la clé de contrôle
For index := 1 To Length (code128) Do
(
dummy := AscW (Mid (code128, index, 1));
dummy := IIf (dummy < 127, dummy - 32, dummy - 105);
If index = 1 Then cleControle := dummy;
cleControle := (cleControle + (index - 1) * dummy) Mod 103);
// Calcul du code ASCII de la clé
cleControle := IIf (cleControle < 95, cleControle + 32, cleControle + 105);
// Ajout de la clé et du STOP
code128 := code128 + ChrW (cleControle) + ChrW (211)
);
);
code128; |
