バーコードの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
サンプルから作られた画像がこちら。

この画像を適当なサイズでプリントして使います。
今のところ数字は必要ないので描画してません。
もしもご要望があったりなんかしたら数字付けるかも。。
コメント