开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 游戏 > 棋牌游戏 > 查看源码
Module1.bas
资源名称：vb_chess.zip　[点击查看]
上传用户：shwyly
上传日期：2007-01-07
资源大小：49k
文件大小：31k
源码类别：

棋牌游戏

开发平台：

Visual Basic

Module1.bas：源码内容
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  4. Public Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  5. Public FoundWindows As String, ZSend As String
  6. Public ZTop As Integer, ZLeft As Integer, ZWidth As Integer, ZHeight As Integer
  7. Public AQZ_H As Integer, AQZ_M As Integer, AQZ_S As Integer, ZTempPath As String
  9. ' Object reference to the DLL that contains the resources to be loaded.
  10. Public clsCTARS As Object
  11. Public Const Indicator = ":':"
  13. 'UDP Port
  14. Public Client As New Collection
  15. Public Names As New Collection
  16. Public RmIP As String, RmPt As String
  18. 'Sound
  19. Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  20. '  flag values for uFlags parameter
  21. Public Const SND_SYNC = &H0         '  play synchronously (default)
  22. Public Const SND_ASYNC = &H1         '  play asynchronously
  23. Public Const SND_NODEFAULT = &H2         '  silence not default, if sound not found
  24. Public Const SND_MEMORY = &H4         '  lpszSoundName points to a memory file
  25. Public Const SND_ALIAS = &H10000     '  name is a WIN.INI [sounds] entry
  26. Public Const SND_FILENAME = &H20000     '  name is a file name
  27. Public Const SND_RESOURCE = &H40004     '  name is a resource name or atom
  28. Public Const SND_ALIAS_ID = &H110000    '  name is a WIN.INI [sounds] entry identifier
  29. Public Const SND_ALIAS_START = 0  '  must be > 4096 to keep strings in same section of resource file
  30. Public Const SND_LOOP = &H8         '  loop the sound until next sndPlaySound
  31. Public Const SND_NOSTOP = &H10        '  don't stop any currently playing sound
  32. Public Const SND_VALID = &H1F        '  valid flags          / ;Internal /
  33. Public Const SND_NOWAIT = &H2000      '  don't wait if the driver is busy
  34. Public Const SND_VALIDFLAGS = &H17201F    '  Set of valid flag bits.  Anything outside
  35. Public Const SND_RESERVED = &HFF000000  '  In particular these flags are reserved
  36. Public Const SND_TYPE_MASK = &H170007
  38. Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  39. Public Declare Function GetDesktopWindow Lib "user32" () As Long
  40. Public Declare Function GetWindowLW Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  41. Public Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
  42. Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  43. Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  44. Public Const GWL_ID = (-12)
  45. Public Const GW_HWNDNEXT = 2
  46. Public Const GW_CHILD = 5
  48. 'My Defs
  49. Public ZWhosTurn As Integer, ZRotated As Boolean, ZToggle As Integer, BoardFrom As Integer, BoardTo As Integer, BlackInCheck As Boolean, WhiteInCheck As Boolean, BlackCheckMate As Boolean, WhiteCheckMate As Boolean
  50. Public LegalMove As Boolean, OpInProgress As Boolean, OpInProgress2 As Boolean, WhatPiece As String, BlackKingHasMoved As Boolean, WhiteKingHasMoved As Boolean
  51. Public WhiteCanCastleKingSide As Boolean, WhiteCanCastleQueenSide As Boolean, BlackCanCastleKingSide As Boolean, BlackCanCastleQueenSide As Boolean, TriedToCastle As Boolean
  52. Public ZBoardFrom As Integer, ZBoardTo As Integer, ZBoardFromTo As String, ZLastMove As String, ZGameInProcess As Boolean, ZMovingPiece As Boolean
  53. Public ZGuestMode As Boolean, ZLastMessage As String
  54. Public Const CWhite = 1
  55. Public Const CBlack = 2
  58. Public Sub SendOutIP()
  59. On Local Error Resume Next
  60. Err.Clear
  62. 'Send a text message to all clients in collection/listbox
  63. Dim X As Integer
  65. 'Loop through all IP in listbox and get the right Users IP
  66. For X = 0 To RJSoftChess.lName.ListCount - 1
  67.     'Select each IP
  68.     RJSoftChess.lName.ListIndex = X
  69.     'Set IP and Port to send to
  70.     RmIP = RJSoftChess.lName.Text
  71.     RmPt = Client(RmIP)
  72.     RJSoftChess.Wsck.RemoteHost = RmIP
  73.     RJSoftChess.Wsck.RemotePort = RmPt
  74.     'Send text message
  75.     RJSoftChess.Wsck.SendData ZSend
  76. Next
  77. Err.Clear
  79. End Sub
  81. Public Sub FindPath()
  82. On Local Error Resume Next
  83. Err.Clear
  85. Dim ZTempPath As String, X As Integer
  87. ZTempPath = String(145, 0)
  88. X = GetWindowsDirectory(ZTempPath, 145)
  89. ZTempPath = Left(ZTempPath, X)
  91. If Right(ZTempPath, 1) <> "" Then
  92.     FoundWindows = ZTempPath + ""
  93. Else
  94.     FoundWindows = ZTempPath
  95. End If
  97. End Sub
  98. Public Function CheckForLegalMove(XMove As Boolean)
  99. On Local Error Resume Next
  100. Err.Clear
  102. Dim ZFrom As Integer, ZTo As Integer, ZFrom2 As Integer, ZTo2 As Integer, XY As Integer, Y As Integer, ZDirection As Long, ZTempKing As String
  104. LegalMove = False
  105. TriedToCastle = False
  107. 'Pawn
  108. If WhatPiece = "PN" Then
  109.     'check 2
  110.     If (Abs(Int(BoardFrom / 8)) = 1) Or (Abs(Int(BoardFrom / 8)) = 6) Then
  111.         If (Abs(BoardFrom - (Int(BoardFrom / 8) * 8) = Abs(BoardTo - (Int(BoardTo / 8) * 8)))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) = 2) And (RJSoftChess.Board(BoardTo).Tag = "") Then LegalMove = True
  112.         If Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 2 Then Exit Function
  113.      Else
  114.         If Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 1 Then Exit Function
  115.     End If
  116.     'check 1
  117.     If ZRotated = True Then
  118.         If ZWhosTurn = CWhite Then
  119.             If BoardTo < BoardFrom Then Exit Function
  120.          Else
  121.             If BoardFrom < BoardTo Then Exit Function
  122.         End If
  123.         If ZWhosTurn = CWhite Then
  124.             If Abs(BoardFrom - (Int(BoardFrom / 8) * 8) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Int(BoardTo / 8) - Int(BoardFrom / 8)) = 1 Then LegalMove = True
  125.             If BoardTo >= 56 And BoardTo <= 63 And XMove = True Then
  126.                 RJSoftChess.Board(BoardFrom).Picture = RJSoftChess.Master_White(1).Picture
  127.                 RJSoftChess.Board(BoardFrom).Tag = "WQU"
  128.             End If
  129.          Else
  130.             If Abs(BoardFrom - (Int(BoardFrom / 8) * 8) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Int(BoardTo / 8) - Int(BoardFrom / 8)) = -1 Then LegalMove = True
  131.             If BoardTo >= 0 And BoardTo <= 7 And XMove = True Then
  132.                 RJSoftChess.Board(BoardFrom).Picture = RJSoftChess.Master_Black(1).Picture
  133.                 RJSoftChess.Board(BoardFrom).Tag = "BQU"
  134.             End If
  135.         End If
  136.      Else
  137.         If ZWhosTurn = CWhite Then
  138.             If BoardFrom < BoardTo Then Exit Function
  139.          Else
  140.             If BoardTo < BoardFrom Then Exit Function
  141.         End If
  142.         If ZWhosTurn = CWhite Then
  143.             If Abs(BoardFrom - (Int(BoardFrom / 8) * 8) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Int(BoardTo / 8) - Int(BoardFrom / 8)) = -1 Then LegalMove = True
  144.             If BoardTo >= 0 And BoardTo <= 7 And XMove = True Then
  145.                 RJSoftChess.Board(BoardFrom).Picture = RJSoftChess.Master_White(1).Picture
  146.                 RJSoftChess.Board(BoardFrom).Tag = "WQU"
  147.             End If
  148.          Else
  149.             If Abs(BoardFrom - (Int(BoardFrom / 8) * 8) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Int(BoardTo / 8) - Int(BoardFrom / 8)) = 1 Then LegalMove = True
  150.             If BoardTo >= 56 And BoardTo <= 63 And XMove = True Then
  151.                 RJSoftChess.Board(BoardFrom).Picture = RJSoftChess.Master_Black(1).Picture
  152.                 RJSoftChess.Board(BoardFrom).Tag = "BQU"
  153.             End If
  154.         End If
  155.     End If
  156.     'Can take the piece?
  157.     If RJSoftChess.Board(BoardTo).Tag <> "" Then
  158.         'Kill at angle
  159.         If (Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) + 1 = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 0) Then LegalMove = True
  160.         If (Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) - 1 = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 0) Then LegalMove = True
  161.         'Can't kill head on.  Must be at an angle
  162.         If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) - Abs(BoardTo - (Int(BoardTo / 8) * 8)) = 0 Then LegalMove = False
  163.         If LegalMove = False Then
  164.             'Must not be backwards
  165.             If ZRotated = True Then
  166.                 If ZWhosTurn = CWhite Then
  167.                     ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  168.                     If ZDirection = 7 Or ZDirection = 9 Then LegalMove = False
  169.                  Else
  170.                     ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  171.                     If ZDirection = -7 Or ZDirection = -9 Then LegalMove = False
  172.                 End If
  173.              Else
  174.                 If ZWhosTurn = CWhite Then
  175.                     ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  176.                     If ZDirection = -7 Or ZDirection = -9 Then LegalMove = False
  177.                  Else
  178.                     ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  179.                     If ZDirection = 7 Or ZDirection = 9 Then LegalMove = False
  180.                 End If
  181.             End If
  182.         End If
  183.      Else
  184.         If Abs(BoardFrom - (Int(BoardFrom / 8) * 8) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8))) = 2 Then
  185.             'Can't move backwards
  186.             If ZRotated = True Then
  187.                 If ZWhosTurn = CWhite Then
  188.                     If RJSoftChess.Board(BoardTo - 8).Tag <> "" Then LegalMove = False
  189.                  Else
  190.                     If RJSoftChess.Board(BoardTo + 8).Tag <> "" Then LegalMove = False
  191.                 End If
  192.              Else
  193.                 If ZWhosTurn = CWhite Then
  194.                     If RJSoftChess.Board(BoardTo + 8).Tag <> "" Then LegalMove = False
  195.                  Else
  196.                     If RJSoftChess.Board(BoardTo - 8).Tag <> "" Then LegalMove = False
  197.                 End If
  198.             End If
  199.         End If
  200.     End If
  201.     GoTo TestMove
  202.     Exit Function
  203. End If
  205. 'Rook
  206. If WhatPiece = "RK" Then
  207.     If (Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 0) Then
  208.         LegalMove = True
  209.         ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  210.     End If
  211.     If (Abs(BoardFrom - (Int(BoardFrom * 8) / 8)) = Abs(BoardTo - (Int(BoardTo * 8) / 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) = 0) Then
  212.         LegalMove = True
  213.         ZDirection = BoardFrom - BoardTo
  214.     End If
  215.     If LegalMove = True Then
  216.         GoSub TestUpDownSideSide
  217.         GoTo TestMove
  218.     End If
  219.     Exit Function
  220. End If
  222. 'Knight
  223. If WhatPiece = "KN" Then
  224.     ZFrom = BoardFrom - (Int(BoardFrom / 8) * 8)
  225.     ZTo = BoardTo - (Int(BoardTo / 8) * 8)
  226.     ZFrom2 = Int(BoardFrom / 8)
  227.     ZTo2 = Int(BoardTo / 8)
  228.     'check 1 right 2 down
  229.     If ZTo = ZFrom + 1 And ZTo2 = ZFrom2 + 2 Then LegalMove = True
  230.     'check 2 right 1 down
  231.     If ZTo = ZFrom + 2 And ZTo2 = ZFrom2 + 1 Then LegalMove = True
  232.     'check 1 right 2 up
  233.     If ZTo = ZFrom + 1 And ZTo2 = ZFrom2 - 2 Then LegalMove = True
  234.     'check 2 right 1 up
  235.     If ZTo = ZFrom + 2 And ZTo2 = ZFrom2 - 1 Then LegalMove = True
  236.     'check 1 left 2 down
  237.     If ZTo = ZFrom - 1 And ZTo2 = ZFrom2 + 2 Then LegalMove = True
  238.     'check 1 left 2 up
  239.     If ZTo = ZFrom - 1 And ZTo2 = ZFrom2 - 2 Then LegalMove = True
  240.     'check 2 left 1 down
  241.     If ZTo = ZFrom - 2 And ZTo2 = ZFrom2 + 1 Then LegalMove = True
  242.     'check 2 left 1 up
  243.     If ZTo = ZFrom - 2 And ZTo2 = ZFrom2 - 1 Then LegalMove = True
  244.     GoTo TestMove
  245.     Exit Function
  246. End If
  248. 'Bishop
  249. If WhatPiece = "BP" Then
  250.     If Abs(Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) - Abs(BoardTo - (Int(BoardTo / 8) * 8))) = Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) Then
  251.         LegalMove = True
  252.         GoSub TestAngle
  253.         GoTo TestMove
  254.     End If
  255.     Exit Function
  256. End If
  258. 'Queen
  259. If WhatPiece = "QU" Then
  260.     'Angle
  261.     If Abs(Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) - Abs(BoardTo - (Int(BoardTo / 8) * 8))) = Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) Then
  262.         LegalMove = True
  263.         GoSub TestAngle
  264.     End If
  265.     'Up/Down/Side/Side
  266.     If LegalMove = False Then
  267.         If (Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = Abs(BoardTo - (Int(BoardTo / 8) * 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) > 0) Then
  268.             LegalMove = True
  269.             ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  270.         End If
  271.         If (Abs(BoardFrom - (Int(BoardFrom * 8) / 8)) = Abs(BoardTo - (Int(BoardTo * 8) / 8))) And (Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)) = 0) Then
  272.             LegalMove = True
  273.             ZDirection = BoardFrom - BoardTo
  274.         End If
  275.         If LegalMove = True Then GoSub TestUpDownSideSide
  276.     End If
  277.     GoTo TestMove
  278.     Exit Function
  279. End If
  281. 'King
  282. If WhatPiece = "KK" Then
  283.     'Up/Down
  284.     If BoardTo = BoardFrom + 8 Then LegalMove = True
  285.     If BoardTo = BoardFrom - 8 Then LegalMove = True
  286.     'Side to Side
  287.     If BoardTo = BoardFrom + 1 Then LegalMove = True
  288.     If BoardTo = BoardFrom - 1 Then LegalMove = True
  289.     'Angle
  290.     If BoardTo = BoardFrom + 7 Then LegalMove = True
  291.     If BoardTo = BoardFrom - 7 Then LegalMove = True
  292.     If BoardTo = BoardFrom + 9 Then LegalMove = True
  293.     If BoardTo = BoardFrom - 9 Then LegalMove = True
  294.     
  295.     'Check to see if moving next to other King
  296.     If ZWhosTurn = CWhite Then
  297.         ZTempKing = "BKK"
  298.      Else
  299.         ZTempKing = "WKK"
  300.     End If
  301.     Err.Clear
  302.     'Up/Down
  303.     If RJSoftChess.Board(BoardTo + 8).Tag = ZTempKing Then
  304.         If Err = 0 Then
  305.             LegalMove = False
  306.             Exit Function
  307.         End If
  308.     End If
  309.     Err.Clear
  310.     If RJSoftChess.Board(BoardTo - 8).Tag = ZTempKing Then
  311.         If Err = 0 Then
  312.             LegalMove = False
  313.             Exit Function
  314.         End If
  315.     End If
  316.     Err.Clear
  317.     'Side to Side
  318.     If RJSoftChess.Board(BoardTo + 1).Tag = ZTempKing Then
  319.         If Err = 0 Then
  320.             LegalMove = False
  321.             Exit Function
  322.         End If
  323.     End If
  324.     Err.Clear
  325.     If RJSoftChess.Board(BoardTo - 1).Tag = ZTempKing Then
  326.         If Err = 0 Then
  327.             LegalMove = False
  328.             Exit Function
  329.         End If
  330.     End If
  331.     Err.Clear
  332.     'Angle
  333.     If RJSoftChess.Board(BoardTo + 7).Tag = ZTempKing Then
  334.         If Err = 0 Then
  335.             LegalMove = False
  336.             Exit Function
  337.         End If
  338.     End If
  339.     Err.Clear
  340.     If RJSoftChess.Board(BoardTo - 7).Tag = ZTempKing Then
  341.         If Err = 0 Then
  342.             LegalMove = False
  343.             Exit Function
  344.         End If
  345.     End If
  346.     Err.Clear
  347.     If RJSoftChess.Board(BoardTo + 9).Tag = ZTempKing Then
  348.         If Err = 0 Then
  349.             LegalMove = False
  350.             Exit Function
  351.         End If
  352.     End If
  353.     Err.Clear
  354.     If RJSoftChess.Board(BoardTo - 9).Tag = ZTempKing Then
  355.         If Err = 0 Then
  356.             LegalMove = False
  357.             Exit Function
  358.         End If
  359.     End If
  360.     
  361.     If ZWhosTurn = CWhite Then
  362.         If ZRotated = True Then
  363.             'Tried To Castle
  364.             If (BoardFrom = 4 And BoardTo = 6) Or (BoardFrom = 4 And BoardTo = 2) Then TriedToCastle = True
  365.             If WhiteKingHasMoved = False And WhiteInCheck = False Then
  366.                 'Castle?
  367.                 If BoardFrom = 4 And BoardTo = 6 Then
  368.                     LegalMove = True
  369.                     If XMove = True Then
  370.                         'Castle King Side
  371.                         RJSoftChess.Board(5).Picture = RJSoftChess.Board(7).Picture
  372.                         RJSoftChess.Board(5).Tag = RJSoftChess.Board(7).Tag
  373.                         RJSoftChess.Board(7).Picture = RJSoftChess.Master_Blank.Picture
  374.                         RJSoftChess.Board(7).Tag = ""
  375.                         WhiteCanCastleKingSide = False
  376.                         WhiteCanCastleQueenSide = False
  377.                     End If
  378.                 End If
  379.                 If BoardFrom = 4 And BoardTo = 2 Then
  380.                     LegalMove = True
  381.                     If XMove = True Then
  382.                         'Castle Queen Side
  383.                         RJSoftChess.Board(3).Picture = RJSoftChess.Board(0).Picture
  384.                         RJSoftChess.Board(3).Tag = RJSoftChess.Board(0).Tag
  385.                         RJSoftChess.Board(0).Picture = RJSoftChess.Master_Blank.Picture
  386.                         RJSoftChess.Board(0).Tag = ""
  387.                         WhiteCanCastleKingSide = False
  388.                         WhiteCanCastleQueenSide = False
  389.                     End If
  390.                 End If
  391.             End If
  392.             If LegalMove = True And XMove = True Then WhiteKingHasMoved = True
  393.          Else
  394.             'Tried To Castle
  395.             If (BoardFrom = 59 And BoardTo = 57) Or (BoardFrom = 59 And BoardTo = 61) Then TriedToCastle = True
  396.             If WhiteKingHasMoved = False And WhiteInCheck = False Then
  397.                 'Castle?
  398.                 If BoardFrom = 59 And BoardTo = 57 Then
  399.                     LegalMove = True
  400.                     If XMove = True Then
  401.                         'Castle King Side
  402.                         RJSoftChess.Board(58).Picture = RJSoftChess.Board(56).Picture
  403.                         RJSoftChess.Board(58).Tag = RJSoftChess.Board(56).Tag
  404.                         RJSoftChess.Board(56).Picture = RJSoftChess.Master_Blank.Picture
  405.                         RJSoftChess.Board(56).Tag = ""
  406.                         WhiteCanCastleKingSide = False
  407.                         WhiteCanCastleQueenSide = False
  408.                     End If
  409.                 End If
  410.                 If BoardFrom = 59 And BoardTo = 61 Then
  411.                     LegalMove = True
  412.                     If XMove = True Then
  413.                         'Castle Queen Side
  414.                         RJSoftChess.Board(60).Picture = RJSoftChess.Board(63).Picture
  415.                         RJSoftChess.Board(60).Tag = RJSoftChess.Board(63).Tag
  416.                         RJSoftChess.Board(63).Picture = RJSoftChess.Master_Blank.Picture
  417.                         RJSoftChess.Board(63).Tag = ""
  418.                         WhiteCanCastleKingSide = False
  419.                         WhiteCanCastleQueenSide = False
  420.                     End If
  421.                 End If
  422.                 If LegalMove = True And XMove = True Then WhiteKingHasMoved = True
  423.             End If
  424.         End If
  425.      Else
  426.         If ZRotated = True Then
  427.             'Tried To Castle
  428.             If (BoardFrom = 62 And BoardTo = 60) Or (BoardFrom = 60 And BoardTo = 58) Then TriedToCastle = True
  429.             If BlackKingHasMoved = False And BlackInCheck = False Then
  430.                 'Castle?
  431.                 If BoardFrom = 60 And BoardTo = 62 Then
  432.                     LegalMove = True
  433.                     If XMove = True Then
  434.                         'Castle King Side
  435.                         RJSoftChess.Board(61).Picture = RJSoftChess.Board(63).Picture
  436.                         RJSoftChess.Board(61).Tag = RJSoftChess.Board(63).Tag
  437.                         RJSoftChess.Board(63).Picture = RJSoftChess.Master_Blank.Picture
  438.                         RJSoftChess.Board(63).Tag = ""
  439.                         BlackCanCastleKingSide = False
  440.                         BlackCanCastleQueenSide = False
  441.                     End If
  442.                 End If
  443.                 If BoardFrom = 60 And BoardTo = 58 Then
  444.                     LegalMove = True
  445.                     If XMove = True Then
  446.                         'Castle Queen Side
  447.                         RJSoftChess.Board(59).Picture = RJSoftChess.Board(56).Picture
  448.                         RJSoftChess.Board(59).Tag = RJSoftChess.Board(56).Tag
  449.                         RJSoftChess.Board(56).Picture = RJSoftChess.Master_Blank.Picture
  450.                         RJSoftChess.Board(56).Tag = ""
  451.                         BlackCanCastleKingSide = False
  452.                         BlackCanCastleQueenSide = False
  453.                     End If
  454.                 End If
  455.                 If LegalMove = True And XMove = True Then BlackKingHasMoved = True
  456.             End If
  457.          Else
  458.             'Tried To Castle
  459.             If (BoardFrom = 3 And BoardTo = 1) Or (BoardFrom = 3 And BoardTo = 5) Then TriedToCastle = True
  460.             If BlackKingHasMoved = False And BlackInCheck = False Then
  461.                 'Castle?
  462.                 If BoardFrom = 3 And BoardTo = 1 Then
  463.                     LegalMove = True
  464.                     If XMove = True Then
  465.                         'Castle King Side
  466.                         RJSoftChess.Board(2).Picture = RJSoftChess.Board(0).Picture
  467.                         RJSoftChess.Board(2).Tag = RJSoftChess.Board(0).Tag
  468.                         RJSoftChess.Board(0).Picture = RJSoftChess.Master_Blank.Picture
  469.                         RJSoftChess.Board(0).Tag = ""
  470.                         BlackCanCastleKingSide = False
  471.                         BlackCanCastleQueenSide = False
  472.                     End If
  473.                 End If
  474.                 If BoardFrom = 3 And BoardTo = 5 Then
  475.                     LegalMove = True
  476.                     If XMove = True Then
  477.                         'Castle Queen Side
  478.                         RJSoftChess.Board(4).Picture = RJSoftChess.Board(7).Picture
  479.                         RJSoftChess.Board(4).Tag = RJSoftChess.Board(7).Tag
  480.                         RJSoftChess.Board(7).Picture = RJSoftChess.Master_Blank.Picture
  481.                         RJSoftChess.Board(7).Tag = ""
  482.                         BlackCanCastleKingSide = False
  483.                         BlackCanCastleQueenSide = False
  484.                     End If
  485.                 End If
  486.                 If LegalMove = True And XMove = True Then BlackKingHasMoved = True
  487.             End If
  488.         End If
  489.     End If
  490.     
  491.     GoTo TestMove
  492.     Exit Function
  493. End If
  495. Exit Function
  497. TestMove:
  498.     'Can not take your on piece
  499.     If ZWhosTurn = CWhite Then
  500.         If Left(RJSoftChess.Board(BoardTo).Tag, 1) = "W" Then LegalMove = False
  501.      Else
  502.         If Left(RJSoftChess.Board(BoardTo).Tag, 1) = "B" Then LegalMove = False
  503.     End If
  504.     If LegalMove = True And XMove = True Then RJSoftChess.Board(BoardTo).Picture = RJSoftChess.Master_Blank.Picture
  505. Exit Function
  507. TestAngle:
  508.     'Can not jump over own piece
  509.     'What Direction?
  510.     ' 7 = Upper Left
  511.     ' 9 = Upper Right
  512.     '-7 = Lower Right
  513.     '-9 = Lower Left
  514.     ZDirection = ((BoardFrom - BoardTo) / Abs(Int(BoardTo / 8) - Int(BoardFrom / 8)))
  515.     If ZDirection = 0 Then Return
  516.     For XY = BoardFrom - ZDirection To BoardTo Step -ZDirection
  517.         If ZWhosTurn = CWhite Then
  518.             If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
  519.                 LegalMove = False
  520.                 Exit For
  521.             End If
  522.             If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
  523.                 LegalMove = False
  524.                 Exit For
  525.             End If
  526.          Else
  527.             If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
  528.                 LegalMove = False
  529.                 Exit For
  530.             End If
  531.             If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
  532.                 LegalMove = False
  533.                 Exit For
  534.             End If
  535.         End If
  536.     Next XY
  537. Return
  539. TestUpDownSideSide:
  540.     If Abs(ZDirection) <> 8 Then
  541.         If BoardFrom < BoardTo Then
  542.             For XY = BoardFrom + 1 To BoardTo
  543.                 If ZWhosTurn = CWhite Then
  544.                     If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
  545.                         LegalMove = False
  546.                         Exit For
  547.                     End If
  548.                     If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
  549.                         LegalMove = False
  550.                         Exit For
  551.                     End If
  552.                  Else
  553.                     If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
  554.                         LegalMove = False
  555.                         Exit For
  556.                     End If
  557.                     If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
  558.                         LegalMove = False
  559.                         Exit For
  560.                     End If
  561.                 End If
  562.             Next XY
  563.          Else
  564.             For XY = BoardFrom - 1 To BoardTo Step -1
  565.                 If ZWhosTurn = CWhite Then
  566.                     If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
  567.                         LegalMove = False
  568.                         Exit For
  569.                     End If
  570.                     If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
  571.                         LegalMove = False
  572.                         Exit For
  573.                     End If
  574.                  Else
  575.                     If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
  576.                         LegalMove = False
  577.                         Exit For
  578.                     End If
  579.                     If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
  580.                         LegalMove = False
  581.                         Exit For
  582.                     End If
  583.                 End If
  584.             Next XY
  585.         End If
  586.     Else
  587.         For XY = BoardFrom - ZDirection To BoardTo Step -ZDirection
  588.             If ZWhosTurn = CWhite Then
  589.                 If Left(RJSoftChess.Board(XY).Tag, 1) = "W" Then
  590.                     LegalMove = False
  591.                     Exit For
  592.                 End If
  593.                 If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "B") Then
  594.                     LegalMove = False
  595.                     Exit For
  596.                 End If
  597.              Else
  598.                 If Left(RJSoftChess.Board(XY).Tag, 1) = "B" Then
  599.                     LegalMove = False
  600.                     Exit For
  601.                 End If
  602.                 If (XY <> BoardTo) And (Left(RJSoftChess.Board(XY).Tag, 1) = "W") Then
  603.                     LegalMove = False
  604.                     Exit For
  605.                 End If
  606.             End If
  607.         Next XY
  608.     End If
  609.     If XMove = True Then
  610.         If ZWhosTurn = CWhite Then
  611.             If ZRotated = True Then
  612.                 If WhiteKingHasMoved = False Then
  613.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 7 Then WhiteCanCastleKingSide = False
  614.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 0 Then WhiteCanCastleQueenSide = False
  615.                     If WhiteCanCastleKingSide = False And WhiteCanCastleQueenSide = False Then WhiteKingHasMoved = True
  616.                 End If
  617.              Else
  618.                 If WhiteKingHasMoved = False Then
  619.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 56 Then WhiteCanCastleKingSide = False
  620.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 63 Then WhiteCanCastleQueenSide = False
  621.                     If WhiteCanCastleKingSide = False And WhiteCanCastleQueenSide = False Then WhiteKingHasMoved = True
  622.                 End If
  623.             End If
  624.          Else
  625.             If ZRotated = True Then
  626.                 If BlackKingHasMoved = False Then
  627.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 63 Then BlackCanCastleKingSide = False
  628.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 56 Then BlackCanCastleQueenSide = False
  629.                     If BlackCanCastleKingSide = False And BlackCanCastleQueenSide = False Then BlackKingHasMoved = True
  630.                 End If
  631.              Else
  632.                 If BlackKingHasMoved = False Then
  633.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 0 Then BlackCanCastleKingSide = False
  634.                     If Abs(BoardFrom - (Int(BoardFrom / 8) * 8)) = 7 Then BlackCanCastleQueenSide = False
  635.                     If BlackCanCastleKingSide = False And BlackCanCastleQueenSide = False Then BlackKingHasMoved = True
  636.                 End If
  637.             End If
  638.         End If
  639.     End If
  640. Return
  642. End Function
  644. Function CheckForCheck(CheckForAlreadyInCheck As Boolean)
  646. Dim X As Integer, InCheck As Boolean, P As Integer
  647. Dim WhereFrom As Integer, WhereTo As Integer, ZTempKing As String, ZTempLegalMove As Boolean
  648. Dim KingLocation As Integer, ZTempWhatPiece As String, ZTempFromTag As String, ZTempToTag As String
  650. InCheck = False
  651. WhereFrom = BoardFrom
  652. WhereTo = BoardTo
  653. ZTempWhatPiece = WhatPiece
  654. ZTempLegalMove = LegalMove
  656. If CheckForAlreadyInCheck = True Then
  657.     If ZWhosTurn = CWhite Then
  658.         ZTempKing = "WKK"
  659.         ZWhosTurn = CBlack
  660.      Else
  661.         ZTempKing = "BKK"
  662.         ZWhosTurn = CWhite
  663.     End If
  664.  Else
  665.     If ZWhosTurn = CWhite Then
  666.         ZTempKing = "BKK"
  667.      Else
  668.         ZTempKing = "WKK"
  669.     End If
  670. End If
  672. 'King Location
  673. If Right(ZTempWhatPiece, 2) = "KK" Then 'Check to see if it's the King that moved
  674.     If CheckForAlreadyInCheck = True And TriedToCastle = True Then
  675.         If BlackInCheck = True Or WhiteInCheck = True Then
  676.             WhatPiece = ZTempWhatPiece
  677.             BoardFrom = WhereFrom
  678.             BoardTo = WhereTo
  679.             LegalMove = False
  680.             If ZWhosTurn = CWhite Then
  681.                 ZWhosTurn = CBlack
  682.              Else
  683.                 ZWhosTurn = CWhite
  684.             End If
  685.             Exit Function
  686.         End If
  687.     End If
  688.     KingLocation = BoardTo
  689.  Else
  690.     For X = 0 To 63
  691.         If Trim(RJSoftChess.Board(X).Tag) = ZTempKing Then
  692.             KingLocation = X
  693.             Exit For
  694.         End If
  695.     Next X
  696. End If
  698. If CheckForAlreadyInCheck = True Then
  699.     ZTempFromTag = RJSoftChess.Board(BoardFrom).Tag
  700.     ZTempToTag = RJSoftChess.Board(BoardTo).Tag
  701.     RJSoftChess.Board(BoardTo).Tag = RJSoftChess.Board(BoardFrom).Tag
  702.     RJSoftChess.Board(BoardFrom).Tag = ""
  703. End If
  705. 'Check all locations to see if king can be killed
  706. For P = 0 To 63
  707.     WhatPiece = Right(RJSoftChess.Board(P).Tag, 2)
  708.     BoardFrom = P
  709.     BoardTo = KingLocation
  710.     If (Trim(Left(RJSoftChess.Board(P).Tag, 1)) <> Left(ZTempKing, 1)) Then
  711.         CheckForLegalMove False
  712.         If LegalMove = True Then
  713.             If Trim(RJSoftChess.Board(BoardTo).Tag) = ZTempKing Then
  714.                 InCheck = True
  715.                 Exit For
  716.             End If
  717.         End If
  718.     End If
  719. Next P
  721. WhatPiece = ZTempWhatPiece
  722. BoardFrom = WhereFrom
  723. BoardTo = WhereTo
  724. LegalMove = ZTempLegalMove
  726. If CheckForAlreadyInCheck = True Then
  727.     RJSoftChess.Board(BoardFrom).Tag = ZTempFromTag
  728.     RJSoftChess.Board(BoardTo).Tag = ZTempToTag
  729.     If ZWhosTurn = CWhite Then
  730.         ZWhosTurn = CBlack
  731.      Else
  732.         ZWhosTurn = CWhite
  733.     End If
  734. End If
  736. BlackInCheck = False
  737. WhiteInCheck = False
  738. If CheckForAlreadyInCheck = True Then
  739.     If InCheck = True Then
  740.         If ZWhosTurn = CWhite Then
  741.             BlackInCheck = Not InCheck
  742.             WhiteInCheck = InCheck
  743.          Else
  744.             BlackInCheck = InCheck
  745.             WhiteInCheck = Not InCheck
  746.         End If
  747.     End If
  748.  Else
  749.     If InCheck = True Then
  750.         If ZWhosTurn = CWhite Then
  751.             BlackInCheck = InCheck
  752.             WhiteInCheck = Not InCheck
  753.          Else
  754.             BlackInCheck = Not InCheck
  755.             WhiteInCheck = InCheck
  756.         End If
  757.     End If
  758. End If
  760. End Function