Code barre en police CODE128.TTF
Note préalable : A partir de la 14.11.0 Adélia fournit la fonction VaToolBxGenerateBarCode qui permet de générer un code barre ou un QR code directement dans une variable IMAGE.
Cette fonction VBScript retourne une chaîne de caractère calculée pour être utilisée avec la police CODE128.TTF.
Pour utiliser cette fonction, partez du code Adelia du modulo 97 d'un IBAN et adaptez le.
Codes à barres de symbologie Code 128
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.
Information à coder
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.
' Calcul la chaine de caractère pour utiliser
' la police code barre 128
'
'*********************************************************************
'
' HARDIS - Code128 - 2009
'
'*********************************************************************
Option Explicit 'All variables have to be declared before use
Dim chaine
Dim Machaine
Dim i, checksum, mini, dummy
Dim tableB
Public Function Code128(chaine)
' Paramètre : une chaine
' Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
' * une chaine vide si paramètre fourni incorrect
Code128 = ""
If Len(chaine) > 0 Then
' Vérifier si caractères valides
For i = 1 To Len(chaine)
IF (Asc(Mid(chaine, i, 1)) >= 32 and Asc(Mid(chaine, i, 1))<= 126) or (Asc(Mid(chaine, i, 1)) = 203) then
' rien
ELSE
i = 0
Exit FOR
END IF
Next
' Calculer la chaine de code en optimisant l'usage des tables B et C
Code128 = ""
tableB = True
If i > 0 Then
i = 1 'i% devient l'index sur la chaine / i% become the string index
Do While i <= Len(chaine)
If tableB Then
' Voir si intéressant de passer en table C
' Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres
IF i = 1 Or i + 3 = Len(chaine) THEN
mini = 4
ELSE
mini = 6
END IF
Testnum mini, chaine, i
If mini < 0 Then ' Choix table C
If i = 1 Then ' Débuter sur table C
Code128 = Chr(210)
Else ' Commuter sur table C
Code128 = Code128 & Chr(204)
End If
tableB = False
Else
If i = 1 Then Code128 = Chr(209) ' Débuter sur table B
End If
End If
If Not tableB Then
' On est sur la table C, essayer de traiter 2 chiffres
mini = 2
Testnum mini, chaine, i
If mini < 0 Then ' OK pour 2 chiffres, les traiter
dummy = Cint(Mid(chaine, i, 2))
if dummy < 95 then
dummy = dummy + 32
else
dummy = dummy + 105
end if
Code128 = Code128 & Chr(dummy)
i = i + 2
Else ' On n'a pas 2 chiffres, repasser en table B
Code128 = Code128 & Chr(205)
tableB = True
End If
End If
If tableB Then
' Traiter 1 caractère en table B
Code128 = Code128 & Mid(chaine, i, 1)
i = i + 1
End If
Loop
' Calcul de la clé de contrôle
For i = 1 To Len(Code128)
dummy = Asc(Mid(Code128, i, 1))
If dummy < 127 then
dummy = dummy - 32
else
dummy = dummy - 105
end if
If i = 1 Then checksum = dummy
checksum = (checksum + (i - 1) * dummy) Mod 103
Next
' Calcul du code ASCII de la clé
IF checksum < 95 then
checksum = checksum + 32
else
checksum = checksum + 105
end if
' Ajout de la clé et du STOP
Code128 = Code128 & Chr(checksum) & Chr(211)
End If
End If
Exit Function
End Function
SUB TESTNUM(mini, chaine, i)
' si les mini% caractères à partir de i% sont numériques, alors mini%=0
mini = mini - 1
If i + mini <= Len(chaine) Then
Do While mini >= 0
If Asc(Mid(chaine, i + mini, 1)) < 48 Or Asc(Mid(chaine, i + mini, 1)) > 57 Then Exit Do
mini = mini - 1
Loop
End If
End Sub