AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

  • 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 11 23:04:28
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 !

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

Le : 06/06/2006 19:21:04
Source : 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


Le : 26/07/2005 15:59:38
Source : ASP.NET - COMMENT OBTENIR LE CONTENU D'UNE PAGE WEB DISTANTE DANS SA PAGE COURANTE
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.)

Le : 21/08/2003 01:39:47
Source : CREER SUPPRIMER UNE BASE UNE TABLE UN CHAMP LIER EXCEL À ACCESS AINSI QUE CREER UNE REQUETE AFIN DE L'EXECUTER
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.

Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Appels d'offres

Comparez les prix Nouvelle version


Console Nintendo DSi Noire
Entre 169€ et 170€


Visiter le guide achat

Photothèque Nouveau !

Photo friends at the beach.Photo femme, plage, bien être, soleil, vacances, été, détente, repos
Photo alphabet langue des sourds 

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,172 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é.