AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

  • Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS
  • RSS CodeS-SourceS
  • CodyxBot, le Bot GTalk & MSN qu'il vous faut !
  • Générez des revenus avec vos codes, scripts et tutoriaux
  • Aide à la navigation du site
begin process at 2009 07 05 02:39:26
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

CLASSE EAN13 VERS BITMAP


Information sur la source

Catégorie :VB.NET Source .NET ( DotNet ) Niveau : Initié Date de création : 14/11/2003 Date de mise à jour : 18/11/2003 12:10:22 Vu / téléchargé: 5 641 / 618
Auteur : drtissot Site perso
Ecrire un message privé
Note :
Aucune note
Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale
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

  • 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
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 :)
 

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

Commentaires et avis

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

un exemple serai le bienvenue.

signaler à un administrateur
Commentaire de drtissot le 18/11/2003 18:56:06

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...

@+

signaler à un administrateur
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

signaler à un administrateur
Commentaire de knarf1664 le 05/09/2006 16:00:22

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

Ajouter un commentaire

Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Comparez les prix Nouvelle version


Apple iPod touch 2nde Gén. Noir 8 Go (Mac/PC)
Entre 209€ et 345€


Visiter le guide achat

Photothèque Nouveau !

Photo sitges beachPhoto pretty girls
Photo femme, Plage, Bien être, 

Visiter la photothèque


Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,296 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.