转载-EAN13条码控件(VB.NET 2005)

 通过EAN13编码规则可以轻松的生成条码控件，该控件允许输入12位或者13位数字，并绘制成EAN13条码，并提供图象打印功能的接口。

代码如下：

Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Drawing.Printing
Imports System.Drawing.Imaging

Public Class EAN13
Inherits System.Windows.Forms.Control
Private m_BarCode As String '输入值
Private m_LineWidth As Integer '基准线宽度
Private CharA As String() = New String(9) {"0001101", "0011001", "0010011", "0111101", "0100011", "0110001", "0101111", "0111011", "0110111", "0001011"} '间隔线左侧编码集合A
Private CharB As String() = New String(9) {"0100111", "0110011", "0011011", "0100001", "0011101", "0111001", "0000101", "0010001", "0001001", "0010111"} '间隔线左侧编码集合B
Private Guid As String() = New String(9) {"AAAAAA", "AABABB", "AABBAB", "AABBBA", "ABAABB", "ABBAAB", "ABBBAA", "ABABAB", "ABABBA", "ABBABA"} '引导数编码规则
Private Rencode As String() = New String(9) {"1110010", "1100110", "1101100", "1000010", "1011100", "1001110", "1010000", "1000100", "1001000", "1110100"} '间隔线右侧编码集合
Private Const Cstar As String = "101" '条形码左护线
Private Const Cmid As String = "01010" '条形码间隔线
Private Const Cend As String = "101" '条形码右护线
Private TempStr As String '临时中间变量

Private m_DisPlayFont As Boolean '是否显示条码数字
Private m_Image As Bitmap

Public Property DisPlayFont() As Boolean
Get
Return m_DisPlayFont
End Get
Set(ByVal value As Boolean)
m_DisPlayFont = value
End Set
End Property

Public Sub New() '初始化值
m_BarCode = "123456789012"
m_LineWidth = 1
m_DisPlayFont = True
Me.Width = 125
Me.Height = 80
End Sub
Public WriteOnly Property Value() As String
Set(ByVal value As String)
m_BarCode = value
Me.Invalidate() '设置值完毕后触发绘画事件
End Set
End Property

Public ReadOnly Property BarCode() As String '返回条码数字
Get
CheckDigit()
Return TempStr
End Get

End Property

Public Property LineWidth() As Integer '设置基准线宽度
Get
Return m_LineWidth
End Get
Set(ByVal value As Integer)
If value > 0 Then
m_LineWidth = value
Me.Width = 95 * value + 30
End If
Me.Invalidate()
End Set
End Property

Private Function Check(ByVal Inptut As String) As Boolean '判断输入值是否符合规范
Return Regex.IsMatch(m_BarCode, "^/d{12,13}$") '只能输入12或者13位数字
End Function

Private Sub CheckDigit()

If Check(m_BarCode) = True Then
Select Case m_BarCode.Length '如果输入12位的话则计算校验位，13位的话则不计算，如果不匹配则为空字符
Case 12
Dim Osum As Integer, Esum As Integer, i As Integer
For i = m_BarCode.Length - 1 To 0 Step -1
If i Mod 2 <> 0 Then
Osum += CInt(m_BarCode.Substring(i, 1))
Else
Esum += CInt(m_BarCode.Substring(i, 1))
End If
Next
Dim m_CheckDigit As Integer
m_CheckDigit = 10 - (3 * Osum + Esum) Mod 10
If CInt(m_CheckDigit) = 10 Then
m_CheckDigit = 0
End If
TempStr = m_BarCode & m_CheckDigit.ToString
Case 13
TempStr = m_BarCode

End Select
Else
TempStr = String.Empty
End If

End Sub

Private Function Convert() As String '通过编码规则将条码数字转换成图形码
Dim BinaryCode As New StringBuilder(95), LMethod As Integer, i As Integer

CheckDigit()

If TempStr.Length = 13 Then

LMethod = CInt(TempStr.Substring(0, 1))

BinaryCode.Append(Cstar)

For i = 1 To 6
If Guid(LMethod).Substring(i - 1, 1) = "A" Then
BinaryCode.Append(CharA(CInt(TempStr.Substring(i, 1))))
Else
BinaryCode.Append(CharB(CInt(TempStr.Substring(i, 1))))
End If
Next

BinaryCode.Append(Cmid)

For i = 7 To 12
BinaryCode.Append(Rencode(CInt(TempStr.Substring(i, 1))))
Next
BinaryCode.Append(Cend)
Return BinaryCode.ToString
Else
Return String.Empty
End If

End Function

Private Sub DrawPic(ByVal Graphic As Graphics) '根据转换后的图象编码进行绘制

Dim BlackPen As New Pen(Color.Black, m_LineWidth)
Dim WhitePen As New Pen(Color.White, m_LineWidth)
Dim i As Integer, Height As Single


Dim ConvertStr As String = Convert()

If ConvertStr <> String.Empty Then '画条码的线条

For i = 0 To ConvertStr.Length - 1
If i < 3 OrElse i > 91 OrElse (i > 45 AndAlso i < 50) Then
Height = 10
Else
Height = 0
End If
If ConvertStr.Substring(i, 1) = "1" Then
Graphic.DrawLine(BlackPen, CSng(15 + m_LineWidth * i), 10, CSng(15 + m_LineWidth * i), CSng(Me.Height - 20 + Height))
Else
Graphic.DrawLine(WhitePen, CSng(15 + m_LineWidth * i), 10, CSng(15 + m_LineWidth * i), Me.Height - 20 + Height)
End If
Next



If m_DisPlayFont = True Then '画条码字

Dim FontSize As Integer = 8 '根据条码宽度不同设置字体大小不同
If m_LineWidth >= 1 AndAlso m_LineWidth < 2 Then
FontSize = 10
ElseIf m_LineWidth >= 2 Then
FontSize = 14
End If

Dim BarCodeFont As New Font("Arial", FontSize, FontStyle.Regular, GraphicsUnit.Pixel)

Dim Y As Single = Me.Height - BarCodeFont.Height - 4 '绘制数字的开始位置
Dim X As Single = 15 + 3 * m_LineWidth


Graphic.DrawString(TempStr.Substring(0, 1), BarCodeFont, Brushes.Black, 2, Y) '画第一个数字

For i = 1 To 6 '画左边的数字
Graphic.DrawString(TempStr.Substring(i, 1), BarCodeFont, Brushes.Black, X + (7 * m_LineWidth) * (i - 1), Y) '由于1个数字有7位数字编码，所以一个条码数字的宽度应该在7条基准线宽度以内

Next

X = 13 + 50 * m_LineWidth '画右边的数字

For i = 7 To 12
Graphic.DrawString(TempStr.Substring(i, 1), BarCodeFont, Brushes.Black, X + (7 * m_LineWidth) * (i - 7), Y)
Next

End If
End If

BlackPen.Dispose() '释放资源
WhitePen.Dispose()
Graphic.Dispose()

End Sub

Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs) '绘图事件的处理程序

Dim Myrect As New Rectangle(0, 0, Me.Width, Me.Height) '指定背景区域并绘成白色

e.Graphics.FillRectangle(Brushes.White, Myrect)

DrawPic(e.Graphics) '调用条码的绘制方法

End Sub

Private Sub EAN13_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize '设置条码随边框大小而变化
m_LineWidth = (Me.Width - 30) / 95
End Sub

Private Sub SavePic() '生成图象以供打印
m_Image = New Bitmap(Me.Width, Me.Height, PixelFormat.Format32bppArgb)
Dim Graphic As Graphics = Graphics.FromImage(m_Image)
Graphic.Clear(Color.White)
DrawPic(Graphic)
Graphic.Dispose()
End Sub

Public ReadOnly Property Image() As Image '提供图象以便能够打印
Get
SavePic()
Return m_Image
m_Image.Dispose()
End Get
End Property
End Class
下面是测试代码

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim EAN As New BarCode.EAN13
EAN.Value = "123456789012"
Me.BackgroundImage = EAN.Image
End Sub