FreeBASIC 般若心経を画面に表示

'作成 2019/06/01 
Dim As String mojiretsu 
Dim As Integer mojisu
Dim As Integer i

Declare Function KLen (mojiretsu As String) As Integer
Declare Function KMid (mojiretsu As String, start As Integer, mojisu As Integer) As String

'般若心経
'http://www.matsumasa.com/report/heartsutra/3.html
'http://hannya.kakukaku-sikajika.com/

Dim kana(60) As String ={"まかはんにゃはらみったしんぎょう","かんじざいぼさつ","ぎょうじんはんにゃはらみったじ" _
,"しょうけんごうんかいくう","どいっさいくやく","しゃりし","しきふいくう","くうふいしき","しきそくぜくう","くうそくぜしき" _
,"じゅそうぎょうしきやくぶにょぜ","しゃりし","ぜしょほうくうそう","ふしょうふめつ","ふくふじょう","ふぞうふげん" _
,"ぜこくうちゅう","むしき","むじゅそうぎょうしき","むげんにびぜっしんに","むしきしょうこうみそくほう","むげんかい" _
,"ないし","むいしきかい","むむみょう","やくむむみょうじん","ないし","むろうし","やくむろうしじん","むくしゅうめつどう" _
,"むちやくむとく","いむしょとっこ","ぼだいさった","えはんにゃはらみったこ","しんむけげ","むけげこ","むうくふ" _
,"おんりいっさいてんどうむそう","くきょうねはん","さんぜしょうぶつ","えはんにゃはらみったこ" _
,"とくあのくたらさんみゃくさんぼだい","こち","はんにゃはらみった","ぜだいじんしゅ","ぜだいみょうしゅ","ぜむじょうしゅ" _
,"ぜむとうどうしゅ","のうじょいっさいく","しんじつふこ","こせつ","はんにゃはらみったしゅ","そくせつしゅわつ" _
,"ぎゃていぎゃてい","はらぎゃてい","はらそうぎゃてい","ぼじそわか","はんにゃしんぎょう"}
Dim kanji(60) As Wstring * 40 ={"摩訶般若波羅蜜多心経","観自在菩薩","行深般若波羅蜜多時" _
,"照見五蘊皆空","度一切苦厄","舎利子","色不異空","空不異色","色即是空","空即是色" _
,"受・想・行・識亦復如是","舎利子","是諸法空相","不生不滅","不垢不浄","不増不減" _
,"是故空中","無色","無受・想・行・識","無眼・耳・鼻・舌・身・意","無色・声・香・味・触・法","無眼界" _
,"乃至","無意識界","無無明","亦無無明尽","乃至","無老死","亦無老死尽","無苦・集・滅・道" _
,"無智亦無得","以無所得故","菩提薩埵","依般若波羅蜜多故","心無罣礙" _
,"無罣礙故","無有恐怖","遠離一切顛倒夢想","究竟涅槃","三世諸仏","依般若波羅蜜多故" _
,"得阿耨多羅三藐三菩提","故知","般若波羅蜜多","是大神呪","是大明呪","是無上呪" _
,"是無等等呪","能除一切苦","真実不虚","故説","般若波羅蜜多呪","即説呪曰" _
,"羯諦羯諦","波羅羯諦","波羅僧羯諦","菩提薩婆訶","般若心経"}
Dim mojisuu As Integer
Dim gyosuu As Integer
Dim gyoClear As Integer
#Include "windows.bi"
Dim KeyInput As Integer

Do

   Locate 2
   
   For gyosuu =1 To 58
      If gyosuu Mod 20 =0  Then 
         For gyoClear =1 To 25
            Print Space(50)
         Next gyoClear
         Cls
         Locate 1
      End If
   
      For mojisuu=1 To KLen(kana(gyosuu-1))
         Print KMid(kana(gyosuu-1),mojisuu,1);
         Sleep(200)
      Next mojisuu

      Sleep (1000)
      Print
      Locate 1+(gyosuu Mod 20)
      Print Space(Len(kana(gyosuu-1)))
      Locate 1+(gyosuu Mod 20)
      Print kanji(gyosuu-1)
      If gyosuu  Mod 20 =19  Then Sleep (1000)
   Next gyosuu
   
   Print
   Print "　　([Esc]キーで終了します)"
   KeyInput = Getkey ' [27]=[Esc] キー入力するまで、繰返す
   If KeyInput = 27 Then
      End
   Else
      For gyoClear =1 To 25
         Print Space(50)
      Next gyoClear
      Cls
   End If
   
Loop



Function KLen (mojiretsu As String) As Integer
    Dim i As Integer
    Dim cCode As Integer
    Dim Result As Integer

    Result = 0

    For i = 1 To Len(mojiretsu)
        cCode = Asc(Mid(mojiretsu, i, 1))
        If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF) Then 'コードが2バイト文字の範囲なら
            i = i + 1
        End If
        Result = Result + 1 
    Next i
    KLen = Result
End Function

Function KMid (mojiretsu As String, start As Integer, mojisu As Integer) As String
   Dim inS As Integer
   Dim inN As Integer
   Dim cCode As Integer
   Dim Counter As Integer
   Dim Modori As Integer
   
   Counter = 0
   inS = 0
   While Counter < start
      Modori = 1
      inS = inS + 1
      cCode = Asc(Mid(mojiretsu, inS, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         inS = inS + 1
         Modori = 2
      End If
      Counter = Counter + 1
   Wend
   
   Counter = 0
   inN = 0
   While Counter < mojisu
      inN = inN + 1
      cCode = Asc(Mid(mojiretsu, inS - Modori + inN, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         inN = inN + 1
      End If
      Counter = Counter + 1
   Wend
   
   KMid = Mid (mojiretsu,inS - Modori + 1 ,inN)
End Function