2016年12月1日木曜日

LibreBasicにいま持ってる知識で立ち向かってみる  法律勉強プログラムを作ってみるの巻 第5回

 取得した条文を整形して、

読みやすく加工する

<<第1回  <第4回                                                            第6回>

↑今回の成果ヽ(`▽´)/

必要なもの:

・自己責任を許容できる寛容な心
・プログラムをトライ&エラーできる程度の時間と勇気
・vlookupがどのように働くのか、理解できる程度の表計算経験
(今回はvlookup使わないですが、似たような概念は使ってます)
・BASICのプログラム経験

 

簡単な解説:

条文は条文シートから1行づつ取ってきているので、そのタイミングで整形することにした。
整形専用のサブルーチン
  • 条、項、号、イロハは行を変え、インデントをつけて表示する
  • 行に含まれる漢数字は”全て”アラビア数字に変換(変換パターン2つに対応w)
    • 百十条 → 110条
    • 百十条 → 一一〇条 ←後で使う事になるのさ
    • 逆変換はできません(;・∀・)

↑おおかたこんな感じの表示になります

↑無慈悲な変換w



LibreOffice(≒OpenOffice)には無いらしい…ので、あえなく自作せざるを得ない。
・文字列置換関数
・漢数字をアラビア数字に変化する関数


以下、今回追加した関数

'一行整形サブルーチン
Function reformoneline(oneline as string)
            oneline = oneline + chr(13) + chr(13) ' 条、項の後には改行を
            ' 号は桁を下げる
            if instr(1, oneline, "一") = 1 or instr(1, oneline, "二") = 1 or instr(1, oneline, "三") =1 or instr(1, oneline, "四") =1 or instr(1, oneline, "五") =1 _
                 or instr(1, oneline, "六") =1 or instr(1, oneline, "七") =1 or instr(1, oneline, "八") =1 or instr(1, oneline, "九") =1 then
                    oneline = "    " + oneline
            end if
           
            ' イロハニ
            if instr(1, oneline, "イ") = 1 or instr(1, oneline, "ロ") = 1 or instr(1, oneline, "ハ") =1 or instr(1, oneline, "ニ") =1 or instr(1, oneline, "ホ") =1 _
                 or instr(1, oneline, "ヘ") =1 or instr(1, oneline, "ト") =1 or instr(1, oneline, "チ") =1 or instr(1, oneline, "リ") =1 then
                    oneline = "        " + oneline
            end if
   
            oneline = replace(oneline,"若しくは"," 若しくは ")
            oneline = replace(oneline,"又は"," 又は ")
            oneline = replace(oneline,"及び"," 及び ")
            oneline = replace(oneline,"並びに"," 並びに ")
            oneline = replace(oneline,"あつた", "あった")
            oneline = replace(oneline,"かつた", "かった")
            oneline = replace(oneline,"かつ"," かつ ") ' ←且つ
   
            oneline =  reFMT(oneline,1) ' 1条文中の漢数字をアラビア数字に変換


            reformoneline = oneline
end function

Sub changeJoubunField(someAjobun as string)
        oDialog.getControl("TextField1").text = someAjobun
end sub

' 漢数字変換サブルーチン
' 文字列中の漢数字を全て入れ替える
' 一般漢数字の千まで対応できるはず
function reFMT(nKnj as string, sw as integer)
        Dim nArb as string
        Dim nLen as Integer
        Dim tmp0 as integer
        Dim tmp1 as integer
        Dim tmp2 as integer
        Dim tmp3 as integer
        Dim total as integer

        if nKnj = "" then
            reFMT = ""
        end if

        nLen = len(nKnj)
        for i=1 to nLen
                if mid(nknj, i, 1) = "一" then
                    tmp0 = 1
                elseif mid(nknj, i, 1) = "二" then
                    tmp0 = 2
                elseif mid(nknj, i, 1) = "三" then
                    tmp0 = 3
                elseif mid(nknj, i, 1) = "四" then
                    tmp0 = 4
                elseif mid(nknj, i, 1) = "五" then
                    tmp0 = 5
                elseif mid(nknj, i, 1) = "六" then
                    tmp0 = 6
                elseif mid(nknj, i, 1) = "七" then
                    tmp0 = 7
                elseif mid(nknj, i, 1) = "八" then
                    tmp0 = 8
                elseif mid(nknj, i, 1) = "九" then
                    tmp0 = 9
                elseif mid(nknj, i, 1) = "十" then
                    if tmp0>0 then
                        tmp1=tmp0*10
                        tmp0=0
                    else
                        tmp1=10
                    endif
                elseif mid(nknj, i, 1) = "百" then
                    if tmp0>0 then
                        tmp2=tmp0*100
                        tmp0=0
                    else
                        tmp2=100
                    endif
                elseif mid(nknj, i, 1) = "千" then
                    if tmp0>0 then
                        tmp3=tmp0*1000
                        tmp0=0
                    else
                        tmp3=1000
                    endif
                else
                    total = tmp0 + tmp1 + tmp2 + tmp3
                    if total >0 then
                            nArb = nArb & total & mid(nknj, i, 1)
                    else
                            nArb = nArb & mid(nknj, i, 1)
                    end if
                    tmp0=0
                    tmp1=0
                    tmp2=0
                    tmp3=0
                end if
        next i
       
        Dim nArbKnj as string
        nLen = len(nArb)
        for i = 1 to nLen
                tmp = Mid(nArb, i, 1)
                if tmp = "1" then
                    tmp="一"
                elseif tmp = "2" then
                    tmp = "二"
                elseif tmp = "3" then
                    tmp ="三"
                elseif tmp = "4" then
                    tmp ="四"
                elseif tmp = "5" then
                    tmp ="五"
                elseif tmp = "6" then
                    tmp ="六"
                elseif tmp = "7" then
                    tmp ="七"
                elseif tmp = "8" then
                    tmp ="八"
                elseif tmp = "9" then
                    tmp ="九"
                elseif tmp = "0" then
                    tmp ="〇"
                else
                end if
               
                nArbKnj=nArbKnj & tmp
        next i
       
        if sw = 1 then
            reFMT = nArb
        elseif sw = 0 then
            reFMT = nArbKnj
        end if
end function

Function ReplacePlural(strData, strReplace,  avarFind) As String
'概要 : 文字列内を指定の複数の文字列で検索して一括置換する
'引数 :  strData 置換対象の元の文字列
'           strReplace 置換後の文字列
'           avarFind 検索する文字列(任意の複数の文字列を指定可)
'返り値 : 置換後の文字列

  Dim schar As Variant
  Dim Result as String
  Result = strData
 
  For Each schar In avarFind
    Result = Replace(Result, schar, strReplace)
  Next schar
 
  ReplacePlural = Result
End Function

Function Replace(Source As String, Search As String, NewPart As String)
  Dim Result As String
  Dim StartPos As Long
  Dim CurrentPos As Long

  Result = ""
  StartPos = 1
  CurrentPos = 1

  If Search = "" Then
    Result = Source
  Else
    Do While CurrentPos <> 0
      CurrentPos = InStr(StartPos, Source, Search)
      If CurrentPos <> 0 Then
        Result = Result + Mid(Source, StartPos, _
        CurrentPos - StartPos)
        Result = Result + NewPart
        StartPos = CurrentPos + Len(Search)
      Else
        Result = Result + Mid(Source, StartPos, Len(Source))
      End If                ' Position <> 0
    Loop
  End If

  Replace = Result
End Function

Function changNKNJtoNARB(nknj as string)
end Function