バーコードのJANコードがプリントできると、商品管理や棚卸など色々なことに使えるので、使いやすそうなアプリを探してみたんだけどボクが使えそうなアプリはなかなか見つかりません。
でもネット上にはたくさんの情報がアップされているのでそれらを参考にプログラムを作ってみました。
（参考にさせていただいたサイト: バーコードの作り方）
↓ 見やすいプログラムではないです… ^^;
Public Class JANCode
Private bit_image()() As Byte = {
New Byte() {13, 39, 63},
New Byte() {25, 51, 52},
New Byte() {19, 27, 50},
New Byte() {61, 33, 49},
New Byte() {35, 29, 44},
New Byte() {49, 57, 38},
New Byte() {47, 5, 35},
New Byte() {59, 17, 42},
New Byte() {55, 9, 41},
New Byte() {11, 23, 37}
} '{左側奇数パリティ, 左側偶数パリティ, 付加文字の組み合わせ}
''' <summary>
''' 1モジュールの幅
''' </summary>
Friend Property ModuleWidth As Integer = 3
''' <summary>
''' JAN-13 バーコードイメージを作る。
''' </summary>
''' <param name="code">バーコード文字列</param>
''' <returns>バーコードイメージ</returns>
Friend Function MakeBarcode13(ByVal code As String) As System.Drawing.Image
If code.Length <> 12 And code.Length <> 13 Then
MessageBox.Show("12桁または13桁のコードを指定してください。", "JAN-13", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return New Bitmap(1, 1)
End If
Dim Quiet As Integer = ModuleWidth * 10 'クワイエットゾーン
Dim code_images As New List(Of Byte) 'コードの描画ビットイメージ
Dim check_digit() As Integer = New Integer() {0, 0, 0} 'チェックデジット
Dim codes(12) As Integer 'コードの数値配列
For i As Integer = 0 To code.Length - 1
If Integer.TryParse(code.Substring(i, 1), codes(i)) = False Then
MessageBox.Show("数値以外のコードが含まれています。", "JAN-13", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return New Bitmap(1, 1)
End If
Next
check_digit(0) = codes(0)
For i As Integer = 1 To codes.Length - 2
If i <= 6 Then
If (bit_image(codes(0))(2) And (1 << (-i + 6))) <> 0 Then '付加文字を判定
code_images.Add(bit_image(codes(i))(0)) '左側奇数パリティ
Else
code_images.Add(bit_image(codes(i))(1)) '左側偶数パリティ
End If
Else
code_images.Add((Not (bit_image(codes(i))(0))) And &H7F) '右側偶数パリティ(左側奇数パリティの反転)
End If
If i Mod 2 = 0 Then
check_digit(0) += codes(i)
Else
check_digit(1) += codes(i)
End If
Next
' チェックデジットの処理
check_digit(2) = 10 - Integer.Parse((check_digit(0) + check_digit(1) * 3).ToString.PadLeft(6, "0").Substring(5, 1))
check_digit(2) = If(check_digit(2) = 10, 0, check_digit(2))
If code.Length = 13 AndAlso check_digit(2) <> codes(12) Then '引数が13桁の時、チェックデジットを比較
MessageBox.Show("チェックデジットが一致しません。", "JAN-13", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return New Bitmap(1, 1)
End If
codes(12) = check_digit(2)
code_images.Add((Not (bit_image(codes(12))(0))) And &H7F)
'描画先とするImageオブジェクトを作成する
Dim char_width As Integer = ModuleWidth * 7
Dim canvas_width As Integer = Quiet * 2 + ModuleWidth * (3 + 5 + 3) + code_images.Count * char_width
Dim canvas_height As Integer = (canvas_width - Quiet * 2) * 0.3
Dim canvas As New Bitmap(canvas_width, canvas_height)
'ImageオブジェクトのGraphicsオブジェクトを作成する
Using g As Graphics = Graphics.FromImage(canvas)
Dim pos As Integer = Quiet
g.FillRectangle(Brushes.White, 0, 0, canvas.Width, canvas.Height)
For cnt As Integer = 0 To code_images.Count - 1
If cnt = 0 Then
pos = PrintBar(g, 5, pos, 3, canvas.Height) '左側のガードバー
ElseIf cnt = 6 Then
pos = PrintBar(g, 10, pos, 5, canvas.Height) 'センターバー
End If
pos = PrintBar(g, code_images(cnt), pos, 7, canvas.Height) 'コード
If cnt = code_images.Count - 1 Then
PrintBar(g, 5, pos, 3, canvas.Height) '右側のガードバー
End If
Next
End Using
Return canvas
End Function
''' <summary>
''' JAN-8 バーコードイメージを作る。
''' </summary>
''' <param name="code">バーコード文字列</param>
''' <returns>バーコードイメージ</returns>
Friend Function MakeBarcode8(ByVal code As String) As System.Drawing.Image
If code.Length <> 7 And code.Length <> 8 Then
MessageBox.Show("7桁または8桁のコードを指定してください。", "JAN-8", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return New Bitmap(1, 1)
End If
Dim Quiet As Integer = ModuleWidth * 10 'クワイエットゾーン
Dim code_values As New List(Of Byte) 'コードの描画ビットイメージ
Dim check_digit() As Integer = New Integer() {0, 0, 0} 'チェックデジット
Dim codes(7) As Integer 'コードの数値配列
For i As Integer = 0 To code.Length - 1
If Integer.TryParse(code.Substring(i, 1), codes(i)) = False Then
MessageBox.Show("数値以外のコードが含まれています。", "JAN-8", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return New Bitmap(1, 1)
End If
Next
For i As Integer = 0 To codes.Length - 2
If i <= 3 Then
code_values.Add(bit_image(codes(i))(0)) '左側奇数パリティ
Else
code_values.Add((Not (bit_image(codes(i))(0))) And &H7F) '右側偶数パリティ(左側奇数パリティの反転)
End If
If i Mod 2 = 0 Then
check_digit(1) += codes(i)
Else
check_digit(0) += codes(i)
End If
Next
check_digit(2) = 10 - Integer.Parse((check_digit(0) + check_digit(1) * 3).ToString.PadLeft(6, "0").Substring(5, 1))
check_digit(2) = If(check_digit(2) = 10, 0, check_digit(2))
If code.Length = 8 AndAlso check_digit(2) <> codes(7) Then '引数が8桁の時、チェックデジットを比較
MessageBox.Show("チェックデジットが一致しません。", "JAN-8", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return New Bitmap(1, 1)
End If
codes(7) = check_digit(2)
code_values.Add((Not (bit_image(codes(7))(0))) And &H7F)
'描画先とするImageオブジェクトを作成する
Dim char_width As Integer = ModuleWidth * 7
Dim canvas_width As Integer = Quiet * 2 + ModuleWidth * (3 + 5 + 3) + code_values.Count * char_width
Dim canvas_height As Integer = (canvas_width - Quiet * 2) * 0.15
Dim canvas As New Bitmap(canvas_width, canvas_height)
'ImageオブジェクトのGraphicsオブジェクトを作成する
Using g As Graphics = Graphics.FromImage(canvas)
Dim pos As Integer = Quiet
g.FillRectangle(Brushes.White, 0, 0, canvas.Width, canvas.Height)
For cnt As Integer = 0 To code_values.Count - 1
If cnt = 0 Then
pos = PrintBar(g, 5, pos, 3, canvas.Height) '左側のガードバー
ElseIf cnt = 4 Then
pos = PrintBar(g, 10, pos, 5, canvas.Height) 'センターバー
End If
pos = PrintBar(g, code_values(cnt), pos, 7, canvas.Height) 'コード
If cnt = code_values.Count - 1 Then
PrintBar(g, 5, pos, 3, canvas.Height) '右側のガードバー
End If
Next
End Using
Return canvas
End Function
''' <summary>
''' バーコードの1アイテムを描画
''' </summary>
''' <param name="g">Graphics</param>
''' <param name="item">描画するアイテム</param>
''' <param name="pos">描画開始位置</param>
''' <param name="bit_count">描画アイテムのビット長</param>
''' <param name="height">バーの高さ</param>
''' <returns>描画終了位置</returns>
Private Function PrintBar(g As Graphics, item As Byte, pos As Integer, bit_count As Integer, height As Single) As Integer
For i As Integer = bit_count - 1 To 0 Step -1
If (item And (1 << i)) = 0 Then
pos += ModuleWidth
Else
'--- ﾊﾞｰを描画
For j As Integer = 1 To ModuleWidth
Using p As New Pen(Color.Black, 1)
g.DrawLine(p, pos, 0, pos, If(bit_count < 7, height, height * 5 / 6))
End Using
pos += 1
Next
End If
Next
Return pos
End Function
End Class
JAN-13とJAN-8のSystem.Drawing.Imageを返します。
使い方はこんな感じ。
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim JanCode As New JANCode With {
.ModuleWidth = 2
}
PictureBox1.Image = JanCode.MakeBarcode13("4547894155004")
PictureBox1.Image.Save("C:\JanCode.jpg")
End Sub
サンプルから作られた画像がこちら。
この画像を適当なサイズでプリントして使います。
今のところ数字は必要ないので描画してません。
もしもご要望があったりなんかしたら数字付けるかも。。
コメント