module1.bas

关于国际象棋的VB示例

    'What Direction?
    ' 7 = Upper Left
    ' 9 = Upper Right
    '-7 = Lower Right
    '-9 = Lower Left
    ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
    If ZDirection = 0 Then Return
    For XY = BoardFrom - ZDirection To BoardTo Step -ZDirection
        If ZWhosTurn = CWhite Then
            If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
                LegalMove = False
                Exit For
            End If
            If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
                LegalMove = False
                Exit For
            End If
         Else
            If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
                LegalMove = False
                Exit For
            End If
            If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
                LegalMove = False
                Exit For
            End If
        End If
    Next XY
Return

TestUpDownSideSide:
    If Abs(ZDirection) <> 8 Then
        If BoardFrom < BoardTo Then
            For XY = BoardFrom + 1 To BoardTo
                If ZWhosTurn = CWhite Then
                    If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
                        LegalMove = False
                        Exit For
                    End If
                    If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
                        LegalMove = False
                        Exit For
                    End If
                 Else
                    If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
                        LegalMove = False
                        Exit For
                    End If
                    If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
                        LegalMove = False
                        Exit For
                    End If
                End If
            Next XY
         Else
            For XY = BoardFrom - 1 To BoardTo Step -1
                If ZWhosTurn = CWhite Then
                    If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
                        LegalMove = False
                        Exit For
                    End If
                    If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
                        LegalMove = False
                        Exit For
                    End If
                 Else
                    If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
                        LegalMove = False
                        Exit For
                    End If
                    If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
                        LegalMove = False
                        Exit For
                    End If
                End If
            Next XY
        End If
    Else
        For XY = BoardFrom - ZDirection To BoardTo Step -ZDirection
            If ZWhosTurn = CWhite Then
                If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
                    LegalMove = False
                    Exit For
                End If
                If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
                    LegalMove = False
                    Exit For
                End If
             Else
                If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
                    LegalMove = False
                    Exit For
                End If
                If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
                    LegalMove = False
                    Exit For
                End If
            End If
        Next XY
    End If
    If XMove = True Then
        If ZWhosTurn = CWhite Then
            If ZRotated = True Then
                If WhiteKingHasMoved = False Then
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 7 Then WhiteCanCastleKingSide = False
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 0 Then WhiteCanCastleQueenSide = False
                    If WhiteCanCastleKingSide = False And WhiteCanCastleQueenSide = False Then WhiteKingHasMoved = True
                End If
             Else
                If WhiteKingHasMoved = False Then
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 56 Then WhiteCanCastleKingSide = False
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 63 Then WhiteCanCastleQueenSide = False
                    If WhiteCanCastleKingSide = False And WhiteCanCastleQueenSide = False Then WhiteKingHasMoved = True
                End If
            End If
         Else
            If ZRotated = True Then
                If BlackKingHasMoved = False Then
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 63 Then BlackCanCastleKingSide = False
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 56 Then BlackCanCastleQueenSide = False
                    If BlackCanCastleKingSide = False And BlackCanCastleQueenSide = False Then BlackKingHasMoved = True
                End If
             Else
                If BlackKingHasMoved = False Then
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 0 Then BlackCanCastleKingSide = False
                    If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 7 Then BlackCanCastleQueenSide = False
                    If BlackCanCastleKingSide = False And BlackCanCastleQueenSide = False Then BlackKingHasMoved = True
                End If
            End If
        End If
    End If
Return

End Function

Function CheckForCheck(CheckForAlreadyInCheck As Boolean)

Dim X As Integer, InCheck As Boolean, P As Integer
Dim WhereFrom As Integer, WhereTo As Integer, ZTempKing As String, ZTempLegalMove As Boolean
Dim KingLocation As Integer, ZTempWhatPiece As String, ZTempFromTag As String, ZTempToTag As String

InCheck = False
WhereFrom = BoardFrom
WhereTo = BoardTo
ZTempWhatPiece = WhatPiece
ZTempLegalMove = LegalMove

If CheckForAlreadyInCheck = True Then
    If ZWhosTurn = CWhite Then
        ZTempKing = "WKK"
        ZWhosTurn = CBlack
     Else
        ZTempKing = "BKK"
        ZWhosTurn = CWhite
    End If
 Else
    If ZWhosTurn = CWhite Then
        ZTempKing = "BKK"
     Else
        ZTempKing = "WKK"
    End If
End If

'King Location
If Right(ZTempWhatPiece, 2) = "KK" Then 'Check to see if it's the King that moved
    If CheckForAlreadyInCheck = True And TriedToCastle = True Then
        If BlackInCheck = True Or WhiteInCheck = True Then
            WhatPiece = ZTempWhatPiece
            BoardFrom = WhereFrom
            BoardTo = WhereTo
            LegalMove = False
            If ZWhosTurn = CWhite Then
                ZWhosTurn = CBlack
             Else
                ZWhosTurn = CWhite
            End If
            Exit Function
        End If
    End If
    KingLocation = BoardTo
 Else
    For X = 0 To 63
        If Trim(RJSoftChess.Board(X).Tag) = ZTempKing Then
            KingLocation = X
            Exit For
        End If
    Next X
End If

If CheckForAlreadyInCheck = True Then
    ZTempFromTag = RJSoftChess.Board(BoardFrom).Tag
    ZTempToTag = RJSoftChess.Board(BoardTo).Tag
    RJSoftChess.Board(BoardTo).Tag = RJSoftChess.Board(BoardFrom).Tag
    RJSoftChess.Board(BoardFrom).Tag = ""
End If

'Check all locations to see if king can be killed
For P = 0 To 63
    WhatPiece = Right(RJSoftChess.Board(P).Tag, 2)
    BoardFrom = P
    BoardTo = KingLocation
    If (Trim(Left(RJSoftChess.Board(P).Tag, 1)) <> Left(ZTempKing, 1)) Then
        CheckForLegalMove False
        If LegalMove = True Then
            If Trim(RJSoftChess.Board(BoardTo).Tag) = ZTempKing Then
                InCheck = True
                Exit For
            End If
        End If
    End If
Next P

WhatPiece = ZTempWhatPiece
BoardFrom = WhereFrom
BoardTo = WhereTo
LegalMove = ZTempLegalMove

If CheckForAlreadyInCheck = True Then
    RJSoftChess.Board(BoardFrom).Tag = ZTempFromTag
    RJSoftChess.Board(BoardTo).Tag = ZTempToTag
    If ZWhosTurn = CWhite Then
        ZWhosTurn = CBlack
     Else
        ZWhosTurn = CWhite
    End If
End If

BlackInCheck = False
WhiteInCheck = False
If CheckForAlreadyInCheck = True Then
    If InCheck = True Then
        If ZWhosTurn = CWhite Then
            BlackInCheck = Not InCheck
            WhiteInCheck = InCheck
         Else
            BlackInCheck = InCheck
            WhiteInCheck = Not InCheck
        End If
    End If
 Else
    If InCheck = True Then
        If ZWhosTurn = CWhite Then
            BlackInCheck = InCheck
            WhiteInCheck = Not InCheck
         Else
            BlackInCheck = Not InCheck
            WhiteInCheck = InCheck
        End If
    End If
End If

End Function