squares.vb

Programming the .NET Compact Framework with vb 源代码

' Squares.vb - Handles details of game squares for 
' JasperDots game.
'
' Code from _Programming the .NET Compact Framework with C#_
' and _Programming the .NET Compact Framework with VB_
' (c) Copyright 2002-2003 Paul Yao and David Durant. 
' All rights reserved.

Imports System
Imports System.Drawing
Imports System.Windows.Forms

Public Class Squares
   Public ReadOnly Property Width() As Integer
      Get
         Return cxWidth
      End Get
   End Property

   Public ReadOnly Property Height() As Integer
      Get
         Return cyHeight
      End Get
   End Property


   Private cxLeft As Integer = 15
   Private cyTop As Integer = 15
   Private cxWidth As Integer
   Private cyHeight As Integer
   Const cxLine As Integer = 20
   Const cyLine As Integer = 20
   Const cxyDelta As Integer = 5
   Private m_asq(,) As Square

   Private m_ctrlParent As Control
   Private m_brPlayer1 As Brush
   Private m_brPlayer2 As Brush
   Private m_brBackground As Brush = _
      New SolidBrush(SystemColors.Window)
   Private hbrBlack As Brush = New SolidBrush(Color.Black)
   Private ptTest As Point = New Point(0, 0)
   Dim rc As Rectangle = New Rectangle(0, 0, 0, 0)
   Private szDot As Size = New Size(4, 4)

   Dim penLine As Pen = New Pen(Color.Black)

   Public Sub New(ByVal ctrlParent As Control)
      m_ctrlParent = ctrlParent
   End Sub

   Public Function SetGridSize( _
   ByVal cxNewWidth As Integer, _
   ByVal cyNewHeight As Integer) As Boolean
      ' Temporary scratch space.
      Dim rcTemp As Rectangle = New Rectangle(0, 0, 0, 0)
      Dim ptTemp As Point = New Point(0, 0)
      Dim szTemp As Size = New Size(0, 0)

      ' Set up array to track squares.
      cxWidth = cxNewWidth
      cyHeight = cyNewHeight
      m_asq = New Square(cxWidth, cyHeight) {}
      If m_asq Is Nothing Then
         Return False
      End If

      Dim x As Integer, y As Integer
      For x = 0 To cxWidth - 1
         For y = 0 To cyHeight - 1
            m_asq(x, y).iOwner = 0 ' No owner.
            Dim xLeft As Integer = cxLeft + x * cxLine
            Dim yTop As Integer = cyTop + y * cyLine
            Dim xRight As Integer = cxLeft + (x + 1) * cxLine
            Dim yBottom As Integer = cyTop + (y + 1) * cyLine
            Dim cxTopBottom As Integer = cxLine - (2 * cxyDelta)
            Dim cyTopBottom As Integer = cxyDelta * 2
            Dim cxLeftRight As Integer = cxyDelta * 2
            Dim cyLeftRight As Integer = cxLine - (2 * cxyDelta)

            ' Main rectangle.
            ptTemp.X = xLeft + 1
            ptTemp.Y = yTop + 1
            szTemp.Width = xRight - xLeft - 1
            szTemp.Height = yBottom - yTop - 1
            rcTemp.Location = ptTemp
            rcTemp.Size = szTemp
            m_asq(x, y).rcMain = rcTemp

            ' Top hit rectangle.
            m_asq(x, y).rcTop = _
                  New Rectangle(xLeft + cxyDelta, _
                  yTop - cxyDelta, _
                  cxTopBottom, _
                  cyTopBottom)
            m_asq(x, y).bTop = False

            ' Right hit rectangle.
            m_asq(x, y).rcRight = _
                  New Rectangle(xRight - cxyDelta, _
                  yTop + cxyDelta, _
                  cxLeftRight, _
                  cyLeftRight)
            m_asq(x, y).bRight = False

            ' Bottom hit rectangle.
            m_asq(x, y).rcBottom = _
                  New Rectangle(xLeft + cxyDelta, _
                  yBottom - cxyDelta, _
                  cxTopBottom, _
                  cyTopBottom)
            m_asq(x, y).bBottom = False

            ' Left hit rectangle.
            m_asq(x, y).rcLeft = _
                  New Rectangle(xLeft - cxyDelta, _
                  yTop + cxyDelta, _
                  cxLeftRight, _
                  cyLeftRight)
            m_asq(x, y).bLeft = False

         Next y
      Next x

      Return True
   End Function

   Public Function _
   SetPlayerBrushes( _
   ByVal br1 As Brush, _
   ByVal br2 As Brush)
      m_brPlayer1 = br1
      m_brPlayer2 = br2

      Return True
   End Function

   Public Sub FillOneSquare( _
   ByVal g As Graphics, _
   ByVal x As Integer, _
   ByVal y As Integer)
      Dim brCurrent As Brush = m_brBackground
      If m_asq(x, y).iOwner = 1 Then
         brCurrent = m_brPlayer1
      ElseIf m_asq(x, y).iOwner = 2 Then
         brCurrent = m_brPlayer2
      End If
      g.FillRectangle(brCurrent, m_asq(x, y).rcMain)
   End Sub

   ' FillSquares -- Fill owned squares with a player's color
   Public Sub FillSquares(ByVal g As Graphics)
      Dim x As Integer, y As Integer
      For x = 0 To cxWidth - 1
         For y = 0 To cyHeight - 1
            If m_asq(x, y).iOwner <> 0 Then
               FillOneSquare(g, x, y)
            End If
         Next
      Next
   End Sub ' FillSquares()

   ' DrawOneLineSet
   '
   Public Sub DrawOneLineSet( _
   ByVal g As Graphics, _
   ByVal x As Integer, _
   ByVal y As Integer)
      Dim xLeft As Integer = cxLeft + x * cxLine
      Dim yTop As Integer = cyTop + y * cyLine
      Dim xRight As Integer = cxLeft + (x + 1) * cxLine
      Dim yBottom As Integer = cyTop + (y + 1) * cyLine

      If (m_asq(x, y).bTop) Then
         g.DrawLine(penLine, xLeft, yTop, xRight, yTop)
      End If
      If (m_asq(x, y).bRight) Then
         g.DrawLine(penLine, xRight, yTop, xRight, yBottom)
      End If
      If (m_asq(x, y).bBottom) Then
         g.DrawLine(penLine, xRight, yBottom, xLeft, yBottom)
      End If
      If (m_asq(x, y).bLeft) Then
         g.DrawLine(penLine, xLeft, yBottom, xLeft, yTop)
      End If
   End Sub ' DrawOneLineSet()

   ' DrawLines -- Draw lines which have been hit.
   '
   Public Sub DrawLines(ByVal g As Graphics)
      Dim x As Integer, y As Integer
      For x = 0 To cxWidth - 1
         For y = 0 To cyHeight - 1
            DrawOneLineSet(g, x, y)
         Next
      Next
   End Sub

   Public Sub DrawDots(ByVal g As Graphics)
      ' Draw array of dots.
      Dim x As Integer, y As Integer
      For x = 0 To cxWidth
         For y = 0 To cyHeight
            ptTest.X = (cxLeft - 2) + x * cxLine
            ptTest.Y = (cyTop - 2) + y * cyLine
            rc.Location = ptTest
            rc.Size = szDot
            g.FillEllipse(hbrBlack, rc)
         Next
      Next
   End Sub ' DrawDots

   Public Enum Side
      None
      Left
      Top
      Right
      Bottom
   End Enum

   ' HitTest - check whether a point hits a line.
   '
   ' Return values:
   ' 0 = miss
   ' 1 = hit a line
   ' 2 = hit and completed a square.
   Public Function HitTest( _
   ByVal xIn As Integer, _
   ByVal yIn As Integer, _
   ByVal iPlayer As Integer) As Integer
      Dim x As Integer, y As Integer
      Dim bHit1 As Boolean = False
      Dim bHit2 As Boolean = False
      Dim sideHit As Side = Side.None

      For x = 0 To cxWidth - 1
         For y = 0 To cyHeight - 1
            ' If already owned, do not check
            If m_asq(x, y).iOwner = 0 Then

               ' Check for lines against point.
               If m_asq(x, y).rcTop.Contains(xIn, yIn) Then
                  ' Line already hit?
                  If m_asq(x, y).bTop Then
                     Return 0
                  End If
                  ' If not, set line as hit.
                  sideHit = Side.Top
                  m_asq(x, y).bTop = True
               ElseIf m_asq(x, y).rcLeft.Contains(xIn, yIn) Then
                  ' Line already hit?
                  If m_asq(x, y).bLeft Then
                     Return 0
                  End If
                  ' If not, set line as hit.
                  sideHit = Side.Left
                  m_asq(x, y).bLeft = True
               ElseIf m_asq(x, y).rcRight.Contains(xIn, yIn) Then
                  ' Line already hit?
                  If m_asq(x, y).bRight Then
                     Return 0
                  End If
                  ' If not, set line as hit.
                  sideHit = Side.Right
                  m_asq(x, y).bRight = True
               ElseIf m_asq(x, y).rcBottom.Contains(xIn, yIn) Then
                  ' Line already hit?
                  If m_asq(x, y).bBottom Then
                     Return 0
                  End If
                  ' If not, set line as hit.
                  sideHit = Side.Bottom
                  m_asq(x, y).bBottom = True
               End If

               If (sideHit <> Side.None) Then
                  ' We hit a side
                  bHit1 = True

                  ' Draw sides
                  Dim g As Graphics = _
                     m_ctrlParent.CreateGraphics()
                  DrawOneLineSet(g, x, y)

                  ' Check whether square is now complete.
                  ' We hit a line - check for hitting a square.
                  If (m_asq(x, y).bLeft And _
                        m_asq(x, y).bTop And _
                        m_asq(x, y).bRight And _
                        m_asq(x, y).bBottom) Then

                     ' Side is complete.
                     m_asq(x, y).iOwner = iPlayer
                     bHit2 = True

                     ' Fill current square
                     FillOneSquare(g, x, y)
                  End If

                  g.Dispose()
               End If
            End If
         Next y
      Next x

      If (bHit2) Then
         Return 2
      ElseIf (bHit1) Then
         Return 1
      Else
         Return 0
      End If

   End Function

   ' GetScore - Get current score for player N
   '
   Public Function GetScore( _
   ByVal iPlayer As Integer) As Integer
      Dim iScore As Integer = 0
      Dim x As Integer, y As Integer
      For x = 0 To cxWidth - 1
         For y = 0 To cyHeight - 1
            If m_asq(x, y).iOwner = iPlayer Then
               iScore = iScore + 1
            End If
         Next
      Next
      Return iScore
   End Function ' GetScore

End Class