VB.NET 绘制 EAN13 （商品条码）

   今天在Zgke(http://blog.csdn.net/zgke/archive/2008/12/11/3496721.aspx)看到了C#版的 绘制 EAN13 （商品条码）的代码,然后自己仿照着写了个VB.NET版本的.下面是界面和代码:

 

 

 

   在textbox里输入13为条形码,例如6901028036955,然后点击生成按钮,即可绘制出商品条码.

 

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click If Me.TextBox1.Text.Trim.Length <> 13 Then MsgBox("条形码必须为13位!", MsgBoxStyle.Exclamation, "系统提示") Me.TextBox1.Focus() Exit Sub End If Try Dim cs As New CISBN If cs.EAN13ISBN(Me.TextBox1.Text.Trim) = False Then MsgBox("条形码输入不正确,请重新输入!", MsgBoxStyle.Exclamation, "系统提示") Me.TextBox1.Focus() Exit Sub End If cs.EAN13() cs.Magnify = 1 cs.Heigth = 100 cs.FontSize = 16 Me.PictureBox1.Image = cs.GetCodeImage(Me.TextBox1.Text.Trim) Me.PictureBox1.Image.Save("C:/Documents and Settings/Administrator/桌面/1.jpg") Me.TextBox1.Text = "" Me.TextBox1.Focus() Catch ex As Exception MsgBox("绘制条形码失败!", MsgBoxStyle.Exclamation, "系统提示") End Try End Sub

 

  下面是绘制商品条码的类:

 

  Imports System.DrawingPublic Class CISBN Private m_EAN13 As New DataTable Public Sub EAN13() m_EAN13.Columns.Add("ID") m_EAN13.Columns.Add("Type") m_EAN13.Columns.Add("A") m_EAN13.Columns.Add("B") m_EAN13.Columns.Add("C") m_EAN13.Rows.Add("0", "AAAAAA", "0001101", "0100111", "1110010") m_EAN13.Rows.Add("1", "AABABB", "0011001", "0110011", "1100110") m_EAN13.Rows.Add("2", "AABBAB", "0010011", "0011011", "1101100") m_EAN13.Rows.Add("3", "AABBBA", "0111101", "0100001", "1000010") m_EAN13.Rows.Add("4", "ABAABB", "0100011", "0011101", "1011100") m_EAN13.Rows.Add("5", "ABBAAB", "0110001", "0111001", "1001110") m_EAN13.Rows.Add("6", "ABBBAA", "0101111", "0000101", "1010000") m_EAN13.Rows.Add("7", "ABABAB", "0111011", "0010001", "1000100") m_EAN13.Rows.Add("8", "ABABBA", "0110111", "0001001", "1001000") m_EAN13.Rows.Add("9", "ABBABA", "0001011", "0010111", "1110100") End Sub Private m_Height As UInt32 ''' <summary> ''' 绘制高 ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> Property Heigth() As UInt32 Get Return m_Height End Get Set(ByVal value As UInt32) m_Height = value End Set End Property Private m_FontSize As Integer = 0 ''' <summary> ''' 字体大小（宋体） ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> Property FontSize() As Integer Get Return m_FontSize End Get Set(ByVal value As Integer) m_FontSize = value End Set End Property Private m_Magnify As Byte = 0 ''' <summary> ''' 放大系数 ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> Property Magnify() As Byte Get Return m_Magnify End Get Set(ByVal value As Byte) m_Magnify = value End Set End Property Public Function GetCodeImage(ByVal p_Text As String) As Bitmap If p_Text.Length <> 13 Then Throw New Exception("数字不是13位!") End If Dim _codeText As String = p_Text.Remove(0, 1) Dim _codeIndex = "101" Dim _LeftType() As Char = GetValue(p_Text.Substring(0, 1), "Type").ToCharArray For i As Integer = 0 To 5 _codeIndex += GetValue(_codeText.Substring(0, 1), _LeftType(i).ToString().Trim) _codeText = _codeText.Remove(0, 1) Next _codeIndex += "01010" For i As Integer = 0 To 5 _codeIndex += GetValue(_codeText.Substring(0, 1), "C") _codeText = _codeText.Remove(0, 1) Next _codeIndex += "101" Return GetImage(_codeIndex, p_Text) End Function ''' <summary> ''' 获取目标对应的数据 ''' </summary> ''' <param name="p_value">编码</param> ''' <param name="p_Type">类型</param> ''' <returns>编码</returns> ''' <remarks></remarks> Private Function GetValue(ByVal p_value As String, ByVal p_Type As String) As String If m_EAN13 Is Nothing Then Return "" Dim _Row() As DataRow = m_EAN13.Select("ID='" + p_value + "'") If _Row.Length <> 1 Then Throw New Exception("错误的编码" + p_value.ToString().Trim) Return _Row(0)(p_Type).ToString.Trim End Function Private Function GetImage(ByVal p_Text As String, ByVal p_ViewText As String) As Bitmap Dim _Value() As Char = p_Text.ToCharArray Dim _FontWidth As Integer = 0 Dim _MyFont As Font = Nothing If m_FontSize <> 0 Then _MyFont = New Font("宋体", m_FontSize) Dim _MyFontBmp As Bitmap = New Bitmap(m_FontSize, m_FontSize) Dim _FontGraphics As Graphics = Graphics.FromImage(_MyFontBmp) For i As Integer = m_FontSize To 1 Step -1 Dim _DrawSize As SizeF = _FontGraphics.MeasureString(p_ViewText.Substring(0, 1), _MyFont) If _DrawSize.Height > m_FontSize Then _MyFont = New Font("宋体", i) Else _FontWidth = Convert.ToInt32(_DrawSize.Width) Exit For End If Next End If If ScanDrawText(_MyFont, p_Text, _FontWidth) = False Then _FontWidth = 0 m_FontSize = 0 End If '宽 = 需要绘制的数量*放大倍数 + 两个字的宽 Dim _CodeImage As Bitmap = New Bitmap(_Value.Length * (Convert.ToInt32(m_Magnify) + 1) + (_FontWidth * 2), Convert.ToInt32(m_Height)) Dim _Garphics As Graphics = Graphics.FromImage(_CodeImage) _Garphics.FillRectangle(Brushes.White, New Rectangle(0, 0, _CodeImage.Width, _CodeImage.Height)) Dim _Height As Integer = 0 Dim _LenEx As Integer = _FontWidth For i As Integer = 0 To _Value.Length - 1 Dim _DrawWidth As Integer = m_Magnify + 1 If i = 0 Or i = 2 Or i = 46 Or i = 48 Or i = 92 Or i = 94 Then _Height = Convert.ToInt32(m_Height) Else _Height = Convert.ToInt32(m_Height) - m_FontSize End If If _Value(i) = "1" Then _Garphics.FillRectangle(Brushes.Black, New Rectangle(_LenEx, 0, _DrawWidth, _Height)) Else _Garphics.FillRectangle(Brushes.White, New Rectangle(_LenEx, 0, _DrawWidth, _Height)) End If _LenEx += _DrawWidth Next '绘制文字 If _FontWidth <> 0 And m_FontSize <> 0 Then Dim _StarX As Integer = 0 Dim _StarY As Integer = Convert.ToInt32(m_Height) - _MyFont.Height _Garphics.DrawString(p_ViewText.Substring(0, 1), _MyFont, Brushes.Blue, 0, _StarY) _StarX = _FontWidth + (3 * (m_Magnify + 1)) _Garphics.DrawString(p_ViewText.Substring(1, 6), _MyFont, Brushes.Blue, _StarX, _StarY) _StarX = _FontWidth + (50 * (m_Magnify + 1)) _Garphics.DrawString(p_ViewText.Substring(7, 6), _MyFont, Brushes.Blue, _StarX, _StarY) End If _Garphics.Dispose() Return _CodeImage End Function ''' <summary> ''' 判断字体是否大于绘制图形 ''' </summary> ''' <param name="_MyFont">字体</param> ''' <param name="p_Text">文字</param> ''' <param name="p_Width">字体的宽</param> ''' <returns>true可以绘制 False不可以绘制</returns> ''' <remarks></remarks> Private Function ScanDrawText(ByVal _MyFont As Font, ByVal p_Text As String, ByVal p_Width As Integer) As Boolean If _MyFont Is Nothing Then Return False Dim _Width As Integer = (p_Text.Length - 6 - 5) * (Convert.ToInt32(m_Magnify) + 1) If ((p_Width * 12) > _Width) Then Return False Return True End Function '算法 '代码位置序号 13 12 11 10 9 8 7 6 5 4 3 2 1 '数字码 2 3 4 2 3 5 6 5 4 6 5 2 ？ '从代码位置序号2开始，所有偶数位的数字代码求和为a。 '将上步中的a乘以3为a。 '从代码位置序号3开始，所有奇数位的数字代码求和为b。 '将a和b相加为c。 '取c的个位数d。 '用10减去d即为校验位数值。 ''' <summary> ''' 验证条码的最后一位是否正确 ''' </summary> ''' <param name="_Numb">条码</param> ''' <returns>true 正确 false 错误</returns> ''' <remarks></remarks> ''' Public Function EAN13ISBN(ByVal _Numb As String) As Boolean Dim _Sum As Integer = 0 Dim Os As Integer = 0 Dim Js As Integer = 0 Dim jym As Integer = 0 For i As Integer = 11 To 0 Step -2 Os += _Numb.Substring(i, 1) Next For j As Integer = 10 To 0 Step -2 Js += _Numb.Substring(j, 1) Next Os = Os * 3 _Sum = Os + Js jym = 10 - (_Sum.ToString.Trim.Substring(_Sum.ToString.Trim.Length - 1, 1)) If jym = _Numb.Trim.Substring(_Numb.Trim.Length - 1, 1) Then Return True Else Return False End If End Function End Class