CLASSE EAN13 VERS BITMAP
Utilisateur anonyme
-
15 nov. 2003 à 13:12
knarf1664 Messages postés 1 Date d'inscription mercredi 29 mars 2006 Statut Membre Dernière intervention 5 septembre 2006 - 5 sept. 2006 à 16:00
knarf1664 Messages postés 1 Date d'inscription mercredi 29 mars 2006 Statut Membre Dernière intervention 5 septembre 2006 - 5 sept. 2006 à 16:00
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
https://codes-sources.commentcamarche.net/source/17931-classe-ean13-vers-bitmap
5 sept. 2006 à 16:00
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
6 juin 2006 à 19:21
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
18 nov. 2003 à 18:56
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...
@+
15 nov. 2003 à 13:12