Draw EAN barcode lines and save image file with ASP.NET (VB codes)

• Download DrawEANBarcode.zip - 21.39 KB

Introduction

Imports System.IO
Imports System.Drawing
Imports System.Drawing.Text
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D


Public Class _Default
    Inherits System.Web.UI.Page

#Region " Web Form Designer Generated Code "
    'This call is required by the Web Form Designer.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
    End Sub

    Protected WithEvents lblMessage As System.Web.UI.WebControls.Label
    Protected WithEvents btnTestDraw As System.Web.UI.WebControls.Button
    Protected WithEvents Label21 As System.Web.UI.WebControls.Label
    Protected WithEvents imgBarkod As System.Web.UI.WebControls.Image
    Protected WithEvents txtBarkod As System.Web.UI.WebControls.TextBox
    'NOTE: The following placeholder declaration is required by the Web Form Designer.
    'Do not delete or move it.
    Private designerPlaceholderDeclaration As System.Object

    Private Sub Page_Init(ByVal sender As System.Object, _
                          ByVal e As System.EventArgs) Handles MyBase.Init
        'CODEGEN: This method call is required by the Web Form Designer
        'Do not modify it using the code editor.
        InitializeComponent()
    End Sub
#End Region

    Public EANimgUrl As String

    Private Sub Page_Load(ByVal sender As System.Object, _
                          ByVal e As System.EventArgs) Handles MyBase.Load
        EANimgUrl = "EAN/"
        If Me.IsPostBack = True Then
            DrawCommand()
        End If
    End Sub

    Private Sub DrawCommand()
        Dim strEANCode, imgUrl As String
        strEANCode = txtBarkod.Text
        imgUrl = EANimgUrl & strEANCode & ".jpg"

        'Check exists EAN image file
        If Not File.Exists(Server.MapPath(imgUrl)) Then
            'Check Digit Control
            If CheckDigit(strEANCode) = True Then
                DrawEANBarCode(strEANCode, imgBarkod.Width.Value, imgBarkod.Height.Value)
                lblMessage.Text = ""
                imgBarkod.Visible = True
                imgBarkod.ImageUrl = imgUrl
            Else
                lblMessage.Text = "Invalid EAN Code!.."
                imgBarkod.Visible = False
            End If
        Else
            lblMessage.Text = ""
            imgBarkod.Visible = True
            imgBarkod.ImageUrl = imgUrl
        End If
    End Sub

    Public Sub DrawEANBarCode(ByVal strEANCode As String, _
                              ByVal imgWidth As Integer, _
                              ByVal imgHeight As Integer)
        Dim oGraphics As Graphics
        Dim oBitmap As Bitmap
        Dim K As Single
        Dim PosX As Single
        Dim PosY As Single
        Dim ScaleX As Single
        Dim strEANBin As String
        Dim strFormat As New StringFormat
        Dim FontForText As Font = New Font("Courier New", 10)
        strEANBin = EAN2Bin(strEANCode)
        Dim X1 As Single = 0
        Dim Y1 As Single = 0
        Dim X2 As Single = imgWidth
        Dim Y2 As Single = imgHeight
        PosX = X1
        PosY = Y2 - CSng(1.2 * FontForText.Height)

        'Draw new bitmap and clear area with white color
        oBitmap = New Bitmap(imgWidth, imgHeight, PixelFormat.Format24bppRgb)
        oGraphics = Graphics.FromImage(oBitmap)
        oGraphics.Clear(Color.White)
        ScaleX = (X2 - X1) / strEANBin.Length

        'Draw the BarCode lines
        For K = 1 To Len(strEANBin)
            If Mid(strEANBin, K, 1) = "1" Then
                oGraphics.FillRectangle(New System.Drawing.SolidBrush(Color.Black), _
                                        PosX, Y1, ScaleX, PosY)
            End If
            PosX = X1 + (K * ScaleX)
        Next K

        'Draw strEAN Code text
        strFormat.Alignment = StringAlignment.Center
        strFormat.FormatFlags = StringFormatFlags.NoWrap
        oGraphics.DrawString(strEANCode, FontForText, _
                             New System.Drawing.SolidBrush(Color.Black), _
                             CSng((X2 - X1) / 2), CSng(Y2 - FontForText.Height), _
                             strFormat)

        'Save Bitmap to jpeg file
        oBitmap.Save(Server.MapPath(EANimgUrl & strEANCode & ".jpg"))

        'If u don't want to save image file use this line
        'oBitmap.Save(Response.OutputStream, ImageFormat.Jpeg)
        'Kill objects
        FontForText.Dispose()
        oGraphics.Dispose()
        oBitmap.Dispose()
    End Sub

    Public Function CheckDigit(ByVal strEANCode As String) As Boolean
        Dim Nums(12), i, k As Integer
        Dim ck As String = Right(strEANCode, 1)
        Dim realCK As String
        'If not is numeric EAN code Return False
        If Not IsNumeric(strEANCode) Then Return False
        i = 1
        If strEANCode.Length = 8 Then
            'Check Digit For EAN 8
            Do While i < 8
                Nums(i) = CType(Mid(strEANCode, i, 1), Integer)
                i += 1
            Loop
            k = (Nums(7) * 3)
            k += (Nums(6) * 1)
            k += (Nums(5) * 3)
            k += (Nums(4) * 1)
            k += (Nums(3) * 3)
            k += (Nums(2) * 1)
            k += (Nums(1) * 3)
            k = k Mod 10
            k = 10 - k
            realCK = k.ToString
        ElseIf strEANCode.Length = 13 Then
            'Check Digit For EAN 13
            Do While i < 13
                Nums(i) = CType(Mid(strEANCode, i, 1), Integer)
                i += 1
            Loop
            k = (Nums(12) * 3)
            k += (Nums(11) * 1)
            k += (Nums(10) * 3)
            k += (Nums(9) * 1)
            k += (Nums(8) * 3)
            k += (Nums(7) * 1)
            k += (Nums(6) * 3)
            k += (Nums(5) * 1)
            k += (Nums(4) * 3)
            k += (Nums(3) * 1)
            k += (Nums(2) * 3)
            k += (Nums(1) * 1)
            k = k Mod 10
            k = 10 - k
            realCK = k.ToString
        Else
            'Nothing EAN 8 or EAN 13 Code
            Return False
        End If
        If ck = realCK Then
            Return True
        Else
            Return False
        End If
    End Function

    Public Function EAN2Bin(ByVal strEANCode As String) As String
        Dim K As Integer
        Dim strAux As String
        Dim strExit As String
        Dim strCode As String
        strEANCode = Trim(strEANCode)
        strAux = strEANCode

        'Check EAN code (EAN8 or EAN13)
        If (strAux.Length <> 13) And (strAux.Length <> 8) Then
            Err.Raise(5, "EAN2Bin", "Invalid EAN Code!..")
        End If

        'Check numbers only
        For K = 0 To strEANCode.Length - 1
            Select Case (strAux.Chars(K).ToString)
                Case Is < "0", Is > "9"
                    Err.Raise(5, "EAN2Bin", "Please don't use any number characters!..")
            End Select
        Next

        'For EAN13
        If (strAux.Length = 13) Then
            strAux = Mid(strAux, 2)
            Select Case CInt(Left(strEANCode, 1))
                Case 0
                    strCode = "000000"
                Case 1
                    strCode = "001011"
                Case 2
                    strCode = "001101"
                Case 3
                    strCode = "001110"
                Case 4
                    strCode = "010011"
                Case 5
                    strCode = "011001"
                Case 6
                    strCode = "011100"
                Case 7
                    strCode = "010101"
                Case 8
                    strCode = "010110"
                Case 9
                    strCode = "011010"
            End Select
        Else 'For EAN8
            strCode = "0000"
        End If

        strExit = "000101"
        For K = 1 To Len(strAux) \ 2
            Select Case CInt(Mid(strAux, K, 1))
                Case 0
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0001101", "0100111")
                Case 1
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0011001", "0110011")
                Case 2
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0010011", "0011011")
                Case 3
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0111101", "0100001")
                Case 4
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0100011", "0011101")
                Case 5
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0110001", "0111001")
                Case 6
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0101111", "0000101")
                Case 7
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0111011", "0010001")
                Case 8
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0110111", "0001001")
                Case 9
                    strExit &= IIf(Mid(strCode, K, 1) = "0", "0001011", "0010111")
            End Select
        Next K

        strExit &= "01010"
        For K = Len(strAux) \ 2 + 1 To Len(strAux)
            Select Case CInt(Mid(strAux, K, 1))
                Case 0
                    strExit &= "1110010"
                Case 1
                    strExit &= "1100110"
                Case 2
                    strExit &= "1101100"
                Case 3
                    strExit &= "1000010"
                Case 4
                    strExit &= "1011100"
                Case 5
                    strExit &= "1001110"
                Case 6
                    strExit &= "1010000"
                Case 7
                    strExit &= "1000100"
                Case 8
                    strExit &= "1001000"
                Case 9
                    strExit &= "1110100"
            End Select
        Next K

        strExit &= "101000"
        EAN2Bin = strExit
    End Function
End Class