Code barre suivant la norme ean-13
Soyez le premier à donner votre avis sur cette source.
Vue 23 079 fois - Téléchargée 2 711 fois
Description
Voir le fichier zip
Source / Exemple :
' Fonction d'impression du code barre < Full Option >
Public Sub CodeBarre_Impression(CodeBarre As String, PictureLogo As PictureBox, _
Optional ImprimerTxt As Boolean = True, _
Optional CalibrageTrait As Integer = 2)
' CodeBarre = valeur du code barre
' PictureLogo = PictureBox contenant l'image placée à cotée du code barre
' ImprimerTxt = definit s'il faut imprimer les textes
' CalibrageTrait = calibre l'epaisseur du trait en fonction de l'imprimante
Dim MaskBinaire As String
'=== Calcul du caractère de contrôle.
CodeBarre = CalculNumControlCodeBarre(CodeBarre)
'=== Génération du mask "binaire"
MaskBinaire = EAN13_Binaire(CodeBarre)
Call CodeBarre_Imp(MaskBinaire, PictureLogo, CalibrageTrait)
If ImprimerTxt Then
Call CodeBarreTxt(CodeBarre)
End If
Printer.EndDoc
End Sub
' Fonction de visualisation du code barre < Full Option >
Public Sub CodeBarre_Image(CodeBarre As String, PictureCodeBarre As PictureBox, PictureLogo As PictureBox)
Dim MaskBinaire As String
'=== Calcul du caractère de contrôle.
CodeBarre = CalculNumControlCodeBarre(CodeBarre)
'=== Génération du mask "binaire"
MaskBinaire = EAN13_Binaire(CodeBarre)
Call CodeBarre_Pict(MaskBinaire, PictureCodeBarre, PictureLogo)
Call CodeBarreLegende(CodeBarre, PictureCodeBarre)
End Sub
'*****************************************************************************
'
' P.e.f outils pour traiter et generer les codes barres
'
'*****************************************************************************
'Conversion du code barre en chiffre -> mask Binaire
Public Function EAN13_Binaire(ByVal CodeBar As String) As String
'// CodeBar=code 13 chiffres à convertir en "binaire"
'//==== "0" = une bande blanche
'//==== "1" = une bande noire
'//==== "-" = décrementer la hauteur de la barre de <HautDec>
'//==== "+" = Incrementer la hauteur de la barre de <HautDec>
Dim TJA(10) As String
Dim TJB(10) As String
Dim TJC(10) As String
Dim Tcontrol(10) As String
Dim Chiffre As Long
Dim ind As Long
Dim Inverseur As String ' Pour inversion suivant le type de code
Dim CodeChiffre As String ' Profil binaire des traits
Dim TypeCode As Long ' Premier caractère du code barre
' Initialisation du jeu de caractères pour code barre EAN-13
TJA(1) = "0001101"
TJA(2) = "0011001"
TJA(3) = "0010011"
TJA(4) = "0111101"
TJA(5) = "0100011"
TJA(6) = "0110001"
TJA(7) = "0101111"
TJA(8) = "0111011"
TJA(9) = "0110111"
TJA(10) = "0001011"
TJB(1) = "0100111"
TJB(2) = "0110011"
TJB(3) = "0011011"
TJB(4) = "0100001"
TJB(5) = "0011101"
TJB(6) = "0111001"
TJB(7) = "0000101"
TJB(8) = "0010001"
TJB(9) = "0001001"
TJB(10) = "0010111"
TJC(1) = "1110010"
TJC(2) = "1100110"
TJC(3) = "1101100"
TJC(4) = "1000010"
TJC(5) = "1011100"
TJC(6) = "1001110"
TJC(7) = "1010000"
TJC(8) = "1000100"
TJC(9) = "1001000"
TJC(10) = "1110100"
Tcontrol(1) = "AAAAAA"
Tcontrol(2) = "AABABB"
Tcontrol(3) = "AABBAB"
Tcontrol(4) = "AABBBA"
Tcontrol(5) = "ABAABB"
Tcontrol(6) = "ABBAAB"
Tcontrol(7) = "ABBBAA"
Tcontrol(8) = "ABABAB"
Tcontrol(9) = "ABABBA"
Tcontrol(10) = "ABBABA"
' Extrait le premier caractère: type de code, non imprimé sous forme de barre
TypeCode = Val(Mid(CodeBar, 1, 1))
Inverseur = Tcontrol(TypeCode + 1) ' Inversera certains profils
CodeBar = Mid(CodeBar, 2, 12) ' Il reste 11 caractères
'//==== Creation du mask représentant le code barre (série de 1, de 0, de + et de -)
'============== GUARD PATTERN
CodeChiffre = "101-"
'============== ODD PARITY
For ind = 1 To 6
Chiffre = Mid(Trim(CodeBar), ind, 1)
If Mid(Inverseur, ind, 1) = "A" Then
CodeChiffre = CodeChiffre & (TJA(Chiffre + 1))
Else
CodeChiffre = CodeChiffre + (TJB(Chiffre + 1))
End If
Next ind
'============== MIDDLE GUARD PATTERN
CodeChiffre = CodeChiffre + "+01010-"
'============== EVEN PARITY
For ind = 7 To 12
Chiffre = Val(Mid(CodeBar, ind, 1))
CodeChiffre = CodeChiffre + TJC(Chiffre + 1)
Next ind
'============== GUARD PATTERN
CodeChiffre = CodeChiffre + "+101"
'Return de la fonction de conversion en "binaire"
EAN13_Binaire = CodeChiffre
End Function
'Fonction de calcul du caractere de controle et renvoi le code complet
Public Function CalculNumControlCodeBarre(pCodeBar As String) As String
Dim ind As Long
Dim CarControl As Long ' Caractère de contrôle
Dim TypeCode As Long ' Premier caractère du code barre
' Extrait le premier caractère: type de code, non imprimé sous forme de barre
TypeCode = Val(Mid(pCodeBar, 1, 1))
pCodeBar = Mid(pCodeBar, 2, 11) ' Il reste 11 caractères
'=== Calcul du caractère de contrôle.
CarControl = TypeCode
For ind = 1 To 11
If ind Mod 2 <> 0 Then
CarControl = CarControl + Val(Mid(pCodeBar, ind, 1)) * 3 ' Controle*3
Else
CarControl = CarControl + Val(Mid(pCodeBar, ind, 1))
End If
Next ind
CarControl = ((Int((CarControl - 1) / 10) + 1) * 10) - CarControl
'renvoi le code barre complet
CalculNumControlCodeBarre = TypeCode & CStr(Mid(pCodeBar, 1, 6)) & CStr(Mid(pCodeBar, 7, 5)) + CStr(CarControl)
End Function
'test la validité du code barre
Public Function CheckSumValide(CodeBarre As String) As Boolean
' CodeBarre = code barre a tester
Dim ind As Integer
Dim CarControl As Long ' Caractère de contrôle
Dim TypeCode As Long ' Premier caractère du code barre
Dim CheckSum As Integer ' Dernier caractere
' Extrait le premier caractère: type de code, non imprimé sous forme de barre
TypeCode = Val(Mid(CodeBarre, 1, 1))
CheckSum = Val(Mid(CodeBarre, 13, 1))
CodeBarre = Mid(CodeBarre, 2, 11) ' Il reste 11 caractères
'=== Calcul du caractère de contrôle.
CarControl = TypeCode
For ind = 1 To 11
If ind Mod 2 <> 0 Then
CarControl = CarControl + Val(Mid(CodeBarre, ind, 1)) * 3 ' Controle*3
Else
CarControl = CarControl + Val(Mid(CodeBarre, ind, 1))
End If
Next ind
CarControl = ((Int((CarControl - 1) / 10) + 1) * 10) - CarControl
CheckSumValide = (CheckSum = CarControl)
End Function
'Visualisation dans une PictureBox du code barre
Public Sub CodeBarre_Pict(MaskCodeBarre As String, Picture As PictureBox, _
Logo As PictureBox, _
Optional nHauteur As Long = 600, Optional nLargeur As Long = 35, _
Optional nHautDec As Long = 40, Optional Col As Long = 100, _
Optional Lig As Long = 100)
'// Col,Lig = Position dans la Picturebox
'// nHauteur = Hauteur du code barre
'// nLargeur = Largeur du code barre
'// nHautDec = Hauteur supplémentaires des traits de séparation
'// MaskCodeBarre = Profil binaire sous forme de "0" et "1" à imprimer
'// Logo = PictureBox contenant le logo de l'entreprise
Dim NumCar As Long ' Position dans le mask "binaire
Dim NbTrait As Long ' Nb de lignes à tracer
Dim Epaisseur1Trait As Double ' Epaisseur d'un trait
Dim i As Integer ' Indice de boucle
Dim X As Double ' Abscisse de la ligne à tracer dans la PictureBox
Dim nLen As Long ' Taille du mask "binaire"
'Efface l'image existante
Picture.Cls
' Nombre de caractères à analyser
nLen = Len(MaskCodeBarre)
' Calcul de l'épaisseur d'un trait suivant la largeur demandée et le nombre de traits
' On comptabilise les caractères "+" et "-" même s'ils ne sont pas imprimés (négligeable)
Epaisseur1Trait = 15
X = Col + Epaisseur1Trait * 7 ' Décalage vers la gauche pour le chiffre affiché dessous
NumCar = 1
'Generation des lignes
Do While NumCar <= nLen
Select Case Mid(MaskCodeBarre, NumCar, 1)
Case "-" ' Indicateur de diminution de hauteur de barre...
nHauteur = nHauteur - nHautDec
NumCar = NumCar + 1
Case "+" ' Indicateur d'augmentation de hauteur de barre...
nHauteur = nHauteur + nHautDec
NumCar = NumCar + 1
Case "0" ' Espace
X = X + Epaisseur1Trait
NumCar = NumCar + 1
Case "1" ' Barre
'Regroupe tous les '1' successif du mask "binaire" pour gagner du temps
NbTrait = 0
Do While Mid(MaskCodeBarre, NumCar, 1) = "1"
NbTrait = NbTrait + 1
NumCar = NumCar + 1
Loop
'Definition de l'épaisseur du trait des barres
Picture.DrawWidth = 1
'Tarce les lignes dans la PictureBox
For i = 1 To NbTrait
Picture.Line (X, Lig)-(X, Lig + nHauteur)
X = X + Epaisseur1Trait
Next i
End Select
Loop
Picture.CurrentX = Picture.CurrentX + 500
Call Picture.PaintPicture(Logo, Picture.CurrentX + 150, 150)
End Sub
'Impressions
Public Sub CodeBarre_Imp(MaskCodeBarre As String, PictureLogo As PictureBox, _
Optional CalibrageTrait As Integer = 2, _
Optional nHauteur As Long = 600, Optional nLargeur As Long = 35, _
Optional nHautDec As Long = 40, Optional Col As Long = 100, _
Optional Lig As Long = 100)
'// Impression des traits
'// Col,Lig = Position pour l'impression
'// nHauteur = Hauteur du code barre
'// nLargeur = Largeur du code barre
'// nHautDec = Hauteur supplémentaires des traits de séparation
'// MaskCodeBarre = profil binaire sous forme de "0" et "1" à imprimer
'// PictureLogo = Logo à imprimer à coté du code barre
'// CalibrageTrait = Epaisseur du trait pour l'imprimante (dépendant de la résolution de celle-ci
'// 300*300 dpi : 4 -------- 180*180 dpi (thermique) : 2 )
'//
'//
'//
' ATTENTTION : il faut une PictureBox dans la frame appelante : Picture1
' ----------
Dim NumCar As Long ' Position dans le mask "binaire
Dim NbTrait As Long ' Nb de lignes à tracer
Dim i As Integer ' Indice de boucle
Dim X As Double ' Abscisse de la ligne à tracer dans la PictureBox
Dim nLen As Long ' Taille du mask "binaire"
Dim Epaisseur1Trait As Integer ' Epaisseur d'un trait
Epaisseur1Trait = 16
nLen = Len(MaskCodeBarre) ' Nombre de caractères à analyser
' Définition de la marge d'impression
X = Col + Epaisseur1Trait * 7
NumCar = 1
'Generation des lignes
Do While NumCar <= nLen
Select Case Mid(MaskCodeBarre, NumCar, 1)
Case "-" ' Indicateur de diminution de hauteur de barre...
nHauteur = nHauteur - nHautDec
NumCar = NumCar + 1
Case "+" ' Indicateur d'augmentation de hauteur de barre...
nHauteur = nHauteur + nHautDec
NumCar = NumCar + 1
Case "0" ' Espace
X = X + Epaisseur1Trait
NumCar = NumCar + 1
Case "1" ' Barre
'Regroupe tous les '1' successif du mask "binaire" pour gagner du temps
NbTrait = 0
Do While Mid(MaskCodeBarre, NumCar, 1) = "1"
NbTrait = NbTrait + 1
NumCar = NumCar + 1
Loop
'Definition de l'épaisseur du trait des barres
Printer.DrawWidth = CalibrageTrait
For i = 1 To NbTrait
Printer.Line (X, Lig)-(X, Lig + nHauteur)
X = X + Epaisseur1Trait
Next i
End Select
Loop
Call Printer.PaintPicture(PictureLogo, X + 500, 100)
End Sub
' Procedure ajoutant un texte sous le code barre
Public Sub CodeBarreTxt(CodeBarre As String, _
Optional txt As String = "Garantie nulle sans cette étiquette", _
Optional NomPolice As String = "verdana", _
Optional TaillePolice As Integer = 7, _
Optional DecalTxt As Integer = 300)
'// CodeBarre = Valeur du code barre
'// txt = texte à afficher sous le code barre
'// DecalTxt = marge du texte à afficher sous le code barre
'Déplace le pointeur de l'imprimante
Printer.CurrentX = 200
Printer.FontName = NomPolice
Printer.FontSize = TaillePolice
'Mise en forme du code barre : mise en place d'espaces
Printer.Print CodeBarre_TxtFormate_Printer(CodeBarre)
Printer.CurrentX = Printer.CurrentX + DecalTxt
Printer.Print txt
End Sub
Public Sub CodeBarreLegende(CodeBarre As String, PictureCodeBarre As PictureBox, _
Optional txt As String = "Garantie nulle sans cette étiquette", _
Optional NomPolice As String = "verdana", _
Optional TaillePolice As Integer = 7, _
Optional DecalTxt As Integer = 300)
'// CodeBarre = Valeur du code barre
'// txt = texte à afficher sous le code barre
'// DecalTxt = marge du texte à afficher sous le code barre
'Déplace le pointeur de l'imprimante
PictureCodeBarre.CurrentX = 200
PictureCodeBarre.FontName = NomPolice
PictureCodeBarre.FontSize = TaillePolice
'Mise en forme du code barre : mise en place d'espaces
PictureCodeBarre.Print CodeBarre_TxtFormate_Image(CodeBarre)
PictureCodeBarre.CurrentX = Printer.CurrentX + DecalTxt
PictureCodeBarre.Print txt
End Sub
'Mises en forme du texte sous le code barre
Public Function CodeBarre_TxtFormate_Printer(CodeBarre As String) As String
'// format de presentation : 1 234567 890128
CodeBarre_TxtFormate_Printer = CStr(Mid(CodeBarre, 1, 1)) & " " & CStr(Mid(CodeBarre, 2, 6)) & " " & CStr(Mid(CodeBarre, 8, 6))
End Function
Public Function CodeBarre_TxtFormate_Image(CodeBarre As String) As String
'// format de presentation : 1 234567 890128
CodeBarre_TxtFormate_Image = CStr(Mid(CodeBarre, 1, 1)) & " " & CStr(Mid(CodeBarre, 2, 6)) & " " & CStr(Mid(CodeBarre, 8, 6))
End Function
Codes Sources
A voir également
- Norme code barre
- Code barre norme - Meilleures réponses
- Norme ean - Meilleures réponses
- Code pour afficher un code barre à la norme 2 of 5 entrelacé - Codes sources - Visual Basic / VB.NET (Divers)
- Code-barre ean-13 - Codes sources - Visual Basic / VB.NET (Graphique)
- Javascript : Generateur de code barre ean 13 - CodeS SourceS - Guide
- PHP : Code barre 128 et EAN 13 - CodeS SourceS - Guide
- Code barre ean 13 - Guide
Commentaires
Peut-on enregistrer le code barre au format image ?
parce que ça fais des choses bizard.....
mais sinon super truc.... merci encore....
@+ Sator
- Messages postés
-
809
- Date d'inscription
- mercredi 11 octobre 2000
- Statut
- Membre
- Dernière intervention
- 29 septembre 2010
6Je voulais savoir qqch, j'aimerais imprimer avec une imprimante spéciale pour créer des étiquette (smart label 100).
Mais quand je veux imprimer, cela me mets une erreur.
Goldfingers
Juste une petite question/suggestion :
j'aimerais récupérer le code barre généré et le placer dans un document Word.
J'ai essayé de faire une copie de la picturebox (piccodebarre) , mais il ne me copie rien ?
Avez vous une suggestion pour que cela fonctionne ??
Merci d'avance,
Cyclone
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.