CLASSE EAN13 VERS BITMAP

Commentaire de BlackWizzard le 15/11/2003 13:12:05 administrateur CS

un exemple serai le bienvenue.

Commentaire de llefe le 06/06/2006 19:21:04

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>
<body>
enregistrement du résultat: <%=Server.MapPath("codeout.png")%><br>
resultat :<%=EAN13_BITMAP("123456789123", Server.MapPath("codeout.png"), 400,200, System.Drawing.Brushes.Black, System.Drawing.Color.White) %>
</body>
</html>


et voilà
gros merci a pascal