module1.bas

关于国际象棋的VB示例

    Exit Function
End If

'Queen
If WhatPiece = "QU" Then
    'Angle
    If Abs(Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) - Abs(BoardTo - (Int(BoardTo / 8) * 8))) = Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) Then
        LegalMove = True
        GoSub TestAngle
    End If
    'Up/Down/Side/Side
    If LegalMove = False Then
        If (Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 0) Then
            LegalMove = True
            ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
        End If
        If (Abs(BoardFrom - (Int(BoardFrom * 8) / 8)) = Abs(BoardTo - (Int(BoardTo * 8) / 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) = 0) Then
            LegalMove = True
            ZDirection = BoardFrom - BoardTo
        End If
        If LegalMove = True Then GoSub TestUpDownSideSide
    End If
    GoTo TestMove
    Exit Function
End If

'King
If WhatPiece = "KK" Then
    'Up/Down
    If BoardTo = BoardFrom + 8 Then LegalMove = True
    If BoardTo = BoardFrom - 8 Then LegalMove = True
    'Side to Side
    If BoardTo = BoardFrom + 1 Then LegalMove = True
    If BoardTo = BoardFrom - 1 Then LegalMove = True
    'Angle
    If BoardTo = BoardFrom + 7 Then LegalMove = True
    If BoardTo = BoardFrom - 7 Then LegalMove = True
    If BoardTo = BoardFrom + 9 Then LegalMove = True
    If BoardTo = BoardFrom - 9 Then LegalMove = True
    
    'Check to see if moving next to other King
    If ZWhosTurn = CWhite Then
        ZTempKing = "BKK"
     Else
        ZTempKing = "WKK"
    End If
    Err.Clear
    'Up/Down
    If RJSoftChess.Board(BoardTo + 8).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    If RJSoftChess.Board(BoardTo - 8).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    'Side to Side
    If RJSoftChess.Board(BoardTo + 1).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    If RJSoftChess.Board(BoardTo - 1).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    'Angle
    If RJSoftChess.Board(BoardTo + 7).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    If RJSoftChess.Board(BoardTo - 7).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    If RJSoftChess.Board(BoardTo + 9).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    Err.Clear
    If RJSoftChess.Board(BoardTo - 9).Tag = ZTempKing Then
        If Err = 0 Then
            LegalMove = False
            Exit Function
        End If
    End If
    
    If ZWhosTurn = CWhite Then
        If ZRotated = True Then
            'Tried To Castle
            If (BoardFrom = 4 And BoardTo = 6) Or (BoardFrom = 4 And BoardTo = 2) Then TriedToCastle = True
            If WhiteKingHasMoved = False And WhiteInCheck = False Then
                'Castle?
                If BoardFrom = 4 And BoardTo = 6 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle King Side
                        RJSoftChess.Board(5).Picture = RJSoftChess.Board(7).Picture
                        RJSoftChess.Board(5).Tag = RJSoftChess.Board(7).Tag
                        RJSoftChess.Board(7).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(7).Tag = ""
                        WhiteCanCastleKingSide = False
                        WhiteCanCastleQueenSide = False
                    End If
                End If
                If BoardFrom = 4 And BoardTo = 2 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle Queen Side
                        RJSoftChess.Board(3).Picture = RJSoftChess.Board(0).Picture
                        RJSoftChess.Board(3).Tag = RJSoftChess.Board(0).Tag
                        RJSoftChess.Board(0).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(0).Tag = ""
                        WhiteCanCastleKingSide = False
                        WhiteCanCastleQueenSide = False
                    End If
                End If
            End If
            If LegalMove = True And XMove = True Then WhiteKingHasMoved = True
         Else
            'Tried To Castle
            If (BoardFrom = 59 And BoardTo = 57) Or (BoardFrom = 59 And BoardTo = 61) Then TriedToCastle = True
            If WhiteKingHasMoved = False And WhiteInCheck = False Then
                'Castle?
                If BoardFrom = 59 And BoardTo = 57 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle King Side
                        RJSoftChess.Board(58).Picture = RJSoftChess.Board(56).Picture
                        RJSoftChess.Board(58).Tag = RJSoftChess.Board(56).Tag
                        RJSoftChess.Board(56).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(56).Tag = ""
                        WhiteCanCastleKingSide = False
                        WhiteCanCastleQueenSide = False
                    End If
                End If
                If BoardFrom = 59 And BoardTo = 61 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle Queen Side
                        RJSoftChess.Board(60).Picture = RJSoftChess.Board(63).Picture
                        RJSoftChess.Board(60).Tag = RJSoftChess.Board(63).Tag
                        RJSoftChess.Board(63).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(63).Tag = ""
                        WhiteCanCastleKingSide = False
                        WhiteCanCastleQueenSide = False
                    End If
                End If
                If LegalMove = True And XMove = True Then WhiteKingHasMoved = True
            End If
        End If
     Else
        If ZRotated = True Then
            'Tried To Castle
            If (BoardFrom = 62 And BoardTo = 60) Or (BoardFrom = 60 And BoardTo = 58) Then TriedToCastle = True
            If BlackKingHasMoved = False And BlackInCheck = False Then
                'Castle?
                If BoardFrom = 60 And BoardTo = 62 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle King Side
                        RJSoftChess.Board(61).Picture = RJSoftChess.Board(63).Picture
                        RJSoftChess.Board(61).Tag = RJSoftChess.Board(63).Tag
                        RJSoftChess.Board(63).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(63).Tag = ""
                        BlackCanCastleKingSide = False
                        BlackCanCastleQueenSide = False
                    End If
                End If
                If BoardFrom = 60 And BoardTo = 58 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle Queen Side
                        RJSoftChess.Board(59).Picture = RJSoftChess.Board(56).Picture
                        RJSoftChess.Board(59).Tag = RJSoftChess.Board(56).Tag
                        RJSoftChess.Board(56).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(56).Tag = ""
                        BlackCanCastleKingSide = False
                        BlackCanCastleQueenSide = False
                    End If
                End If
                If LegalMove = True And XMove = True Then BlackKingHasMoved = True
            End If
         Else
            'Tried To Castle
            If (BoardFrom = 3 And BoardTo = 1) Or (BoardFrom = 3 And BoardTo = 5) Then TriedToCastle = True
            If BlackKingHasMoved = False And BlackInCheck = False Then
                'Castle?
                If BoardFrom = 3 And BoardTo = 1 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle King Side
                        RJSoftChess.Board(2).Picture = RJSoftChess.Board(0).Picture
                        RJSoftChess.Board(2).Tag = RJSoftChess.Board(0).Tag
                        RJSoftChess.Board(0).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(0).Tag = ""
                        BlackCanCastleKingSide = False
                        BlackCanCastleQueenSide = False
                    End If
                End If
                If BoardFrom = 3 And BoardTo = 5 Then
                    LegalMove = True
                    If XMove = True Then
                        'Castle Queen Side
                        RJSoftChess.Board(4).Picture = RJSoftChess.Board(7).Picture
                        RJSoftChess.Board(4).Tag = RJSoftChess.Board(7).Tag
                        RJSoftChess.Board(7).Picture = RJSoftChess.Master_Blank.Picture
                        RJSoftChess.Board(7).Tag = ""
                        BlackCanCastleKingSide = False
                        BlackCanCastleQueenSide = False
                    End If
                End If
                If LegalMove = True And XMove = True Then BlackKingHasMoved = True
            End If
        End If
    End If
    
    GoTo TestMove
    Exit Function
End If

Exit Function

TestMove:
    'Can not take your on piece
    If ZWhosTurn = CWhite Then
        If Left(RJSoftChess.Board(BoardTo).Tag, 1) = "W" Then LegalMove = False
     Else
        If Left(RJSoftChess.Board(BoardTo).Tag, 1) = "B" Then LegalMove = False
    End If
    If LegalMove = True And XMove = True Then RJSoftChess.Board(BoardTo).Picture = RJSoftChess.Master_Blank.Picture
Exit Function

TestAngle:
    'Can not jump over own piece