board.bas

机器人程序

Attribute VB_Name = "Board"
Public LastBoard As BOARD_ARRAY

'board.bas
'有关棋盘的一些方法

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

'在board(PictureBox)中画棋盘
Public Sub DrawBoard()
Attribute DrawBoard.VB_Description = "Draw Board"
  GRVBMain.Board.Cls
  GRVBMain.Board.DrawWidth = 1
  
  For i = 0 To BWidth Step Int(BWidth / (BSize - 1))
    GRVBMain.Board.Line (BTop, i)-(BTop + BWidth, i), vbBlack
    GRVBMain.Board.Line (i, BTop)-(i, BTop + BWidth), vbBlack
  Next 'i
  
  'Draw each stone
  Call DrawStone
  
End Sub

'画每个棋子
Public Sub DrawStone()
  Dim draw_arr As BOARD_ARRAY
  
  draw_arr = GNUGO_GetBoard
  
  GRVBMain.Board.FillStyle = 0
  GRVBMain.Board.DrawWidth = 1
  
  GRVBMain.Board.Font.size = 14
  GRVBMain.Board.Font.Name = "Times New Roman"
  
  Dim u, v As Integer
  u = 0: v = 0
  For i = 0 To BWidth Step Int(BWidth / (BSize - 1))
    For j = 0 To BWidth Step Int(BWidth / (BSize - 1))
      
      '画星位
      If ((u = 3 Or u = 9) And (v = 3 Or v = 9)) Or (u = 6 And v = 6) Then
        GRVBMain.Board.FillStyle = 0
        GRVBMain.Board.FillColor = vbBlack
        GRVBMain.Board.Circle (i, j), BWidth / (BSize - 1) * 1 / 10, vbBlack

      End If
           
      'Draw stone on board
      If draw_arr.b(v, u) = WHITE Then
            GRVBMain.Board.FillColor = vbWhite
            GRVBMain.Board.Circle (i, j), BWidth / (BSize - 1) * 7 / 16, vbBlack
            
            If (optMoveNumShow = True) _
            Then
              
              '显示手数
              If (StepNumBoard.b(u, v) < 10) Then
                GRVBMain.Board.CurrentX = i - 20: GRVBMain.Board.CurrentY = j - 25
              ElseIf (StepNumBoard.b(u, v) >= 10 And StepNumBoard.b(u, v) < 100) Then
                GRVBMain.Board.CurrentX = i - 34: GRVBMain.Board.CurrentY = j - 25
              Else '>100
                GRVBMain.Board.CurrentX = i - 45: GRVBMain.Board.CurrentY = j - 25
              End If
              
              '突出显示新棋子
              If (StepNumBoard.b(u, v) = GNUGO_GetMoveNumber) Then
                GRVBMain.Board.ForeColor = vbRed
              Else
                GRVBMain.Board.ForeColor = vbBlack
              End If
            
            GRVBMain.Board.Print StepNumBoard.b(u, v)
            
            Else
              '突出显示新棋子
              If (StepNumBoard.b(u, v) = GNUGO_GetMoveNumber) Then
                'draw triangle
                GRVBMain.Board.FillStyle = 0
                GRVBMain.Board.FillColor = vbRed
                GRVBMain.Board.Circle (i, j), BWidth / (BSize - 1) * 1 / 16, vbRed
              End If
            End If
      ElseIf draw_arr.b(v, u) = BLACK Then
            GRVBMain.Board.FillColor = vbBlack
            GRVBMain.Board.Circle (i, j), BWidth / (BSize - 1) * 7 / 16, vbWhite
            
            If (optMoveNumShow = True) _
            Then
            
              '显示手数
              If (StepNumBoard.b(u, v) < 10) Then
                GRVBMain.Board.CurrentX = i - 20: GRVBMain.Board.CurrentY = j - 25
              ElseIf (StepNumBoard.b(u, v) >= 10 And StepNumBoard.b(u, v) < 100) Then
                GRVBMain.Board.CurrentX = i - 34: GRVBMain.Board.CurrentY = j - 25
              Else
                GRVBMain.Board.CurrentX = i - 45: GRVBMain.Board.CurrentY = j - 25
              End If
              
              '突出显示新棋子
              If (StepNumBoard.b(u, v) = GNUGO_GetMoveNumber) Then
                GRVBMain.Board.ForeColor = vbRed
              Else
                GRVBMain.Board.ForeColor = vbWhite
              End If
              GRVBMain.Board.Print StepNumBoard.b(u, v)
              
            Else
              '突出显示新棋子
              If (StepNumBoard.b(u, v) = GNUGO_GetMoveNumber) Then
                'draw triangle
                GRVBMain.Board.FillStyle = 0
                GRVBMain.Board.FillColor = vbRed
                GRVBMain.Board.Circle (i, j), BWidth / (BSize - 1) * 1 / 16, vbRed
                 
              End If
            End If
      End If
      v = v + 1
    Next 'j & v
    u = u + 1
    v = 0
  Next 'i & u
End Sub

'找出新下棋子的位置
'A funciton that return a ps struct ,
'that is the change between state(*,*) and GNUGO_GetBoard
Public Function BoardChange(ByVal StoneOverFlow As Boolean) As ps
  'If StoneOverFlow is TRUE ,then check the more stone.(n>1)
  Dim n, tx, ty, mx, my As Integer
  Dim MoveDir As Integer
  
  For i = 0 To 12
    For j = 0 To 12
      'If (LastBoard.b(i, j) <> 0) Then ToList str$(i + 1) & str$(j + 1) & str$(LastBoard.b(i, j))
    Next
  Next
  
  n = 0
  For i = 1 To BSize
    For j = 1 To BSize
      If LastBoard.b(i - 1, j - 1) = NONE And _
         State(i, j) = BLACK _
      Then
          tx = i: ty = j
          'ToList "%" & str$(tx) & str$(ty)
          n = n + 1
      End If
    Next j
  Next i
  
  If n > 1 And StoneOverFlow = True Then
    ToList "So Many Chess"
    BoardChange.X = -1
    BoardChange.Y = -1
    Exit Function
  End If
    
    
  If n = 0 Then
    ToList "No new stone"
  End If
  'Show it in list
  'If n = 1 Then ToList ">>" & str$(tx) & " -" & str$(ty)
  
  'Return Value As ps struct
  BoardChange.X = tx
  BoardChange.Y = ty
  
  For i = 1 To BSize
    For j = 1 To BSize
      LastBoard.b(i - 1, j - 1) = State(i, j)
    Next
  Next
End Function

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


'在ListBox中显示当前的棋盘信息
'List board infomation in listbox
Public Sub ListBoard()
  Dim arrtmp As BOARD_ARRAY
  Dim i, j As Integer
  
  arrtmp = GNUGO_GetBoard()
  
  For i = 0 To 12
    For j = 0 To 12
      If arrtmp.b(i, j) > 0 Then
        If (arrtmp.b(i, j) = BLACK) Then ToList "+" & str$(i + 1) & str$(j + 1) & "- 黑"
        If (arrtmp.b(i, j) = WHITE) Then ToList "+" & str$(i + 1) & str$(j + 1) & "- 白"
      End If
    Next j
  Next i
End Sub

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