Imports System.IO, System.Text Public Class Form1 Dim haifu = Path.Combine(Application.StartupPath, "totalhaihu.txt") Dim shutu = Path.Combine(Application.StartupPath, "shutu.txt") Dim dataa = Path.Combine(Application.StartupPath, "data.txt") Dim fs As FileStream Dim sr As StreamReader Dim bun As String = "" Dim names(4) As String Dim tensu(4) As Integer Dim gen(4) As String Dim tehai(4) As String Dim sute(4) As String Dim oya As Integer Dim souturn As Integer Dim maeturn As Integer Dim turn As Integer Dim koudou As Char Dim hai As String Dim agarifu As Integer Dim agarihan As Integer Dim honbaq As Integer Dim bakaze As String Dim ribou As Integer Dim nocount As Boolean Dim doras As String Dim dora1nomi As String Dim uras As String Dim tukai As String Dim yama As Integer Public tekatu As List(Of String) = New List(Of String)() Public agarihai0 As List(Of String) = New List(Of String)() Public agarihai1 As List(Of String) = New List(Of String)() Dim ritisha As List(Of Integer) = New List(Of Integer)() Dim ritijun As List(Of Integer) = New List(Of Integer)() Dim ritiagarihai(3, 14) As String Dim ritimati As List(Of Integer) = New List(Of Integer)() Dim ritiagarimai As List(Of Integer) = New List(Of Integer)() Dim ritida As Boolean Dim furoda As Boolean Dim furo(4) As Integer Dim furogo(4) As Integer Dim furonoten(4) As Boolean Dim furoagarihai(4, 14) As String Dim genbutumai(4, 4) As Integer Dim kansita(4) As Boolean Dim kyoku As Integer = 0 Dim risuu As Integer = 0 Dim ippatu As Boolean Dim houritu(20, 10) As Double Dim some(4) As Boolean '染め手か Dim histurnsu(4) As Integer Dim titoika(4, 18) As Boolean Dim saishutedasi(4) As String Dim ritisengenhai(4) As String Const KEKKA2 As Integer = 10 Const KEKKA3 As Integer = 1 Const KEKKA4 As Integer = 0 Dim kekka1(22, KEKKA2, KEKKA3, KEKKA4) As Long Sub hyouji() 'listbox1に結果を表示 Dim itebun As String Dim k As Integer = NumericUpDown1.Value Dim l As Integer = NumericUpDown2.Value For i As Integer = 1 To 18 itebun = i For j As Integer = 0 To KEKKA2 itebun &= ControlChars.Tab & kekka1(i, j, k, l) Next ListBox1.Items(i) = itebun Next End Sub Function haitoint(ByVal hai As String) '牌を整数で番号化（数牌１〜２７、字牌２８〜３４） Dim num As Integer If Integer.TryParse(hai.Chars(0), num) Then Select Case hai.Chars(1) Case "m" Case "p" num += 9 Case "s" num += 18 End Select Else Select Case hai Case "東" num = 28 Case "南" num = 29 Case "西" num = 30 Case "北" num = 31 Case "白" num = 32 Case "発" num = 33 Case "中" num = 34 End Select End If Return num End Function Function kesi2(ByVal sute As String) '末尾の牌を消去したものを返す Dim ato As String Dim a As Integer If sute.Length > 1 AndAlso Integer.TryParse(sute.Chars(sute.Length - 2), a) Then ato = sute.Remove(sute.Length - 2) Else ato = sute.Remove(sute.Length - 1) End If Return ato End Function Function miemai(ByVal mie As String, ByVal hai As String) 'mieの中にあるhaiの枚数を返す Dim mai As Integer = 0 Do While mie.Contains(hai) mai += 1 mie = mie.Substring(InStr(mie, hai)) Loop Return mai End Function Function yakuhai(ByVal hai As String, ByVal turn As Integer) 'haiがダブル役牌なら2、通常役牌なら1、非役牌なら0を返す Dim yaku As Integer = 0 Select Case hai Case "白", "発", "中" yaku = 1 Case Else If hai = bakaze Then yaku += 1 End If Select Case (4 + turn - oya) Mod 4 Case 0 If hai = "東" Then yaku += 1 End If Case 1 If hai = "南" Then yaku += 1 End If Case 2 If hai = "西" Then yaku += 1 End If Case 3 If hai = "北" Then yaku += 1 End If End Select End Select Return yaku End Function Function yakuhai2(ByVal hai As String) 'haiが場風か三元牌ならtrueを返す Select Case hai Case "白", "発", "中" Return True Case Else If hai = bakaze Then Return True Else Return False End If End Select End Function Function sarasiyakuhai(ByVal sarasi As String, ByVal turn As Integer) 'sarasiに役牌があったら2、オタ風があったら1、字牌なしなら0を返す Dim tmpsarasi As String = sarasi Dim kekka As Integer = 0 Do Until tmpsarasi = "" If tmpsarasi.Chars(0) = ";" Then tmpsarasi = tmpsarasi.Substring(1) Else If jihaika(tmpsarasi.Chars(0)) Then If yakuhai(tmpsarasi.Chars(0), turn) > 0 Then kekka = 2 Exit Do Else kekka = 1 End If End If If tmpsarasi.Contains(";") Then tmpsarasi = tmpsarasi.Substring(tmpsarasi.IndexOf(";") + 1) Else Exit Do End If End If Loop Return kekka End Function Function bunrui(ByVal hai As String, ByVal gen As String, ByVal mie As String) '牌種類 0-筋19 1-筋2378 2-片筋456 3-両筋456 4-無筋19 5-無筋2378 6-無筋456 7-１枚見え字牌 8-２枚見え字牌 9-３枚見え字牌 10-現物、４枚見え字牌 Dim rui As Integer = 0 Dim suu As Integer If gen.Contains(hai) Then Return 10 End If If Integer.TryParse(hai.Chars(0), suu) Then Select Case suu Case 1, 2, 3 If gen.Contains(suu + 3 & hai.Chars(1)) Then If suu = 1 Then rui = 0 Else rui = 1 End If Else If suu = 1 Then rui = 4 Else rui = 5 End If End If Case 4, 5, 6 rui = 0 If gen.Contains(suu + 3 & hai.Chars(1)) Then rui += 1 End If If gen.Contains(suu - 3 & hai.Chars(1)) Then rui += 1 End If Select Case rui Case 0 rui = 6 Case 1 rui = 2 Case 2 rui = 3 End Select Case 7, 8, 9 If gen.Contains(suu - 3 & hai.Chars(1)) Then If suu = 9 Then rui = 0 Else rui = 1 End If Else If suu = 9 Then rui = 4 Else rui = 5 End If End If End Select Else rui = 6 + miemai(mie, hai) End If Return rui End Function Function bunrui2(ByVal hai As String, ByVal gen As String, ByVal mie As String, someshoku As String, sarasi As String) As Integer '牌種類 0-他色無筋,1-他色筋,2-染め色非晒し19,3-染め色晒し19,4-染め色非晒し28,5-染め色晒し28,6-染め色非晒し37,7-染め色晒し37,8-染め色非晒し456,9-染め色晒し456,10-１枚見え字牌 11-２枚見え字牌 12-３枚見え字牌 13-現物、４枚見え字牌 Dim rui As Integer = 0 Dim suu As Integer If gen.Contains(hai) Then Return 13 End If If Integer.TryParse(hai.Chars(0), suu) Then If someshoku.Contains(hai.Chars(1)) Then '染め色 Select Case suu Case 1, 9 If sarasi.Contains(hai) Then rui = 3 Else rui = 2 End If Case 2, 8 If sarasi.Contains(hai) Then rui = 5 Else rui = 4 End If Case 3, 7 If sarasi.Contains(hai) Then rui = 7 Else rui = 6 End If Case 4, 5, 6 If sarasi.Contains(hai) Then rui = 9 Else rui = 8 End If End Select Else '非染め色 Select Case suu Case 1, 2, 3 If gen.Contains(suu + 3 & hai.Chars(1)) Then rui = 1 Else rui = 0 End If Case 4, 5, 6 rui = 0 If gen.Contains(suu + 3 & hai.Chars(1)) Then rui += 1 End If If gen.Contains(suu - 3 & hai.Chars(1)) Then rui += 1 End If Select Case rui Case 0, 1 rui = 0 Case 2 rui = 1 End Select Case 7, 8, 9 If gen.Contains(suu - 3 & hai.Chars(1)) Then rui = 1 Else rui = 0 End If End Select End If Else rui = 9 + miemai(mie, hai) End If Return rui End Function Function bunrui3(hai As String, turn As Integer) As Integer '0-1枚見え19、1-2枚見え19、2-3枚見え19、3-1枚見え28、4-2枚見え28．5-3枚見え28、6-1枚見え37、7-2枚見え37、8-3枚見え37、9-1枚見え46、10-2枚見え46、11-3枚見え46、12-1枚見え5、13-2枚見え5、14-3枚見え5、15-1枚見え字牌、16-2枚見え字牌、17-3枚見え字牌,18-4枚見え Dim mie As Integer = miemai(mieteru(turn), hai) Dim shu As Integer If Integer.TryParse(hai.Chars(0), shu) Then Select Case shu Case 1, 9 shu = 0 Case 2, 8 shu = 1 Case 3, 7 shu = 2 Case 4, 6 shu = 3 Case 5 shu = 4 End Select Else shu = 5 End If If mie = 4 Then Return 18 Else Return 3 * shu + mie - 1 End If End Function Function bunrui4(ByVal hai As String) As Integer '0-19,1-28,2-37,3-46,4-5,5-役牌,6-オタ風 Dim shu As Integer = 0 If Integer.TryParse(hai.Chars(0), shu) Then Select Case shu Case 1, 9 shu = 0 Case 2, 8 shu = 1 Case 3, 7 shu = 2 Case 4, 6 shu = 3 Case 5 shu = 4 End Select Else If yakuhai2(hai) Then shu = 5 Else shu = 6 End If End If Return shu End Function Function mieteru(ByVal turn As Integer) 'turnの人から見えてる牌の列を返す Dim mie As String = "" For i As Integer = 1 To 4 mie &= sute(i) If i = turn Then mie &= tehai(i) Else If tehai(i).Contains(";") Then mie &= tehai(i).Substring(tehai(i).IndexOf(";")) End If End If Next Return mie End Function Function kireteru() '切れてる牌の列を返す Dim mie As String = "" For i As Integer = 1 To 4 mie &= sute(i) If tehai(i).Contains(";") Then mie &= tehai(i).Substring(tehai(i).IndexOf(";")) End If Next Return mie End Function Sub jikyoku(ByVal shukei As Boolean) '局開始 Dim k As Integer = 0 Dim l As Integer = 0 Dim mo As String = "" Dim p As Random = New Random() nocount = Not shukei Do If k = 1 Then k = 0 For i As Integer = 1 To 4 bun = bun.Substring(bun.IndexOf("[") + 3) names(i) = bun.Substring(0, InStr(bun, " R") - 1) bun = bun.Substring(InStr(bun, " R") + 1) Next End If If bun.Contains("===== ") Then k = 1 End If bun = sr.ReadLine Loop Until bun Is Nothing OrElse bun.Contains("本場(リーチ") = True If Not bun Is Nothing Then bakaze = bun.Chars(2) honbaq = Integer.Parse(bun.Substring(bun.IndexOf("局") + 2, bun.IndexOf("本") - bun.IndexOf("局") - 2)) ribou = Integer.Parse(bun.Substring(bun.IndexOf("チ") + 1, bun.IndexOf(")") - bun.IndexOf("チ") - 1)) bun = bun.Substring(16) For i As Integer = 1 To 4 tensu(i) = 0 Next Do Until bun = "" For i As Integer = 1 To 4 If bun.StartsWith(names(i) & " ") Then bun = bun.Substring(names(i).Length + 1) Integer.TryParse(bun.Substring(0, bun.IndexOf(" ")), tensu(i)) bun = bun.Substring(bun.IndexOf(" ") + 1) End If Next Loop bun = sr.ReadLine If bun.Contains("チョンボ") Then nocount = True End If Do While bun.Chars(0) = " " bun = bun.Substring(1) Loop If bun.Contains("符") Then Integer.TryParse(bun.Substring(0, bun.IndexOf("符")), agarifu) If bun.Contains("飜") Then Select Case bun.Chars(bun.IndexOf("飜") - 1) Case "一" agarihan = 1 Case "二" agarihan = 2 Case "三" agarihan = 3 Case "四" agarihan = 4 End Select ElseIf bun.Contains("翻") Then Select Case bun.Chars(bun.IndexOf("翻") - 1) Case "一" agarihan = 1 Case "二" agarihan = 2 Case "三" agarihan = 3 Case "四" agarihan = 4 End Select End If End If If bun.Contains("満") Then agarifu = 40 If bun.Contains("役満") Then agarihan = 13 ElseIf bun.Contains("３倍満貫") Then If p.NextDouble < 0.4 Then agarihan = 12 Else agarihan = 11 End If ElseIf bun.Contains("倍満貫") Then If p.NextDouble < 0.5 Then agarihan = 8 ElseIf p.NextDouble < 1 / 3 Then agarihan = 10 Else agarihan = 9 End If ElseIf bun.Contains("ハネ満貫") Then If p.NextDouble < 0.4 Then agarihan = 7 Else agarihan = 6 End If ElseIf bun.Contains("満貫") Then If p.NextDouble < 0.5 Then agarihan = 5 Else agarihan = 4 End If End If End If If bun.Contains("流局") Then Else End If If bun.Contains("一発") Or bun.Contains("底") Then ippatu = True Else ippatu = False End If bun = sr.ReadLine For i As Integer = 0 To 3 If bun.Chars(6) = "東" Then oya = Integer.Parse(bun.Chars(5)) End If If bun.Chars(5) = "表" Then nocount = True Else tehai(Integer.Parse(bun.Chars(5))) = bun.Substring(8) bun = sr.ReadLine End If Next tukai = "" For i As Integer = 1 To 4 tukai &= tehai(i) kansita(i) = False Next yama = 84 bun = bun.Substring(9) doras = bun.Substring(0, bun.IndexOf(" ")) Dim tmpp As Integer If Integer.TryParse(doras.Chars(0), tmpp) Then dora1nomi = doras.Substring(0, 2) Else dora1nomi = doras.Chars(0) End If uras = bun.Substring(bun.IndexOf("]") + 1) tukai &= dorahyou() bun = sr.ReadLine Do mo = sr.ReadLine bun &= mo Loop Until mo = "" ritisha.Clear() ritijun.Clear() For i As Integer = 0 To 3 For j As Integer = 0 To 14 ritiagarihai(i, j) = "" Next Next For i As Integer = 0 To 4 For j As Integer = 0 To 14 furoagarihai(i, j) = "" Next Next ritimati.Clear() ritiagarimai.Clear() ritida = False furoda = False souturn = 1 For i As Integer = 0 To 4 gen(i) = "" sute(i) = "" furo(i) = 0 furogo(i) = 0 furonoten(i) = True some(i) = False histurnsu(i) = 0 For j As Integer = 1 To 4 genbutumai(i, j) = -1 Next For j As Integer = 0 To 18 titoika(i, j) = False Next saishutedasi(i) = "" ritisengenhai(i) = "" Next End If End Sub Sub nexturn() '次ターンの行動 If bun Is "" Or bun Is Nothing Then Exit Sub ElseIf nocount Then bun = "" Else Do While bun.StartsWith(" ") Or bun.StartsWith("*") bun = bun.Substring(1) Loop turn = Integer.Parse(bun.Chars(0)) koudou = bun.Chars(1) bun = bun.Substring(2) If koudou = "C" Then If bun.IndexOf(" ") < 0 Then hai &= bun.Substring(0, bun.Length) bun = bun.Remove(0, bun.Length) Else hai &= bun.Substring(0, bun.IndexOf(" ")) bun = bun.Remove(0, bun.IndexOf(" ")) End If Else If bun.IndexOf(" ") < 0 Then Select Case koudou Case "G", "d", "D", "K" hai = bun.Substring(0, bun.Length) End Select bun = "" Else Select Case koudou Case "G", "d", "D", "K" hai = bun.Substring(0, bun.IndexOf(" ")) End Select bun = bun.Remove(0, bun.IndexOf(" ")) End If End If histurn(turn) maeturn = turn End If End Sub Function ryanmenka(ByVal turn As Integer, ByVal ritika As Boolean) As Integer '両面なら１〜３を、亜両面なら４〜６を、非両面なら0を返す Dim t As Integer = 0 Dim aa As Integer = 0 Dim kk As Integer = 0 Dim s As String Dim s2 As String If ritika Then s = ritiagarihai(ritisha.IndexOf(turn), 0) If Not jihaika(s) Then Integer.TryParse(s.Chars(0), t) t += 3 s2 = t & s.Chars(1) If ritiagarihai(ritisha.IndexOf(turn), 1) = s2 And ritiagarihai(ritisha.IndexOf(turn), 2) = "" Then kk += miemai(tehai(turn), s) kk += miemai(tehai(turn), s2) If kk = 0 Or kk = 1 Then Select Case t Case 4, 9 aa = 1 Case 5, 8 aa = 2 Case 6, 7 aa = 3 End Select Else Select Case t Case 4, 9 aa = 4 Case 5, 8 aa = 5 Case 6, 7 aa = 6 End Select End If End If End If Else s = furoagarihai(turn, 0) If Not jihaika(s) Then Integer.TryParse(s.Chars(0), t) t += 3 s2 = t & s.Chars(1) If furoagarihai(turn, 1) = s2 And furoagarihai(turn, 2) = "" Then kk += miemai(tehai(turn), s) kk += miemai(tehai(turn), s2) If kk = 0 Or kk = 1 Then Select Case t Case 4, 9 aa = 1 Case 5, 8 aa = 2 Case 6, 7 aa = 3 End Select Else Select Case t Case 4, 9 aa = 4 Case 5, 8 aa = 5 Case 6, 7 aa = 6 End Select End If End If End If End If Return aa End Function Function sanmenchan(ByVal turn As Integer, ByVal ritika As Boolean) '3メンチャンなら1を、そうでないなら0を返す。 Dim aa As Integer = 0 Dim s As String Dim s2 As String Dim s3 As String Dim s4 As String If ritika Then s = ritiagarihai(ritisha.IndexOf(turn), 0) s2 = ritiagarihai(ritisha.IndexOf(turn), 1) s3 = ritiagarihai(ritisha.IndexOf(turn), 2) s4 = ritiagarihai(ritisha.IndexOf(turn), 3) Else s = furoagarihai(turn, 0) s2 = furoagarihai(turn, 1) s3 = furoagarihai(turn, 2) s4 = furoagarihai(turn, 3) End If If Not s = "" And Not s2 = "" And Not s3 = "" And s4 = "" Then If miemai(tehai(turn), s) + miemai(tehai(turn), s2) + miemai(tehai(turn), s3) <= 3 Then aa = 1 End If End If Return aa End Function Function tankika(ByVal turn As Integer, ByVal ritika As Boolean) As Integer '字牌単騎なら1を、19単騎なら2を、タンヤオ牌単騎なら3を、非単騎なら0を返す Dim t As Integer = 0 Dim aa As Integer = 0 Dim kk As Integer = 0 Dim s As String Dim s2 As String If ritika Then s = ritiagarihai(ritisha.IndexOf(turn), 0) s2 = ritiagarihai(ritisha.IndexOf(turn), 1) If Not s = "" And s2 = "" Then If miemai(tehai(turn), s) = 1 Then If jihaika(s) Then aa = 1 ElseIf s.Chars(0) = "1" Or s.Chars(0) = "9" Then aa = 2 Else aa = 3 End If End If End If Else s = furoagarihai(turn, 0) s2 = furoagarihai(turn, 1) If Not s = "" And s2 = "" Then If miemai(tehai(turn), s) = 1 Then If jihaika(s) Then aa = 1 ElseIf s.Chars(0) = "1" Or s.Chars(0) = "9" Then aa = 2 Else aa = 3 End If End If End If End If Return aa End Function Function kanpen(ByVal turn As Integer, ByVal ritika As Boolean) As Integer 'カンペンチャンで28待ちなら1を、37待ちなら2を、456待ちなら3を、非カンペンチャンなら0を返す。 Dim t As Integer = 0 Dim aa As Integer = 0 Dim kk As Integer = 0 Dim s As String Dim s2 As String Dim s3 As String If ritika Then s = ritiagarihai(ritisha.IndexOf(turn), 0) If Not jihaika(s) Then Integer.TryParse(s.Chars(0), t) If ritiagarihai(ritisha.IndexOf(turn), 1) = "" Then Select Case t Case 2, 8 s2 = (t - 1) & s.Chars(1) s3 = (t + 1) & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 1 End If End If Case 3 s2 = 2 & s.Chars(1) s3 = 4 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If Else s3 = 1 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If End If End If Case 7 s2 = 6 & s.Chars(1) s3 = 8 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If Else s2 = 9 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If End If End If Case 4, 5, 6 s2 = (t - 1) & s.Chars(1) s3 = (t + 1) & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 3 End If End If End Select End If End If Else s = furoagarihai(turn, 0) If Not jihaika(s) Then Integer.TryParse(s.Chars(0), t) If furoagarihai(turn, 1) = "" Then Select Case t Case 2, 8 s2 = (t - 1) & s.Chars(1) s3 = (t + 1) & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 1 End If End If Case 3 s2 = 2 & s.Chars(1) s3 = 4 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If Else s3 = 1 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If End If End If Case 7 s2 = 6 & s.Chars(1) s3 = 8 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If Else s2 = 9 & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 2 End If End If End If Case 4, 5, 6 s2 = (t - 1) & s.Chars(1) s3 = (t + 1) & s.Chars(1) If miemai(tehai(turn), s2) > 0 And miemai(tehai(turn), s3) > 0 Then If agarika(kiri(kiri(tehai(turn), s2), s3)) Then aa = 3 End If End If End Select End If End If End If Return aa End Function Function shaboka(ByVal turn As Integer, ByVal ritika As Boolean) As Integer '字牌含みシャボなら1を、19牌含みシャボなら2を、タンヤオ牌シャボなら3を、非シャボなら0を返す Dim t As Integer = 0 Dim aa As Integer = 0 Dim kk As Integer = 0 Dim s As String Dim s2 As String If ritika Then s = ritiagarihai(ritisha.IndexOf(turn), 0) s2 = ritiagarihai(ritisha.IndexOf(turn), 1) If Not s = "" And Not s2 = "" Then If miemai(tehai(turn), s) = 2 And miemai(tehai(turn), s2) = 2 And ritiagarihai(ritisha.IndexOf(turn), 2) = "" Then If jihaika(s) Or jihaika(s2) Then aa = 1 ElseIf s.Chars(0) = "1" Or s.Chars(0) = "9" Or s2.Chars(0) = "1" Or s2.Chars(0) = "9" Then aa = 2 Else aa = 3 End If End If End If Else s = furoagarihai(turn, 0) s2 = furoagarihai(turn, 1) If Not s = "" And Not s2 = "" Then If miemai(tehai(turn), s) = 2 And miemai(tehai(turn), s2) = 2 And furoagarihai(turn, 2) = "" Then If jihaika(s) Or jihaika(s2) Then aa = 1 ElseIf s.Chars(0) = "1" Or s.Chars(0) = "9" Or s2.Chars(0) = "1" Or s2.Chars(0) = "9" Then aa = 2 Else aa = 3 End If End If End If End If Return aa End Function Function matinani(ByVal turn As Integer, ByVal ritika As Boolean) As Integer '待ちの種類で0〜16を返す Dim tmp As Integer tmp = ryanmenka(turn, ritika) If tmp > 0 Then '両面、亜両面 Return tmp End If tmp = shaboka(turn, ritika) If tmp > 0 Then Return tmp + 6 'シャボ End If tmp = kanpen(turn, ritika) If tmp > 0 Then Return tmp + 9 'カンチャン、ペンチャン End If tmp = tankika(turn, ritika) If tmp > 0 Then Return tmp + 12 End If tmp = sanmenchan(turn, ritika) If tmp > 0 Then Return 16 End If Return 0 End Function Function kotu(ByVal turn As Integer) As Integer '上がり形での刻子の数 Dim tt As String = tehai(turn) Dim ttt As String Dim katamari As String Dim ha As String Dim k As Integer Dim d As Integer = 0 Do While tt.Contains(";;") If jihaika(tt.Chars(InStr(tt, ";;") + 1)) Then ha = tt.Chars(InStr(tt, ";;") + 1) Else ha = tt.Substring(InStr(tt, ";;") + 1, 2) End If tt = kiri(tt, ";;" & ha & ha & ha & ha) d += 1 Loop Do While tt.Contains(";") If jihaika(tt.Chars(InStrRev(tt, ";"))) Then ha = tt.Chars(InStrRev(tt, ";")) Else ha = tt.Substring(InStrRev(tt, ";"), 2) End If ttt = tt.Substring(InStrRev(tt, ";")) If miemai(ttt, ha) >= 3 Then d += 1 End If tt = tt.Substring(0, InStrRev(tt, ";") - 1) Loop katamari = tt Do Until katamari = "" ttt = tt If jihaika(katamari.Chars(0)) Then ha = katamari.Chars(0) Else ha = katamari.Substring(0, 2) End If k = miemai(tt, ha) If k > 2 Then ttt = kiri(kiri(kiri(tt, ha), ha), ha) If agarika(ttt) Then d += 1 End If End If For i As Integer = 1 To k katamari = kiri(katamari, ha) Next Loop Return d End Function Function simo(ByVal turn As Integer) 'turnの下家 Dim a As Integer If turn < 4 Then a = turn + 1 Else a = 1 End If Return a End Function Function someka(ByVal tehai As String) As Boolean 'tehaiが1色になってるか Dim iro As Integer = 0 Dim ke As Boolean = False If tehai.Contains("m") Then '手牌にマンズがある iro += 1 End If If tehai.Contains("p") Then '手牌にピンズがある iro += 1 End If If tehai.Contains("s") Then '手牌にソーズがある iro += 1 End If If iro <= 1 Then ke = True End If Return ke End Function Function sutejun(ByVal turn As Integer, ByVal jun As Integer) As String '対象者のjun順目までの捨て牌 Dim tmpte As String = "" Dim tmpte2 As String = sute(turn) Dim a As Integer Do Until tmpte2 = "" Or jun = 0 If Integer.TryParse(tmpte2.Substring(0, 1), a) Then tmpte &= tmpte2.Substring(0, 2) '数牌 tmpte2 = tmpte2.Substring(2) Else tmpte &= tmpte2.Substring(0, 1) '字牌 tmpte2 = tmpte2.Substring(1) End If jun -= 1 Loop Return tmpte End Function Function sutejun2(ByVal turn As Integer, ByVal jun As Integer) As String '対象者のjun順前からの捨て牌 Dim tmpte As String = "" Dim tmpte2 As String = sute(turn) Dim a As Integer Do Until tmpte2 = "" Or jun = 0 Dim tmplen As Integer = tmpte2.Length If tmpte2.Chars(tmplen - 1) = "m" Or tmpte2.Chars(tmplen - 1) = "p" Or tmpte2.Chars(tmplen - 1) = "s" Then tmpte = tmpte2.Substring(tmplen - 2, 2) & tmpte '数牌 tmpte2 = tmpte2.Substring(0, tmplen - 2) Else tmpte = tmpte2.Substring(tmplen - 1, 1) & tmpte '字牌 tmpte2 = tmpte2.Substring(0, tmplen - 1) End If jun -= 1 Loop Return tmpte End Function Function somesute1(ByVal turn As Integer, ByVal jun As Integer, ByVal jisuu As Integer) As Boolean '対象者のjun順目までに染め色が切られてなく、字牌がjisuu枚以下か Dim iro As Integer = 0 Dim ji As Integer = 0 Dim tmpsute As String = sutejun(turn, jun) Dim ke As Boolean = False If tmpsute.Contains("m") Then '捨て牌にマンズがある iro += 1 End If If tmpsute.Contains("p") Then '捨て牌にピンズがある iro += 1 End If If tmpsute.Contains("s") Then '捨て牌にソーズがある iro += 1 End If If iro = 3 Then Return False '染め色が切られている End If ji += miemai(tmpsute, "東") ji += miemai(tmpsute, "南") ji += miemai(tmpsute, "西") ji += miemai(tmpsute, "北") ji += miemai(tmpsute, "白") ji += miemai(tmpsute, "発") ji += miemai(tmpsute, "中") If ji > jisuu Then Return False '字牌がjisuu枚より多い Else Return True End If End Function Function doradore(ByVal doras As String, ByVal someshoku As String) As Integer 'ドラ（カンドラ考慮せず）の区分,0-非染め色,1-染め色,2-字牌 Dim a As Integer If Integer.TryParse(doras.Chars(0), a) Then If someshoku.Contains(doras.Chars(1)) Then Return 1 Else Return 0 End If Else Return 2 End If End Function Function somesute2(ByVal turn As Integer, ByVal jun As Integer, ByVal jisuu As Integer) As String '対象者のjun順目までに染め色が切られてなく、字牌がjisuu枚以下か Dim iro As Integer = 0 Dim iro2 As String = "mps" Dim ji As Integer = 0 Dim tmpsute As String = sutejun(turn, jun) Dim ke As Boolean = False If tmpsute.Contains("m") Then '捨て牌にマンズがある iro += 1 iro2 = iro2.Remove(iro2.IndexOf("m"), 1) End If If tmpsute.Contains("p") Then '捨て牌にピンズがある iro += 1 iro2 = iro2.Remove(iro2.IndexOf("p"), 1) End If If tmpsute.Contains("s") Then '捨て牌にソーズがある iro += 1 iro2 = iro2.Remove(iro2.IndexOf("s"), 1) End If If iro = 3 Then Return "" '染め色が切られている End If ji += miemai(tmpsute, "東") ji += miemai(tmpsute, "南") ji += miemai(tmpsute, "西") ji += miemai(tmpsute, "北") ji += miemai(tmpsute, "白") ji += miemai(tmpsute, "発") ji += miemai(tmpsute, "中") If ji > jisuu Then Return "" '字牌がjisuu枚より多い Else Return iro2 End If End Function Function sutezenshoku(ByVal turn As Integer) As Boolean Return sute(turn).Contains("m") And sute(turn).Contains("p") And sute(turn).Contains("s") End Function Function sarasi1shoku(ByVal tehai As String) As Boolean '副露部分が1色か If tehai.Contains(";") Then Dim tmpte = tehai.Substring(tehai.IndexOf(";")) Return someka(tmpte) Else Return False End If End Function Function sarasi(ByVal tehai As String) As String '晒し部分を返す If Not tehai.Contains(";") Then Return "" Else Return tehai.Substring(tehai.IndexOf(";")) End If End Function Function sarasitenaitehai(ByVal tehai As String) As String '晒していない手牌を返す If Not tehai.Contains(";") Then Return tehai Else Return tehai.Substring(0, tehai.IndexOf(";")) End If End Function Function furosu(ByVal tehai As String) As Integer '副露数 Dim tmpte As String = tehai Dim tmp As Integer = 0 Do Until tmpte = "" If tmpte.StartsWith(";;") Then tmpte = tmpte.Substring(1) ElseIf tmpte.StartsWith(";") Then tmp += 1 tmpte = tmpte.Substring(1) ElseIf tmpte.Contains(";") Then tmpte = tmpte.Substring(tmpte.IndexOf(";")) Else tmpte = "" End If Loop Return tmp End Function Function mieyaku(ByVal tehai As String, ByVal someka As Boolean, ByVal turn As Integer) As Integer '見えてる役、ドラ数（非染めのとき、1役目の役牌は数えない） Dim tmpte As String = sarasi(tehai) Dim tmpyaku As Integer = 0 Dim yakuari As Boolean = someka Dim tmphai As String = "" Dim a As Integer Do Until tmpte = "" If tmpte.StartsWith(";") Then tmpte = tmpte.Substring(1) Else If Integer.TryParse(tmpte.Chars(0), a) Then tmphai = tmpte.Substring(0, 2) If doras.Contains(tmphai) Then tmpyaku += 1 End If tmpte = tmpte.Substring(2) Else tmphai = tmpte.Chars(0) a = yakuhai(tmphai, turn) If a > 0 Then If yakuari Then tmpyaku += a Else yakuari = True tmpyaku += a - 1 End If End If a = miemai(tmpte, tmphai) If doras.Contains(tmphai) Then tmpyaku += a End If tmpte = tmpte.Substring(a) End If End If Loop Return tmpyaku End Function Function futoint(ByVal agarifu As Integer) '符の数を０〜６の整数に Select Case agarifu Case 20 Return 0 Case 25 Return 1 Case 30 Return 2 Case 40 Return 3 Case 50 Return 4 Case 60 Return 5 Case Is > 60 Return 6 End Select End Function Function dorahyou() As String 'ドラ表示牌を返す Dim hyoujihai As String = "" Dim tmp As String = doras Dim hai As String Dim a As Integer Do Until tmp = "" If Integer.TryParse(tmp.Chars(0), a) Then hai = tmp.Substring(0, 2) tmp = tmp.Substring(2) If a = 1 Then hyoujihai &= "9" & hai.Chars(1) Else hyoujihai &= a - 1 & hai.Chars(1) End If Else hai = tmp.Chars(0) tmp = tmp.Substring(1) Select Case hai Case "東" hyoujihai &= "北" Case "南" hyoujihai &= "東" Case "西" hyoujihai &= "南" Case "北" hyoujihai &= "西" Case "白" hyoujihai &= "中" Case "発" hyoujihai &= "白" Case "中" hyoujihai &= "発" End Select End If yama -= 1 Loop Return hyoujihai End Function Function sujika(ByVal hai As String, ByVal turn As Integer) As Boolean '現物に筋牌があるときtrueを返す Dim tmphai As String Dim tmphai2 As String Dim a As Integer Dim ke As Boolean = False If Integer.TryParse(hai.Chars(0), a) Then Select Case a Case 1, 2, 3 tmphai = (a + 3) & hai.Chars(1) If gen(turn).Contains(tmphai) Then ke = True End If Case 4, 5, 6 tmphai = (a + 3) & hai.Chars(1) tmphai2 = (a - 3) & hai.Chars(1) If gen(turn).Contains(tmphai) And gen(turn).Contains(tmphai2) Then ke = True End If Case 7, 8, 9 tmphai2 = (a - 3) & hai.Chars(1) If gen(turn).Contains(tmphai2) Then ke = True End If End Select End If Return ke End Function Function yamamai(ByVal hai As String) 'haiが山にある枚数を返す Dim zente As String = "" zente &= dorahyou() For i As Integer = 1 To 4 zente &= tehai(i) zente &= sute(i) Next Return 4 - miemai(zente, hai) End Function Function genmai(ByVal ritisha As Integer, ByVal turn As Integer) 'ritishaに対するturnの現物数 Dim tmpte As String = tehai(turn) Dim tmphai As String Dim a As Integer Dim mai As Integer = 0 If tmpte.Contains(";") Then tmpte = tmpte.Substring(0, tmpte.IndexOf(";")) End If Do Until tmpte = "" If Integer.TryParse(tmpte.Chars(0), a) Then tmphai = tmpte.Substring(0, 2) tmpte = tmpte.Substring(2) Else tmphai = tmpte.Substring(0, 1) tmpte = tmpte.Substring(1) End If If gen(ritisha).Contains(tmphai) Then mai += 1 End If Loop Return mai End Function Function chance(ByVal hai As String, ByVal turn As Integer) '切る人turn、ノーチャンス→0、ワンチャンス→1、それ以外（字牌456牌含む）→2 Dim kekka As Integer = 2 Dim a As Integer Dim tmphai As String Dim iro As String If Integer.TryParse(hai.Chars(0), a) Then iro = hai.Chars(1) Select Case a Case 1, 2, 3 tmphai = (a + 1) & iro Select Case miemai(mieteru(turn), tmphai) Case 3 kekka = 1 Case 4 kekka = 0 End Select tmphai = (a + 2) & iro Select Case miemai(mieteru(turn), tmphai) Case 3 kekka = Math.Min(1, kekka) Case 4 kekka = 0 End Select Case 7, 8, 9 tmphai = (a - 1) & iro Select Case miemai(mieteru(turn), tmphai) Case 3 kekka = 1 Case 4 kekka = 0 End Select tmphai = (a - 2) & iro Select Case miemai(mieteru(turn), tmphai) Case 3 kekka = Math.Min(1, kekka) Case 4 kekka = 0 End Select End Select End If Return kekka End Function Function jojunsoto(ByVal hai As String, ByVal turn As Integer) '聴牌者turn、序順（6巡目）までの捨て牌の外側→0、その他→1 Dim kekka As Integer = 1 Dim a As Integer Dim tmphai As String Dim iro As String If Integer.TryParse(hai.Chars(0), a) Then iro = hai.Chars(1) Select Case a Case 1, 2, 3 tmphai = (a + 1) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka = 0 End If tmphai = (a + 2) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka = 0 End If Case 7, 8, 9 tmphai = (a - 1) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka = 0 End If tmphai = (a - 2) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka = 0 End If End Select End If Return kekka End Function Function jojunsoto2(ByVal hai As String, ByVal turn As Integer) '聴牌者turn、序順（6巡目）までの捨て牌の外側→0、その他→1 Dim kekka As Integer = 0 Dim a As Integer Dim tmphai As String Dim iro As String If Integer.TryParse(hai.Chars(0), a) Then iro = hai.Chars(1) Select Case a Case 1, 2, 3 tmphai = (a + 1) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka += 1 End If tmphai = (a + 2) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka += 2 End If Case 7, 8, 9 tmphai = (a - 1) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka += 1 End If tmphai = (a - 2) & iro If sutejun(turn, 6).Contains(tmphai) Then kekka += 2 End If End Select End If Return kekka End Function Function jojun5kiri(ByVal hai As String, ByVal turn As Integer) '聴牌者turn、序順（6巡目）までの5切り→0、その他→1 Dim kekka As Integer = 1 Dim a As Integer Dim tmphai As String Dim iro As String If Integer.TryParse(hai.Chars(0), a) Then iro = hai.Chars(1) tmphai = 5 & iro If sutejun(turn, 6).Contains(tmphai) Then If Not someka(tehai(turn)) Then If Not sarasi(tehai(turn)).Contains(hai) Then kekka = 0 End If End If End If End If Return kekka End Function Function dorasoba(ByVal hai As String, ByVal turn As Integer) '聴牌者turn、ドラ切りドラそば→0、ドラ切らないドラそば→1、その他→2 Dim kekka As Integer = 2 Dim a As Integer Dim tmphai As String Dim iro As String If Integer.TryParse(hai.Chars(0), a) Then iro = hai.Chars(1) Select Case a Case 1, 2, 3 tmphai = (a + 1) & iro If tmphai = dora1nomi Then kekka = 0 End If tmphai = (a + 2) & iro If tmphai = dora1nomi Then kekka = 0 End If Case 4, 5, 6 tmphai = (a + 1) & iro If tmphai = dora1nomi Then kekka = 0 End If tmphai = (a + 2) & iro If tmphai = dora1nomi Then kekka = 0 End If tmphai = (a - 1) & iro If tmphai = dora1nomi Then kekka = 0 End If tmphai = (a - 2) & iro If tmphai = dora1nomi Then kekka = 0 End If Case 7, 8, 9 tmphai = (a - 1) & iro If tmphai = dora1nomi Then kekka = 0 End If tmphai = (a - 2) & iro If tmphai = dora1nomi Then kekka = 0 End If End Select If kekka = 0 Then If Not sute(turn).Contains(dora1nomi) Then kekka = 1 End If End If End If Return kekka End Function Function sarasishuhen(ByVal hai As String, ByVal turn As Integer) '聴牌者turn、晒されてる牌→0、晒されてる周辺→1、その他→2 Dim kekka As Integer = 2 Dim a As Integer Dim tmphai As String Dim tmpsarasi As String = sarasi(tehai(turn)) Dim iro As String If Integer.TryParse(hai.Chars(0), a) Then iro = hai.Chars(1) If tmpsarasi.Contains(hai) Then kekka = 0 Else Select Case a Case 1, 2, 3 tmphai = (a + 1) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If tmphai = (a + 2) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If Case 4, 5, 6 tmphai = (a + 1) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If tmphai = (a + 2) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If tmphai = (a - 1) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If tmphai = (a - 2) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If Case 7, 8, 9 tmphai = (a - 1) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If tmphai = (a - 2) & iro If tmpsarasi.Contains(tmphai) Then kekka = 1 End If End Select End If End If Return kekka End Function Function sarasishuhen2(ByVal hai As String, ByVal turn As Integer) '聴牌者turn、最終手出しが晒されてる牌でその周辺→0、最終手出しが晒されてる牌でなくその周辺→1、その他→2 Dim kekka As Integer = 2 Dim a As Integer Dim tmphai As String Dim tmpsarasi As String = sarasi(tehai(turn)) Dim iro As String If Integer.TryParse(saishutedasi(turn).Chars(0), a) Then iro = saishutedasi(turn).Chars(1) Select Case a Case 1, 2, 3, 4, 5, 6, 7, 8 tmphai = (a + 1) & iro If hai = tmphai Then kekka = 1 End If End Select Select Case a Case 1, 2, 3, 4, 5, 6, 7 tmphai = (a + 2) & iro If hai = tmphai Then kekka = 1 End If End Select Select Case a Case 2, 3, 4, 5, 6, 7, 8, 9 tmphai = (a - 1) & iro If hai = tmphai Then kekka = 1 End If End Select Select Case a Case 3, 4, 5, 6, 7, 8, 9 tmphai = (a - 2) & iro If hai = tmphai Then kekka = 1 End If End Select End If If kekka = 1 Then If tmpsarasi.Contains(saishutedasi(turn)) Then kekka = 0 End If End If Return kekka End Function Function sarasishurui(ByVal turn As Integer) '役牌仕掛けなら2、タンヤオ仕掛けなら1、その他なら0を返す Dim tmpsarasi As String = sarasi(tehai(turn)) Dim kekka = 0 Select Case sarasiyakuhai(tmpsarasi, turn) Case 0 '字牌なし仕掛け If tmpsarasi.Contains("1") Or tmpsarasi.Contains("9") Then kekka = 0 Else kekka = 1 End If Case 1 'オタ風仕掛け kekka = 0 Case 2 '役牌仕掛け kekka = 2 End Select Return kekka End Function Function sengenhaisuji(ByVal hai As String, ByVal turn As Integer) Dim kekka As Integer = 0 Dim a As Integer Dim iro As String If Integer.TryParse(ritisengenhai(turn).Chars(0), a) Then iro = ritisengenhai(turn).Chars(1) Select Case a Case 1, 2, 3 If hai = (a + 3) & iro Then kekka = 1 End If Case 4, 5, 6 If hai = (a + 3) & iro Then kekka = 1 End If If hai = (a - 3) & iro Then kekka = 1 End If Case 7, 8, 9 If hai = (a - 3) & iro Then kekka = 1 End If End Select End If Return kekka End Function Function kamicha(ByVal turn As Integer) 'turnの上家 If turn = 1 Then Return 4 Else Return turn - 1 End If End Function Function agarihaimaisu(ByVal ritika As Boolean, ByVal turn As Integer) '上がり牌の見えてない枚数 Dim maisu As Integer = 0 Dim tmphai As String If ritika Then 'リーチ者 For j As Integer = 0 To 14 If ritiagarihai(ritisha.IndexOf(turn), j) = "" Then Exit For Else tmphai = ritiagarihai(ritisha.IndexOf(turn), j) maisu += 4 - miemai(mieteru(turn), tmphai) End If Next Else '副露者 For j As Integer = 0 To 14 If furoagarihai(turn, j) = "" Then Exit For Else tmphai = furoagarihai(turn, j) maisu += 4 - miemai(mieteru(turn), tmphai) End If Next End If Return maisu End Function Function nokorisuji(ByVal gen As String) '残りスジ本数 Dim sujihon As Integer = 0 Dim tmphai As String Dim tmphai2 As String For i As Integer = 1 To 6 tmphai = i & "m" tmphai2 = (i + 3) & "m" If Not (gen.Contains(tmphai) Or gen.Contains(tmphai2)) Then sujihon += 1 End If tmphai = i & "p" tmphai2 = (i + 3) & "p" If Not (gen.Contains(tmphai) Or gen.Contains(tmphai2)) Then sujihon += 1 End If tmphai = i & "s" tmphai2 = (i + 3) & "s" If Not (gen.Contains(tmphai) Or gen.Contains(tmphai2)) Then sujihon += 1 End If Next Return sujihon End Function Sub histurn(ByVal turn As Integer) '各ターンの動き Select Case koudou Case "G" 'ツモ tehai(turn) = tumo(tehai(turn), hai) tukai &= hai yama -= 1 Case "D", "d" '切る For i As Integer = 0 To ritisha.Count() - 1 'リーチ者がいる場合 If Not turn = ritisha(i) And (Not ritisha.Contains(turn) And furonoten(turn)) Then 'kekka1(1 + jojun5kiri(hai, ritisha(i)), bunrui(hai, gen(ritisha(i)), mieteru(turn)), 0, 0) += 1 For j As Integer = 0 To 14 If ritiagarihai(i, j) = "" Then Exit For Else If ritiagarihai(i, j) = hai Then 'kekka1(3 + jojun5kiri(hai, ritisha(i)), bunrui(hai, gen(ritisha(i)), mieteru(turn)), 0, 0) += 1 End If End If Next End If Next For i As Integer = 1 To 4 If Not turn = i And Not furonoten(i) Then 'kekka1(5 + jojun5kiri(hai, i), bunrui(hai, gen(i), mieteru(turn)), 0, 0) += 1 For j As Integer = 0 To 14 If furoagarihai(i, j) = "" Then Exit For Else If furoagarihai(i, j) = hai Then 'kekka1(7 + jojun5kiri(hai, i), bunrui(hai, gen(i), mieteru(turn)), 0, 0) += 1 End If End If Next End If Next histurnsu(turn) += 1 tehai(turn) = kiri(tehai(turn), hai) sute(turn) &= hai gen(turn) &= hai For i As Integer = 0 To ritisha.Count() - 1 'リーチ者がいる場合 If Not turn = ritisha(i) Then genbutumai(ritisha(i), turn) = genmai(ritisha(i), turn) '現物枚数 End If Next If furoda Then '直前に副露 furonoten(turn) = Not tenpaika(tehai(turn)) If Not furonoten(turn) Then For i As Integer = 0 To 14 If i <= agarihai1.Count - 1 Then furoagarihai(turn, i) = agarihai1(i) Else furoagarihai(turn, i) = "" End If Next End If furoda = False furogo(turn) = 1 If histurnsu(turn) > 6 Then some(turn) = somesute1(turn, 6, 1) End If ElseIf furogo(turn) > 0 Then If koudou = "d" Then '副露後手出し furonoten(turn) = Not tenpaika(tehai(turn)) If Not furonoten(turn) Then For i As Integer = 0 To 14 If i <= agarihai1.Count - 1 Then furoagarihai(turn, i) = agarihai1(i) Else furoagarihai(turn, i) = "" End If Next End If gen(turn) = sute(turn) '現物リセット furogo(turn) += 1 End If End If If koudou = "d" Then saishutedasi(turn) = hai End If If ritida Then '直前にリーチ If tenpaika(tehai(turn)) Then Dim m As Integer = ritisha.Count For i As Integer = 0 To agarihai1.Count - 1 ritiagarihai(m, i) = agarihai1(i) Next ritisha.Add(turn) ritijun.Add((souturn + 3) / 4) ritimati.Add(matinani(turn, True)) ritisengenhai(turn) = hai ritiagarimai.Add(agarihaimaisu(True, turn)) End If ritida = False End If For i As Integer = 0 To ritisha.Count() - 1 'リーチ者がいる場合 If Not ritisha(i) = turn Then gen(ritisha(i)) &= hai End If Next For k As Integer = 1 To 4 If Not furonoten(k) And Not k = turn Then '副露聴牌者がいる場合 gen(k) &= hai End If Next If histurnsu(turn) = 6 And tehai(turn).Contains(";") Then some(turn) = somesute1(turn, 6, 1) End If souturn += 1 Case "C" 'チー tehai(turn) = kiri(tehai(turn), hai.Substring(2, 2)) tehai(turn) = kiri(tehai(turn), hai.Substring(4, 2)) tehai(turn) &= ";" & hai sute(maeturn) = kesi2(sute(maeturn)) furoda = True furo(turn) += 1 Case "N" 'ポン tehai(turn) = kiri(tehai(turn), hai) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) &= ";" & hai & hai & hai sute(maeturn) = kesi2(sute(maeturn)) furoda = True furo(turn) += 1 Case "K" 'カン If maeturn = turn Then If tehai(turn).Contains(";" & hai & hai & hai) Then '加カン tehai(turn) = kiri(tehai(turn), hai) If hai.Length = 1 Then tehai(turn) = tehai(turn).Insert(InStr(tehai(turn), hai), hai) Else tehai(turn) = tehai(turn).Insert(InStr(tehai(turn), hai) + 1, hai) End If Else '暗カン tehai(turn) = kiri(tehai(turn), hai) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) &= ";;" & hai & hai & hai & hai furo(turn) += 1 End If Else '大明カン sute(maeturn) = kesi2(sute(maeturn)) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) = kiri(tehai(turn), hai) tehai(turn) &= ";" & hai & hai & hai & hai furo(turn) += 1 End If kansita(turn) = True Case "R" '立直 sute(turn) &= "R" ribou += 1 ritida = True risuu += 1 Case "A" '上がり Dim p As Random = New Random() Dim ten As Integer If Not turn = maeturn Then tehai(turn) = tumo(tehai(turn), hai) End If '赤牌考慮 If p.NextDouble < miemai(tehai(turn), "5m") / 4 Then 'agarihan += 1 End If If p.NextDouble < miemai(tehai(turn), "5p") / 4 Then 'agarihan += 1 End If If p.NextDouble < miemai(tehai(turn), "5s") / 4 Then 'agarihan += 1 End If If turn = maeturn Then 'ツモのとき If oya = turn Then End If End If If Not turn = maeturn Then 'ロンのとき gen(turn) = kesi2(gen(turn)) 'ten = tokuten(agarihan, agarifu, 3) If oya = turn Then End If End If End Select End Sub Sub kyoku1(ByVal shukei As Boolean) '1局分 jikyoku(shukei) Do Until bun = "" nexturn() Loop kyoku += 1 End Sub Function tumo(ByVal tehai As String, ByVal tumohai As String) 'tehaiの状態からtumohaiをツモった手牌を返す Dim sento As String Dim sinte As String = "" Dim a As Integer Do Until tehai = "" If tehai.StartsWith(";") Then Exit Do End If If Integer.TryParse(tehai.Chars(0), a) Then '手牌の先頭が数牌のとき sento = tehai.Substring(0, 2) If haitoint(sento) >= haitoint(tumohai) Then sinte &= tumohai Exit Do End If tehai = tehai.Remove(0, 2) Else '手牌の先頭が字牌のとき sento = tehai.Chars(0) If haitoint(sento) >= haitoint(tumohai) Then sinte &= tumohai Exit Do End If tehai = tehai.Remove(0, 1) End If sinte &= sento Loop If Not sinte.Contains(tumohai) Then sinte &= tumohai End If sinte &= tehai Return sinte End Function Function kiri(ByVal tehai As String, ByVal sutehai As String) 'tehaiからsutehaiを切った手牌を返す Dim sinte As String = "" sinte = tehai.Remove(InStr(tehai, sutehai) - 1, sutehai.Length) Return sinte End Function Function anzen(ByVal tehai As String, ByVal gen As String, ByVal mie As String, ByVal jun As Integer) As Integer '手牌から一番安全度が高い牌の種類を返す。 Dim ima As String Dim ritu As Double = 1.0 Dim rui As Integer = 0 Dim rui2 As Integer Dim hai As String Dim a As Integer ima = tehai If ima.Contains(";") Then ima = ima.Substring(0, ima.IndexOf(";")) End If Do Until ima = "" If ima.Length > 1 AndAlso Integer.TryParse(ima.Chars(ima.Length - 2), a) Then 'imaの最後の牌が数牌 hai = ima.Substring(ima.Length - 2) ima = ima.Remove(ima.Length - 2) Else hai = ima.Substring(ima.Length - 1) ima = ima.Remove(ima.Length - 1) End If rui2 = bunrui(hai, gen, mie) If ritu > houritu(jun, rui2) Then ritu = houritu(jun, rui2) rui = rui2 End If Loop Return rui End Function Sub bunkatu(ByVal tehai As String, ByVal tumomae As Integer) '手牌分割。ツモ前のテンパイ判定→tumomae=1、ツモ後の上がり判定→tumomae=0 Dim katamari As String Dim suumae As Integer = 0 Dim suuato As Integer Dim iromae As String = "a" Dim iroato As String tekatu.Clear() Do While tehai.Contains(";") '鳴き牌を別途処理 If tehai.EndsWith(";") Then '直前がカンだったときの処理 tehai = tehai.Substring(0, tehai.Length - 1) Else katamari = tehai.Substring(tehai.LastIndexOf(";") + 1) 'katamari=鳴き面子 If Integer.TryParse(katamari.Chars(0), suuato) Then iroato = katamari.Substring(0, 2) Else iroato = katamari.Substring(0, 1) End If If miemai(katamari, iroato) = 4 Then '鳴きがカンのとき補正 katamari = kiri(katamari, iroato) End If If Integer.TryParse(katamari.Chars(0), suuato) Then '鳴き牌が数牌 iroato = iroato.Chars(1) Do Until katamari = "" If Integer.TryParse(katamari.Chars(0), suuato) Then iroato = iroato & suuato End If katamari = katamari.Substring(1) Loop iroato = iroato.Chars(0) & upsort3(Integer.Parse(iroato.Substring(1))) tekatu.Add(iroato) Else '鳴き牌が字牌 tekatu.Add(katamari) End If tehai = tehai.Substring(0, tehai.LastIndexOf(";")) End If Loop Do Until tehai = "" If Integer.TryParse(tehai.Chars(0), suuato) Then '最初の牌が数牌 iroato = tehai.Chars(1) tehai = tehai.Substring(2) If suumae < suuato - 1 - tumomae Or Not iromae = iroato Then '最初の牌が前のグループと違う tekatu.Add(iroato & suuato) Else '最初の牌が前のグループと同じ tekatu(tekatu.Count() - 1) = tekatu(tekatu.Count() - 1) & suuato End If suumae = suuato iromae = iroato Else '最初の牌が字牌 iroato = tehai.Chars(0) tehai = tehai.Substring(1) If iroato = iromae Then '字牌が前のグループと同じ tekatu(tekatu.Count() - 1) = tekatu(tekatu.Count() - 1) & iroato Else '字牌が前のグループと違う tekatu.Add(iroato) End If iromae = iroato End If Loop End Sub Function upsort3(ByVal narabi As Integer) As Integer '3数の昇順並べ替え Dim a As Integer Dim suu() As Integer = New Integer(2) {} suu(0) = narabi \ 100 suu(1) = (narabi Mod 100) \ 10 suu(2) = narabi Mod 10 Do Until suu(0) <= suu(1) And suu(1) <= suu(2) If suu(0) > suu(1) Then a = suu(0) suu(0) = suu(1) suu(1) = a End If If suu(1) > suu(2) Then a = suu(1) suu(1) = suu(2) suu(2) = a End If Loop a = suu(0) * 100 + suu(1) * 10 + suu(2) Return a End Function Function mentuka(ByVal katamari As String) As Boolean '面子数組ができるときtrue、katamariに色情報無しorあり Dim suu As Integer = 0 If katamari = "" Then Return True End If If katamari.Chars(0) = "m" Or katamari.Chars(0) = "p" Or katamari.Chars(0) = "s" Then '数牌で色情報ありのとき色情報除去 katamari = katamari.Substring(1) End If If katamari.Length Mod 3 = 0 Then Do Until katamari = "" If miemai(katamari, katamari.Chars(0)) >= 3 Then katamari = katamari.Substring(3) ElseIf Integer.TryParse(katamari.Chars(0), suu) AndAlso katamari.Contains(suu + 1) And katamari.Contains(suu + 2) Then katamari = kiri(katamari.Substring(1), suu + 1) katamari = kiri(katamari, suu + 2) Else Return False End If Loop Return True Else Return False End If End Function Function atamenka(ByVal katamari1 As String) As Boolean '頭1つと面子何組ができるときtrue、katamariに色情報無しorあり Dim katamari As String Dim mae As String = "0" If katamari1 = "" Then Return False End If If katamari1.Chars(0) = "m" Or katamari1.Chars(0) = "p" Or katamari1.Chars(0) = "s" Then '数牌で色情報ありのとき色情報除去 katamari1 = katamari1.Substring(1) End If katamari = katamari1 Do Until katamari = "" If Not mae = katamari.Chars(0) And miemai(katamari1, katamari.Chars(0)) >= 2 Then If mentuka(kiri(kiri(katamari1, katamari.Chars(0)), katamari.Chars(0))) Then Exit Do End If End If mae = katamari.Chars(0) katamari = katamari.Substring(1) Loop If katamari = "" Then Return False Else Return True End If End Function Function mentukap1(ByVal katamari As String) As Boolean '1枚加えて面子数組ができるときtrue、katamariに色情報あり、上がり牌はagarihai0へ Dim katamari1 As String Dim katamari2 As String Dim seikou As Boolean = False agarihai0.Clear() If katamari.Chars(0) = "m" Or katamari.Chars(0) = "p" Or katamari.Chars(0) = "s" Then '数牌のとき Dim min As Integer = Math.Max(Integer.Parse(katamari.Chars(1)) - 1, 1) Dim max As Integer = Math.Min(Integer.Parse(katamari.Chars(katamari.Length - 1)) + 1, 9) Dim iro As String = katamari.Chars(0) katamari = katamari.Substring(1) For i As Integer = min To max katamari1 = katamari katamari2 = "" Do Until katamari1 = "" If i <= Integer.Parse(katamari1.Chars(0)) Then katamari2 &= i & katamari1 Exit Do Else katamari2 &= katamari1.Chars(0) katamari1 = katamari1.Substring(1) End If Loop If katamari1 = "" Then katamari2 &= i End If If mentuka(katamari2) Then seikou = True agarihai0.Add(i & iro) End If Next Else '字牌のとき If katamari = katamari.Chars(0) & katamari.Chars(0) Then seikou = True agarihai0.Add(katamari.Chars(0)) End If End If Return seikou End Function Function atamenkap1(ByVal katamari As String) As Boolean '1枚加えて頭+面子数組できるときtrue、色情報あり、上がり牌はagarihai0へ Dim katamari1 As String Dim katamari2 As String Dim seikou As Boolean = False agarihai0.Clear() If katamari.Chars(0) = "m" Or katamari.Chars(0) = "p" Or katamari.Chars(0) = "s" Then '数牌のとき Dim min As Integer = Math.Max(Integer.Parse(katamari.Chars(1)) - 1, 1) Dim max As Integer = Math.Min(Integer.Parse(katamari.Chars(katamari.Length - 1)) + 1, 9) Dim iro As String = katamari.Chars(0) katamari = katamari.Substring(1) For i As Integer = min To max katamari1 = katamari katamari2 = "" Do Until katamari1 = "" If i <= Integer.Parse(katamari1.Chars(0)) Then katamari2 &= i & katamari1 Exit Do Else katamari2 &= katamari1.Chars(0) katamari1 = katamari1.Substring(1) End If Loop If katamari1 = "" Then katamari2 &= i End If If atamenka(katamari2) Then seikou = True agarihai0.Add(i & iro) End If Next Else '字牌のとき If katamari.Length = 1 Then seikou = True agarihai0.Add(katamari.Chars(0)) End If End If Return seikou End Function Function kokusika(ByVal tehai As String) As Boolean '国士で上がっているか Dim suu As Integer Dim ketu() As Integer = New Integer(12) {} For i As Integer = 0 To 12 ketu(i) = 0 Next If tehai.Contains(";") Then Return False End If Do Until tehai = "" If Integer.TryParse(tehai.Chars(0), suu) Then '最初の牌が数牌 Select Case tehai.Chars(1) Case "m" If suu = 1 Then ketu(0) += 1 ElseIf suu = 9 Then ketu(1) += 1 Else Return False End If Case "p" If suu = 1 Then ketu(2) += 1 ElseIf suu = 9 Then ketu(3) += 1 Else Return False End If Case "s" If suu = 1 Then ketu(4) += 1 ElseIf suu = 9 Then ketu(5) += 1 Else Return False End If Case Else Return False End Select tehai = tehai.Substring(2) Else '最初の牌が字牌 Select Case tehai.Chars(0) Case "東" ketu(6) += 1 Case "南" ketu(7) += 1 Case "西" ketu(8) += 1 Case "北" ketu(9) += 1 Case "白" ketu(10) += 1 Case "発" ketu(11) += 1 Case "中" ketu(12) += 1 Case Else Return False End Select tehai = tehai.Substring(1) End If Loop suu = 0 For i As Integer = 0 To 12 If ketu(i) = 1 Then ElseIf ketu(i) = 2 Then If suu = 0 Then suu += 1 Else Return False End If Else Return False End If Next Return True End Function Function kokusip1(ByVal tehai As String) As Boolean '1枚たして国士か、上がり牌はagarihai1へ Dim suu As Integer Dim ketu() As Integer = New Integer(12) {} For i As Integer = 0 To 12 ketu(i) = 0 Next If tehai.Contains(";") Then Return False End If Do Until tehai = "" If Integer.TryParse(tehai.Chars(0), suu) Then '最初の牌が数牌 Select Case tehai.Chars(1) Case "m" If suu = 1 Then ketu(0) += 1 ElseIf suu = 9 Then ketu(1) += 1 Else Return False End If Case "p" If suu = 1 Then ketu(2) += 1 ElseIf suu = 9 Then ketu(3) += 1 Else Return False End If Case "s" If suu = 1 Then ketu(4) += 1 ElseIf suu = 9 Then ketu(5) += 1 Else Return False End If Case Else Return False End Select tehai = tehai.Substring(2) Else '最初の牌が字牌 Select Case tehai.Chars(0) Case "東" ketu(6) += 1 Case "南" ketu(7) += 1 Case "西" ketu(8) += 1 Case "北" ketu(9) += 1 Case "白" ketu(10) += 1 Case "発" ketu(11) += 1 Case "中" ketu(12) += 1 Case Else Return False End Select tehai = tehai.Substring(1) End If Loop suu = 1 Dim j As Integer = -1 For i As Integer = 0 To 12 If Not ketu(i) = 1 Then suu = 0 Exit For End If Next If suu = 1 Then '13面待ち agarihai1.Add("1m") agarihai1.Add("9m") agarihai1.Add("1p") agarihai1.Add("9p") agarihai1.Add("1s") agarihai1.Add("9s") agarihai1.Add("東") agarihai1.Add("南") agarihai1.Add("西") agarihai1.Add("北") agarihai1.Add("白") agarihai1.Add("発") agarihai1.Add("中") Return True End If For i As Integer = 0 To 12 If ketu(i) = 1 Then ElseIf ketu(i) = 0 Then If j = -1 Then j = i Else Return False End If ElseIf ketu(i) = 2 Then suu += 1 Else Return False End If Next If j >= 0 And suu = 1 Then '国士1面待ち Select Case j Case 0 agarihai1.Add("1m") Case 1 agarihai1.Add("9m") Case 2 agarihai1.Add("1p") Case 3 agarihai1.Add("9p") Case 4 agarihai1.Add("1s") Case 5 agarihai1.Add("9s") Case 6 agarihai1.Add("東") Case 7 agarihai1.Add("南") Case 8 agarihai1.Add("西") Case 9 agarihai1.Add("北") Case 10 agarihai1.Add("白") Case 11 agarihai1.Add("発") Case 12 agarihai1.Add("中") Case Else Return False End Select Return True Else '国士の待ちでない Return False End If End Function Function titoi(ByVal tehai As String) As Boolean 'チートイであがっているか Dim hai As String Dim suu As Integer If tehai.Contains(";") Then Return False End If Do Until tehai = "" If Integer.TryParse(tehai.Chars(0), suu) Then hai = tehai.Substring(0, 2) Else hai = tehai.Substring(0, 1) End If If miemai(tehai, hai) = 2 Then tehai = kiri(kiri(tehai, hai), hai) Else Return False End If Loop Return True End Function Function titoip1(ByVal tehai As String) As Boolean '1枚たしてチートイか、上がり牌はagarihai1へ Dim hai As String Dim hai2 As String = "" Dim suu As Integer If tehai.Contains(";") Then Return False End If Do Until tehai = "" If Integer.TryParse(tehai.Chars(0), suu) Then hai = tehai.Substring(0, 2) Else hai = tehai.Substring(0, 1) End If If miemai(tehai, hai) = 2 Then tehai = kiri(kiri(tehai, hai), hai) ElseIf miemai(tehai, hai) = 1 And hai2 = "" Then hai2 = hai tehai = kiri(tehai, hai) Else Return False End If Loop If hai2 = "" Then Return False Else agarihai1.Add(hai2) Return True End If End Function Function titoiishan(ByVal tehai As String) As String 'チートイ一向聴か聴牌なら浮き牌を返す Dim hai As String Dim hai2 As String = "" Dim suu As Integer Dim toitu As Integer = 0 If tehai.Contains(";") Then Return "" End If Do Until tehai = "" If Integer.TryParse(tehai.Chars(0), suu) Then hai = tehai.Substring(0, 2) Else hai = tehai.Substring(0, 1) End If If miemai(tehai, hai) >= 2 Then toitu += 1 Else hai2 &= hai End If tehai = tehai.Substring(hai.Length * miemai(tehai, hai)) Loop If toitu >= 5 Then Return hai2 Else Return "" End If End Function Public Function agarika(ByVal tehai As String) As Boolean '14枚手牌が上がりならtrue Dim atamanasi As Boolean = True Dim katamari1 As String Dim kekka As Boolean = True bunkatu(tehai, 0) For i As Integer = 0 To tekatu.Count - 1 If tekatu(i).Chars(0) = "m" Or tekatu(i).Chars(0) = "p" Or tekatu(i).Chars(0) = "s" Then katamari1 = tekatu(i).Substring(1) Else katamari1 = tekatu(i) End If Select Case katamari1.Length Mod 3 Case 0 '3の倍数→塊で面子を作れるか If Not mentuka(katamari1) Then kekka = False End If Case 1 'あまり1→面子や頭を作りえない kekka = False Case 2 'あまり2→頭1組と面子を作れるか If atamanasi And atamenka(katamari1) Then 'まだ頭がなくてこのkatamariで頭と面子が作れる atamanasi = False Else kekka = False End If End Select Next If atamanasi Then kekka = False End If If Not kekka AndAlso (kokusika(tehai) OrElse titoi(tehai)) Then kekka = True End If Return kekka End Function Public Function tenpaika(ByVal tehai As String) As Boolean '13枚手牌が聴牌ならtrue、上がり牌はagarihai1へ Dim suu1 As Integer = -1 Dim suu2 As Integer = -1 Dim suu3 As Integer = -1 Dim katamari As String Dim kekka As Boolean = True Dim kekka2 As Boolean = False bunkatu(tehai, 1) agarihai1.Clear() For i As Integer = 0 To tekatu.Count - 1 If tekatu(i).Chars(0) = "m" Or tekatu(i).Chars(0) = "p" Or tekatu(i).Chars(0) = "s" Then katamari = tekatu(i).Substring(1) Else katamari = tekatu(i) End If Select Case katamari.Length Mod 3 Case 0 '3の倍数→塊で面子を作れるか If Not mentuka(katamari) Then kekka = False End If Case 1 'あまり1→この部分に1枚加えて頭+面子 If suu1 = -1 Then suu1 = i Else kekka = False End If Case 2 'あまり2→これが２つで1枚加えて頭+面子 If suu2 = -1 Then suu2 = i ElseIf suu3 = -1 Then suu3 = i Else kekka = False End If End Select Next If kekka And suu1 >= 0 Then If suu2 >= 0 Then kekka = False Else If atamenkap1(tekatu(suu1)) Then kekka = True For i As Integer = 0 To agarihai0.Count - 1 agarihai1.Add(agarihai0(i)) Next Else kekka = False End If End If ElseIf kekka And suu2 >= 0 And suu3 >= 0 Then If atamenka(tekatu(suu2)) And mentukap1(tekatu(suu3)) Then kekka2 = True For i As Integer = 0 To agarihai0.Count - 1 agarihai1.Add(agarihai0(i)) Next End If If atamenka(tekatu(suu3)) And mentukap1(tekatu(suu2)) Then kekka2 = True For i As Integer = 0 To agarihai0.Count - 1 agarihai1.Add(agarihai0(i)) Next End If kekka = kekka2 Else kekka = False End If If Not kekka AndAlso (kokusip1(tehai) OrElse titoip1(tehai)) Then '面子手でテンパイでないとき国士とチートイを判定 kekka = True End If Return kekka End Function Public Function tenpaika14(ByVal tehai As String) As Boolean '14枚手牌が聴牌ならtrue Dim kekka As Boolean = False If agarika(tehai) Then kekka = False Else Dim hais As List(Of String) = New List(Of String)() Dim hai As String Dim temp As String = tehai Dim a As Integer Do Until temp = tehai If Integer.TryParse(temp.Chars(0), a) Then hai = temp.Substring(0, 2) temp = temp.Substring(2) If Not hais.Contains(hai) Then hais.Add(hai) End If Else hai = temp.Chars(0) temp = temp.Substring(0, 1) If Not hais.Contains(hai) Then hais.Add(hai) End If End If Loop For i As Integer = 0 To hais.Count - 1 temp = kiri(tehai, hais(0)) If tenpaika(temp) Then kekka = True Exit For End If Next End If End Function Function tokuten(ByVal agarihan As Integer, ByVal agarifu As Integer, ByVal kubun As Integer) As Integer '得点 'kubun…0-親ツモ和了点,1-親ロン和了点,2-子ツモ和了点,3-子ロン和了点,4-子被ツモ失点,5-親被ツモ失点、親和了時被ツモ失点 Dim oyatumo As Integer = 0 Dim oyaron As Integer = 0 Dim kotumo As Integer = 0 Dim koron As Integer = 0 Select Case agarihan Case 1 Select Case agarifu Case 30 oyatumo = 500 oyaron = 1500 kotumo = 300 koron = 1000 Case 40 oyatumo = 700 oyaron = 2000 kotumo = 400 koron = 1300 Case 50 oyatumo = 800 oyaron = 2400 kotumo = 400 koron = 1600 Case 60 oyatumo = 1000 oyaron = 2900 kotumo = 500 koron = 2000 Case 70 oyatumo = 1200 oyaron = 3400 kotumo = 600 koron = 2300 Case 80 oyatumo = 1300 oyaron = 3900 kotumo = 700 koron = 2600 Case 90 oyatumo = 1500 oyaron = 4400 kotumo = 800 koron = 2900 Case 100 oyatumo = 1600 oyaron = 4800 kotumo = 800 koron = 3200 End Select Case 2 Select Case agarifu Case 20 oyatumo = 700 oyaron = 2000 kotumo = 400 koron = 1300 Case 25 oyatumo = 800 oyaron = 2400 kotumo = 400 koron = 1600 Case 30 oyatumo = 1000 oyaron = 3000 kotumo = 500 koron = 2000 Case 40 oyatumo = 1300 oyaron = 3900 kotumo = 700 koron = 2600 Case 50 oyatumo = 1600 oyaron = 4800 kotumo = 800 koron = 3200 Case 60 oyatumo = 2000 oyaron = 5800 kotumo = 1000 koron = 3900 Case 70 oyatumo = 2300 oyaron = 6800 kotumo = 1200 koron = 4500 Case 80 oyatumo = 2600 oyaron = 7700 kotumo = 1300 koron = 5200 Case 90 oyatumo = 2900 oyaron = 8700 kotumo = 1500 koron = 5800 Case 100 oyatumo = 3200 oyaron = 9600 kotumo = 1600 koron = 6400 Case 110 oyatumo = 3600 oyaron = 10600 kotumo = 1800 koron = 7100 End Select Case 3 Select Case agarifu Case 20 oyatumo = 1300 oyaron = 3900 kotumo = 700 koron = 2600 Case 25 oyatumo = 1600 oyaron = 4800 kotumo = 800 koron = 3200 Case 30 oyatumo = 2000 oyaron = 5800 kotumo = 1000 koron = 3900 Case 40 oyatumo = 2600 oyaron = 7700 kotumo = 1300 koron = 5200 Case 50 oyatumo = 3200 oyaron = 9600 kotumo = 1600 koron = 6400 Case 60 oyatumo = 3900 oyaron = 11600 kotumo = 2000 koron = 7700 Case Is > 60 oyatumo = 4000 oyaron = 12000 kotumo = 2000 koron = 8000 End Select Case 4 Select Case agarifu Case 20 oyatumo = 2600 oyaron = 7700 kotumo = 1300 koron = 5200 Case 25 oyatumo = 3200 oyaron = 9600 kotumo = 1600 koron = 6400 Case 30 oyatumo = 3900 oyaron = 11600 kotumo = 2000 koron = 7700 Case Is > 30 oyatumo = 4000 oyaron = 12000 kotumo = 2000 koron = 8000 End Select Case 5 oyatumo = 4000 oyaron = 12000 kotumo = 2000 koron = 8000 Case 6, 7 oyatumo = 6000 oyaron = 18000 kotumo = 3000 koron = 12000 Case 8, 9, 10 oyatumo = 8000 oyaron = 24000 kotumo = 4000 koron = 16000 Case 11, 12 oyatumo = 12000 oyaron = 36000 kotumo = 6000 koron = 24000 Case 13 oyatumo = 16000 oyaron = 48000 kotumo = 8000 koron = 32000 End Select Select Case kubun Case 0 '親ツモ和了点 Return oyatumo * 3 Case 1 '親ロン和了点 Return oyaron Case 2 '子ツモ和了点 Return kotumo * 2 + oyatumo Case 3 '子ロン和了点 Return koron Case 4 '子被ツモ失点 Return kotumo Case 5 '親被ツモ失点、親和了時被ツモ失点 Return oyatumo End Select End Function Function jihaika(ByVal hai As String) As Boolean '字牌ならtrueを返す Select Case hai Case "東", "南", "西", "北", "白", "発", "中" Return True Case Else Return False End Select End Function Public Function ryoukei(ByVal tehai As String) As Boolean '良型（字牌待ちか2種5枚以上待ち）ならtrueを返す Dim mai As Integer = 0 For i As Integer = 0 To agarihai1.Count - 1 If jihaika(agarihai1(i)) Then '上がり牌が字牌 Return True End If mai += 4 - miemai(tehai, agarihai1(i)) Next If agarihai1.Count >= 2 And mai >= 5 Then Return True Else Return False End If End Function Function ritigenbutu(ByVal hai As String) As Boolean '全リーチ者の現物ならtureを返す(リーチ者なしでもtrue) Dim k As Integer = ritisha.Count Dim hantei As Boolean = True For i As Integer = 1 To k If Not gen(ritisha(i - 1)).Contains(hai) Then hantei = False End If Next Return hantei End Function Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim fs2 As FileStream Dim sw As StreamWriter Dim fs3 As FileStream Dim sr2 As StreamReader Try fs = New FileStream(haifu, FileMode.Open) sr = New StreamReader(fs, Encoding.GetEncoding("Shift_jis")) Dim yomi As String fs3 = New FileStream(dataa, FileMode.Open) sr2 = New StreamReader(fs3, Encoding.GetEncoding("Shift_jis")) For i As Integer = 1 To 18 yomi = sr2.ReadLine For j As Integer = 0 To 10 If yomi.Contains(ControlChars.Tab) Then houritu(i, j) = Double.Parse(yomi.Substring(0, yomi.IndexOf(ControlChars.Tab))) yomi = yomi.Substring(yomi.IndexOf(ControlChars.Tab) + 1) Else houritu(i, j) = Double.Parse(yomi) End If Next Next For i As Integer = 0 To 22 For j As Integer = 0 To KEKKA2 For k As Integer = 0 To KEKKA3 For l As Integer = 0 To KEKKA4 kekka1(i, j, k, l) = 0 Next Next Next Next sr2.Close() For j As Integer = 0 To 10 houritu(19, j) = houritu(18, j) houritu(20, j) = houritu(18, j) Next kyoku = 0 risuu = 0 Do kyoku1(True) '集計本体 Loop Until bun Is Nothing For j As Integer = 0 To KEKKA2 For k As Integer = 0 To KEKKA3 For l As Integer = 0 To KEKKA4 kekka1(18, j, k, l) += kekka1(19, j, k, l) kekka1(18, j, k, l) += kekka1(20, j, k, l) kekka1(18, j, k, l) += kekka1(21, j, k, l) kekka1(18, j, k, l) += kekka1(22, j, k, l) Next Next Next Label2.Text = kyoku sr.Close() hyouji() fs2 = New FileStream(shutu, FileMode.Append) sw = New StreamWriter(fs2, Encoding.GetEncoding("Shift_jis")) sw.WriteLine("局数" & ControlChars.Tab & kyoku) For K4 As Integer = 0 To KEKKA4 sw.WriteLine("K4=" & K4) For K3 As Integer = 0 To KEKKA3 sw.WriteLine("K3=" & K3) For i As Integer = 1 To 18 sw.Write(i) For j As Integer = 0 To KEKKA2 sw.Write(ControlChars.Tab & kekka1(i, j, K3, K4)) Next sw.Write(ControlChars.CrLf) Next Next Next sw.Close() Catch ex As FileNotFoundException Label2.Text = "ファイルが存在しません" End Try End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click End Sub Private Sub NumericUpDown1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) hyouji() End Sub End Class