同人誌にバーコードを付ける。2
以前のエントリで書いた、フリーバーコードフォント用文字列書き出しプログラムの続きです。
JANコード標準13桁、短絡8桁とチェックディジット算出に対応まで。
まだExcelマクロの標準モジュールでしか動いていないので、次はVBSに対応させる予定です。
BarFont.bas
' ' BarFont(JAN)補助モジュール ' ' version 0.02 ' Jan 05, 2014 ' ' by REGEKATSU ' ' release ' ' version 0.02 ' JANコード標準なら12〜13桁、短絡なら7〜8桁での入力に対応しています ' (チェックディジットの計算機能が備わっています。)。 ' ' version 0.01 ' JANコード13桁のみ対応しています。12桁での入力には対応していません ' (チェックディジットの計算機能はありません。)。 ' '入力ボックスに指定されたJANコード標準13桁又は短絡8桁に対するバーコード表示用文字列を、 '同じく入力ボックスに出力します。 '入力無しかキャンセルボタンをクリックすることで、処理が終了します。 Public Sub JanCodeToFontChar() Const DEFAULT_PROMPT As String = "JANコード標準13桁又は短絡8桁を入力してください。" 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 "############" Or inputCode Like "#############" Or _ inputCode Like "#######" Or inputCode Like "########" Then prompt = DEFAULT_PROMPT & vbCrLf & vbCrLf & "前回入力JANコード: " & 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 '指定したJANコード標準13桁又は短絡8桁に対する、チェックディジットを返します。 ' 'パラメータ janCode: バーコードの文字列。 ' 標準なら12〜13桁、短絡なら7〜8桁で指定 '戻り値 チェックディジット1桁の文字列。 ' 指定に誤りがあれば空白スペースを返す ' Public Function CalcCheckDigit(janCode As String) As String Dim i, j As Integer Dim checkOdd As Integer Select Case Len(janCode) '短絡8桁の場合。 Case 7, 8 For i = 1 To 7 '奇数桁が何文字目か調べる '(チェックデジットを除いた1番右側より奇数桁、右から2番目を偶数桁…と数える。)。 If i Mod 2 = 1 Then checkOdd = 1 Else checkOdd = 0 End If '奇数桁の数を3倍に、偶数桁の数を1倍にして全てを合計する。 j = j + (Asc(Mid(janCode, i, 1)) And &HF) * (1 + 2 * checkOdd) Next '合計の1の位を10から引いた数がチェックディジットなので、戻り値として返す。 CalcCheckDigit = Chr$(48 + (10 - (j Mod 10)) Mod 10) '標準13桁の場合。 Case 12, 13 For i = 1 To 12 '奇数桁が何文字目か調べる '(チェックデジットを除いた1番右側より奇数桁、右から2番目を偶数桁…と数える。)。 If i Mod 2 = 0 Then checkOdd = 1 Else checkOdd = 0 End If '奇数桁の数を3倍に、偶数桁の数を1倍にして全てを合計する。 j = j + (Asc(Mid(janCode, i, 1)) And &HF) * (1 + 2 * checkOdd) Next '合計の1の位を10から引いた数がチェックディジットなので、戻り値として返す。 CalcCheckDigit = Chr$(48 + (10 - (j Mod 10)) Mod 10) '標準13桁又は短絡8桁以外の桁数だった場合。 Case Else '指定に誤りがあるので空白スペースを、戻り値として返す。 CalcCheckDigit = " " End Select End Function 'BarFont(JAN)を利用した、バーコード描画関数です。 '指定したJANコード標準13桁又は短絡8桁、及びロングバーの有無に対する、 'バーコード表示用文字列を返します。 ' 'JANコード標準なら12〜13桁、短絡なら7〜8桁での入力に対応しています '(チェックディジットの計算機能が備わっています。)。 ' 'パラメータ janCode: バーコードの文字列。 ' 標準なら12〜13桁、短絡なら7〜8桁で指定 ' noUseLongBar: ロングバーを使わない場合True '戻り値 バーコードで表現される文字列 ' 指定に誤りがあればNULL文字列を返す ' Public Function ConvertFontChar(janCode As String, noUseLongBar As Boolean) As String '変換文字列用変数。 Dim janConv As String janConv = "" 'JANコード13桁用、パリティビット算出用テーブル。 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) Dim i As Integer Select Case Len(janCode) '短絡8桁の場合。 Case 7, 8 janCode = Mid(janCode, 1, 7) & CalcCheckDigit(janCode) '左側4桁に対する、キャラクタをセットしていく。 For i = 1 To 4 janConv = janConv + Chr$(Asc(Mid(janCode, i, 1)) + &H20) Next 'センターバーをセットする。 janConv = janConv & Chr$(&H2B - noUseLongBar - 1) '右側6桁に対するキャラクタをセットする。 janConv = janConv & Mid(janCode, 5, 4) '標準13桁の場合。 Case 12, 13 janCode = Mid(janCode, 1, 12) & CalcCheckDigit(janCode) '左側7桁に対する、パリティビットに基づいたキャラクタをセットしていく。 Dim parityCheck, 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) '指定に誤りがあった場合。 Case Else janConv = "" End Select '右ガイドバーをセットする。 If janConv <> "" Then janConv = janConv & Chr$(&H29 - noUseLongBar - 1) '変換文字列を返す。 ConvertFontChar = janConv End Function
今日から僕もプログラマ(職業的な意味で。)。
過去の案件見たりして、プロの仕事スゲーって思いました。
ちゃんと勤まるのか早くも不安がギュンギュンと募るばかりです。
同人誌にバーコードを付ける。
同人誌に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
コミックマーケット85
今年末、東京ビッグサイトにて行われるコミックマーケット85にサークル参加する事となりました。
頒布物は新刊と、夏に出した既刊になります。
今回も新刊で取り上げた製作例を展示してお待ちしておりますので、宜しければ是非お立ち寄りください。
レトロゲーム活用研究同好会
日時: 2013/12/31(火)
場所: 東京ビッグサイト
スペース: 西地区“す”ブロック−27b
新刊:
誌名: レトロゲーム活用研究同好会会報 PART02 -GBAスロットはPIOの夢を見るか?-
表紙:
サイズ: B5
価格: 200円
内容:
ニンテンドーDS〜DS LiteにあるGBAスロットの制御方法について解説した本です。
既刊:
誌名: レトロゲーム活用研究同好会会報 PART01 -DSに自作ハードを繋ぐ試み-
表紙:
サイズ: B5 40p
価格: 300円
内容:
ニンテンドーDSに繋いだ自作ハードをプログラムから制御する方法について解説した本です。
原稿が進まない。
いくら頭で練ってても結果が得られてない状態だと文章にまとまらない。
理論とか回路図とかプログラムは大体整えたんだけど試作回路のハンダ付けに時間食ってる。
DS の GBA Slot は一般的なマイコンと違ってラッチ機構持たないから固定的な出力はそもそも出来なくて
74HC573とか74HC574等のラッチ回路咬ます必要があるのと、ポートがビット単位で指定出来ないってのは理解した。
AD0 〜 AD15 の unsigned short (u16) か A16 〜 A23 の unsigned char (u8) かでそれぞれ入出力選べるハズなので
全て実証すれば PIO 実験のレポとして体裁は保てる感じ。
この調子では今回もギリギリ展開な予感な悪寒。
コミックマーケット85 受かりました。
ちゅーことで本文書いたりテストプログラム作ったりしてます。
コミケウェブカタログって当落確定すると、全サークルの当・落・抽選漏れが全て調べられちゃうんですね。
冊子及びROM版出るまでの間サークル参加情報を隠蔽出来なくなってしまった訳ですか、そうですか。