Draw EAN Barcode Without True Type Fonts

Category:

C#, VB.NET, ASP.NET

Type:

Snippets

Difficulty:

Advanced

Author: Anonymous

Version Compatibility: Visual Basic.NET

More information:

Running Code URL = http://www.e-canakkale.com

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

---HTML Code ---
<HTML>
	<HEAD>

--- VB File Code ---
Imports System.IO
Imports System.Drawing
Imports System.Drawing.Text
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D

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