同人誌にバーコードを付ける。


同人誌にISDNなるバーコードを付けてみた。


ISDN - 国際標準同人誌番号
http://isdn.jp/


ISBNをパロったインストアJANコード
「司書にゃん」なる蔵書管理アプリが同人誌DBとして使ってたり。


んで、このコードを書籍バーコード風にして貼り付けたいと思った訳だが、
・左右センターバー含め全て均一サイズ
・バーコードの下にOCR Bフォントで数字を表記
という書式で吐き出してくれる無料なWebサービスは無いっぽかった。


じゃあ別のアプローチってんで、ベクターにあったフリーのJANバーコードフォントを入手。


バーコードフォント(サンプル版)
http://www.vector.co.jp/soft/data/writing/se293727.html


このフォント、単純に整数13桁入れてもまともなバーコードは生成されないので、
付属のDelphiコードをExcelVBAに部分移植した。


マクロで出力した文字列を、上記バーコードフォントで表示することで
ようやく正しいバーコードが生成されるようになった。
が、今欲してた必要最小限でしか組んでないのでコミケが無事終わって落ち着いてきたら、
チェックディジット算出と短絡8桁も含めたVBSに手直しする予定。


BarFont.bas

'
'   BarFont(JAN)補助モジュール
'
'   version 0.01
'   Dec 23, 2013
'
'   by REGEKATSU
'
'   release
'
'   version 0.01
'   JANコード13桁のみ対応しています。12桁での入力には対応していません
'   (チェックディジットの計算機能はありません。)。
'

'入力ボックスに指定されたJANコード13桁に対するバーコード表示用文字列を、同じく入力ボックスに出力します。
'入力無しかキャンセルボタンをクリックすることで、処理が終了します。
Public Sub JanCodeToFontChar()
    
    Const DEFAULT_PROMPT As String = "JANコード13桁を入力してください。"
    Dim prompt As String
    prompt = DEFAULT_PROMPT
    Dim promptNoUseLongBar As String
    Dim inputNoUseLongBar As Boolean
    Dim inputCode As String
    inputCode = ""
    
    Do
        inputCode = InputBox(prompt, "バーコードフォント、表示用変換マクロ", inputCode)
        If inputCode Like "#############" Then
            prompt = DEFAULT_PROMPT & vbCrLf & vbCrLf & "前回JANコード13桁: " & inputCode & vbCrLf
            If MsgBox("バーコードの高さを均一に揃えますか?" & vbCrLf & vbCrLf & _
                "はい(Y): 同サイズ, いいえ(N): ロング", vbYesNo Or vbQuestion, _
                "指定") = vbYes Then
                inputNoUseLongBar = True
                promptNoUseLongBar = "同サイズ"
            Else
                inputNoUseLongBar = False
                promptNoUseLongBar = "ロング"
            End If
            prompt = prompt & "前回バーコードサイズ: " & promptNoUseLongBar & vbCrLf
            inputCode = ConvertFontChar(inputCode, inputNoUseLongBar)
            prompt = prompt & "前回表示用文字列: " & inputCode
            MsgBox "変換が完了しました。", vbInformation, "完了"
        ElseIf inputCode <> "" Then
            MsgBox "入力に誤りがあります。", vbCritical, "エラー"
        End If
    Loop While inputCode <> ""
    
End Sub

'BarFont(JAN)を利用した、バーコード描画関数です。
'指定したJANコード13桁及びロングバーの有無に対する、バーコード表示用文字列を返します。
'
'JANコード13桁のみ対応しています。12桁での入力には対応していません
'(チェックディジットの計算機能はありません。)。
'
'パラメータ janCode:        バーコードの文字列
'           noUseLongBar:   ロングバーを使わない場合True
'戻り値     バーコードで表現される文字列
'
Public Function ConvertFontChar(janCode As String, noUseLongBar As Boolean) As String
    
    '変換文字列用変数。
    Dim janConv As String
    janConv = ""
    
    'パリティビット算出用テーブル。
    Dim combiTable(2 To 7) As Byte
    combiTable(2) = 32
    combiTable(3) = 16
    combiTable(4) = 8
    combiTable(5) = 4
    combiTable(6) = 2
    combiTable(7) = 1
    Dim prifixTable(9) As Byte
    prifixTable(0) = 0  '000000b
    prifixTable(1) = 11 '001011b
    prifixTable(2) = 13 '001101b
    prifixTable(3) = 14 '001110b
    prifixTable(4) = 19 '010011b
    prifixTable(5) = 25 '011001b
    prifixTable(6) = 28 '011100b
    prifixTable(7) = 21 '010101b
    prifixTable(8) = 22 '010110b
    prifixTable(9) = 26 '011010b
    
    '左ガイドバーをセットする。
    janConv = janConv & Chr$(&H29 - noUseLongBar - 1)
    '左側7桁に対する、パリティビットに基づいたキャラクタをセットしていく。
    Dim parityCheck As Integer
    Dim i, x As Integer
    '左1文字目を取得して、使用するパリティテーブルを決定する。
    x = Asc(Mid(janCode, 1, 1)) And &HF
    '使用するパリティテーブルに基づいて2〜7文字目の、奇数または偶数パリティのキャラクタをセットしていく。
    For i = 2 To 7
        parityCheck = 0
        If (combiTable(i) And prifixTable(x)) = 0 Then parityCheck = 1
        janConv = janConv + Chr$(Asc(Mid(janCode, i, 1)) + &H10 + (&H10 * parityCheck))
    Next
    'センターバーをセットする。
    janConv = janConv & Chr$(&H2B - noUseLongBar - 1)
    '右側6桁に対するキャラクタをセットする。
    janConv = janConv & Mid(janCode, 8, 6)
    '右ガイドバーをセットする。
    janConv = janConv & Chr$(&H29 - noUseLongBar - 1)
    
    '変換文字列を返す。
    ConvertFontChar = janConv
    
End Function