一个五子棋源码(2)

作者：佚名来源：不详整理日期：2007-4-13

End Sub

Private Function sCount(ByVal Fx As Integer, ByVal Fy As Integer, ByVal adx As Integer, _
                        ByVal ady As Integer, ByVal Compe As Integer) As Integer
Dim n As Integer
n = 0
Do While Compe = State(Fx + adx, Fy + ady)
   n = n + 1
   Fx = Fx + adx
   Fy = Fy + ady
Loop

sCount = n
End Function

Private Function PreCount(ByVal Fx As Integer, ByVal Fy As Integer, ByVal adx As Integer, _
                        ByVal ady As Integer, ByVal Compe As Integer) As Integer
Dim n As Integer
Dim xX1 As Integer
Dim yY1 As Integer
xX1 = Fx
yY1 = Fy
n = 0
Do While Compe = State(Fx + adx, Fy + ady)
   n = n + 1
   Fx = Fx + adx
   Fy = Fy + ady
Loop
   If State(Fx + adx, Fy + ady) = 0 Then
      If State(Fx + adx * 2, Fy + ady * 2) <> Compe Then
         PreCount = n
      Else
      PreCount = 0
      Exit Function
      End If
   End If
Do While Compe = State(xX1 - adx, yY1 - ady)
   n = n + 1
   xX1 = xX1 - adx
   yY1 = yY1 - ady
Loop
   If State(xX1 - adx, yY1 - ady) = 0 Then
      If State(xX1 - adx * 2, yY1 - ady * 2) <> Compe Then
      PreCount = n
      Else
      PreCount = 0
      Exit Function
      End If
   End If
End Function

Private Sub maxXY()

Dim index As Integer
For index = 1 To 6
If X1(index) = 2 Then
   nowX = XwinX(index)
   nowY = XwinY(index)
   CWIN = True
   GoTo compuwin
End If
Next
For index = 1 To 6
If X1(index) = 1 Then
   nowX = XwinX(index)
   nowY = XwinY(index) 当HW=1时，nowX,nowY 被改变
   X1(index) = 0
   GoTo compuwin
End If
Next

If llW = 1 Then
   nowX = llWinX
   nowY = llWinY
   llW = 0
   GoTo compuwin
End If
If HW = 1 Then
   nowX = HuX         当上面的步骤发生后，无法保证HuX,HuY的有效性，
   nowY = HuY                   可能有BUG的存在
   HW = 0
   GoTo compuwin
End If
Dim sumExp(1 To 13, 1 To 13) As Single
maxX = 1
maxY = 1
Dim n As Integer
Dim m As Integer
Dim i As Integer
i = 1
m = 1
n = 1
For n = 1 To 13
     For m = 1 To 13
        If State(n, m) <> 0 Then GoTo ln1
        For i = 1 To 8
            sumExp(n, m) = Exp(n, m, i, 1) + sumExp(n, m)
        Next
ln1: Next
Next
For n = 1 To 13
    For m = 1 To 13
        If State(n, m) <> 0 Then GoTo ln2

        If sumExp(n, m) <> 0 And sumExp(n, m) >= sumExp(maxX, maxY) Then
           maxX = n
           maxY = m
        End If
ln2:
    Next
Next
nowX = maxX
nowY = maxY

compuwin:

If State(nowX, nowY) = 0 Then
   State(nowX, nowY) = NowCompe
Else                                   判断和局
   MsgBox "和棋 !!", , "和棋 !!"
   picMain.Enabled = False
   Exit Sub
End If

picMain.PaintPicture picComputer.Picture, (nowX - 1) * 360 + 140, (nowY - 1) * 360 + 140, 222, 222
If CWIN = True Then

   Dim Sy As Integer, Sx As Integer, Tx As Integer, Ty As Integer
   Dim IsT As Boolean
   IsT = lineCount(nowX, nowY, Sx, Sy, Tx, Ty, 1, 1)
   If IsT = True Then
      picMain.Line ((Sx - 1) * 360 + 222, (Sy - 1) * 360 + 222)-((Tx - 1) * 360 + 222, (Ty - 1) * 360 + 222), QBColor(14)
      GoTo OKWIN
   End If
   IsT = lineCount(nowX, nowY, Sx, Sy, Tx, Ty, 1, 0)
   If IsT = True Then
      picMain.Line ((Sx - 1) * 360 + 222, (Sy - 1) * 360 + 222)-((Tx - 1) * 360 + 222, (Ty - 1) * 360 + 222), QBColor(14)
      GoTo OKWIN
   End If
   IsT = lineCount(nowX, nowY, Sx, Sy, Tx, Ty, 1, -1)
   If IsT = True Then
      picMain.Line ((Sx - 1) * 360 + 222, (Sy - 1) * 360 + 222)-((Tx - 1) * 360 + 222, (Ty - 1) * 360 + 222), QBColor(14)
      GoTo OKWIN
   End If
   IsT = lineCount(nowX, nowY, Sx, Sy, Tx, Ty, 0, 1)
   If IsT = True Then
      picMain.Line ((Sx - 1) * 360 + 222, (Sy - 1) * 360 + 222)-((Tx - 1) * 360 + 222, (Ty - 1) * 360 + 222), QBColor(14)
      GoTo OKWIN
   End If


OKWIN:
   picMain.Enabled = False
   Exit Sub
End If

picMain.Enabled = True
   If Not CheckDead(nowX, nowY, 1, 1) Then
      LeftCheck nowX, nowY, 1, 1
      CheckExp nowX, nowY, 1, 1
      DimenAdd nowX, nowY, 1, 1, 1
   End If
   If Not CheckDead(nowX, nowY, 1, 0) Then
      LeftCheck nowX, nowY, 1, 0
      CheckExp nowX, nowY, 1, 0
      DimenAdd nowX, nowY, 1, 0, 1
   End If
   If Not CheckDead(nowX, nowY, 0, 1) Then
      LeftCheck nowX, nowY, 0, 1
      CheckExp nowX, nowY, 0, 1
      DimenAdd nowX, nowY, 0, 1, 1
   End If
   If Not CheckDead(nowX, nowY, -1, 1) Then
      LeftCheck nowX, nowY, -1, 1
      CheckExp nowX, nowY, -1, 1
      DimenAdd nowX, nowY, -1, 1, 1
   End If
   If Not CheckDead(nowX, nowY, 1, -1) Then
      LeftCheck nowX, nowY, 1, -1
      CheckExp nowX, nowY, 1, -1
      DimenAdd nowX, nowY, 1, -1, 1
   End If
   If Not CheckDead(nowX, nowY, -1, 0) Then
      LeftCheck nowX, nowY, -1, 0
      CheckExp nowX, nowY, -1, 0
      DimenAdd nowX, nowY, -1, 0, 1
   End If
   If Not CheckDead(nowX, nowY, 0, -1) Then
      LeftCheck nowX, nowY, 0, -1
      CheckExp nowX, nowY, 0, -1
      DimenAdd nowX, nowY, 0, -1, 1
   End If
   If Not CheckDead(nowX, nowY, -1, -1) Then
      LeftCheck nowX, nowY, -1, -1
      CheckExp nowX, nowY, -1, -1
      DimenAdd nowX, nowY, -1, -1, 1
   End If
   PrePCX = nowX
   PrePCY = nowY
   NowCompe = 1
End Sub
Private Function XYDecide(ByRef Sx As Single, ByRef Sy As Single) As Integer
Dim rX As Single
Dim rY As Single
Dim tempX As Single
Dim tempY As Single
Dim sum As Integer
tempX = Sx Mod 360
tempY = Sy Mod 360
If (tempX >= 0 And tempX < 90) Or (tempX < 0 And tempX > -90) Then
   rX = (Sx \ 360) * 360
   sum = sum + 1
Else
   If tempX > 270 Then
      rX = (Sx \ 360 + 1) * 360
      sum = sum + 1
   End If
End If
If (tempY >= 0 And tempY < 90) Or (tempY < 0 And tempY > -90) Then
   rY = (Sy \ 360) * 360
   sum = sum + 1
Else
   If tempY > 270 Then
      rY = (Sy \ 360 + 1) * 360
      sum = sum + 1
   End If
End If

Sx = rX
Sy = rY
If sum = 2 Then XYDecide = 1
End Function

Private Function CheDimens(ByVal adx As Integer, ByVal ady As Integer) As Integer
adx，ady表示往哪儿加
要求往左边加表明有来自右边的期望
If adx = -1 And ady = 0 Then
CheDimens = 2 来自右边
Exit Function
End If
If adx = 1 And ady = 0 Then
CheDimens = 1 来自左边
Exit Function
End If
If adx = 0 And ady = 1 Then
CheDimens = 3 来自上边
Exit Function
End If
If adx = 0 And ady = -1 Then
CheDimens = 4 来自下边
Exit Function
End If
If adx = -1 And ady = 1 Then
CheDimens = 5 来自右上
Exit Function
End If
If adx = 1 And ady = -1 Then
CheDimens = 6 来自左下
Exit Function
End If
If adx = 1 And ady = 1 Then
CheDimens = 7 来自左上
Exit Function
End If
If adx = -1 And ady = -1 Then
CheDimens = 8 来自右下
Exit Function
End If
End Function

Private Sub cmmExit_Click()
End
End Sub

Private Sub cmmRestart_Click()
picMain.Enabled = True
If cmmRestart.Caption = "(&S)开始" Then
   cmmRestart.Caption = "(&S)重新开始"
   If optComputer.Value = True Then GoTo ComputerF
Else
   ReClear
   If optComputer.Value = True Then GoTo ComputerF
End If
Exit Sub

ComputerF:
       picMain.Enabled = False
       picMain.PaintPicture picComputer.Picture, 6 * 360 + 140, 6 * 360 + 140, 222, 222
       nowX = 7
       nowY = 7
       NowCompe = 2
       State(7, 7) = 2
      If Not CheckDead(nowX, nowY, 1, 1) Then
         LeftCheck nowX, nowY, 1, 1
         CheckExp nowX, nowY, 1, 1
         DimenAdd nowX, nowY, 1, 1, 1
         End If
      If Not CheckDead(nowX, nowY, 1, 0) Then
         LeftCheck nowX, nowY, 1, 0
         CheckExp nowX, nowY, 1, 0
         DimenAdd nowX, nowY, 1, 0, 1
      End If
      If Not CheckDead(nowX, nowY, 0, 1) Then
         LeftCheck nowX, nowY, 0, 1
         CheckExp nowX, nowY, 0, 1
         DimenAdd nowX, nowY, 0, 1, 1
      End If
      If Not CheckDead(nowX, nowY, -1, 1) Then
         LeftCheck nowX, nowY, -1, 1
         CheckExp nowX, nowY, -1, 1
         DimenAdd nowX, nowY, -1, 1, 1
      End If
      If Not CheckDead(nowX, nowY, 1, -1) Then
         LeftCheck nowX, nowY, 1, -1
         CheckExp nowX, nowY, 1, -1
         DimenAdd nowX, nowY, 1, -1, 1
      End If
      If Not CheckDead(nowX, nowY, -1, 0) Then
         LeftCheck nowX, nowY, -1, 0
         CheckExp nowX, nowY, -1, 0
         DimenAdd nowX, nowY, -1, 0, 1
      End If
      If Not CheckDead(nowX, nowY, 0, -1) Then
         LeftCheck nowX, nowY, 0, -1
         CheckExp nowX, nowY, 0, -1
         DimenAdd nowX, nowY, 0, -1, 1
      End If
      If Not CheckDead(nowX, nowY, -1, -1) Then
         LeftCheck nowX, nowY, -1, -1
         CheckExp nowX, nowY, -1, -1
         DimenAdd nowX, nowY, -1, -1, 1
      End If
         PrePCX = nowX
         PrePCY = nowY
         NowCompe = 1
         picMain.Enabled = True

End Sub

Private Sub Form_Activate()
Spaint
End Sub

Private Sub Form_GotFocus()
Spaint
End Sub

Private Sub Form_Paint()
Spaint
End Sub

Private Sub picMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim t As Integer
X = X - 240
Y = Y - 240
t = XYDecide(X, Y)
If t = 1 Then

[1] [2] [3]

【相关文章】

暂无