JANコードを作ってみました

バーコードの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 &amp;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 &amp;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 &amp;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 &amp;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

サンプルから作られた画像がこちら。

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

Tweet