CLASSE EAN13 VERS BITMAP

Signaler
Messages postés
1258
Date d'inscription
mercredi 21 mars 2001
Statut
Modérateur
Dernière intervention
21 juin 2009
-
Messages postés
1
Date d'inscription
mercredi 29 mars 2006
Statut
Membre
Dernière intervention
5 septembre 2006
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/17931-classe-ean13-vers-bitmap

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.