begin process at 2012 02 11 00:26:25
  Trouver un code source :
 
dans
 

3 commentaire(s) de llefe sur des sources sur tout CodeS-SourceS

Déposé sur Classe ean13 vers bitmap

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

Posté le : 06/06/2006 19:21:04

Déposé sur Asp.net - comment obtenir le contenu d'une page web distante ...

Réponse à lolofb
je crois que c'est ton getResponse (myWebResponse) qui ne respecte pas le caractère set,
moi j'utilise un encoding pour la reception et l'ecriture
Dim Encoding As System.Text.Encoding = _
    System.Text.Encoding.GetEncoding("utf-8")
'puis
strOut = Encoding.GetString(WebClient1.DownloadData(remoteScript))
'Ecriture du résultat dans un fichier:
Dim sw As StreamWriter = New StreamWriter("Seminaire.txt", False, Encoding)
sw.Write(strOut)
sw.Close()
(bien sur tu n'est pas obligé de l'écrire dans un fichier
car à mon  avis la redirection de ton streamreader fonctionne.)
Posté le : 26/07/2005 15:59:38

Déposé sur Creer supprimer une base une table un champ lier excel à acce...

super
ce code fonctionne très avec asp
par contre l'ouverture de la base m'a créé un lock que
je n'arrive pas à supprimer ...
enfin c'est un détail.
Posté le : 21/08/2003 01:39:47

1


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

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

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,499 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales