Draw EAN barcode lines and save image file with ASP.NET (VB codes)
2.72/5 (12 votes)
My project includes check digit control. Fast and easy codes for your web application.
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