VB写的古诗格律检测程序

【实例简介】VB写的古诗格律检测程序，方便实用。
【实例截图】
【核心代码】Rem 根据给定的汉字拼音确定其平仄
Public Function PingZe(PinYin As String) As String
Dim sheng_Ary() As Variant
Dim PingZe_Ary() As Variant
Dim r As Integer

sheng_Ary = Array("ā", "á", "ǎ", "à", "ē", "é", "ě", "è", "ī", "í", "ǐ", "ì", "ō", "ó", "ǒ", _
                    "ò", "ū", "ú", "ǔ", "ù", "ǖ", "ǘ", "ǚ", "ǜ", "ü", "", "ń", "ň", "")
PingZe_Ary = Array("平", "平", "仄", "仄", "平", "平", "仄", "仄", "平", "平", "仄", "仄", "平", "平", "仄", _
                  "仄", "平", "平", "仄", "仄", "平", "平", "仄", "仄", "平", "平", "平", "仄", "仄")

For r = 0 To 28
    If InStr(PinYin, sheng_Ary(r)) > 0 Then
       PingZe = PingZe_Ary(r)
       Exit For
    End If
Next

Erase sheng_Ary
Erase PingZe_Ary

End Function

Rem 平水韵
Rem 判断汉字平仄

Function PinZeByYunKu(sWord As String, ykName As String) As String
  PinZeByYunKu = ""
  sWord = Trim(sWord)
  fnum = FreeFile
  Open App.Path & "\格律样式\" & ykName & ".zzq" For Input As #fnum
  s01 = ""
  s02 = ""
  Do Until EOF(fnum)
     Line Input #fnum, s00
     If Mid(s00, 6, 1) = sWord Then
        s01 = Mid(s00, 8, 1)
        If s02 <> "" Then
            If s01 <> s02 Then
                Exit Do
            End If
        Else
            s02 = s01
        End If
     End If
  Loop
  Close #fnum
  If s01 = s02 Then
        PinZeByYunKu = Trim(s01)
  Else
        PinZeByYunKu = "可平可仄"
  End If
End Function

Rem 判断汉字韵部
Function YunBuByYunKu(sWord As String, ykName As String) As String
    YunBuByYunKu = ""
    sWord = Trim(sWord)
    fnum = FreeFile
    Open App.Path & "\格律样式\" & ykName & ".zzq" For Input As #fnum
    Do Until EOF(fnum)
        Line Input #fnum, s00
        If Mid(s00, 6, 1) = sWord Then
            YunBuByYunKu = Mid(s00, 1, 1)
            Exit Do
        End If
    Loop
    Close #fnum
End Function