⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 play.bas

📁 机器人程序
💻 BAS
字号:
Attribute VB_Name = "Play"
'Play.bas
'下棋函数
'Man & Robot Play

'- - - - - - - - - - - - - - - - - - - - - - - - - -

Option Explicit

'人走
'Man Play
Public Sub ManPlay(ByVal mx As Integer, ByVal my As Integer, ByVal mcolor As Integer)
  Dim tmp As String
  Dim ManPlayPos As ps
  
  nowPlayer = MAN_PLAY
  
  ProcessImage
  
  
  ManPlayPos = BoardChange(True)
  
  'MsgBox str$(ManPlayPos.X) & " -" & str$(ManPlayPos.Y)
  
  If (ManPlayPos.X = -1 Or ManPlayPos.X = 0) Then
    Exit Sub
  End If
  
 
  mx = ManPlayPos.X
  my = ManPlayPos.Y
  mcolor = BLACK
  
  tmpx = mx: tmpy = my: tmpc = mcolor
  
  
  If (GNUGO_IsLegal(tmpx - 1, tmpy - 1, BLACK) = 0) Then Exit Sub
    
  Call PlayMove(mx, my, BLACK)
    
  If (nowColour = BLACK) Then
      tmp = "黑"
  Else
      tmp = "白"
  End If
  
  ToList tmp & " -> " & _
         str$(mx) & _
         str$(my)
         
  nowColour = 3 - nowColour
  
  DrawBoard
  
  RobotPlay
End Sub

'机器人走
'Robot Play
Public Sub RobotPlay()
  Dim Pos As ps
  Dim ggx, ggy As Long
  Dim xi, yi As Integer
  
  nowPlayer = ROBOT_PLAY
  
  ggx = 0: ggx = 0
  
  Call GNUGO_GenMove(ggx, ggy, nowColour)
  
  '终盘
  If (ggx < 0 Or ggx > 12) Then
    Game_Finish
    Exit Sub
  End If
    
  Call IsLegal(ggx, ggy, nowColour)
  
  Call PlayMove(ggx + 1, ggy + 1, nowColour)
  
  'Long -> Integer
  xi = ggx + 1: yi = ggy + 1
  
  'to debug
  Call SendPosToRCX(xi, yi, nowColour)
  'to debug
  
  '换颜色
  nowColour = 3 - nowColour
  
  DrawBoard
End Sub

'PlayMove ,为GNUGO_PlayMove的替代函数,可以做一些手脚
'NOTICE:from 1~13 to 0~12
Public Sub PlayMove(ByVal i As Integer, ByVal j As Integer, ByVal color As Integer)
  Dim st As String
  tmpx = i: tmpy = j: tmpc = color
  
  Call GNUGO_PlayMove(tmpx - 1, tmpy - 1, tmpc)
  
  If (color = BLACK) Then
    st = "B"
  Else
    st = "W"
  End If
  
  SgfNode(GNUGO_GetMoveNumber) = st & "[" & Chr$(i + 96) & Chr$(j + 96) & "];"
  
  '存储手数
  StepNumBoard.b(tmpx - 1, tmpy - 1) = GNUGO_GetMoveNumber
End Sub

'找出人下在哪
Public Sub FindNew()
  Dim tmps As ps
  
  Call ProcessImage
  tmps = BoardChange(True)
  Call ManPlay(tmps.X, tmps.Y, nowColour)
    
End Sub

'游戏结束
Public Sub Game_Finish()
  CalcScore
  'AskForSave
End Sub

'- - - - - - - - - - - - - - - - - - - - - - - - - -

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -