frmmian.frm

wu zi qi suan fa

                       Tu2 = meUser
                       Tsx2 = I
                       Tsy2 = L
                       Ts2 = Ts
                    End If
                 End If
              Else:
                 Tu2 = meUser
                 Tsx2 = I
                 Tsy2 = L
                 L = 15
                 I = 15
              End If
           End If
       Next
   Next
   If Ts2 < 6 And Ts2 > 0 Then
      If Ts2 < 4 Then
         Tt = 2
      Else:
         If Ts1 < Ts2 Then
            Tt = 1
         Else:
            Tt = 2
         End If
      End If
   Else:
      Tt = 0
   End If
Else:
   Tt = 1
End If
If Tt = 1 Then
   mTest = Ts1
   meUser = Tu1
   mGetx = Tsx1
   mGety = Tsy1
Else:
   If Tt = 2 Then
      mTest = Ts2
      mGetx = Tsx2
      mGety = Tsy2
      meUser = Tu2
   End If
End If
meThink1 = Tt
End Function

'陷阱识别
Private Function meTest3(ByVal X As Integer, ByVal Y As Integer) As Byte
Dim L As Integer, I As Integer
Dim Ts As Integer, Tn As Integer
Dim Tx As String
'特征数值
mTx1 = "A"
mTx2 = "B"
Tx = ""
For L = 0 To 7
    meChangV X, Y, L
    Tn = 0
    For I = 0 To 4
        Tn = Tn + 1
        If mBT(I) = mBW(X, Y) Then
           Ts = Ts + mBaseDa(Tn)
        Else:
           If mBT(I) <> 0 Then
              Ts = 0
              Exit For
           End If
       End If
    Next
    Tx = Tx & mTx1 & Ts & mTx2
Next
'********* 检索陷阱记录
Dim dbTt As Recordset
Set dbTt = dbsS.OpenRecordset("SELECT * From XianJ WHERE Tex LIKE '*" & Tx & "*'")
Ts = 0
mErrTx = ""
If dbTt.RecordCount > 0 Then
   '回忆以前所犯错误
   If dbTt("Err") <> "" Then mErrTx = dbTt("Err")
End If
meTest3 = Ts
End Function

'陷阱学习
Private Function meStu1() As Byte
Dim I As Integer, Tn As Integer
'模拟棋局复盘
For I = 0 To mIndex Step 2
    Tn = mIndex - I
    If Tn > 4 Then
       '判断陷阱的开始
       mBW(mBP(Tn - 1, 0), mBP(Tn - 1, 1)) = 0
       If mBP(Tn - 2, 2) > 5 And mBP(Tn - 3, 2) > 5 Then
          Ts = meTest2(mBP(Tn, 0), mBP(Tn, 1), Tn)
          Exit For
       Else:
          mBW(mBP(Tn, 0), mBP(Tn, 1)) = 0
       End If
    End If
Next
For I = 1 To mIndex
    If I Mod 2 = 0 Then
       mBW(mBP(I, 0), mBP(I, 1)) = 2
    Else:
       mBW(mBP(I, 0), mBP(I, 1)) = 1
    End If
Next
End Function

'倍份棋局
Private Sub meSaveBack()
Dim dbsT As Recordset, Tnl As Long
Dim I As Integer, Tn As Integer
   Set dbsT = dbsS.OpenRecordset("SELECT MAX(ID) FROM QiJu")
   mIDs = 1
   If VarType(dbsT(0)) > 1 Then mIDs = dbsT(0) + 1
   Set dbsT = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE ID=" & CStr(mIDs))
   If dbsT.RecordCount > 0 Then
      Do Until dbsT.RecordCount = 0
         dbsT.MoveFirst
         dbsT.Delete
      Loop
   End If
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE ID=0 ORDER BY INDEX")
   Tn = dbsR.Fields.Count - 1
   If dbsR.RecordCount > 0 Then
      Do Until dbsR.EOF
         dbsT.AddNew
         For I = 0 To Tn
             dbsT(I) = dbsR(I)
             dbsT("ID") = mIDs
         Next
         dbsT.Update
         dbsR.MoveNext
      Loop
   End If
End Sub

'陷阱阵型学习
Private Function meTest2(ByVal X As Integer, ByVal Y As Integer, ByVal Index As Integer) As Byte
Dim L As Integer, I As Integer
Dim Ts As Integer, Tn As Integer
Dim mTsn(7) As Byte, Tx As String
Dim mTx1 As String, mTx2 As String
'特征数值
mTx1 = "A"
mTx2 = "B"
For L = 0 To 7
    meChangV X, Y, L
    Tn = 0
    For I = 0 To 4
        Tn = Tn + 1
        If mBT(I) = mBW(X, Y) Then
           Ts = Ts + mBaseDa(Tn)
        Else:
           If mBT(I) <> 0 Then
              Ts = 0
              Exit For
           End If
       End If
    Next
    mTsn(L) = Ts
Next
'分析阵型变化
'************ 1 旋转
Tx = ""
For L = 0 To 7
    Tx = Tx & "0" & L
    For I = 0 To 7
        Ts = I - L
        If Ts < 0 Then
           Ts = 8 + Ts
        End If
        Tx = Tx & mTx1 & mTsn(Ts) & mTx2
    Next
Next
'************ 2 镜象+旋转
For I = 1 To 3
    Ts = mTsn(I)
    mTsn(I) = mTsn(8 - I)
    mTsn(8 - I) = Ts
Next
For L = 0 To 7
    Tx = Tx & "1" & L
    For I = 0 To 7
        Ts = I - L
        If Ts < 0 Then
           Ts = 8 + Ts
        End If
        Tx = Tx & mTx1 & mTsn(Ts) & mTx2
    Next
Next
'********* 记录学习结果
Dim dbTt As Recordset
Set dbTt = dbsS.OpenRecordset("SELECT * From XianJ WHERE Tex='" & Tx & "'")
If dbTt.RecordCount = 0 Then
   dbTt.AddNew
   dbTt("ID") = mIDs
   dbTt("Index") = Index
   dbTt("Tex") = Tx
   dbTt("Err") = mTx1 & mBP(Index + 1, 3) & mTx2
   dbTt.Update
Else:
   '记录电脑所犯错误
   Tx = mTx1 & mBP(Index + 1, 3) & mTx2
   If InStr(1, dbTt("Err"), Tx) = 0 Then
      dbTt.Edit
      dbTt("ID") = mIDs
      dbTt("Index") = Index
      dbTt("Err") = dbTt("Err") & Tx
      dbTt.Update
   End If
End If
End Function

'棋盘坐标转换(陷阱)
Private Sub meChangV(ByVal X As Integer, ByVal Y As Integer, ByVal Index As Integer)
Dim I As Integer, Xg As Integer, Yg As Integer, Ts As Byte
Dim Tx1 As Integer, Tx2 As Integer, Ty1 As Integer, Ty2 As Integer
If mBW(X, Y) = 1 Then
   Ts = 2
Else:
   Ts = 1
End If
For I = 0 To 4
    Select Case Index
        Case 0
             Xg = X
             Yg = Y - I
        Case 1
             Xg = X - I
             Yg = Y - I
        Case 2
             Xg = X + I
             Yg = Y
        Case 3
             Xg = X + I
             Yg = Y + I
        Case 4
             Xg = X
             Yg = Y + I
        Case 5
             Xg = X - I
             Yg = Y + I
        Case 6
             Xg = X - I
             Yg = Y
        Case 7
             Xg = X - I
             Yg = Y - I
    End Select
    If Xg >= 0 And Yg >= 0 And Xg < 15 And Yg < 15 Then
       mBT(I) = mBW(Xg, Yg)
    Else:
       mBT(I) = Ts
    End If
Next
End Sub

'基本状态判断
Private Function meTest1(ByVal X As Integer, ByVal Y As Integer, ByVal Index As Integer) As Byte
Dim L As Byte, I As Byte, N As Byte, Tt As Byte
Dim Ts As Byte, Tn As Byte, Tl As Byte
Dim mMuset As Byte, Lu As Byte
mMuset = 100
mSpxyCu = 0
mSpxyLu = 0
For L = 0 To 7
    meChangH X, Y, L
    Tn = 0
    Ts = 0
    Lu = 0
    Tt = 0
    For I = 0 To 7
        Tn = Tn + 1
        If mBT(I) = mBW(X, Y) Then
           Ts = Ts + mBaseDa(Tn)
        Else:
           If mBT(I) <> 0 Then
              Tt = 3
              If Ts > 0 Then
                 Ts = Ts + 100
                 If mBase(Ts, 0) > 0 Then
                    Tt = 1
                 End If
              End If
          End If
       End If
       If Tn = 6 Or (I = 7 And Tn > 0) Then
          If Ts > 0 Then
             Tt = 2
          Else:
             Tt = 4
          End If
       End If
       If Tt = 1 Or Tt = 2 Then
          If mMuset >= mBase(Ts, 0) Then
             If mMuset > mBase(Ts, 0) Then mSpxyCu = 0
             mMuset = mBase(Ts, 0)
             If mMuset < 6 Then Lu = 1
             For N = 1 To 4
                 If mBase(Ts, N) = 0 Then
                    Exit For
                 Else:
                    meChangP X, Y, L, mBase(Ts, N) + I - 6
                 End If
             Next
          End If
       End If
       If Tt = 2 Or Tt = 4 Then
          If I <> 7 Then I = I - 5
          Tn = 0
          Ts = 0
       Else:
          If Tt = 1 Or Tt = 3 Then
             Tn = 0
             Ts = 0
          End If
       End If
       Tt = 0
    Next
    If Lu = 1 Then mSpxyLu = mSpxyLu + 1
Next
meUser = 0
If Index = 1 Then
   If mMuset > 1 And mMuset < 6 Then
      If mSpxyLu > 2 Then
         mMuset = 2 '加权
      Else:
         Ts = meTest3(X, Y) '陷阱
         If Ts = 2 Then
            mMuset = 2
         Else:
            mMuset = 3
         End If
      End If
   End If
End If
meTest1 = mMuset
End Function

'状转换到棋盘坐标(基本分析)
Private Sub meChangP(ByVal X As Integer, ByVal Y As Integer, ByVal Index As Integer, ByVal IndLp As Integer)
Dim I As Integer, Xg As Integer, Yg As Integer, Ts As Byte
Dim Tx1 As Integer, Tx2 As Integer, Ty1 As Integer, Ty2 As Integer
Tx1 = X - 4
Tx2 = X + 4
Ty1 = Y - 4
Ty2 = Y + 4
If mBW(X, Y) = 1 Then
   Ts = 2
Else:
   Ts = 1
End If
Select Case Index
    Case 0
         Xg = X
         Yg = Ty1 + IndLp
    Case 1
         Xg = Tx1 + IndLp
         Yg = Ty2 - IndLp
    Case 2
         Xg = Tx1 + IndLp
         Yg = Y
    Case 3
         Xg = Tx1 + IndLp
         Yg = Ty1 + IndLp
    Case 4
         Xg = X
         Yg = Ty2 - IndLp
    Case 5
         Xg = Tx2 - IndLp
         Yg = Ty1 + IndLp
    Case 6
         Xg = Tx2 - IndLp
         Yg = Y
    Case 7
         Xg = Tx2 - IndLp
         Yg = Ty2 - IndLp
End Select
If mSpxyCu < 990 And Xg >= 0 And Yg >= 0 And Xg < 15 And Yg < 15 Then
   If mBW(Xg, Yg) = 0 Then
      Ts = 0
      For I = 1 To mSpxyCu
          If mSpxy(I, 0) = Xg And mSpxy(I, 1) = Yg Then
             Ts = 1
             Exit For
          End If
      Next
      If Ts = 0 Then
         mSpxyCu = mSpxyCu + 1
         mSpxy(mSpxyCu, 0) = Xg
         mSpxy(mSpxyCu, 1) = Yg
      End If
'   Else:
'      MsgBox " 坐标计算错误！", 48
   End If
End If
End Sub

'棋盘坐标转换(基本分析)
Private Sub meChangH(ByVal X As Integer, ByVal Y As Integer, ByVal Index As Integer)
Dim I As Integer, Xg As Integer, Yg As Integer, Ts As Byte
Dim Tx1 As Integer, Tx2 As Integer, Ty1 As Integer, Ty2 As Integer
Tx1 = X - 4
Tx2 = X + 4
Ty1 = Y - 4
Ty2 = Y + 4
If mBW(X, Y) = 1 Then