点字を書く 26 (点字凹面を出力する)
◆ Mission5. 点字凹面を出力する ◆ 凹面出力するように、マクロを修正した。Option ExplicitPrivate Declare Function IbukiTenSetup Lib "ibukiTenC.dll" _ Alias "?IbukiTenSetup@@YGHPBD0@Z" _ (ByVal sDic As String, ByVal sPATH As String) As LongPrivate Declare Function IbukiTenGetNabcc Lib "ibukiTenC.dll" _ Alias "?IbukiTenGetNabcc@@YGHPBDPADPAHH_N3H@Z" _ (ByVal sSource As String, ByVal sNabcc As String, _ ByVal lTaiou As Long, ByVal lLength As Long, _ ByVal lIsFirstTextInParagrath As Long, _ ByVal lIsNumberWago As Long, _ ByVal lTransBrlMode As Long) As Long'NABCC(&h20~&h7F)の凹面対応ASCIIPrivate Const S_CONCAVE = "20,7A,31,76,6E,6D,79,2C,29,28,2F,75,27,2D,6B,2A," _ & "38,22,3B,33,36,39,34,37,30,35,73,32,3E,3D,3C,70," _ & "61,60,7E,63,66,69,64,67,6A,65,68,2E,7F,25,24,7B," _ & "3F,7D,77,3A,7C,2B,23,72,78,26,21,6F,74,71,62,6C," _ & "61,60,7E,63,66,69,64,67,6A,65,68,2E,7F,25,24,7B," _ & "3F,7D,77,3A,7C,2B,23,72,78,26,21,6F,74,71,62,6C"Private mfSetup As BooleanPrivate msConcave() As String'--------*---------*---------*---------*---------*---------*---------*---------' 点字一筆くん MacroPublic Sub 点字一筆くん() Const s_PATH As String = "C:\Program Files\ibukiTenC\dic\" Const l_MIN_BUF_SIZE As Long = 256 Const l_NO_FIRST_TEXT As Long = 0 '先頭2マス取らない Const l_NO_NUMBER_WAGO As Long = 0 '数字を和語にしない Const l_TRANSE_MODE_JPN1ENG As Long = 0 '日本語点訳1級英語 Dim i As Long Dim sSource As String Dim lBufSize As Long Dim sNabcc As String Dim sTaiou As String Dim lngRet As Long Dim lPos As Long Dim lCode As Long Dim sResult As String Dim sErrMes As String '未初期化の場合、点訳用辞書と凹面コードを指定します。 If Not mfSetup Then If IbukiTenSetup(s_PATH & "initdic.pat", s_PATH) = 0 Then MsgBox "辞書の読込に失敗しました" Exit Sub End If msConcave = Split(S_CONCAVE, ",") For i = 0 To (&H7F - &H20) msConcave(i) = Chr(CLng("&h" & msConcave(i))) Next mfSetup = True End If '原文に応じてバッファを確保 sSource = ActiveDocument.Content.Text lBufSize = l_MIN_BUF_SIZE + LenB(sSource) * 3 sNabcc = String(lBufSize, vbNullChar) sTaiou = String(lBufSize * 2, vbNullChar) 'DLL呼出:1文を入力して点訳を実行しNABCCコードを取得 Dim sDebug As String lngRet = IbukiTenGetNabcc(sSource, sNabcc, StrPtr(sTaiou), lBufSize, _ l_NO_FIRST_TEXT, l_NO_NUMBER_WAGO, l_TRANSE_MODE_JPN1ENG) If lngRet = 1 Then Do lPos = lPos + 1 lCode = Asc(Mid(sNabcc, lPos, 1)) If lCode = 0 Then Exit Do sDebug = sDebug & Hex$(lCode) & ":" sResult = msConcave(lCode - &H20) & sResult Loop ActiveDocument.Content.Text = sSource & vbCr & sDebug With ActiveDocument.Paragraphs Call .Add .Alignment = wdAlignParagraphLeft With .Last.Range .Font.Name = "Braille" .Font.Size = "22" .Text = Left$(sNabcc, lPos - 1) & vbCr & sResult End With End With Else Select Case lngRet Case -1: sErrMes = "入力テキストがありません" Case -2: sErrMes = "点訳に失敗しました" Case -3: sErrMes = "NABCC変換DLLの読み込みに失敗" Case -4: sErrMes = "バッファからあふれました" End Select MsgBox sErrMes End If End Sub 実行結果は。 最下行が、凹面の墨点字。よし、ばっちり裏返っている。