Public Class Form1
Private bmpBarcode As Bitmap
Private arySPreFixPTRN(10) As String ' プリフィックスパターンストア用
Private frmH As Integer = 0
Private nbarX As Integer = 0
Private nbarY As Integer = 0
Private drawPen As Pen
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
bmpBarcode = New Bitmap(PictureBox1.Width, PictureBox1.Height)
PictureBox1.Image = bmpBarcode
InitializePreFixPattern()
End Sub
Private Sub InitializePreFixPattern()
'************************************'
' バーコードの左側プリフィックス対応 '
' 奇数/偶数パリティデータ '
'************************************'
arySPreFixPTRN(0) = "111111"
arySPreFixPTRN(1) = "110100"
arySPreFixPTRN(2) = "110010"
arySPreFixPTRN(3) = "110001"
arySPreFixPTRN(4) = "101100"
arySPreFixPTRN(5) = "100110"
arySPreFixPTRN(6) = "100011"
arySPreFixPTRN(7) = "101010"
arySPreFixPTRN(8) = "101001"
arySPreFixPTRN(9) = "100101"
End Sub
'JAN13バーコードを作成()
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Not CheckJAN13Digit(MaskedTextBox1.Text) Then
BarcodeImageClear()
MessageBox.Show("JANコード入力エラー")
Else
WriteBarcode13(MaskedTextBox1.Text)
Dim sbmpFileName As String = Application.StartupPath + "\JAN13BCD" _
+ MaskedTextBox1.Text + ".bmp"
bmpBarcode.Save(sbmpFileName) ' 自動的にBMPファイルを作成登録
End If
End Sub
Private Function MakeJAN13Digit(ByVal sBarcode12 As String) As String
'*****************************************'
' MakeJAN13Digit("バーコード12桁文字列") '
' 13桁目のチェックデジットを生成して戻す '
' エラーチックは実施していない '
'*****************************************'
Dim nSum As Integer = 0
Dim nI As Integer
Dim aryCBarcode() As Char = New Char() {}
aryCBarcode = sBarcode12.ToCharArray()
'1. すべての偶数位置の数字を加算する。
For nI = 1 To 12 Step 2
nSum = nSum + Integer.Parse(aryCBarcode(nI).ToString())
Next
'2. 1の結果を3倍する
nSum *= 3
'3. すべての奇数位置の数字を加算する。
For nI = 0 To 11 Step 2
nSum = nSum + Integer.Parse(aryCBarcode(nI).ToString())
Next
'4. 2の答えと3の答えを加算する。
'5. 最後に4の結果の下1桁の数字を"10"から引く。
'6. 下1桁が"0"となった場合は、チェックデジットはそのまま"0"となる。
'nSum = ((nSum / 10) + 1) * 10 - nSum
nSum = Strings.Right(10 - Strings.Right(nSum, 1), 1)
Return sBarcode12 + nSum.ToString()
End Function
Private Function CheckJAN13Digit(ByVal sBarcode13 As String) As Boolean
'*****************************************'
' CheckJAN13Digit("バーコード13桁文字列") '
' 13桁目のチェックデジットについて検証 '
' エラー時 falseで戻す '
'*****************************************'
If (sBarcode13.Length <> 13) Then
Return False
End If
If (sBarcode13 <> MakeJAN13Digit(sBarcode13.Substring(0, 12))) Then
Return False
End If
Return True
End Function
'JAN13バーコードを作成()
Private Sub BarcodeImageClear()
'*****************************************'
' pictureBox1の描画データをCLEARします '
' グラフィックスオブジェクトを取得し '
' 戻り時破棄しているので他の描画プロシー '
' ジャ内の描画処理の間にこの関数を呼ばな '
' いようにします '
'*****************************************'
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
g.Clear(Color.White)
PictureBox1.Refresh()
g.Dispose()
End Sub
Private Sub SetDrawStartPoint()
'*****************************************'
' pictureBox1に描画するバーコード線の開始 '
' 位置を設定します。 '
'*****************************************'
frmH = PictureBox1.Height - 26
nbarX = 14
nbarY = 4
drawPen = New Pen(Color.Black, 1)
End Sub
Private Sub WriteBarcode13(ByVal sBarcode13 As String)
'*****************************************'
' WriteBarcode13("バーコード13桁文字列") '
' 13桁のバーコード数値をパラメータとして '
' 与える。バーコード数値についてチェック '
' 行っていないので事前に '
' CheckJAN13Digit(string sBarcode13)を実 '
' 行すること '
' バーコードを描画するメインプロシージャ '
'*****************************************'
Dim nI As Integer
Dim fGothic10 As Font = New Font("ＭＳ ゴシック", 10)
Dim aryCBarcode() As Char = New Char() {}
aryCBarcode = sBarcode13.ToCharArray()
Dim nPreFix = Integer.Parse(aryCBarcode(0).ToString())
Dim PreFixPTRN() As Char = arySPreFixPTRN(nPreFix).ToCharArray()
BarcodeImageClear()
SetDrawStartPoint()
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
g.DrawString(aryCBarcode(0).ToString(), fGothic10, Brushes.Black, nbarX - 8, frmH + 8)
WriteGuardBar(g)
For nI = 1 To 6
g.DrawString(aryCBarcode(nI).ToString(), fGothic10, Brushes.Black, nbarX, frmH + 8)
WriteEachBarLine(g, aryCBarcode(nI), PreFixPTRN(nI - 1))
Next
WriteGuardBar(g)
For nI = 7 To 12
g.DrawString(aryCBarcode(nI).ToString(), fGothic10, Brushes.Black, nbarX, frmH + 8)
WriteEachBarLine(g, aryCBarcode(nI), "2")
Next
WriteGuardBar(g)
PictureBox1.Refresh()
g.Dispose()
End Sub
'JAN13バーコードを作成()
Private Sub WriteGuardBar(ByVal g As Graphics)
'*****************************************'
' バーコードのガードバーを描画する。 '
' 両端と中央に縦線を入れる '
' WriteBarcode13(string sBarcode13) から '
' 呼ばれる '
'*****************************************'
nbarX = nbarX + 2
For nI = 0 To 1
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH + 16)
nbarX = nbarX + 4
Next
End Sub
Private Sub WriteEachBarLine(ByVal g As Graphics, ByVal cPos As Char, ByVal cPattern As Char)
'*****************************************'
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャへの分岐を担当 '
' WriteBarcode13から呼ばれる '
'*****************************************'
Select Case cPos
Case "0"
WriteBcd0(g, cPattern)
Case "1"
WriteBcd1(g, cPattern)
Case "2"
WriteBcd2(g, cPattern)
Case "3"
WriteBcd3(g, cPattern)
Case "4"
WriteBcd4(g, cPattern)
Case "5"
WriteBcd5(g, cPattern)
Case "6"
WriteBcd6(g, cPattern)
Case "7"
WriteBcd7(g, cPattern)
Case "8"
WriteBcd8(g, cPattern)
Case "9"
WriteBcd9(g, cPattern)
End Select
End Sub
Private Sub WriteBcd0(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (0)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
Case "1"
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 10
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
End Select
End Sub
Private Sub WriteBcd1(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (1)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
Case "1"
nbarX = nbarX + 2
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
End Select
End Sub
Private Sub WriteBcd2(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (2)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
nbarX = nbarX + 2
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
Case "1"
nbarX = nbarX + 2
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 8
End Select
End Sub
Private Sub WriteBcd3(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (3)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 10
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "1"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 8, frmH)
nbarX = nbarX + 10
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
End Select
End Sub
Private Sub WriteBcd4(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (4)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
nbarX = nbarX + 2
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "1"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 10
End Select
End Sub
Private Sub WriteBcd5(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (5)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 10
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "1"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 10
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
End Select
End Sub
Private Sub WriteBcd6(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (6)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "1"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 8, frmH)
nbarX = nbarX + 10
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 10
End Select
End Sub
Private Sub WriteBcd7(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (7)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
nbarX = nbarX + 2
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "1"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
End Select
End Sub
Private Sub WriteBcd8(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (8)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
Case "1"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 8
End Select
End Sub
Private Sub WriteBcd9(ByVal g As Graphics, ByVal cPattern As Char)
'*****************************************'
' バーコード値 (9)に対応 '
' バーコード数値に応じた各バーコード線を '
' 描画するプロシージャ '
' WriteEachBarLineから呼ばれる '
'*****************************************'
Select Case cPattern
Case "0"
nbarX = nbarX + 2
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
Case "1"
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 4
g.FillRectangle(Brushes.Black, nbarX, nbarY, 4, frmH)
nbarX = nbarX + 6
Case "2"
g.FillRectangle(Brushes.Black, nbarX, nbarY, 6, frmH)
nbarX = nbarX + 8
g.FillRectangle(Brushes.Black, nbarX, nbarY, 2, frmH)
nbarX = nbarX + 6
End Select
End Sub
End Class
最終更新：2012年12月28日 23:48
