lifecontrol.vb

Programming the .NET Compact Framework with vb 源代码

' -----------------------------------------------------------------------------
' Code from _Programming the .NET Compact Framework with VB_
' and _Programming the .NET Compact Framework with C#_
' (c) Copyright 2002-2004 Paul Yao and David Durant. 
' All rights reserved.
' -----------------------------------------------------------------------------

Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Data
Imports System.Windows.Forms

Public Class LifeControl
   Inherits System.Windows.Forms.Control

   ' Summary description for LifeControl.
   ' The display control for a Life game.
   '   Draws one generation.  this.genCurr 
   '   is always the generation that will 
   '   be drawn.
   ' Also handles mouse clicks that occur in
   '   its client area.
   ' A reference to this is stored in the 
   '   refFacade property of the LifeMain 
   '   object.

#Region " Component Designer generated code "

   Public Sub New(ByVal Container As System.ComponentModel.IContainer)
      MyClass.New()

      'Required for Windows.Forms Class Composition Designer support
      Container.Add(Me)
   End Sub

   Public Sub New()
      MyBase.New()

      'This call is required by the Component Designer.
      InitializeComponent()

      'Add any initialization after the InitializeComponent() call

   End Sub

   'Required by the Component Designer
   Private components As System.ComponentModel.IContainer

   'NOTE: The following procedure is required by the Component Designer
   'It can be modified using the Component Designer.
   'Do not modify it using the code editor.
   <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
      components = New System.ComponentModel.Container
   End Sub

#End Region

#Region "Properties"
   ' Properties used for drawing.
   '    The current generation is the one that is displayed;
   '    the previous generation is used for optimization.
   '    They will be set by the LifeMain   object before this
   '    control is invalidated.
   Friend refCurr As LifeGeneration
   Friend refPrev As LifeGeneration
#End Region

#Region "Base Class Overrides"

   Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
      ' Determine the cell that was clicked.
      Dim displayLo As Integer = (LifeMain.noofCells - LifeMain.noofDisplay) / 2
      Dim xUnit As Integer = CInt(ClientRectangle.Width / LifeMain.noofDisplay)
      Dim yUnit As Integer = CInt(ClientRectangle.Height / LifeMain.noofDisplay)

      ' Tell the current generation to toggle this cell.
      refCurr.FlipCell(e.Y / yUnit + displayLo + 1, e.X / xUnit + displayLo + 1)

      ' Have the current display repainted, including
      '    a background erase.
      LifeMain.boolPaintAll = True
      Me.Invalidate()

      ' Call the base class.
      MyBase.OnMouseUp(e)
   End Sub 'OnMouseUp


   Protected Overrides Sub OnPaint(ByVal pe As PaintEventArgs)
      ' If requested, erase the background.
      If LifeMain.boolPaintAll Then
         pe.Graphics.FillRectangle(New SolidBrush(Me.BackColor), pe.ClipRectangle)
      End If

      ' Draw the current generation.
      '   The previous generation is included for optimization 
      '   purposes only (only draw what has changed).
      If Not (refCurr Is Nothing) Then
         Me.DrawGeneration(refCurr, refPrev, pe.Graphics)
      End If
   End Sub

   Protected Overrides Sub OnPaintBackground(ByVal pe As PaintEventArgs)
      ' Do NOT call the base class routine.  
      '    This control does its own erase
      '    background from within the paint
      '    event.
   End Sub

#End Region

#Region "Drawing Routines"

   ' Draw the current generation.
   Friend Sub DrawGeneration(ByVal genCurr As LifeGeneration, _
                             ByVal genPrev As LifeGeneration, _
                             ByVal graphLifeGame As Graphics)
      ' Calculate the range of rows to display.
      Dim displayLo As Integer = genCurr.middle - (LifeMain.noofDisplay - 1) / 2
      Dim displayHi As Integer = displayLo + (LifeMain.noofDisplay - 1)

      ' For each of those rows.
      Dim j As Integer
      For j = displayLo To displayHi
         ' Only draw the row if necessary.
         If LifeMain.boolPaintAll = True Or genCurr.countGeneration <= 1 Or genCurr.Rows(j).CompareTo(genPrev.Rows(j)) <> 0 Then
            Me.DrawRow(genCurr.Rows(j), genPrev.Rows(j), j, graphLifeGame)
         End If
      Next j
   End Sub


   ' Draw the current row.
   Friend Sub DrawRow(ByVal rowCurr As LifeRow, _
                      ByVal rowPrev As LifeRow, _
                      ByVal ixRow As Integer, _
                      ByVal graphLifeGame As Graphics)
      ' Calculate the range of rows to display.
      Dim displaySpan As Integer = LifeMain.noofDisplay
      Dim displayLo As Integer = rowCurr.middle - (displaySpan - 1) / 2
      Dim displayHi As Integer = displayLo + (displaySpan - 1)

      ' Drawing tools
      Dim xUnit As Integer = CInt(Me.ClientRectangle.Width / displaySpan)
      Dim yUnit As Integer = CInt(Me.ClientRectangle.Height / displaySpan)
      Dim brshLive As New SolidBrush(Color.Black)
      Dim brshDead As New SolidBrush(Color.Tan)

      ' This routine attemps to optimize the
      '    drawing of rows.  Rows are drawn
      '    using FillRect.  The three primary
      '    optimizations are:
      ' 1.   Do not erase the background.
      ' 2.   Draw contiguous cells of the same
      '      state (color) in a single FillRect
      '      call.
      ' 3.   Do not call FillRect if the rectangle
      '      specified is already the correct
      '      color.  That is, if there is no 
      '      change in the range of cells since
      '      the previous generation.
      Dim ixStart As Integer = displayLo
      Dim ixEnd As Integer = displayHi
      Dim j As Integer = displayLo ' The left cell of the rect.
      ' The right cell of the rect.
      ' The current cell.
      Dim byteCurrent As Byte = rowCurr.cellsRow(displayLo)

      ' Force the last cell of a row to end a rectangle.
      Dim cellTemp As Byte = rowCurr.cellsRow(displayHi)
      rowCurr.cellsRow(displayHi) = 2

      ' Scan from the end of the previous rectangle until 
      '    a change in cell value occurs, indicating the
      '    need for a new rectangle.
      For j = displayLo To displayHi
         If rowCurr.cellsRow(j) <> byteCurrent Then
            ' Note the end of the rectangle.
            ixEnd = j - 1

            ' Only call FillRect if nexessary.
            If LifeMain.boolPaintAll _
            Or rowCurr.CompareTo(rowPrev, ixStart, ixEnd) <> 0 Then
               graphLifeGame.FillRectangle _
                  (IIf(byteCurrent = 1, brshLive, brshDead), _
                      (ixStart - displayLo) * xUnit, _
                      (ixRow - displayLo) * yUnit, _
                      (ixEnd - ixStart + 1) * xUnit, _
                      1 * yUnit)
            End If

            ' Note the start of the next rectangle.
            ixStart = j
            ' Note the value of the new rectangle's
            '    starting cell.
            byteCurrent = rowCurr.cellsRow(j)
         End If
      Next j

      ' Restore the last cell to its origional value.
      rowCurr.cellsRow(displayHi) = cellTemp
   End Sub
#End Region

End Class