frmmian.frm

wu zi qi suan fa

   Ts = 2
Else:
   Ts = 1
End If
For I = 0 To 7
    Select Case Index
        Case 0
             Xg = X
             Yg = Ty1 + I
        Case 1
             Xg = Tx1 + I
             Yg = Ty2 - I
        Case 2
             Xg = Tx1 + I
             Yg = Y
        Case 3
             Xg = Tx1 + I
             Yg = Ty1 + I
        Case 4
             Xg = X
             Yg = Ty2 - I
        Case 5
             Xg = Tx2 - I
             Yg = Ty1 + I
        Case 6
             Xg = Tx2 - I
             Yg = Y
        Case 7
             Xg = Tx2 - I
             Yg = Ty2 - 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 Sub meSave(ByVal X As Integer, ByVal Y As Integer)
dbsR.AddNew
dbsR("ID") = mIDs
dbsR("Index") = mIndex
dbsR("TsX") = X
dbsR("TsY") = Y
dbsR("Test") = mTest
dbsR("User") = meUser
dbsR.Update
mBP(mIndex, 2) = mTest
mBP(mIndex, 3) = meUser
If mTest = 1 Then
   mModel = 3
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE INDEX=0 AND ID=0")
   dbsR.Edit
   dbsR("TestMode") = mBW(X, Y)
   dbsR.Update
   meSaveBack
   meStu1
   If mBW(X, Y) = 1 Then
      MsgBox " 黑方胜！", 64
   Else:
      MsgBox " 白方胜！", 64
   End If
End If
End Sub

'显示棋子
Private Sub meShow(ByVal X As Integer, ByVal Y As Integer)
Timer1.Enabled = False
Timer1.Tag = "4"
If mPCountB > 0 Then mUserCtrl.Visible = True
If mPCountB > mPCountW Then
   mPCountW = mPCountW + 1
   Load imgW(mPCountW)
   Set mUserCtrl = imgW(mPCountW)
   mBW(X, Y) = 2
Else:
   mPCountB = mPCountB + 1
   Load imgB(mPCountB)
   Set mUserCtrl = imgB(mPCountB)
   mBW(X, Y) = 1
End If
mIndex = mIndex + 1
mBP(mIndex, 0) = X
mBP(mIndex, 1) = Y
mBP(mIndex, 2) = mTest
mBP(mIndex, 3) = meUser
mUserCtrl.ToolTipText = mIndex
If numFlash.Checked Then Timer1.Enabled = True
With mUserCtrl
     .Left = mWidthStr + mWidth * X - 165
     .Top = mWidthStr + mWidth * Y - 165
     .Visible = True
End With
End Sub

'鼠标位置计算
Private Sub meDown(ByVal X As Single, ByVal Y As Single)
Dim Tl As Integer, Ts As Long
Dim Tsx As Integer, Tsy As Integer
Tl = mWidth \ 4
If X > mWidthStr - Tl And X < mWidthEnd + Tl Then
   If Y > mWidthStr - Tl And Y < mWidthEnd + Tl Then
      Ts = X - mWidthStr
      If Ts < 0 Then
         Tsx = 0
      Else:
         Tsx = Ts \ mWidth
         Ts = Ts Mod mWidth
         If Ts > Tl * 3 Then
            Tsx = Tsx + 1
         Else:
            If Ts > Tl Then Tsx = -1
         End If
      End If
      Ts = Y - mWidthStr
      If Ts < 0 Then
         Tsy = 0
      Else:
         Tsy = Ts \ mWidth
         Ts = Ts Mod mWidth
         If Ts > Tl * 3 Then
            Tsy = Tsy + 1
         Else:
            If Ts > Tl Then Tsy = -1
         End If
      End If
      If Tsx >= 0 And Tsy >= 0 Then
         If mBW(Tsx, Tsy) = 0 Then
            If mPCountB > mPCountW Then
               mBW(Tsx, Tsy) = 2
            Else:
               mBW(Tsx, Tsy) = 1
            End If
            meUser = 0
            mTest = meTest1(Tsx, Tsy, 1)
            meShow Tsx, Tsy
            meSave Tsx, Tsy
            If mTest <> 1 Then meComP1
         End If
      End If
   End If
End If
End Sub

'清除棋子
Private Sub meClear()
Dim I As Integer, L As Integer
For I = 1 To mPCountB
    Unload imgB(I)
Next
For L = 1 To mPCountW
    Unload imgW(L)
Next
For I = 0 To 15
    For L = 0 To 15
        mBW(I, L) = 0
    Next
Next
mPCountB = 0
mPCountW = 0
Me.MousePointer = 0
End Sub

Private Sub Form_Load()
Dim Tx As String
mModel = 0
meUser = 0
mTest = 0
mErrTx = ""
mPCountB = 0
mPCountW = 0
mWidth = 420
mWidthStr = 285
mWidthEnd = 6165
numSetP(0).Checked = True
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then
    AppPath = AppPath & "\"
End If
numM1(1).Checked = True
Tx = AppPath & "BW.mdb"
If Len(Dir(Tx)) > 0 Then
   On Error GoTo ErOpenDB
   Set dbsS = OpenDatabase(Tx, 0, 0, ";PWD=")
   '*****************************************
   '读取基本知识库
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM Base  ORDER BY Index")
   If dbsR.RecordCount > 0 Then
      With dbsR
          Do Until .EOF
             mBase(dbsR("Index"), 0) = dbsR("Mode")
             Ts = 0
             Tx = dbsR("XY")
             Tn = 1
             Tl = 0
             If Tx <> "" Then
                For I = 1 To Len(Tx)
                    Ts = InStr(Tn, Tx, ",")
                    If Ts > 0 Then
                       Tl = Tl + 1
                       mBase(dbsR("Index"), Tl) = Val(Mid(Tx, Tn, Ts - Tn))
                       Tn = Ts + 1
                    Else:
                       Exit For
                    End If
                Next
             End If
             .MoveNext
          Loop
      End With
   End If
   mBaseDa(0) = 0
   mBaseDa(1) = 1
   mBaseDa(2) = 2
   mBaseDa(3) = 4
   mBaseDa(4) = 8
   mBaseDa(5) = 16
   mBaseDa(6) = 32
   '******************************************
   Me.Show
Else:
   MsgBox " 数据库文件丢失！", 48
   End
End If
Exit Sub
ErOpenDB: MsgBox " 系统数据库错误！", 48
          End
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 1 And mModel = 1 Then
   meDown X, Y
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Me.Visible Then
   Ts = MsgBox(" 退出游戏吗？", 36)
   If Ts = 6 Then
      Timer1.Enabled = False
      dbsS.Close
   Else:
      Cancel = True
   End If
End If
End Sub

Private Sub numBack_Click() '悔棋
If mModel = 1 Or mModel = 3 Then
   If mIndex > 0 Then
      Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE ID=0 AND Index=" & CStr(mIndex))
      If dbsR.RecordCount > 0 Then
         Timer1.Enabled = False
         Timer1.Tag = "4"
         mUserCtrl.Visible = True
         If mPCountB > mPCountW Then
            If mPCountB > 0 Then
            Unload imgB(mPCountB)
            Set mUserCtrl = imgW(mPCountW)
            mPCountB = mPCountB - 1
            End If
         Else:
            If mPCountW > 0 Then
            Unload imgW(mPCountW)
            Set mUserCtrl = imgB(mPCountB)
            mPCountW = mPCountW - 1
            End If
         End If
         If numFlash.Checked Then Timer1.Enabled = True
         dbsR.Delete
         If mModel = 3 Then
            Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE INDEX=0 AND ID=0")
            dbsR.Edit
            dbsR("TestMode") = 0
            dbsR.Update
            mModel = 1
         End If
         mBW(mBP(mIndex, 0), mBP(mIndex, 1)) = 0
         mBP(mIndex, 2) = 99
         mBP(mIndex, 3) = 1
         mIndex = mIndex - 1
      End If
'   numSetP(1).Checked = False
'   numSetP(0).Checked = True
   End If
End If
End Sub

Private Sub numCou_Click() '继续棋局
If mModel = 0 Then
   mIDs = 0
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE ID=0")
   If dbsR.RecordCount > 0 Then
      With dbsR
           .MoveNext
           Do Until .EOF
              mTest = dbsR("Test")
              meUser = dbsR("User")
              meShow dbsR("TsX"), dbsR("TsY")
              .MoveNext
           Loop
           .MovePrevious
           mIndex = dbsR("Index")
           mModel = 1
           numSetP(1).Checked = False
           numSetP(0).Checked = True
      End With
   End If
End If
End Sub

Private Sub numExit_Click()
Unload Me
End Sub

Private Sub numFlash_Click() '闪烁棋子
If numFlash.Checked Then
   numFlash.Checked = False
   Timer1.Enabled = False
Else:
   numFlash.Checked = True
   If mModel > 0 And mModel < 3 Then Timer1.Enabled = True
End If
End Sub

Private Sub numM1_Click(Index As Integer)
numM1(0).Checked = False
numM1(1).Checked = False
numM1(2).Checked = False
numM1(Index).Checked = True
mModeC = Index
End Sub

Private Sub numNew_Click()
Dim Ts As Integer
If mModel > 0 Then
   Ts = MsgBox(" 终止当前游戏吗？", 36)
   If Ts = 6 Then
      mModel = 0
   End If
End If
If mModel = 0 Then
   Timer1.Enabled = False
   meClear
   mIDs = 0
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE ID=0")
   If dbsR.RecordCount > 0 Then
      With dbsR
         Do Until .RecordCount = 0
            .Delete
            .MoveFirst
         Loop
      End With
   End If
   mIndex = 0
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM QiJu WHERE ID=0")
   dbsR.AddNew
   dbsR("ID") = mIDs
   dbsR("Index") = 0
   dbsR.Update
   mModel = 1
   numSetP(1).Checked = False
   numSetP(0).Checked = True
End If
End Sub

Private Sub numSetP_Click(Index As Integer)
If mModel > 0 And mModel < 3 Then
   If Index = 1 Then
      mModel = 2
      If mIndex = 0 Then
         meShow 7, 7
         meSave 7, 7
      Else:
         Ts = mIndex
         mTest = meTest1(mBP(Ts, 0), mBP(Ts, 1), 1)
         If mTest <> 1 Then meComP1
      End If
      mModel = 1
   End If
End If
End Sub

Private Sub Timer1_Timer()
If mIndex > 0 Then
   Select Case Timer1.Tag
       Case "H"
            Timer1.Tag = "S"
            mUserCtrl.Visible = False
       Case "S"
            Timer1.Tag = "1"
            mUserCtrl.Visible = True
       Case "1"
            Timer1.Tag = "2"
       Case "2"
            Timer1.Tag = "3"
       Case "3"
            Timer1.Tag = "4"
       Case "4"
            Timer1.Tag = "5"
       Case "5"
            Timer1.Tag = "H"
   End Select
Else:
   mUserCtrl.Visible = False
   Timer1.Enabled = False
End If
End Sub