Classe ean13 vers bitmap

Soyez le premier à donner votre avis sur cette source.

Vue 7 547 fois - Téléchargée 712 fois

Description

Une petite classe en VB.NET, qui génère tout simplement un code barre en image...
Sans police, juste avec GDI+
Pour le fun j'ai juste ajouté, une variante "BICOLOR", même en deux couleurs, le code barre est parfaitement lisible par une douchette...

La clé de controle est genérée automatiquement, tout ce dont cette classe a besoin, c'est 12 chiffres, un nom d'image pour la sortie, des dimensions
...et donc des couleurs pour ceux qui veulent jouer avec...:)

Cette classe est vraiment simple et efficace...

Source / Exemple :


Function EAN13_BITMAP_BICOLOR(ByVal digits As String, ByVal FileName As String, ByVal widthMM As Integer, ByVal heightMM As Integer, ByVal Color1 As Brush, ByVal Color2 As Brush, ByVal BackColor As System.Drawing.Color) As String

Conclusion :


(.NET 1.1)

Bonjour à Nix !

DrTissot :)

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
mercredi 29 mars 2006
Statut
Membre
Dernière intervention
5 septembre 2006

Super ce code, il marche vraiment bien.

Serait il possible d'ajouter la valeur du code barres sous les lignes et un label libre au dessus ? Comme pour les "vrais" code barres quoi...

Merci encore
Messages postés
4
Date d'inscription
jeudi 21 août 2003
Statut
Membre
Dernière intervention
23 juin 2006

ce code n'est pas directement utilisable

voici le code de la classe revisité pour être utilisé directement
sur un service web iis asp.net

' La classe de DrTissot pour les code barre EAN13 vers image !!!! facile !!!! - 2003

Public Class EAN13_IMAGE

Inherits System.Web.UI.Page
'encodage pour la police ean-13.ttf
Private Function EAN13_STR(ByVal digits As String) As String
'Written by drtissot
Dim digitsEncoded As String = ""
Dim digit(12) As Integer
Dim TypeF1(9) As String
Dim TypeF2(9) As String
Dim TypeLA(9) As String
Dim TypeLB(9) As String
Dim TypeR(9) As String
Dim TypeE(9) As String

'Initialisation des valeurs
TypeF1(0) "!" : TypeF2(0) "`" : TypeLA(0) = "0" : TypeLB(0) = "@" : TypeR(0) = "P" : TypeE(0) = "p"
TypeF1(1) """" : TypeF2(1) "a" : TypeLA(1) = "1" : TypeLB(1) = "A" : TypeR(1) = "Q" : TypeE(1) = "q"
TypeF1(2) "#" : TypeF2(2) "b" : TypeLA(2) = "2" : TypeLB(2) = "B" : TypeR(2) = "R" : TypeE(2) = "r"
TypeF1(3) "$" : TypeF2(3) "c" : TypeLA(3) = "3" : TypeLB(3) = "C" : TypeR(3) = "S" : TypeE(3) = "s"
TypeF1(4) "%" : TypeF2(4) "d" : TypeLA(4) = "4" : TypeLB(4) = "D" : TypeR(4) = "T" : TypeE(4) = "t"
TypeF1(5) "&" : TypeF2(5) "e" : TypeLA(5) = "5" : TypeLB(5) = "E" : TypeR(5) = "U" : TypeE(5) = "u"
TypeF1(6) "'" : TypeF2(6) "f" : TypeLA(6) = "6" : TypeLB(6) = "F" : TypeR(6) = "V" : TypeE(6) = "v"
TypeF1(7) "(" : TypeF2(7) "g" : TypeLA(7) = "7" : TypeLB(7) = "G" : TypeR(7) = "W" : TypeE(7) = "w"
TypeF1(8) ")" : TypeF2(8) "h" : TypeLA(8) = "8" : TypeLB(8) = "H" : TypeR(8) = "X" : TypeE(8) = "x"
TypeF1(9) "*" : TypeF2(9) "i" : TypeLA(9) = "9" : TypeLB(9) = "I" : TypeR(9) = "Y" : TypeE(9) = "y"

digit(0) = Microsoft.VisualBasic.Mid(digits, 1, 1)
digit(1) = Microsoft.VisualBasic.Mid(digits, 2, 1)
digit(2) = Microsoft.VisualBasic.Mid(digits, 3, 1)
digit(3) = Microsoft.VisualBasic.Mid(digits, 4, 1)
digit(4) = Microsoft.VisualBasic.Mid(digits, 5, 1)
digit(5) = Microsoft.VisualBasic.Mid(digits, 6, 1)
digit(6) = Microsoft.VisualBasic.Mid(digits, 7, 1)
digit(7) = Microsoft.VisualBasic.Mid(digits, 8, 1)
digit(8) = Microsoft.VisualBasic.Mid(digits, 9, 1)
digit(9) = Microsoft.VisualBasic.Mid(digits, 10, 1)
digit(10) = Microsoft.VisualBasic.Mid(digits, 11, 1)
digit(11) = Microsoft.VisualBasic.Mid(digits, 12, 1)



'détermination du dernier digit (12)


Dim checkNumber_tempo As Integer = ((digit(11) + digit(9) + digit(7) + digit(5) + digit(3) + digit(1)) * 3) + digit(10) + digit(8) + digit(6) + digit(4) + digit(2) + digit(0)
If (checkNumber_tempo.ToString).Length 3 Then checkNumber_tempo CInt(Microsoft.VisualBasic.Mid(checkNumber_tempo.ToString, 3, 1))
If (checkNumber_tempo.ToString).Length 2 Then checkNumber_tempo CInt(Microsoft.VisualBasic.Mid(checkNumber_tempo.ToString, 2, 1))

If checkNumber_tempo = 0 Then
digit(12) = 0
Else
digit(12) = 10 - checkNumber_tempo
End If
digitsEncoded = TypeF1(digit(0)) & TypeF2(digit(1))
Select Case digit(0)
Case 0
digitsEncoded &= TypeLA(digit(2)) & TypeLA(digit(3)) & TypeLA(digit(4)) & TypeLA(digit(5)) & TypeLA(digit(6))
Case 1
digitsEncoded &= TypeLA(digit(2)) & TypeLB(digit(3)) & TypeLA(digit(4)) & TypeLB(digit(5)) & TypeLB(digit(6))
Case 2
digitsEncoded &= TypeLA(digit(2)) & TypeLB(digit(3)) & TypeLB(digit(4)) & TypeLA(digit(5)) & TypeLB(digit(6))
Case 3
digitsEncoded &= TypeLA(digit(2)) & TypeLB(digit(3)) & TypeLB(digit(4)) & TypeLB(digit(5)) & TypeLA(digit(6))
Case 4
digitsEncoded &= TypeLB(digit(2)) & TypeLA(digit(3)) & TypeLA(digit(4)) & TypeLB(digit(5)) & TypeLB(digit(6))
Case 5
digitsEncoded &= TypeLB(digit(2)) & TypeLB(digit(3)) & TypeLA(digit(4)) & TypeLA(digit(5)) & TypeLB(digit(6))
Case 6
digitsEncoded &= TypeLB(digit(2)) & TypeLB(digit(3)) & TypeLB(digit(4)) & TypeLA(digit(5)) & TypeLA(digit(6))
Case 7
digitsEncoded &= TypeLB(digit(2)) & TypeLA(digit(3)) & TypeLB(digit(4)) & TypeLA(digit(5)) & TypeLB(digit(6))
Case 8
digitsEncoded &= TypeLB(digit(2)) & TypeLA(digit(3)) & TypeLB(digit(4)) & TypeLB(digit(5)) & TypeLA(digit(6))
Case 9
digitsEncoded &= TypeLB(digit(2)) & TypeLB(digit(3)) & TypeLA(digit(4)) & TypeLB(digit(5)) & TypeLA(digit(6))
End Select

digitsEncoded &= "|" & TypeR(digit(7)) & TypeR(digit(8)) & TypeR(digit(9)) & TypeR(digit(10)) & TypeR(digit(11)) & TypeE(digit(12))
Return digitsEncoded
End Function

'encodage binaire
Private Function EAN13_BIN(ByVal digits As String) As String
'Written by drtissot
Dim digitsEncoded As String = ""



Dim digit(12) As Integer

Dim TypeBorderGuard As String = "101"
Dim TypeCenterGuard As String = "01010"

Dim TypeLA(9) As String
Dim TypeLB(9) As String
Dim TypeR(9) As String


'Initialisation des valeurs
TypeLA(0) "0001101" : TypeLB(0) "0100111" : TypeR(0) = "1110010"
TypeLA(1) "0011001" : TypeLB(1) "0110011" : TypeR(1) = "1100110"
TypeLA(2) "0010011" : TypeLB(2) "0011011" : TypeR(2) = "1101100"
TypeLA(3) "0111101" : TypeLB(3) "0100001" : TypeR(3) = "1000010"
TypeLA(4) "0100011" : TypeLB(4) "0011101" : TypeR(4) = "1011100"
TypeLA(5) "0110001" : TypeLB(5) "0111001" : TypeR(5) = "1001110"
TypeLA(6) "0101111" : TypeLB(6) "0000101" : TypeR(6) = "1010000"
TypeLA(7) "0111011" : TypeLB(7) "0010001" : TypeR(7) = "1000100"
TypeLA(8) "0110111" : TypeLB(8) "0001001" : TypeR(8) = "1001000"
TypeLA(9) "0001011" : TypeLB(9) "0010111" : TypeR(9) = "1110100"

digit(0) = Microsoft.VisualBasic.Mid(digits, 1, 1)
digit(1) = Microsoft.VisualBasic.Mid(digits, 2, 1)
digit(2) = Microsoft.VisualBasic.Mid(digits, 3, 1)
digit(3) = Microsoft.VisualBasic.Mid(digits, 4, 1)
digit(4) = Microsoft.VisualBasic.Mid(digits, 5, 1)
digit(5) = Microsoft.VisualBasic.Mid(digits, 6, 1)
digit(6) = Microsoft.VisualBasic.Mid(digits, 7, 1)
digit(7) = Microsoft.VisualBasic.Mid(digits, 8, 1)
digit(8) = Microsoft.VisualBasic.Mid(digits, 9, 1)
digit(9) = Microsoft.VisualBasic.Mid(digits, 10, 1)
digit(10) = Microsoft.VisualBasic.Mid(digits, 11, 1)
digit(11) = Microsoft.VisualBasic.Mid(digits, 12, 1)

'détermination du dernier digit(12)
Dim checkNumber_tempo As Integer = ((digit(11) + digit(9) + digit(7) + digit(5) + digit(3) + digit(1)) * 3) + digit(10) + digit(8) + digit(6) + digit(4) + digit(2) + digit(0)
If (checkNumber_tempo.ToString).Length 3 Then checkNumber_tempo CInt(Microsoft.VisualBasic.Mid(checkNumber_tempo.ToString, 3, 1))
If (checkNumber_tempo.ToString).Length 2 Then checkNumber_tempo CInt(Microsoft.VisualBasic.Mid(checkNumber_tempo.ToString, 2, 1))

If checkNumber_tempo = 0 Then
digit(12) = 0
Else
digit(12) = 10 - checkNumber_tempo
End If



digitsEncoded = TypeBorderGuard & TypeLA(digit(1))
Select Case digit(0)
Case 0
digitsEncoded &= TypeLA(digit(2)) & TypeLA(digit(3)) & TypeLA(digit(4)) & TypeLA(digit(5)) & TypeLA(digit(6))
Case 1
digitsEncoded &= TypeLA(digit(2)) & TypeLB(digit(3)) & TypeLA(digit(4)) & TypeLB(digit(5)) & TypeLB(digit(6))
Case 2
digitsEncoded &= TypeLA(digit(2)) & TypeLB(digit(3)) & TypeLB(digit(4)) & TypeLA(digit(5)) & TypeLB(digit(6))
Case 3
digitsEncoded &= TypeLA(digit(2)) & TypeLB(digit(3)) & TypeLB(digit(4)) & TypeLB(digit(5)) & TypeLA(digit(6))
Case 4
digitsEncoded &= TypeLB(digit(2)) & TypeLA(digit(3)) & TypeLA(digit(4)) & TypeLB(digit(5)) & TypeLB(digit(6))
Case 5
digitsEncoded &= TypeLB(digit(2)) & TypeLB(digit(3)) & TypeLA(digit(4)) & TypeLA(digit(5)) & TypeLB(digit(6))
Case 6
digitsEncoded &= TypeLB(digit(2)) & TypeLB(digit(3)) & TypeLB(digit(4)) & TypeLA(digit(5)) & TypeLA(digit(6))
Case 7
digitsEncoded &= TypeLB(digit(2)) & TypeLA(digit(3)) & TypeLB(digit(4)) & TypeLA(digit(5)) & TypeLB(digit(6))
Case 8
digitsEncoded &= TypeLB(digit(2)) & TypeLA(digit(3)) & TypeLB(digit(4)) & TypeLB(digit(5)) & TypeLA(digit(6))
Case 9
digitsEncoded &= TypeLB(digit(2)) & TypeLB(digit(3)) & TypeLA(digit(4)) & TypeLB(digit(5)) & TypeLA(digit(6))
End Select

digitsEncoded &= TypeCenterGuard & TypeR(digit(7)) & TypeR(digit(8)) & TypeR(digit(9)) & TypeR(digit(10)) & TypeR(digit(11)) & TypeR(digit(12)) & TypeBorderGuard
Return digitsEncoded
End Function

'creation d'une bitmap
Public Function EAN13_BITMAP(ByVal digits As String, ByVal FileName As String, ByVal widthMM As Integer, ByVal heightMM As Integer, ByVal Color As System.Drawing.Brush, ByVal BackColor As System.Drawing.Color) As String

Try
digits = EAN13_BIN(digits)
' destruction de l'ancienne image éventuelle
If System.IO.File.Exists(FileName) Then System.IO.File.Delete(FileName)
'déclaration
Dim table_digits(2000) As String
Dim digits_tour As Integer = 0
For digits_tour = 1 To digits.Length
table_digits(digits_tour - 1) = Microsoft.VisualBasic.Mid(digits, digits_tour, 1)
Next


'calcul de la taille ideale des pixel pour un code barre à 85% de l'image
Dim EAN13Largeur As Integer = (((widthMM * 7500) / 635) * 85) / 100
Dim EAN13Hauteur As Integer = (((heightMM * 7500) / 635) * 85) / 100
Dim EAN13LargeurCoef As Integer = CInt(EAN13Largeur / digits.Length)

Dim xDépart As Integer = (((widthMM * 7500) / 635) * 7.5) / 100
Dim yDépart As Integer = (((heightMM * 7500) / 635) * 7.5) / 100

Dim EAN13BITMAP As New System.Drawing.Bitmap((widthMM * 7500) / 635, (heightMM * 7500) / 635, System.Drawing.Imaging.PixelFormat.Format32bppRgb)

EAN13BITMAP.SetResolution(300, 300)
Dim EAN13Gfx As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(EAN13BITMAP)
EAN13Gfx.Clear(BackColor)

Dim ZeroOne As Integer
For Each ZeroOne In table_digits
If ZeroOne = 0 Then
xDépart += (1 * EAN13LargeurCoef)
End If
If ZeroOne = 1 Then
xDépart += (1 * EAN13LargeurCoef)
EAN13Gfx.FillRectangle(Color, xDépart, yDépart, (1 * EAN13LargeurCoef), EAN13Hauteur)
End If
Next
EAN13Gfx.PixelOffsetMode = System.Drawing.Drawing2D.PixelOffsetMode.HighQuality
'Enregistrement de l'image:
EAN13BITMAP.Save(FileName, System.Drawing.Imaging.ImageFormat.Png)

Return "OK"
Catch ex As System.Exception
Return ex.ToString
End Try

End Function

Public Function EAN13_BITMAP_BICOLOR(ByVal digits As String, ByVal FileName As String, ByVal widthMM As Integer, ByVal heightMM As Integer, ByVal Color1 As System.Drawing.Brush, ByVal Color2 As System.Drawing.Brush, ByVal BackColor As System.Drawing.Color) As String

Try
digits = EAN13_BIN(digits)
' destruction de l'ancienne image éventuelle
If System.IO.File.Exists(FileName) Then System.IO.File.Delete(FileName)
'déclaration
Dim table_digits(2000) As String
Dim digits_tour As Integer = 0
For digits_tour = 1 To digits.Length
table_digits(digits_tour - 1) = Microsoft.VisualBasic.Mid(digits, digits_tour, 1)
Next


'calcul de la taille ideale des pixel pour un code barre à 85% de l'image
Dim EAN13Largeur As Integer = (((widthMM * 7500) / 635) * 85) / 100
Dim EAN13Hauteur As Integer = (((heightMM * 7500) / 635) * 85) / 100
Dim EAN13LargeurCoef As Integer = CInt(EAN13Largeur / digits.Length)

Dim xDépart As Integer = (((widthMM * 7500) / 635) * 7.5) / 100
Dim yDépart As Integer = (((heightMM * 7500) / 635) * 7.5) / 100

Dim EAN13BITMAP As New System.Drawing.Bitmap((widthMM * 7500) / 635, (heightMM * 7500) / 635, System.Drawing.Imaging.PixelFormat.Format32bppRgb)

EAN13BITMAP.SetResolution(300, 300)
Dim EAN13Gfx As System.Drawing.Graphics
EAN13Gfx = System.Drawing.Graphics.FromImage(EAN13BITMAP)
EAN13Gfx.Clear(BackColor)

Dim ZeroOne As Integer
Dim colorSwap As Boolean = False
Dim colorChange As Boolean = False
For Each ZeroOne In table_digits
If ZeroOne = 0 Then
colorChange = True
xDépart += (1 * EAN13LargeurCoef)
End If
If ZeroOne = 1 Then
xDépart += (1 * EAN13LargeurCoef)
If colorChange Then
If colorSwap Then
colorSwap = False
Else
colorSwap = True
End If
End If
If colorSwap Then
EAN13Gfx.FillRectangle(Color1, xDépart, yDépart, (1 * EAN13LargeurCoef), EAN13Hauteur)
Else

EAN13Gfx.FillRectangle(Color2, xDépart, yDépart, (1 * EAN13LargeurCoef), EAN13Hauteur)
End If
colorChange = False
End If
Next
EAN13Gfx.PixelOffsetMode = System.Drawing.Drawing2D.PixelOffsetMode.HighQuality

EAN13BITMAP.Save(FileName)

Return "OK"
Catch ex As System.Exception
Return ex.ToString
End Try

End Function

End Class

et voici le code de la page aspx :


<%@ Page src="ean13.vb" Inherits="EAN13_IMAGE" %>
<html>
<head>
<title>Demo asp.net </title>
</head>

enregistrement du résultat: <%=Server.MapPath("codeout.png")%>

resultat :<%=EAN13_BITMAP("123456789123", Server.MapPath("codeout.png"), 400,200, System.Drawing.Brushes.Black, System.Drawing.Color.White) %>

</html>


et voilà
gros merci a pascal
Messages postés
2
Date d'inscription
mardi 4 novembre 2003
Statut
Membre
Dernière intervention
30 mars 2007

En réponse à BlackWizzrd voici un petit exemple:

Pour créer un code barre nommé "test.png" en deux couleur...(rouge & noir)

1) tu déclares ta nouvelle instance de classe:
Private MONEAN13 As New EAN13_IMAGE

2)tu tape appels la fonction:
MONEAN13.EAN13_BITMAP_BICOLOR(txtIn.Text, "c: est.png", 40, 5, Brushes.Red, Brushes.Black, Color.White)

3)Si mes souvenir son bons, la fonction retour "ok", si la génération n'a rencontré aucun problème...

@+
Messages postés
1258
Date d'inscription
mercredi 21 mars 2001
Statut
Modérateur
Dernière intervention
21 juin 2009
2
un exemple serai le bienvenue.

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.