Option Explicit
Private Declare Function IbukiTenSetup Lib "ibukiTenC.dll" _
Alias "?IbukiTenSetup@@YGHPBD0@Z" _
(ByVal sDic As String, ByVal sPATH As String) As Long
Private 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)の凹面対応ASCII
Private 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 Boolean
Private msConcave() As String
'--------*---------*---------*---------*---------*---------*---------*---------
' 点字一筆くん Macro
Public 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 '日本語点訳１級英語
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
