• Почему именно VB.NET и С#?
  • Примеры к главе 5 (конечные автоматы)
  • Примеры к главе 7 (производительность: введение)
  • Примеры к главе 8 (производительность и память)
  • Примеры к главе 9 (производительность и многопоточное выполнение)
  • Примеры к главе 10 (производительность и XML)
  • Примеры к главе 11 (производительность и графика)
  • Примеры к главе 13 (проектирование пользовательского интерфейса)
  • Примеры к главе 14 (данные)
  • Примеры к главе 15 (передача данных)
  • ПРИЛОЖЕНИЕ Б

    Примеры программ на языке Visual Basic .NET 

    Почему именно VB.NET и С#?

    Споры между разработчиками программ на языках VB.NET и С# никогда не прекращается, и это неплохо! Представителям обоих лагерей есть чему поучиться друг у друга. Что касается меня, то, поработав с обоими языками в течение многих лет, и в частности, имея опыт работы в составе группы разработчиков на Visual Basic, могу поделиться следующими наблюдениями. Каждый из этих языков может быть использован для решения практически любой задачи программирования — все дело в акцентах. Я обнаружил, что Visual Basic .NET с его традиционным для Visual Basic акцентом на продуктивности программирования великолепно приспособлен для разработки конечных приложений.

    С другой стороны, преимуществом С# является его строгость, что делает его более приспособленным для проектирования каркасов приложений. По всей видимости, оба языка в равной степени хорошо приспособлены для проектирования повторно используемых компонент, которые занимают промежуточное положение между независимыми приложениями и обширными библиотеками программ. Кроме того, оба языка предлагают опции, отличные от используемых по умолчанию, которые сближают подходы, основанные на использовании каждого из них. Так, в Visual Basic .NET имеется директива Option Strict On, которую я настоятельно рекомендую помещать в начале любого модуля, который вы пишете, в качестве меры, позволяющей вылавливать многие виды распространенных синтаксических и логических ошибок. Помимо этого, оба языка учатся друг у друга, заимствуя каждый с выходом очередной новой версии нечто полезное, что впервые было предложено в другом языке; это порождает хороший дух соперничества между этими двумя языками.

    В Visual Basic .NET мне особенно нравятся возможности, относящиеся к обработке событий; ключевые слова AddHandler и Handles (используемые в приведенных ниже кодах) гораздо более элегантны и декларативны, чем их текущие варианты, используемые в С#. Поскольку удобнее всего работать с примерами, которые написаны на наиболее привычном языке, я поместил в данное приложение VB.NET-версии почти всех листингов, приведенных в основной части книги.

    Не включены в приложение только листинги примеров, которые, либо в силу малости их размера, либо в силу того, что они должны быть одинаково хорошо понятны разработчикам, принадлежащим любому лагерю, автор счел слишком тривиальными, чтобы тратить время на их трансляцию. Везде, где только возможно, соблюдается практика записи кода, принятая в Visual Basic, в том смысле, что приведенный ниже код является не результатом прямой трансляции кода, написанного на языке C#, а скорее его "VB-версией"; в то же время, оба вида примеров функционально эквивалентны друг другу, и тем, для кого представляет интерес сравнение возможностей языков Visual Basic и C#, чтобы решить для себя, какой из них выбрать, сделать это не составит труда. Удачного программирования!

    Примеры к главе 5 (конечные автоматы)

    Листинг 5.1. Простой код конечного автомата для игры с множественным выбором

    Option Explicit On

    Class MyStateMachineClass


    Private Enum GameState

     StartScreen

     AskQuestion

     CongratulateUser

     ScoldUser

    End Enum


    Private m_CurrentGameStateAs GameState

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

    'Конечный автомат, воздействующий на пользовательский интерфейс и

    'управляющий переходами приложения в другие состояния в соответствии с

    'текущим режимом работы пользователя

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

    Private Sub StateChangeForGame(ByVal newGameUIState _

     As GameState)

     'Определить, в какое состояние переходит приложение

     Select Case (newGameUIState)

     Case GameState.StartScreen

      'Если переход в данное состояние осуществляется из состояния,

      'для которого это запрещено, возбудить исключение

      If ((m_CurrentGameState <> GameState.CongratulateUser) _

       AndAlso (m_CurrentGameState <> GameState.ScoldUser)) Then

       Throw New System.Exception("Запрещённое изменение состояния!")

      End If


      'ЧТО СДЕЛАТЬ: Поместите сюда код, выполняющий следующие операции:

      ' 1. Скрытие (Hide), отображение (Show) и перемещение (Move)

      ' элементов управления пользовательского интерфейса

      ' 2. Настройка переменных/состояний игры, соответствующих

      ' данному режиму работы

      ' SetUpGameStateForStartScreen()


     Case GameState.AskQuestion

      'Если переход в данное состояние осуществляется из состояния,

      'для которого это запрещено, возбудить исключение

      If ((m_CurrentGameState <> GameState.StartScreen) _

       AndAlso (m_CurrentGameState <> GameState.CongratulateUser) _

       AndAlso (m_CurrentGameState <> GameState.ScoldUser)) Then

       Throw New System.Exception("Запрещённое изменение состояния!")

      End If


      'ЧТО СДЕЛАТЬ: Поместите сюда код, выполняющий следующие операции:

      ' 1. Скрытие (Hide), отображение (Show) и перемещение (Move)

      ' элементов управления пользовательского интерфейса

      ' 2. Настройка переменных/состояний игры, соответствующих

      ' данному режиму работы

      '

      ' SetUpGameStateForAskQuestion()


     Case GameState.CongratulateUser

      'Если переход в данное состояние осуществляется из состояния,

      'для которого это запрещено, возбудить исключение

      If (m_CurrentGameState <> GameState.AskQuestion) Then

       Throw New System.Exception("Запрещённое изменение состояния!")

      End If


      'ЧТО СДЕЛАТЬ: Поместите сюда код, выполняющий следующие операции:

      ' 1. Скрытие (Hide), отображение (Show) и перемещение (Move)

      ' элементов управления пользовательского интерфейса

      ' 2. Настройка переменных/состояний игры, соответствующих

      ' данному режиму работы

      '

      ' SetUpGameStateForCongratulateUser()


     Case GameState.ScoldUser

      'Если переход в данное состояние осуществляется из состояния,

      'для которого это запрещено, возбудить исключение

      If (m_CurrentGameState <> GameState.AskQuestion) Then

       Throw New System.Exception("Запрещённое изменение состояния!")

      End If


      'ЧТО СДЕЛАТЬ: Поместите сюда код, выполняющий следующие операции:

      ' 1. Скрытие (Hide), отображение (Show) и перемещение (Move)

      ' элементов управления пользовательского интерфейса

      ' 2. Настройка переменных/состояний игры, соответствующих

      ' данному режиму работы

      ' SetUpGameStateForScoldUser()

     Case Else

      Throw New System.Exception("Наизвестное состояние!")

     End Select


     'Сохранить запрошенное новое состояние в качестве текущего

     m_CurrentGameState = newGameUIState

    End Sub

    End Class

    Листинг 5.2. Неявное изменение состояния приложения (неудачный подход)

    'Код, выполняющийся при загрузке формы

    Private Sub Form1_Load(ByVal senderAs System.Object,ByVal _

     e As System.EventArgs) Handles MyBase.Load

     TextBox1.Visible = True

     ListBox1.Visible = False

    End Sub


    'Данные

    Private m_someImportantInfoAs String


    'Пользователь щелкнул на кнопке и хочет перейти к выполнению

    'следующего шага данного приложения. Скрыть текстовое окно и отобразить

    'окно списка в отведенном для этого месте.

    Private Sub Button1_Click(ByVal senderAs System.Object,ByVal _

     e As System.EventArgs) Handles Button1.Click

     m_someImportantInfo = TextBox1.Text

     TextBox1.Visible = False

     ListBox1.Visible =True

    End Sub

    Листинг 5.3. Явное изменение состояния приложения (удачный подход)

    Private m_someImportantInfo As String

    'Определить состояния, в которых может находиться приложение

    Enum MyStates

     step1

     step2

    End Enum


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

    'Главная функция, которая

    'вызывается всякий раз, когда возникает необходимость

    'в изменении состояния приложения

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

    Sub ChangeApplicationState(ByVal newStateAs MyStates)

     Select Case newState

     Case MyStates.step1

      TextBox1.Visible = True

      ListBox1.Visible = False

     Case MyStates.step2

      m_someImportantInfo = TextBox1.Text

      TextBox1.Visible = False

      ListBox1.Visible = True

     End Select

    End Sub


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

    'Пользователь щелкнул на кнопке и хочет перейти к выполнению

    'следующего шага данного приложения. Скрыть текстовое окно и отобразить

    'окно списка в отведенном для этого месте.

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

    Private Sub button1_Click(ByVal sender As Object, ByVal e As System.EventArgs)

     'Вызвать главную функцию для изменения состояния

     ChangeApplicationState(MyStates.step2)

    End Sub


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

    'Код, выполняющийся при загрузке формы

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

    Private Sub Forml_Load(ByVal sender As Object, _

     ByVal eAs System.EventArgs)

     'Вызвать главную функцию для изменения состояния

     ChangeApplicationState(MyStates.step1)

    End Sub

    Листинг 5.4. Код программы нахождения простых чисел, предназначенный для выполнения фоновым потоком

    Option Strict On

    Imports System

    Public Class FindNextPrimeNumber


    'Определить возможные состояния

    Public Enum ProcessingState

     notYetStarted

     waitingToStartAsync

     lookingForPrime

     foundPrime

     requestAbort

     aborted

    End Enum


    Private m_startTickCount As Integer

    Private m_endTickCount As Integer

    Private m_startPoint As Long

    Private m_NextHighestPrime As Long

    Private m_processingState As ProcessingState


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

    'Простейший конечный автомат

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

    Public Sub setProcessingState(ByVal nextState As ProcessingState)

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

     'Простейший защитный код, гарантирующий

     'невозможность перехода в другое состояние в случае успешного

     'завершения задачи или успешной отмены ее выполнения

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

     Dim currentState As ProcessingState

     currentState = getProcessingState()

     If ((currentState = ProcessingState.aborted) _

      OrElse (currentState = ProcessingState.foundPrime)) Then

      Return

     End If


     'Безопасное параллельное выполнение потоков

     SyncLock (Me)

      'Разрешить изменение состояния

      m_processingState = nextState

     End SyncLock

    End Sub

    Public Function getProcessingState() As ProcessingState

     Dim currentState As ProcessingState

     'Безопасное параллельное выполнение потоков

     SyncLock (Me)

      currentState = m_processingState

     End SyncLock

     Return currentState

    End Function


    Public Function getTickCountDelta() As Integer

     If (getProcessingState() = _

      ProcessingState.lookingForPrime) Then

      Throw New Exception( _

       "Продолжается поиск простого числа! Окончательное время еще не вычислено")

     End If

     Return m_endTickCount - m_startTickCount

    End Function


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

    'Возвращает простое число

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

    Public Function getPrime() As Long

     If (getProcessingState() <> ProcessingState.foundPrime) Then

      Throw New Exception("Простое число еще не найдено!")

     End If

     Return m_NextHighestPrime

    End Function

    'Конструктор класса

    Public Sub New(ByVal startPoint As Long)

     setProcessingState(ProcessingState.notYetStarted)

     m_startPoint = startPoint

    End Sub


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

    'Создает новый рабочий поток, который будет вызывать функцию

    'findNextHighestPrime()

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

    Public Sub findNextHighestPrime_Async()

     Dim threadStartAs System.Threading.ThreadStart

     threadStart = _

      New System.Threading.ThreadStart( _

      AddressOf findNextHighestPrime)

     Dim newThread As System.Threading.Thread

     newThread = New System.Threading.Thread(threadStart)


     'Состояние должно отвечать, что поиск продолжается

     setProcessingState(ProcessingState.waitingToStartAsync)

     newThread.Start()

    End Sub


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

    'Основной рабочий поток. Этот поток запускает поиск очередного

    'простого числа и выполняется до тех пор, пока не произойдет

    'одно из следующих двух событий:

    ' (а) найдено очередное простое число

    ' (b) от внешнего (по отношению к данному) потока поступила команда

    ' прекратить выполнение

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

    Public Sub findNextHighestPrime()

     'Если поступила команда прекратить выполнение, то поиск даже

     'не должен начинаться

     If (getProcessingState() = ProcessingState.requestAbort) Then

      GoTo finished_looking

     End If


     'Состояние должно отвечать, что поиск продолжается

     setProcessingState(ProcessingState.lookingForPrime)

     m_startTickCount = System.Environment.TickCount

     Dim currentItemAs Long

     'Проверить, является ли число нечетным

     If ((m_startPointAnd 1) = 1) Then

      'Число является нечетным, начать поиск со следующего нечетного числа

      currentItem = m_startPoint + 2

     Else

      'Число является четным, начать поиск со следующего нечетного числа

      currentItem = m_startPoint + 1

     End If


     'Приступить к поиску простого числа

     While (getProcessingState() = ProcessingState.lookingForPrime)

      'В случае нахождения простого числа возвратить его

      If (isItemPrime(currentItem) = True) Then

       m_NextHighestPrime = currentItem

       'Обновить состояние

       setProcessingState(ProcessingState.foundPrime)

      End If

      currentItem = currentItem + 2

     End While

    finished_looking:

     'Выход. К этому моменту либо от другого потока поступила

     'команда прекратить поиск, либо было найдено и записано

     'следующее наибольшее простое число


     'Зафиксировать время

     m_endTickCount = System.Environment.TickCount


     'Если поступил запрос прекратить выполнение,

     'сообщить, что выполнение процесса прекращено

     If (getProcessingState() = ProcessingState.requestAbort) Then

      setProcessingState(ProcessingState.aborted)

     End If

    End Sub


    'Вспомогательная функция, которая проверяет, является

    'ли число простым

    Private Function isItemPrime(ByVal potentialPrime As Long) As Boolean

     'Если число - четное, значит, оно не является простым

     If ((potentialPrime And 1) = 0) Then

      Return False

     End If


     'Продолжать поиск до тех пор, пока не будет превышено значение

     'квадратного корня из числа

     Dim end_point_of_searchAs Long end_point_of_search = _

      CLng(System.Math.Sqrt(potentialPrime) + 1)

     Dim current_test_itemAs Long = 3

     While (current_test_item <= end_point_of search)


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

      'Проверить, не поступила ли команда прекратить выполнение!

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

      If (getProcessingState() <> ProcessingState.lookingForPrime) Then

       Return False

      End If

      'Если число делится без остатка,

      'значит, оно не является простым

      If (potentialPrimeMod current_test_item = 0) Then

       Return False

      End If


      'Увеличить число на два

      current_test_item = current test_item + 2

     End While


     'Число является простым

     Return True

    End Function

    End Class

    Листинг 5.5. Тестовая программа, которая вызывает на выполнение приведенный выше код фонового потока, осуществляющего поиск простого числа

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

    'Код, обрабатывающий событие щелчка на кнопке Button1 формы

    'Вызвать из этого потока функцию поиска простого числа!

    '(Это приведет к блокированию потока)

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

    Private Sub Button1_Click(ByVal senderAs System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     Dim testItem As Long

     testItem = System.Convert.ToInt64("123456789012345")


     Dim nextPrimeFinder As FindNextPrimeNumber

     nextPrimeFinder = New FindNextPrimeNumber(testItem)

     nextPrimeFinder.findNextHighestPrime()

     Dim nextHighestPrime As Long

     nextHighestPrime = nextPrimeFinder.getPrime()

     MsgBox(CStr(nextHighestPrime))


     'Сколько времени заняли вычисления?

     Dim calculation_time As Integer

     calculationtime = nextPrimeFinder.getTickCountDelta()

     MsgBox(CStr(calculation time) + " мс")

    End Sub


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

    'Код, обрабатывающий событие щелчка на кнопке Button2 формы

    'Вызвать функцию поиска простого числа из другого потока!

    '(Данный поток блокироваться не будет)

    'Для отслеживания состояния выполнения задачи используем конечный автомат

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

    Private Sub Button2_Click(ByVal senderAs System.Object, _

     ByVal eAs System.EventArgs) Handles Button2.Click

     Dim testItem As Long

     testItem = System.Convert.ToInt64("123456789012345")

     Dim nextPrimeFinderAs FindNextPrimeNumber

     nextPrimeFinder = New FindNextPrimeNumber(testItem)


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

     'Выполнить обработку в другом потоке

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

     nextPrimeFinder.findNextHighestPrime_Async()


     'Войти в цикл и ожидать до тех пор, пока не будет найдено простое число

     'или выполнение не будет прекращено

     While ((nextPrimeFinder.getProcessingState() <> _

      FindNextPrimeNumber.ProcessingState.foundPrime) And _

      (nextPrimeFinder.getProcessingState() <> _

      FindNextPrimeNumber.ProcessingState.aborted))


      'ТОЛЬКО В ТЕСТОВОМ КОДЕ:

      'Отобразить окно сообщений и предоставить пользователю возможность

      'убрать его с экрана.

      'Это позволяет организовать паузу

      MsgBox("Поиск продолжается... Щелкните на кнопке OK")


      'Мы могли бы прекратить поиск путем следующего вызова функции:

      'nextPrimeFinder.setProcessingState(

      ' FindNextPrimeNumber.ProcessingState.requestAbort)

     End While


     'Осуществить корректный выход в случае прекращения поиска

     If (nextPrimeFinder.getProcessingState() = _

      FindNextPrimeNumber.ProcessingState.aborted) Then

      MsgBox("Поиск прекращен!")

      Return

     End If


     Dim nextHighestPrime As Long

     nextHighestPrime = nextPrimeFinder.getPrime()

     MsgBox(CStr(nextHighestPrime))


     'Сколько времени заняли вычисления?

     Dim calculation_time As Integer

     calculation_time = nextPrimeFinder.getTickCountDelta()

     MsgBox(CStr(calculation_time) + " мс")

    End Sub
     

    Примеры к главе 7 (производительность: введение)

    Листинг 7.1. Пример кода для измерения временных интервалов, который вы можете использовать для хронометрирования работы своих приложений

    Option Strict On

    Imports System


    Friend Class PerformanceSampling

    'Значение этого параметра может быть задано произвольным, но количество

    'тестовых интервалов, равное 8, представляется достаточным для большинства

    'случаев

    Const NUMBER_SAMPLERS As Integer = 8

    Private Shared m_perfSamplesNames(NUMBER_SAMPLERS) As String

    Private Shared m_perfSamplesStartTicks(NUMBER_SAMPLERS) As Integer

    Private Shared m_perfSamplesDuration(NUMBER_SAMPLERS) As Integer


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

    'Определить начальное значение счетчика тактов системных часов для интервала

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

    Friend Shared Sub StartSample(ByVal sampleIndex As Integer, _

     ByVal sampleName As String)

     m_perfSamplesNames(sampleIndex) = sampleName

     m_perfSamplesStartTicks(sampleIndex) = System.Environment.TickCount()

    End Sub


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

    'Определить конечное значение счетчика тактов системных часов для интервала

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

    Friend Shared Sub StopSample(ByVal sampleIndex As Integer)

     Dim stopTickCountAs Integer = System.Environment.TickCount


     'Счетчик тактов системных часов сбрасывается в ноль каждые 24,9 дня

     '(что соответствует примерно 2 миллиардам мс)

     'Эта маловероятная возможность будет принята нами во внимание

     If (stopTickCount >= m_perfSamplesStartTicks(sampleIndex)) Then

      'Обычно будет выполняться этот код

      m_perfSamplesDuration(sampleIndex) = _

       stopTickCount - m_perfSamplesStartTicks(sampleIndex)

     Else

      'Значение счетчика тактов "завернулось" через ноль, и мы

      'должны это учесть

      m_perfSamplesDuration(sampleIndex) = stopTickCount + _

       (Integer.MaxValue - m_perfSamplesStartTicks(sampleIndex)) + 1

     End If

    End Sub


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

    'Возвратить длительность тестового интервала

    '(в миллисекундах)

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

    Friend Shared Function GetSampleDuration(ByVal sampleIndex _

     As Integer) As Integer

     Return m_perfSamplesDuration(sampleIndex)

    End Function


    'Возвращает длительность истекшего тестового

    ' интервала в секундах

    Friend Shared Function GetSampleDurationText(ByVal _

     sampleIndexAs Integer) As String

     Return m_perfSamplesNames(sampleIndex) + ": " + _

      System.Convert.ToString( _

      (m_perfSamplesDuration(sampleIndex) / CDbl(1000.0)) ) + " секунд."

    End Function


    End Class

    Листинг 7.2. Тестовая программа, демонстрирующая использование приведенного выше кода для измерения временных интервалов

    Private Sub Button1_Click(ByVal senderAs System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     Const TEST_SAMPE_INDEXAs Integer = 2 'Выбрать любой допустимый индекс

     'Начать измерение

     PerformanceSampling.StartSample(TEST_SAMPE_INDEX, "TestSample")

     'Отобразить окно сообщений

     MsgBox("Для прекращения измерения нажмите кнопку OK")

     'Прекратить измерение

     PerformanceSampling.StopSample(TEST_SAMPE_INDEX)

     'Отобразить результаты

     MsgBox(PerformanceSampling.GetSampleDurationText( _

      TEST_SAMPE_INDEX))

    End Sub

    Листинг 7.3. Демонстрация трех различных уровней организации обратной связи с пользователем

    'Поместить надписи на кнопках

    Private Sub Form2_Load(ByVal senderAs System.Object, _

     ByVal e As System.EventArgs) Handles MyBase.Load

     button1.Text = "Плохая обратная связь"

     button2.Text = "Хорошая обратная связь"

     button3.Text = "Улучшенная обратная связь"

    End Sub

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

    'Пример слабых интерактивных возможностей интерфейса:

    ' - Визуальная индикация начала выполнения работы отсутствует

    ' - Визуальная индикация окончания выполнения работы отсутствует

    ' - Пользовательский интерфейс не способен к отклику в процессе работы

    ' - 0 завершении выполнения задачи пользователь вынужден только догадываться

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

    Private Sub Button1_Click(ByVal senderAs System.Object, _

     ByVal eAs System.EventArgs) Handles Button1.Click

     'Имитировать выполнение работы путем создания паузы продолжительностью

     '4 секунды

     System.Threading.Thread.Sleep(4000)

    End Sub

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

    'Пример лучших интерактивных возможностей интерфейса:

    ' + Визуальная индикация начала выполнения работы

    ' (появление курсора ожидания)

    ' + Визуальная индикация окончания выполнения работы

    ' (исчезновение курсора ожидания)

    ' - Пользовательский интерфейс не способен к отклику в процессе работы

    ' + По завершении выполнения задачи конечный пользователь узнает об этом,

    ' а пользовательский интерфейс восстанавливает способность к отклику

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

    Private Sub Button2_Click(ByVal senderAs System.Object, _

     ByVal eAs System.EventArgs) Handles Button2.Click

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.WaitCursor

     'Имитировать выполнение работы путем создания паузы продолжительностью

     '4 секунды

     System.Threading.Thread.Sleep(4000)

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.Default

    End Sub

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

    'Пример еще лучших интерактивных возможностей интерфейса:

    ' + Визуальная индикация начала выполнения работы

    ' (появление курсора ожидания)

    ' + Отображение дополнительного текста, сообщающего пользователю

    ' о том, что происходит

    ' + Визуальная индикация окончания выполнения работы

    ' (исчезновение курсора ожидания)

    ' - Пользовательский интерфейс не способен к отклику в процессе работы

    ' + По завершении выполнения задачи конечный пользователь узнает об этом,

    ' а пользовательский интерфейс восстанавливает способность к отклику

    ' + Текстовые сообщения информируют пользователя о том, что происходит

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

    Private Sub Button3_Click(ByVal senderAs System.Object, _

     ByVal e As System.EventArgs) Handles Button3.Click

     'Предоставить пользователю текст, информирующий его обо всем происходящем

     Label1.Text = "Ждите! Работа выполняется!"

     'Заставить ПИ обновить текст

     '(иначе он сделает это только тогда, когда будет перерисовывать сообщение,

     'а это может произойти и после выхода из данной функции)

     Label1.Update()


     'Отобразить курсор ожидания

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors WaitCursor


     'Имитировать выполнение работы путем создания паузы продолжительностью

     '2,8 секунды

     System.Threading.Thread.Sleep(2800)


     'Необязательное дополнительное обновление состояния

     Label1.Text = "Ждите! Работа близка к завершению!"

     Label1.Update()


     'Имитировать выполнение работы путем создания паузы продолжительностью

     '1,2 секунды

     System.Threading.Thread.Sleep(1200)


     'Известить пользователя текстовым сообщением о завершении работы

     '(текст обновляется всякий раз, когда ПИ выполняет обычное обновление

     'экрана)

     Label1.Text = "Работа успешно завершена!"

     'Избавиться от курсора ожидания

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.Default

    End Sub

    Листинг 7.4. Сравнение производительности двух алгоритмов, в одном из которых используются исключения, а во втором — нет

    '==================================================================

    'Примечание. В этом примере используется класс PerformanceSampling,

    ' определенный ранее в этой главе. Убедитесь в том, что

    ' этот класс включен в проект

    'ТЕСТОВАЯ ФУНКЦИЯ:

    'Сложить n1 и n2 и возвратить результат

    'в n3

    ' Возвращаемое значение:

    ' TRUE: если результат положителен

    ' FALSE: если результат отрицателен

    '==================================================================

    Function returnFalseIfLessThanZero_Add2Numbers( _

     ByVal n1As Integer, ByVal n2 As Integer, _

     ByRef n3 As Integer) As Boolean

     n3 = n1 + n2


     'Результат меньше 0?

     If (n3 < 0) Then

      Return False

     End If


     Return True

    End Function


    '========================================================================

    'ТЕСТОВАЯ ФУНКЦИЯ:

    'Сложить n1 и n2 и возвратить результат

    'в n3

    'Если n3 меньше 0, то функция ПЕРЕДАЕТ УПРАВЛЕНИЕ ОБРАБОТЧИКУ ИСКЛЮЧЕНИЙ.

    'В противном случае возвращается TRUE

    '========================================================================

    Function exceptionIfLessThanZero_Add2Numbers( _

     ByVal n1As Integer, ByVal n2As Integer, _

     ByRef n3 As Integer) As Boolean

     n3 = n1 + n2


     'Результат меньше 0?

     If (n3 <0) Then

      Throw New Exception("Результат меньше 0!")

     End If

     Return True

    End Function


    '=======================================================

    'Осуществляет многократные вызовы простой функции и

    'измеряет общее время выполнения

    'Вызываемая функция НЕ приводит к возбуждению исключений

    '=======================================================

    Private Sub buttonRunNoExceptionCode_Click(ByVal senderAs System.Object, _

     ByVal eAs System.EventArgs) Handles buttonRunNoExceptionCode.Click

     Const TEST_NUMBERAs Integer = 0

     Dim numberItterations As Integer

     numberItterations = _

      CInt(textBoxNumberAttempts.Text)


     'Отобразить количество итераций, которые предстоит выполнить

     ListBox1.Items.Add("=>" + numberItterations.ToString() + " итераций")

     Dim count_SumLessThanZero As Integer

     Dim dataOut As Integer


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

     'Запустить таймер

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

     PerformanceSampling.StartSample(TEST_NUMBER, "Исключения отсутствуют")

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

     'Выполнить цикл, в котором осуществляется вызов функции

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

     count_SumLessThanZero = 0

     Dim sumGreaterThanZero As Boolean

     Dim i As Integer

     While (i < numberItterations)


      '=========================

      'Вызвать тестовую функцию!

      '=========================

      sumGreaterThanZero = _

       returnFalseIfLessThanZero_Add2Numbers(-2, -3, dataOut)


      If (sumGreaterThanZero = False) Then

       count_SumLessThanZero = count_SumLessThanZero + 1

      End If

      i = i + 1

     End While


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

     'Остановить таймер

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

     PerformanceSampling.StopSample(TEST_NUMBER)


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

     'Показать результаты пользователю

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

     If (count_SumLessThanZero = numberItterations) Then

      MsgBox("Тест выполнен")

      ListBox1.Items.Add( _

       PerformanceSampling.GetSampleDurationText(TEST_NUMBER))

     Else

      MsgBox("При выполнении теста возникали осложнения")

     End If

    End Sub


    '==================================================

    'Осуществляет многократные вызовы простой функции и

    'измеряет общее время выполнения.

    'Вызываемая функция ВОЗБУЖДАЕТ исключения

    '==================================================

    Private Sub buttonRunExceptionCode_Click_Click(ByVal senderAs System.Object, _

     ByVal e As System.EventArgs) Handles buttonRunExceptionCode_Click.Click

     Const TESTNUMBERAs Integer = 1


     'Получить количество итераций Dim numberItterationsAs

     Integer numberItterations = _

      CInt(textBoxNumberAttempts.Text)


     'Отобразить количество итераций, которые надлежит выполнить

     ListBox1.Items.Add("=>" + numberItterations.ToString() + " итераций")


     Dim count_SumLessThanZero As Integer

     Dim dataOut As Integer


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

     'Запустить таймер

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

     PerformanceSampling.StartSample(TEST_NUMBER, "Перехват исключения")


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

     'Выполнить цикл, в котором осуществляется вызов функции

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

     count_SumLessThanZero = 0

     Dim sumGreaterThanZero As Boolean

     Dim i As Integer


     While (i < numberItterations)

      Try

       '=========================

       'Вызвать тестовую функцию!

       '=========================

       sumGreaterThanZero = _

        exceptionIfLessThanZero_Add2Numbers(-2, -3, dataOut)

      Catch

       count_SumLessThanZero = count_SumLessThanZero + 1

      End Try


      i = i + 1

     End While 'конец цикла

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

     'Остановить таймер

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

     PerformanceSampling.StopSample(TEST_NUMBER)


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

     'Показать результаты пользователю

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

     If (count_SumLessThanZero = numberItterations) Then

      MsgBox("Тест выполнен")

      ListBox1.Items.Add( _

       PerformanceSampling.GetSampleDurationText(TEST_NUMBER))

     Else

      MsgBox("При выполнении теста возникали осложнения")

     End If

    End Sub
     

    Примеры к главе 8 (производительность и память)

    Листинг 8.1. Применение отложенной загрузки, кэширования и освобождения графических ресурсов

    Option Strict On


    Public Class GraphicsGlobals


    Private Shared s_Player_Bitmap1 As System.Drawing.Bitmap

    Private Shared s_Player_Bitmap2 As System.Drawing.Bitmap

    Private Shared s_Player_Bitmap3 As System.Drawing.Bitmap

    Private Shared s_Player_Bitmap4 As System.Drawing.Bitmap

    Private Shared s_colPlayerBitmaps As _

     System.Collections.ArrayList


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

    'Освободить все ресурсы

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

    Public Shared Sub g_PlayerBitmapsCollection_CleanUp()

     'Если не загружено ни одно изображение, то и память освобождать не от чего

     If (s_colPlayerBitmapsIs Nothing) Then Return


     'Дать указание каждому из этих объектов освободить

     'любые удерживаемые ими неуправляемые ресурсы

     s_Player_Bitmap1.Dispose()

     s_Player_Bitmap2.Dispose()

     s_Player_Bitmap3.Dispose()

     s_Player_Bitmap4.Dispose()


     'Обнулить каждую из этих переменных, чтобы им не соответствовали

     'никакие объекты в памяти

     s_Player_Bitmap1 = Nothing

     s_Player_Bitmap2 = Nothing

     s_Player_Bitmap3 = Nothing

     s_Player_Bitmap4 = Nothing


     'Избавиться от массива

     s_colPlayerBitmaps = Nothing

    End Sub


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

    'Функция: возвращает коллекцию изображений

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

    Public Shared Function g_PlayerBitmapsCollection() _

     As System.Collections.ArrayList

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

     'Если изображения уже загружены, их достаточно только возвратить

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

     If Not (s_colPlayerBitmaps Is Nothing) Then

      Return scolPlayerBitmaps

     End If


     'Загрузить изображения как ресурсы из исполняемого двоичного файла

     Dim thisAssemblyAs System.Reflection.Assembly = _

      System.Reflection.Assembly.GetExecutingAssembly()


     Dim thisAssemblyNameAs System.Reflection.AssemblyName = _

      thisAssembly.GetName()


     Dim assemblyNameAs String = thisAssemblyName.Name


     'Загрузить изображения

     s_Player_Bitmap1 =New System.Drawing.Bitmap( _

      thisAssembly.GetManifestResourceStream(assemblyName _

      + ".Hank_RightRun1.bmp"))

     s_Player_Bitmap2 = New System.Drawing.Bitmap( _

      thisAssembly.GetManifestResourceStream(assemblyName _

      + ".Hank_RightRun2.bmp"))

     s_Player_Bitmap3 = New System.Drawing.Bitmap( _

      thisAssembly.GetManifestResourceStream(assemblyName _

      + ".Hank_LeftRun1.bmp"))

     s_Player_Bitmap4 = New System.Drawing.Bitmap( _

      thisAssembly.GetManifestResourceStream(assemblyName _

      + ".Hank_LeftRun2.bmp"))


     'Добавить изображения в коллекцию

     s_colPlayerBitmaps = New System.Collections.ArrayList

     s_colPlayerBitmaps.Add(s_Player_Bitmap1)

     s_colPlayerBitmaps.Add(s_Player_Bitmap2)

     s_colPlayerBitmaps.Add(s_Player_Bitmap3)

     s_colPlayerBitmaps.Add(s_Player_Bitmap4)


     'Возвратить коллекцию

     Return s_colPlayerBitmaps

    End Function


    Private Shared s_blackPen As System.Drawing.Pen

    Private Shared s_whitePen As System.Drawing.Pen

    Private Shared s_ImageAttribute As _

     System.Drawing.Imaging.ImageAttributes


    Private Shared s_boldFont As System.Drawing.Font


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

    'Вызывается для освобождения от любых графических

    'ресурсов, которые могли быть кэшированы

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

    Private Shared Sub g_CleanUpDrawingResources()

     'Освободить память от черного пера, если таковое имеется

     If Not (s_blackPenIs Nothing) Then

      s_blackPen.Dispose()

      s_blackPen = Nothing

     End If


     'Освободить память от белого пера, если таковое имеется

     If Not (s_whitePenIs Nothing) Then

      s_whitePen.Dispose()

      s_whitePen = Nothing

     End If


     'Освободить память от атрибута ImageAttribute, если таковой имеется.

     'Примечание. Метод Dispose() для этого типа не предусмотрен,

     'поскольку все его данные являются управляемыми

     If Not (s_ImageAttribute Is Nothing) Then

      s_ImageAttribute = Nothing

     End If


     'Освободить память от полужирного шрифта, если таковой имеется

     If Not (s_boldFontIs Nothing) Then

      b_boldFont.Dispose()

      s_boldFont = Nothing

     End If

    End Sub


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

    'Эта функция позволяет получить доступ

    'к черному перу, находящемуся в кэш-памяти

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

    Private Shared Function g_GetBlackPen() As System.Drawing.Pen

     'Если перо еще не существует, создать его

     If (s_blackPen Is Nothing) Then

      s_blackPen = New System.Drawing.Pen( _

       System.Drawing.Color.Black)

     End If


     'Возвратить черное перо

     Return s_blackPen

    End Function


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

    'Эта функция позволяет получить доступ

    'к белому перу, находящемуся в кэш-памяти

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

    Private Shared Function g_GetWhitePen() As System.Drawing.Pen

     'Если перо еще не существует, создать его

     If (s_whitePen Is Nothing) Then

      s_whitePen = New System.Drawing.Pen( _

       System.Drawing.Color.White)

     End If


     'Возвратить белое перо

     Return s_whitePen

    End Function


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

    'Эта функция позволяет получить доступ

    'к полужирному шрифту, находящемуся в кэш-памяти

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

    Private Shared Function g_GetBoldFont() As System.Drawing.Font

     'Если перо еще не существует, создать его

     If (s_boldFont Is Nothing) Then

      s_boldFont = New System.Drawing.Font( _

      System.Drawing.FontFamily.GenericSerif, 10, System.Drawing.FontStyle.Bold)

     End If


     'Возвратить полужирный шрифт

     Return s_boldFont

    End Function


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

    'Эта функция позволяет осуществлять доступ

    'к находящемуся в кэш-памяти объекту imageAttributes,

    'который мы используем для изображений с прозрачностью

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

    Private Shared Function g_GetTransparencyImageAttribute() As _

     System.Drawing.Imaging.ImageAttributes

     'Если объект не существует, создать его

     If (s_ImageAttributeIs Nothing) Then

      'Создать атрибут изображения

      s_ImageAttribute = _

       New System.Drawing.Imaging.ImageAttributes

      s_ImageAttribute.SetColorKey(System.Drawing.Color.White, _

       System.Drawing.Color.White)

     End If


     'Возвратить его

     Return s_ImageAttribute

    End Function


    End Class

    Листинг 8.2. Общий код, используемый во всех приведенных ниже вариантах тестов

    'Желаемое число повторений теста

    Const LOOP_SIZE As Integer = 8000

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

    'Эта функция переустанавливает содержимое нашего тестового

    'массива, что обеспечивает возможность многократного

    'выполнения тестового алгоритма

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

    Private Sub ResetTestArray(ByRef testArray() As String)

     If (testArray Is Nothing) Then

      ReDim testArray(6)

     End If

     testArray(0) = "big_blue_duck"

     testArray(1) = "small_yellow_horse"

     testArray(2) = "wide_blue_cow"

     testArray(3) = "tall_green_zepplin"

     testArray(4) = "short_blue_train"

     testArray(5) = "short_purple_dinosaur"

    End Sub

    Листинг 8.3. Тестовый пример, демонстрирующий неэкономное распределение памяти (типичный первоначальный вариант реализации интересующей нас функции)

    Private Sub Button2_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button2.Click

     'Вызвать сборщик мусора, чтобы быть уверенными в том, что

     'тест начнется с чистого состояния.

     'ПРИБЕГАЙТЕ К ЭТОЙ МЕРЕ ТОЛЬКО В ЦЕЛЯХ ТЕСТИРОВАНИЯ! Вызовы

     'сборщика мусора в программах вручную будут приводить к снижению

     'общей производительности приложений!

     System.GC.Collect()

     Dim testArray() As String = Nothing


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

     'Просмотреть элементы массива и

     'найти те из них, в которых средним словом является

     '"blue". Заменить "blue" на "orange"

     'Запустить секундомер для нашего теста!

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

     PerformanceSampling.StartSample(0, "WastefulWorkerClass")

     Dim workerClass1 As WastefulWorkerClass

     Dim outerLoop As Integer

     For outerLoop = 1 To LOOP_SIZE

      'Присвоить элементам массива значения, которые мы хотим использовать

      'при тестировании

      ResetTestArray(testArray)


      Dim topIndex = testArray.Length - 1

      Dim idx As Integer

      For idx = 0 To topIndex

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

       'Создать экземпляр вспомогательного класса,

       'который расчленяет строку на три части

       'Это неэкономный способ!

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

       workerClass1 = New WastefulWorkerClass(testArray(idx))

       'Если средним словом является "blue", заменить его на "orange"

       If (workerClass1.MiddleSegment = "blue") Then

        'Заменить средний сегмент

        workerClass1.MiddleSegment = "orange"

        'Заменить слово

        testArray(idx) = workerClass1.getWholeString()

       End If

      Next 'внутренний цикл

     Next 'внешний цикл

     'Получить время окончания теста

     PerformanceSampling.StopSample(0)

     MsgBox(PerformanceSampling.GetSampleDurationText(0))

    End Sub

    Листинг 8.4. Рабочий класс для первого тестового примера

    Option Strict On

    Imports System


    Public Class WastefulWorkerClass

    Private m_beginning_segment As String

    Public Property BeginSegment() As String

     Get

      Return m_beginning_segment

     End Get

     Set(ByVal Value As String)

      m_beginning_segment = Value

     End Set

    End Property


    Private m_middle_segment As String

    Public Property MiddleSegment() As String

     Get

      Return m_middle_segment

     End Get

     Set(ByVal Value As String)

      m_middle_segment = Value

     End Set

    End Property


    Private m_end_segment As String

    Public Property EndSegment() As String

     Get

      Return m_end_segment

     End Get

     Set(ByVal Value As String)

      m_end_segment = Value

     End Set

    End Property


    Public Sub New(ByVal in_word As String)

     Dim index_segment1 As Integer


     'Осуществляем поиск символов подчеркивания ("_") в строке

     index_segment1 = in_word.IndexOf("_", 0)


     'В случае отсутствия символов "_" все, что нам нужно, это первый сегмент

     If (index_segment1 = -1) Then

      m_beginning_segment = in_word

      m_middle_segment = ""

      m_end segment = ""

      Return

     Else

      'Если присутствует символ "_", отсечь его


      'Если первым символом является "_", то первым сегментом будет ""

      If (index_segment1 = 0) Then

       m_beginning_segment = ""

      Else

       'Первый сегмент

       m_beginning_segment = in_word.Substring(0, index_segment1)

      End If


      'Найти второй символ "_"

      Dim index_segment2 As Integer

      index_segment2 = in_word.IndexOf("_", index_segment1 + 1)


      'Второй символ "_" отсутствует

      If (index_segment2 = -1) Then

       m_middle_segment = ""

       m_end_segment = in_word.Substring(index_segment1 + 1)

       Return

      End If


      'Установить последний сегмент

      m_middle_segment = in_word.Substring(index_segment1 + 1, _

       index_segment2 - index_segment1 - 1)

      m_end_segment = in_word.Substring(index_segment2 + 1)

     End If

    End Sub


    'Возвращает все три сегмента, объединенные символами "_"

    Public Function getWholeString() As String

     Return m_beginning_segment + "_" + m_middle_segment + "_" + _

      m_end_segment

    End Function

    End Class

    Листинг 8.5. Тестовый пример, демонстрирующий уменьшение объема памяти, распределяемой для объектов (типичный образец улучшения первоначального варианта реализации интересующей нас функции)

    Private Sub Button3_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button3.Click

     'Вызвать сборщик мусора, чтобы тест

     'начинался с чистого состояния.

     'ПРИБЕГАЙТЕ К ЭТОЙ МЕРЕ ТОЛЬКО В ЦЕЛЯХ ТЕСТИРОВАНИЯ! Вызовы

     'сборщика мусора в программах вручную будут приводить к снижению

     'общей производительности приложений!

     System.GC.Collect()


     Dim testArray() As String = Nothing


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

     'Просмотреть элементы массива и

     'найти те из них, в которых средним словом является

     '"blue". Заменить "blue" на "orange"

     'Запустить секундомер!

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

     PerformanceSampling.StartSample(1, "LessWasteful")


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

     'БОЛЕЕ ЭКОНОМНЫЙ СПОСОБ: Распределить память для объекта

     'до вхождения в цикл

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

     Dim workerClass1 As LessWastefulWorkerClass

     workerClass1 = New LessWastefulWorkerClass


     Dim outerLoop As Integer

     For outerLoop = 1 To LOOP_SIZE

      'Присвоить элементам массива значения, которые мы хотим использовать

      'при тестировании ResetTestArray(testArray)

      Dim topIndex As Integer = testArray.Length -1 Dim idx As Integer

      For idx = 0 To topIndex

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

       'Теперь вместо повторного распределения памяти для объекта

       'нам достаточно лишь повторно воспользоваться им

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

       'workerClass1 = new WastefulWorkerClass(

       ' testArray(topIndex))

       workerClass1.ReuseClass(testArray(idx))


       'Если средним словом является "blue", заменить его на "orange"

       If (workerClass1.MiddleSegment = "blue") Then

        'Заменить средний сегмент

        workerClass1.MiddleSegment = "orange"

        'Заменить слово

        testArray(idx) = workerClass1.getWholeString()

       End If

      Next ' внутренний цикл

     Next 'внешний цикл


     'Остановить секундомер!

     PerformanceSampling.StopSample(1)

     MsgBox(PerformanceSampling.GetSampleDurationText(1))

    End Sub

    Листинг 8.6. Рабочий класс для второго тестового примера

    Option Strict

    On Imports System


    Public Class LessWastefulWorkerClass

    Private m_beginning_segment As String

    Public Property BeginSegment() As String

     Get

      Return m_beginning_segment

     End Get

     Set(ByVal Value As String)

      m_beginning_segment = Value

     End Set

    End Property


    Private m_middle_segment As String

    Public Property MiddleSegment() As String

     Get

      Return m_middle_segment

     End Get

     Set(ByVal Value As String)

      m_middle_segment = Value

     End Set

    End Property


    Private m_end_segment As String

    Public Property EndSegment() As String

     Get

      Return m_end_segment

     End Get

     Set(ByVal Value As String)

      m_end_segment = Value

     End Set

    End Property


    Public Sub ReuseClass(ByVal in_word As String)

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

     'Для повторного использования класса необходимо

     'полностью очистить внутреннее состояние

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

     m_beginning_segment = ""

     m_middle_segment = ""

     m_end_segment = ""


     Dim index_segment1 As Integer


     'Осуществляем поиск символов подчеркивания ("_") в строке

     index_segment1 = in_word.IndexOf("_", 0)


     'В случае отсутствия символов "_" все, что нам нужно, это первый сегмент

     If (index_segment1 = -1) Then

      m_beginning_segment = in_word

      Return

     Else

      'Если присутствует символ "_", отсечь его

      If (index_segment1 = 0) Then

      Else

       m_beginning_segment = in_word.Substring(0, _

        index_segment1)

      End If

      Dim index_segment2 As Integer

      index_segment2 = in_word.IndexOf("_", index_segment1 + 1)

      If (index segment2 = -1) Then

       m_end_segment = in_word.Substring(index_segment1 + 1)

       Return

      End If


      'Установить последний сегмент

      m_middle_segment = in_word.Substring(index_segment1 + 1, _

       index_segment2 - index_segment1 - 1)

      m_end_segment = in_word.Substring(index_segment2 + 1)

     End If

    End Sub


    Public Function getWholeString() As String

     Return m_beginning_segment + " " + m_middle_segment + " " + _

      m_end_segment

    End Function

    End Class

    Листинг 8.7. Тестовый пример, демонстрирующий значительное уменьшение объема памяти, распределяемой для объектов (типичный образец существенной алгоритмической оптимизации первоначального варианта реализации интересующей нас функции)

    Private Sub Button5 Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button5.Click

     'Вызвать сборщик мусора, чтобы тест

     'начинался с чистого состояния.

     'ПРИБЕГАЙТЕ К ЭТОЙ МЕРЕ ТОЛЬКО В ЦЕЛЯХ ТЕСТИРОВАНИЯ! Вызовы

     'сборщика мусора в программах вручную будут приводить к снижению

     'общей производительности приложений!

     System.GC.Collect()


     Dim testArray() As String = Nothing


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

     'Просмотреть элементы массива и

     'найти те из них, в которых средним словом является

     '"blue". Заменить "blue" на "orange"

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


     'Запустить секундомер перед началом выполнения теста

     PerformanceSampling.StartSample(2, "DefferedObjects")


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

     'БОЛЕЕ ЭКОНОМНЫЙ СПОСОБ: Распределить память для объекта

     'до вхождения в цикл

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


     Dim workerClass1 As LessAllocationsWorkerClass

     workerClass1 = New LessAllocationsWorkerClass


     Dim outerLoop As Integer

     For outerLoop = 1 To LOOP_SIZE

      'Присвоить элементам массива значения, которые мы хотим использовать

      'при тестировании

      ResetTestArray(testArray)

      Dim topIndex As Integer = testArray.Length - 1 Dim idx As Integer

      For idx = 0 To topIndex

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

       'Более экономный способ:

       'Теперь вместо повторного распределения памяти для объекта

       'нам достаточно лишь повторно воспользоваться им

       'Кроме того: в этом варианте реализации дополнительные строки

       'НЕ создаются

       'workerClass1 = new WastefulWorkerClass(

       '      testArray[topIndex])

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

       workerClass1.ReuseClass(testArray(idx))


       'Если средним словом является "blue", заменить его на "orange"

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

       'Более экономный способ:

       'При таком способе сравнения не требуется создавать

       'никаких дополнительных строк

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

       If (workerClass1.CompareMiddleSegment("blue") = 0) Then

        'Заменить средний сегмент

        workerClass1.MiddleSegment = "orange"

        'Заменить слово

        testArray(idx) = workerClass1.getWholeString()

       End If

      Next 'внутренний цикл

     Next 'внешний цикл

     'Остановить секундомер!

     PerformanceSampling.StopSample(2)

     MsgBox(PerformanceSampling.GetSampleDurationText(2))

    End Sub

    Листинг 8.8. Рабочий класс для третьего тестового примера

    Option Strict On

    Imports System


    Public Class LessAllocationsWorkerClass

    Public WriteOnly Property MiddleSegment() As String

     Set(ByVal Value As String)

      m_middleSegmentNew = Value

     End Set

    End Property


    Private m_middleSegmentNew As String

    Private m_index_1st_undscore As Integer

    Private m_index_2nd_undscore As Integer

    Private m_stringIn As String


    Public Sub ReuseClass(ByVal in_word As String)

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

     'Для повторного использования класса необходимо

     'полностью очистить внутреннее состояние

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

     m_index_1st_undscore = -1

     m_index_2nd_undscore = -1

     m_middleSegmentNew = Nothing

     m_stringIn = in_word 'Это не приводит к созданию копии строки


     'Осуществляем поиск символов подчеркивания ("_") в строке

     m_index_1st_undscore = in_word.IndexOf("_", 0)


     'В случае отсутствия символов "_" все, что нам нужно, это первый сегмент

     If (m_index_1st_undscore = -1) Then

      Return

     End If


     'Найти второй символ "_"

     m_index_2nd_undscore = in_word.IndexOf("_", _

      m_index_1st_undscore + 1)

    End Sub


    Public Function CompareMiddleSegment(ByVal compareTo As String) As Integer

     'В случае отсутствия второго символа "_" отсутствует и средний сегмент

     If (m_index_2nd_undscore < 0) Then

      'Если мы сравниваем с пустой строкой, то это означает

      'совпадение

      If ((compareTo = Nothing) OrElse (compareTo = "")) Then

       Return 0

      End If


      Return -1

     End If


     'Сравнить средний сегмент с первым и вторым сегментами

     Return System.String.Compare(m_stringIn, m_index_1st_undscore + 1, _

      compareTo, 0, _

      m_index_2nd_undscore - m_index_1st_undscore - 1)

    End Function


    Public Function getWholeString() As String

     'Если полученный средний сегмент не является новым,

     'возвратить исходный сегмент

     If (m_middleSegmentNew = Nothing) Then

      Return m_stringIn

     End If


     'Создать возвращаемую строку

     Return m_stringIn.Substring(0, m index_1st_undscore + 1) + _

      m_middleSegmentNew + m_stringIn.Substring( _

      m_index_2nd_undscore, _

      m_stringIn.Length - m_index_2nd_undscore)

    End Function

    End Class

    Листинг 8.9. Сравнение эффективности использования строк и класса stringBuilder в алгоритмах

    Const COUNT_UNTIL As Integer = 300

    Const LOOP_ITERATIONS As Integer = 40

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

    'НЕ ОЧЕНЬ ЭФФЕКТИВНЫЙ АЛГОРИТМ!

    'Для имитации создания типичного набора строк используются

    'обычные строки

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     'Вызвать сборщик мусора, чтобы тест

     'начинался с чистого состояния.

     'ПРИБЕГАЙТЕ К ЭТОЙ МЕРЕ ТОЛЬКО В ЦЕЛЯХ ТЕСТИРОВАНИЯ! Вызовы

     'сборщика мусора в программах вручную будут приводить к снижению

     'общей производительности приложений!

     System.GC.Collect()

     Dim numberToStore As Integer


     PerformanceSampling.StartSample(0, "StringAllocaitons")

     Dim total_result As String

     Dim outer_loop As Integer


     For outer_loop = 1 To LOOP_ITERATIONS

      'Сбросить старый результат

      total_result = ""


      'Выполнять цикл до максимального значения x_counter, каждый раз

      'присоединяя очередную тестовую строку к рабочей строке

      Dim x_counter As Integer

      For x_counter = 1 To COUNT_UNTIL

       total_result = total_result + numberToStore.ToString() + ", "


       'Увеличить значение счетчика

       numberToStore = numberToStore + 1

      Next

     Next

     PerformanceSampling.StopSample(0)


     'Отобразить длину строки

     MsgBox("String Length: " + total_result.Length.ToString())

     'Отобразить строку

     MsgBox("String : " + total_result)

     'Отобразить длительность интервала времени, ушедшего на вычисления

     MsgBox(PerformanceSampling.GetSampleDurationText(0))

    End Sub


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

    'ГОРАЗДО БОЛЕЕ ЭФФЕКТИВНЫЙ АЛГОРИТМ!

    'Для имитации создания типичного набора строк используется

    'конструктор строк (String Builder)

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

    Private Sub Button2_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button2.Click

     'Вызвать сборщик мусора, чтобы тест

     'начинался с чистого состояния.

     'ПРИБЕГАЙТЕ К ЭТОЙ МЕРЕ ТОЛЬКО В ЦЕЛЯХ ТЕСТИРОВАНИЯ! Вызовы

     'сборщика мусора в программах вручную будут приводить к снижению

     'общей производительности приложений!

     System.GC.Collect()

     Dim sb As System.Text.StringBuilder = _

      New System.Text.StringBuilder


     Dim total_result As String

     Dim numberToStore As Integer


     PerformanceSampling.StartSample(1, "StringBuilder")

     Dim outer_loop As Integer

     For outer_loop = 1 To LOOP_ITERATIONS


      'Очистить конструктор строк

      sb.Length = 0

      'Очистить строку со старым результатом

      total_result = ""


      'Выполнять цикл до максимального значения x_counter, каждый раз

      'присоединяя очередную тестовую строку к рабочей строке

      Dim x_counter As Integer

      For x_counter = 1 To COUNT_UNTIL

       sb.Append(numberToStore)

       sb.Append(", ")


       'Увеличить значение счетчика

       numberToStore = numberToStore + 1

      Next

      'Имитируем выполнение некоторых операций над строкой...

      total_result = sb.ToString()

     Next

     PerformanceSampling StopSample(1)


     'Отобразить длину строки

     MsgBox("Длина строки: " + total_result.Length.ToString())

     'Отобразить строку

     MsgBox("String : " + total_result)

     'Отобразить длительность интервала времени, ушедшего на вычисления

     MsgBox(PerformanceSampling.GetSampleDurationText(1))

    End Sub

    Примеры к главе 9 (производительность и многопоточное выполнение)

    Листинг 9.1. Код для управления выполнением одиночной задачи фоновым потоком

    Option Strict On

    Imports System

    Public Class ThreadExecuteTask

    'Перечисляем возможные состояния

    Public Enum ProcessingState

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

     'Начальное состояние

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

     'Перечисляем возможные состояния

      notYetStarted


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

     'Рабочие состояния

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

     'Ожидание запуска фонового потока

     waitingToStartAsync

     'Выполнение кода в фоновом потоке

     running

     'Запросить отмену выполнения вычислений

     requestAbort

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

     'Состояния завершения

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

     'Состояние завершения: выполнение фонового потока

     'успешно завершено

     done

     'Состояние завершения: выполнение потока отменено

     'до его завершения

     aborted

    End Enum

    Private m_processingState As ProcessingState


    Public Delegate Sub ExecuteMeOnAnotherThread(_

     ByVal checkForAborts As ThreadExecuteTask)


    Private m_CallFunction As ExecuteMeOnAnotherThread

    Private m_useForStateMachineLock As Object


    Public Sub New(ByVal functionToCall As ExecuteMeOnAnotherThread)

     'Создать объект, который мы можем использовать в конечном автомате

     'в целях блокировки

     m_useForStateMachineLock = New Object


     'Обозначить готовность к началу выполнения

     m_processingState = ProcessingState.notYetStarted


     'Сохранить функцию, которую необходимо вызвать

     'в новом потоке

     m CallFunction = functionToCall


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

     'Создать новый поток и вызвать в нем функцию на выполнение:

     ' this.ThreadStartPoint()

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

     Dim threadStart As System.Threading.ThreadStart threadStart = _

      New System.Threading.ThreadStart(AddressOf ThreadStartPoint)

     Dim newThread As System.Threading.Thread

     newThread = New System.Threading.Thread(threadStart)


     'Обозначить готовность к началу выполнения (в целях определенности

     'это важно сделать еще до того, как будет запущен поток!)

     setProcessingState(ProcessingState.waitingToStartAsync)


     'Дать ОС команду начать выполнение нового потока в асинхронном режиме

     newThread.Start()

     'Возвратить управление функции, вызывающей этот поток

    End Sub


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

    'Эта функция является точкой входа, вызываемой для

    'выполнения в новом потоке

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

    Private Sub ThreadStartPoint()

     'Установить состояние обработки, соответствующее выполнению

     'функции в новом потоке!

     setProcessingState(ProcessingState.running)

     'Запустить на выполнение пользовательский код и передать указатель в наш

     'класс, чтобы этот код мог периодически проверять, не поступил ли запрос

     'на прекращение выполнения

     m_CallFunction (Me)


     'Если выполнение не было отменено, изменить состояние таким образом,

     'чтобы оно соответствовало успешному завершению

     If (m_processingState <> ProcessingState.aborted) Then

      'Обозначить завершение выполнения

      setProcessingState(ProcessingState.done)

     End If


     'Выйти из потока...

    End Sub


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

    'Конечный автомат

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

    Public Sub setProcessingState(ByVal nextState As _

     ProcessingState)

     'В любой момент времени только одному потоку выполнения могут быть

     'разрешены попытки изменить состояние

     SyncLock (m_useForStateMachineLock)

      'В случае попытки повторного вхождения в текущее состояние

      'никакие дополнительные действия не выполняются

      If (m_processingState = nextState) Then

       Return

      End If

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

      'Простейший защитный код, гарантирующий

      'невозможность перехода в другое состояние, если задача либо

      'успешно завершена, либо успешно отменена

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

      If ((m_processingState = ProcessingState.aborted) OrElse _

       (m_processingState = ProcessingState.done)) Then

       Return

      End If


      'Убедиться в допустимости данного изменения состояния

      Select Case (nextState)

      Case ProcessingState.notYetStarted

       Throw New Exception _

        ("Переход в состояние 'notYetStarted' невозможен")

      Case ProcessingState.waitingToStartAsync

       If (m_processingState <> ProcessingState.notYetStarted) Then

        Throw New Exception("Недопустимое изменение состояния")

       End If

      Case ProcessingState.running

       If (m_processingState <> _

        ProcessingState.waitingToStartAsync) Then

        Throw New Ехсерtion("Недопустимое изменение состояния")

       End If

      Case ProcessingState.done

       'Мы можем завершить работу лишь тогда, когда она выполняется.

       'Это возможно также в тех случаях, когда пользователь затребовал

       'отмену выполнения, но работа к этому моменту уже была закончена

       If ((m_processingState <> ProcessingState.running) AndAlso _

        (m_processingState <> ProcessingState.requestAbort)) Then

        Throw New Exception("Недопустимое изменение состояния")

       End If

      Case ProcessingState.aborted

       If (m_processingState <> ProcessingState.requestAbort) Then

        Throw New Exception("Недопустимое изменение состояния")

       End If

      End Select


      'Разрешить изменение состояния

      m_processingState = nextState

     End SyncLock

    End Sub


    Public ReadOnly Property State() As ProcessingState

     Get

      Dim currentState As ProcessingState

      'Предотвратить попытки одновременного чтения/записи состояния

      SyncLock (m_useForStateMachineLock)

       currentState = m_orocessingState

      End SyncLock

      Return currentState

     End Get

    End Property

    End Class

    Листинг 9.2. Тестовая программа для выполнения работы в фоновом потоке

    Option Strict On

    Imports System

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

    'Тестовый код, который используется для выполнения фоновым

    'потоком

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

    Public Class Test1

    Public m_loopX As Integer

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

    'Функция, вызываемая фоновым потоком

    ' [in] threadExecute: Класс, управляющий выполнением нашего потока.

    ' Мы можем контролировать его для проверки

    ' того, не следует ли прекратить вычисления

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

    Public Sub ThreadEntryPoint(ByVal threadExecute As _

     ThreadExecuteTask)

     'Это окно сообщений будет отображаться в контексте того потока,

     'в котором выполняется задача MsgBox("Выполнение ТЕСТОВОГО ПОТОКА")

     '-------

     ' 60 раз

     '-------

     For m_loopX = 1 To 60

      'Если затребована отмена выполнения, мы должны завершить задачу

      If (threadExecute.State = _

       ThreadExecuteTask.ProcessingState.requestAbort) Then

       threadExecute.setProcessingState( _

        ThreadExecuteTask.ProcessingState.aborted)

       Return

      End If


      'Имитировать выполнение работы: пауза 1/3 секунды

      System.Threading.Thread.Sleep(333)

     Next

    End Sub

    End Class

    Листинг 9.3. Код для запуска и тестирования приведенного выше тестового кода

    'Класс, который будет управлять выполнением нового потока

    Private m_threadExecute As ThreadExecuteTask

    'Класс, метод которого мы хотим выполнять в асинхронном режиме

    Private m_testMe As Test1


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

    'Этот код должен быть запущен ранее другого кода, поскольку он запускает

    'новый поток выполнения!

    '

    'Создать новый поток и обеспечить его выполнение

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

    Private Sub buttonStartAsyncExecution_Click(ByVal sender _

     As System.Object, ByVal e As System.EventArgs) _

     Handles buttonStartAsyncExecution.Click

     'Создать экземпляр класса, метод которого мы хотим вызвать

     'в другом потоке

     m_testMe = New Test1


     'Упаковать точку входа метода класса в делегат

     Dim delegateCallCode As _

      ThreadExecuteTask.ExecuteMeOnAnotherThread


     delegateCallCode = _

      New ThreadExecuteTask.ExecuteMeOnAnotherThread(AddressOf _

      m_testMe.ThreadEntryPoint)


     'Дать команду начать выполнение потока!

     m_threadExecute = New ThreadExecuteTask(delegateCallCode)

    End Sub


    'Принудительно вызвать запрещенное изменение состояния (это приведет

    'к возбуждению исключения)

    Private Sub buttonCauseException_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) _

     Handles buttonCauseException.Click

     m_threadExecute.setProcessingState( _

      ThreadExecuteTask.ProcessingState.notYetStarted)

    End Sub


    'Послать асинхронному коду запрос с требованием отмены его выполнения

    Private Sub buttonAbort_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles buttonAbort.Click

     m_threadExecute.setProcessingState( _

      ThreadExecuteTask.ProcessingState.requestAbort)

    End Sub


    'Проверить состояние выполнения

    Private Sub buttonCheckStatus_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles ButtonCheckStatus.Click

     'Запросить у класса управления потоком, в каком состоянии он находится

     MsgBox(m_threadExecute.State.ToString())


     'Запросить класс, метод которого выполняется в потоке,

     'o состоянии выполнения

     MsgBox(m_testMe.m_loopX.ToString())

    End Sub

    Листинг 9.4. Код, который должен быть помещен в класс Smartphone Form1.cs

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

    'Весь этот код должен находиться внутри класса Form1.cs

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


    'Объект, который будет выполнять все фоновые вычисления

    Private m_findNextPrimeNumber As FindNextPrimeNumber

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

    'Обновить текст, информирующий о состоянии...

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

    Sub setCalculationStatusText(ByVal text As String)

     Label1.Text = text

    End Sub

    Private Sub menuItemExit_Click(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles menuItemExit.Click

     Me.Close()

    End Sub


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

    'Пункт меню для начала фоновых вычислений

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

    Private Sub menuItemStart Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) _

     Handles menuItemStart.Click

     'Число, с которого мы хотим начать поиск

     Dim startNumber As Long = System.Convert.ToInt64(TextBox1.Text)


     'Установить фоновое выполнение

     m_findNextPrimeNumber = New FindNextPrimeNumber(startNumber)


     'Запустить выполнение задачи в фоновом режиме...

     m_findNextPrimeNumber.findNextHighestPrime_Async()


     'Установить таймер, используемый для контроля длительности вычислений

     Timer1.Interval = 400 '400 мс

     Timer1.Enabled = True

    End Sub


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

    'Пункт меню для "отмены" выполняющейся задачи

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

    Private Sub menuItemAbortClick(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles menuItemAbort.Click

     'Не делать ничего, если вычисления не выполняются

     If (m_findNextPrimeNumber Is Nothing) Then Return

     'Установить поток в состояние прекращения выполнения

     m_findNextPrimeNumber.setProcessingState( _

      FindNextPrimeNumber.ProcessingState.requestAbort)

     'Немедленно известить пользователя 'o готовности прекратить выполнение...

     setCalculationStatusText("Ожидание прекращения выполнения...")

    End Sub


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

    'Этот таймер, вызываемый потоком пользовательского интерфейса,

    'позволяет отслеживать состояние выполнения 'фоновых вычислений

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

    Private Sub Timer1_Tick(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Timer1.Tick

     'Если к моменту вызова искомое простое число еще

     'не было найдено, отключить таймер

     If (m_findNextPrimeNumber Is Nothing) Then

      Timer1.Enabled = False

      Return

     End If


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

     'Если выполнение было отменено, освободить объект,

     'осуществляющий поиск, и выключить таймер

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

     If (m_findNextPrimeNumber.getProcessingState = _

      FindNextPrimeNumber.ProcessingState.aborted) Then

      Timer1.Enabled = False

      m_findNextPrimeNumber = Nothing

      setCalculationStatusText("Поиск простого числа отменен")

      Return

     End If


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

     'Удалось ли найти правильный ответ?

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

     If (m_findNextPrimeNumber.getProcessingState = _

      FindNextPrimeNumber.ProcessingState.foundPrime) Then

      Timer1.Enabled = False


      'Отобразить результат

      setCalculationStatusText("Число найдено! Следующее простое число = " + _

       m_findNextPrimeNumber.getPrime().ToString())

      m_findNextPrimeNumber = Nothing

      Return

     End If


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

     'Вычисления продолжаются. Информировать

     'пользователя о состоянии выполнения...

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

     'Получить два выходных значения

     Dim numberCalculationsToFar As Long

     Dim currentItem As Long

     m_findNextPrimeNumber.getExecutionProgressInfo( _

      numberCalculationsToFar, currentItem)

     setCalculationStatusText("Вычисления продолжаются. Поиск в области: " + _

      CStr(currentItem) + ". " + _

      "Для вас выполнено " + CStr(numberCalculationsToFar) + _

      " расчетов!")

    End Sub

    Листинг 9.5. Код класса FindNextPrimeNumber.cs

    Option Strict On

    Imports System

    Public Class FindNextPrimeNumber

    'Перечисляем возможные состояния

    Public Enum ProcessingState

     notYetStarted

     waitingToStartAsync

     lookingForPrime

     foundPrime

     requestAbort

     aborted

    End Enum


    Private m_startPoint As Long

    Private m_NextHighestPrime As Long


    'Поиск какого количества элементов выполнен?

    Private m_comparisonsSoFar As Long

    'Для какого элемента сейчас выполняется поиск простого числа?

    Private m_CurrentNumberBeingExamined As Long

    'Вызывается для обновления информации о состоянии выполнения

    Public Sub getExecutionProgressInfo( _

     ByRef numberCalculationsSoFar As Long, _

     ByRef currentItemBeingLookedAt As Long)

     'ПРИМЕЧАНИЕ. Мы используем блокирование потока для уверенности в том,

     'что эти значения не считываются во время выполнения операции

     'их записи. Поскольку доступ к m_comparisonsSoFar

     'и m_CurrentNumberBeingExamined могут осуществлять

     'одновременно несколько потоков, любая выполняемая над ними

     'операция записи/считывания должна синхронизироваться с "блокировкой",

     'что будет гарантировать "атомарность" этих операций

     SyncLock (Me)

      numberCalculationsSoFar = m_comparisonsSoFar

      currentItemBeingLookedAt = m_CurrentNumberBeingExamined

     End SyncLock

    End Sub


    Private m_processingState As ProcessingState

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

    'Простейший конечный автомат

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

    Public Sub setProcessingState(ByVal nextState As _

     ProcessingState)

     'Простейший защитный код, гарантирующий

     'невозможность перехода в другое состояние, если задача

     'либо успешно завершена, либо успешно отменена

     If ((m_processingState = ProcessingState.aborted) _

      OrElse (m_processingState = ProcessingState.foundPrime)) Then

      Return

     End If

     'Разрешить изменение состояния

     m_processingState = nextState

    End Sub


    Public ReadOnly Property getProcessingState() As ProcessingState

     Get

      Return m_processingState

     End Get

    End Property


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

    'Возвращает простое число

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

    Public Function getPrime() As Long

     If (m_processingState <> ProcessingState.foundPrime) Then

      Throw New Exception("Простое число еще не найдено!")

     End If

     Return m_NextHighestPrime

    End Function


    'Конструктор класса

    Public Sub New(ByVal startPoint As Long)

     setProcessingState(ProcessingState.notYetStarted)

     m_startPoint = startPoint

    End Sub


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

    'Создает новый рабочий поток, который будет вызывать функцию

    'findNextHighestPrime()

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

    Public Sub findNextHighestPrime_Async()

     Dim threadStart As System.Threading.ThreadStart

     threadStart = _

      New System.Threading.ThreadStart(AddressOf _

      findNextHighestPrime)

     Dim newThread As System.Threading.Thread

     newThread = New System.Threading.Thread(threadStart)


     'Состояние должно отвечать, что поиск продолжается

     setProcessingState(ProcessingState.waitingToStartAsync)

     newThread.Start()

    End Sub


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

    'Основной рабочий поток. Этот поток запускает поиск очередного

    'простого числа и выполняется до тех пор, пока не произойдет

    'одно из следующих двух событий:

    ' (а) найдено очередное простое число

    ' (b) от внешнего (по отношению к данному) потока поступила

    ' команда прекратить выполнение

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

    Public Sub findNextHighestPrime()

     'Если поступила команда прекратить выполнение, то поиск даже

     'не должен начинаться

     If (m_processingState = ProcessingState.requestAbort) Then

      GoTo finished_looking

     End If


     'Состояние должно отвечать, что поиск продолжается

     setProcessingState(ProcessingState.lookingForPrime)


     Dim currentItem As Long

     'Проверить, является ли число нечетным

     If ((m_startPoint And 1) = 1) Then

      'Число является нечетным, начать поиск со следующего нечетного числа

      currentItem = m_startPoint + 2

     Else

      'Число является четным, начать поиск со следующего нечетного числа

      currentItem = m_startPoint + 1

     End If


     'Приступить к поиску простого числа

     While (m_processingState = ProcessingState.lookingForPrime)

      'B случае нахождения простого числа, возвратить его

      If (isItemPrime(currentItem) = True) Then

       m_NextHighestPrime = currentItem

       'Обновить состояние

       setProcessingState(ProcessingState.foundPrime)

      End If

      currentItem = currentItem + 2

     End While

    finished_looking:

     'Выход. К этому моменту либо от другого потока поступила

     'команда прекратить поиск, либо было найдено и записано

     'следующее наибольшее простое число

     'Если поступил запрос прекратить выполнение,

     'сообщить, что выполнение процесса прекращено

     If (m_processingState = ProcessingState.requestAbort) Then

      setProcessingState(ProcessingState.aborted)

     End If

    End Sub


    'Вспомогательная функция, которая проверяет, является

    'ли число простым

    Private Function isItemPrime(ByVal potentialPrime _

     As Long) As Boolean

     'Если число - четное, значит, оно не является простым

     If ((potentialPrime And 1) = 0) Then

      Return False

     End If


     'Продолжать поиск до тех пор, пока не будет превышено значение

     'квадратного корня из числа

     Dim end_point_of_search As Long end_point_of_search = _

      CLng(System.Math.Sqrt(potentialPrime)) + 1

     Dim current_test_item As Long = 3

     While (current_test_item <= end_point_of_search)

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

      'Проверить, не поступила ли команда прекратить выполнение!

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

      If (m_processingState <> ProcessingState.lookingForPrime) Then

       Return False

      End If


      'Если число делится без остатка,

      'значит, оно не является простым

      If (potentialPrime Mod current_test_item = 0) Then

       Return False

      End If


      'Увеличить число на два

      current_test_item = current test_item + 2

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

      'Увеличить число проверенных элементов

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

      'ПРИМЕЧАНИЕ. Мы используем блокирование потока для уверенности в том,

      'что эти значения не считываются во время выполнения операции

      'их записи. Поскольку доступ к m_comparisonsSoFar

      'и m_CurrentNumberBeingExamined могут осуществлять

      'одновременно несколько нитей, любая выполняемая над ними

      'операция записи/считывания должна синхронизироваться с "блокировкой",

      'что будет гарантировать "атомарность" этих операций

      SyncLock (Me)

       m_CurrentNumberBeingExamined = potentialPrime

       m_comparisonsSoFar = m_comparisonsSoFar + 1

      End SyncLock

     End While


     'Число является простым

     Return True

    End Function

    End Class

    Примеры к главе 10 (производительность и XML)

    Листинг 10.1. Использование XML DOM для сохранения данных в файле и их загрузки

    Option Strict On

    Option Compare Binary


    Imports System

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

    'Демонстрирует сохранение и загрузку файлов с

    'использованием объектной модели документа XML

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

    Public Class SaveAndLoadXML_UseDOM

     'XML-дескрипторы, которые мы будем использовать в нашем документе

     Const XML_ROOT_TAG As String = "AllMyData"

     Const XML_USERINFO_TAG As String = "UserInfo"

     Const XML_USERID_TAG As String = "UserID"

     Const XML_NAMEINFO_TAG As String = "Name"

     Const XML_FIRSTNAME _TAG As String = "FirstName"

     Const XML_LASTNAME_TAG As String = "LastName"


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

     'Загружает пользовательское состояние

     ' [in] fileName: Имя файла, используемого для сохранения данных

     ' [out] userId: Загруженный идентификатор пользователя

     ' [out] firstName: Загруженное имя пользователя

     ' [out] lastName: Загруженная фамилия пользователя

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

     Public Shared Sub XML_LoadUserInfo(ByVal fileName As String, _

      ByRef userId As Integer, ByRef firstName As String, _

      ByRef lastName As String)


     'Начинаем с нулевых значений

     userId = 0

     firstName = ""

     lastName = ""

     'Предполагаем, что данные еще не загружены

     Dim gotUserInfoData As Boolean = False


     Dim xmlDocument As System.Xml.XmlDocument = _

      New System.Xml.XmlDocument


     xmlDocument.Load(fileName)


     'Получить корневой узел

     Dim rootElement As System.Xml.XmlElement

     rootElement = _

      CType(xmlDocument.ChildNodes(0), System.Xml.XmlElement)


     'Убедиться в том, что корневой узел согласуется с ожидаемым текстом,

     'ибо противное означает, что мы имеем дело с каким-то другим XML-файлом

     If (rootElement.Name <> XML_ROOT_TAG) Then

      Throw New Exception("Тип корневого узла не совпадает с ожидаемым!")

     End If


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

     'Простой конечный автомат для итеративного обхода всех узлов

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

     Dim childOf_RootNode As System.Xml.XmlElement

     For Each childOf_RootNode In _

      rootElement.ChildNodes


      'Если это узел UserInfo, то мы хотим просмотреть его содержимое

      If (childOf_RootNode.Name = XML_USERINFO_TAG) Then

       gotUserInfoData = True

       'Пользовательские данные найдены


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

       'Загрузить каждый из подэлементов

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

       Dim child_UserDataNode As System.Xml.XmlElement

       For Each child_UserDataNode In _

        childOf_RootNode.ChildNodes

        'Идентификатор пользователя (UserID)

        If (child_UserDataNode.Name = XML_USERID_TAG) Then

         userId = CInt(child_UserDataNode.InnerText)

         'ФИО пользователя (UserName)

        ElseIf (child_UserDataNode.Name = XML_NAMEINFO_TAG) Then

         Dim child_Name As System.Xml.XmlElement

          For Each child_Name In child_UserDataNode.ChildNodes

          'Имя (FirstName)

          If (child_Name.Name = XML_FIRSTNAME_TAG) Then

           firstName = child_Name.InnerText

           'Фамилия (LastName)

          ElseIf (chi1d_Name.Name = XML_LASTNAME_TAG) Then

           lastName = child_Name.InnerText

          End If

         Next 'Конец цикла разбора UserName

        End If 'Конец оператора if, осуществляющего проверку UserName

       Next 'Конец цикла разбора UserInfo

      End If 'Конец оператора if, осуществляющего проверку UserInfo

     Next 'Конец цикла разбора корневого узла

     If (gotUserInfoData = False) Then

      Throw New Exception("Данные пользователя в XML-документе не найдены!")

     End If

    End Sub

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

    'Сохраняет пользовательское состояние

    ' [in] fileName: Имя файла, используемого для сохранения данных

    ' [in] userId: Идентификатор пользователя, который мы хотим сохранить

    ' [in] firstName: Имя пользователя, которое мы хотим сохранить

    ' [in] lastName: Фамилия пользователя, которую мы хотим сохранить

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

    Public Shared Sub XML_SaveUserInfo(ByVal fileName As String, _

     ByVal userId As Integer, ByVal firstName As String, _

     ByVal lastName As String)

     Dim xmlDocument As System.Xml.XmlDocument = _

      New System.Xml.XmlDocument


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

     'Добавить элемент документа высшего уровня

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

     Dim rootNodeForDocument As System.Xml.XmlElement

     rootNodeForDocument = xmlDocument.CreateElement( _

      XML_ROO T_TAG)

     xmlDocument.AppendChild(rootNodeForDocument)


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

     'Добавить данные в элемент UserInfo

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

     Dim topNodeForUserData As System.Xml.XmlElement

     topNodeForUserData = xmlDocument.CreateElement( _

      XML_USERINFO_TAG)

     rootNodeForDocument.AppendChild(topNodeForUserData)


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

     'Добавить значение UserID в наш документ

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

     'Создать подузел для информации о пространстве имен

     Dim subNodeForUserID As System.Xml.XmlElement

     subNodeForUserID = _

      xmlDocument.CreateElement(XML_USERID_TAG)

     subNodeForUserID.InnerText = _

      System.Convert.ToString(userId)

     'Присоединить подузел UserID к узлу высшего уровня

     topNodeForUserData.AppendChild(subNodeForUserID)


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

     'Добавить все значения NameInfo в наш документ

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

     'Создать подузел для информации о пространстве имен

     Dim subNodeForNameInfo As System.Xml.XmlElement

     subNodeForNameInfo = xmlDocument.CreateElement( _

      XML_NAMEINFO_TAG)

     'Имя (FirstName)

     Dim subNodeFirstName As System.Xml.XmlElement

     subNodeFirstName = xmlDocument.CreateElement( _

      XML_FIRSTNAME TAG)

     subNodeFirstName.InnerText = firstName


     'Фамилия (LastName)

     Dim subNodeLastName As System.Xml.XmlElement

     subNodeLastName = xmlDocument.CreateElement( _

      XML_LASTNAME_TAG)

     subNodeLastName.InnerText = lastName


     'Присоединить подузлы имени и фамилии к родительскому узлу

     'NameInfo

     subNodeForNameInfo.AppendChild(subNodeFirstName)

     subNodeForNameInfo.AppendChild(subNodeLastName)


     'Присоединить подузел NameInfo (вместе с его дочерними узлами)

     'к узлу высшего уровня

     topNodeForUserData.AppendChild(subNodeForNameInfo)


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

     'Сохранить документ

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

     Try

      xmlDocument.Save(fileName)

     Catch ex As System.Exception

      MsgBox( _

       "Ошибка при сохранении XML-документа - " + ex.Message)

     End Try

    End Sub 'Конец функции

    End Class 'Конец класса

    Листинг 10.2. Вызов кода, предназначенного для сохранения и загрузки XML-документа

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     Const FILENAME As String = "TestFileName.XML"


     'Сохранить, используя XML DOM

     SaveAndLoadXML_UseDOM.XML_SaveUserInfo(FILENAME, 14, "Ivo", _

      "Salmre")

     'Сохранить, используя объект однонаправленной записи XMLWriter

     'SaveAndLoadXML_UseReaderWriter.XML_SaveUserInfo(FILENAME, _

     ' 18, "Ivo", "Salmre")

     Dim userID As Integer

     Dim firstName As String

     Dim lastName As String


     'Загрузить, используя XML DOM

     SaveAndLoadXML_UseDOM.XML_LoadUserInfo(FILENAME, userID, _

      firstName, lastName)

     'Загрузить, используя объект однонаправленного чтения XMLReader

     'SaveAndLoadXML_UseReaderWriter.XML_LoadUserInfo(FILENAME, _

     ' userID, firstName, lastName)

     MsgBox("Готово! " + _

      userID.ToString() + ", " + lastName + ", " + firstName)

    End Sub

    Листинг 10.3. Использование однонаправленного чтения/записи XML-данных для загрузки XML-документа из файла и его сохранения

    Option Strict On

    Option Compare Binary

    Imports System

    Public Class SaveAndLoadXML UseReaderWriter


    'XML-дескрипторы, которые мы будем использовать в своем документе

    Const XML_ROOT_TAG As String = "AllMyData"

    Const XML_USERINFO_TAG As String = "UserInfo"

    Const XML_USERID_TAG As String = "UserID"

    Const XML_NAMEINFO_TAG As String = "Name"

    Const XML_FIRSTNAME_TAG As String = "FirstName"

    Const XML_LASTNAME TAG As String = "LastName"


    'Набор состояний, отслеживаемых по мере чтения данных

    Private Enum ReadLocation

     inAllMyData

     inUserInfo

     inUserID

     inName

     inFirstName

     inLastName

    End Enum


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

    'Сохраняет пользовательское состояние

    ' [in] fileName: Имя файла, используемого для сохранения данных

    ' [in] userId: Идентификатор пользователя, который мы хотим сохранить

    ' [in] firstName: Имя пользователя, которое мы хотим сохранить

    ' [in] lastName: Фамилия пользователя, которую мы хотим сохранить

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

    Public Shared Sub XML_SaveUserInfo(ByVal fileName As String, _

     ByVal userId As Integer, ByVal firstName As String, _

     ByVal lastName As String)

     Dim xmlTextWriter As System.Xml.XmlTextWriter

     xmlTextWriter = New System.Xml.XmlTextWriter(fileName, _

      System.Text.Encoding.Default)

     'Записать содержимое документа!

     '<Root>

     xmlTextWriter.WriteStartElement(XML_ROOT_TAG)


     '<Root>

     xmlTextWriter.WriteStartElement(XML_USERINFO_TAG)

     '<Root><UserID>


     '<Root><UserInfo>

     xmlTextWriter.WriteStartElement(XML_NAMEINFO_TAG)

     '<Root><UserInfo><Name>

     xmlTextWriter.WriteStartElement(XML_FIRSTNAME_TAG)

     '<Root><UserInfo><Name><FirstName>

     xmlTextWriter.WriteString(firstName) 'Запись значения

     xmlTextWriter.WriteEndElement() 'Закрыть дескриптор имени

     '<Root><UserInfo><Name>

     xmlTextWriter.WriteStartElement(XML_LASTNAME_TAG)

     '<Root><UserInfo><Name><LastName>

     xmlTextWriter.WriteString(lastName) 'Запись значения

     xmlTextWriter.WriteEndElement() 'Закрыть дескриптор фамилии

     '<Root><UserInfo><Name>

     xmlTextWriter.WriteEndElement() 'Закрыть дескриптор ФИО

     '<Root><UserInfo>


     '<Root><UserInfo>

     xmlTextWriter.WriteStartElement(XML_USERID_TAG)

     '<Root><UserInfo><UserID>


     'Запись значения

     xmlTextWriter.WriteString(userId.ToString())

     xmlTextWriter.WriteEndElement() 'Закрыть дескриптор UserID

     '<Root><UserInfo>


     xmlTextWriter.WriteEndElement()

     'Закрыть дескриптор UserInfo

     '<Root>


     xmlTextWriter.WriteEndElement() 'Закрыть дескриптор документа

     xmlTextWriter.Close()

    End Sub


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

    'Загружает пользовательское состояние

    ' [in] fileName: Имя файла, используемого для сохранения данных

    ' [out] userId: Загруженный идентификатор пользователя

    ' [out] firstName: Загруженное имя пользователя

    ' [out] lastName: Загруженная фамилия пользователя

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

    Public Shared Sub XML_LoadUserInfo(ByVal fileName As String, _

     ByRef userId As Integer, ByRef firstName As String, _

     ByRef lastName As String)


     Dim currentReadLocation As ReadLocation

     'Начинаем с нулевых значении

     userId = 0

     firstName = ""

     lastName = ""


     Dim xmlReader As System.Xml.XmlTextReader = _

      New System.Xml.XmlTextReader(fileName)


     xmlReader.WhitespaceHandling = _

      System.Xml.WhitespaceHandling.None


     Dim readSuccess As Boolean

     readSuccess = xmlReader.Read()

     If (readSuccess = False) Then

      Throw New System.Exception("Отсутствуют XML-данные для чтения!")

     End If


     'Убедиться в том, что мы распознали корневой дескриптор

     If (xmlReader.Name <> XML_ROOT_TAG) Then

      Throw New System.Exception( _

       "Корневой дескриптор отличается от ожидаемого!")

     End If


     'Отметить текущее местоположение в документе

     currentReadLocation = ReadLocation.inAllMyData


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

     'Цикл прохождения документа и чтение необходимых данных

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

     While (readSuccess)

      Select Case (xmlReader.NodeType)

      'Вызывается при входе в новый элемент

      Case System.Xml.XmlNodeType.Element

       Dim nodeName As String = xmlReader.Name

       LoadHelper_NewElementEncountered(nodeName, _

        currentReadLocation)


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

       'Здесь мы можем извлечь некоторый фактический текст

       'и получить данные, которые пытаемся загрузить

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

      Case System.Xml.XmlNodeType.Text

       Select Case currentReadLocation

       Case ReadLocation.inFirstName

        firstName = xmlReader.Value

       Case ReadLocation.inLastName

        lastName = xmlReader.Value

       Case ReadLocation.inUserID

        userId = CInt(xmlReader.Value)

       End Select

       'Конец оператора Case "System.Xml.XmlNodeType.Text"


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

       'Вызывается, когда встречается конец

       'элемента

       '

       'Мы можем захотеть переключить состояние в зависимости

       'от вида покидаемого узла, чтобы указать на то, что

       'собираемся вернуться назад к его предку

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

      Case System.Xml.XmlNodeType.EndElement

       Dim continueParsing As Boolean

       continueParsing = LoadHelper_EndElementEncountered( _

        currentReadLocation)

       If (continueParsing = False) Then

        GoTo finished_reading_wanted_data

       End If

      Case Else

       'He страшно, если имеются XML-узлы других типов, но

       'в нашем примере работы с XML-документом мы должны

       'оповестить об этом факте

       MsgBox( _

        "Встретился непредвиденный XML-тип " + xmlReader.Name)

      End Select 'Конец оператора Case, используемого для определения текущего

      'типа XML-элeмeнтa, oбpaбaтывaeмoгo анализатором


      'Перейти к следующему узлу

      readSuccess = xmlReader.Read()

     End While

     'Если мы оказались в этом месте программы, не покинув

     'XML-дескриптора UserInfo, то с XML-данными, которые мы считываем,

     'что-то не так

     Throw New Exception("He найден элемент UserInfo в XML-документе!")

    finished reading_wanted_data:

     'Закрыть файл, поскольку работа с ним закончена!

     xmlReader.Close()

    End Sub


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

    'Вспомогательный код, ответственный за принятие решения

    'относительно того, в какое состояние необходимо перейти,

    'когда встречается закрывающий дескриптор

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

    Private Shared Function LoadHelper_EndElementEncountered( _

     ByRef currentReadLocation As ReadLocation) As Boolean

     Select Case (currentReadLocation)


     'Если мы покидаем узел Name, то должны вернуться

     'обратно в узел UserInfo

     Case ReadLocation.inName

      currentReadLocation = ReadLocation.inUserInfo


     'Если мы покидаем узел FirstName, то должны вернуться

     'обратно в узел Name

     Case ReadLocation.inFirstName

      currentReadLocation = ReadLocation.inName


     'Если мы покидаем узел LastName, то должны вернуться

     'обратно в узел Name

      Case ReadLocation.inLastName

       currentReadLocation = ReadLocation.inName


     'Если мы покидаем узел UserID, то должны вернуться

     'обратно в узел UserInfo

     Case ReadLocation.inUserID

      currentReadLocation = ReadLocation.inUserInfo


     'Если мы покидаем узел UserInfo, то мы только что

     'закончили чтение данных в узлах UserID, FirstName

     'и LastName

     '

     'Можно выйти из цикла, поскольку у нас уже есть вся

     'информация, которую мы хотели получить!

     Case ReadLocation.inUserInfo

      Return False 'Анализ должен быть прекращен

     End Select

     Return True

     'Продолжить анализ

    End Function


    Private Shared Sub LoadHelper_NewElementEncountered( _

     ByVal nodeName As String, _

     ByRef currentReadLocation As ReadLocation)


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

     'Мы вошли в новый элемент!

     'В какое состояние переход возможен, зависит от того,

     'в каком состоянии мы находимся в данный момент

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

     Select Case (currentReadLocation)

     'Если мы находимся в узле AllMyData, то переход возможен

     'в узлы, которые указаны ниже

     Case (ReadLocation.inAllMyData)

      If (nodeName = XML_USERINFO_TAG) Then

       currentReadLocation = ReadLocation.inUserInfo

      End If


     'Если мы находимся в узле UserInfo, то переход возможен

     'в узлы, которые указаны ниже

     Case (ReadLocation.inUserInfo)

      If (nodeName = XML_USERID_TAG) Then

       currentReadLocation = ReadLocation.inUserID

      ElseIf (nodeName = XML_NAMEINFO_TAG) Then

       currentReadLocation = ReadLocation.inName

      End If


     'Если мы находимся в узле Name, то переход возможен

     'в узлы, которые указаны ниже

     Case (ReadLocation.inName)

      If (nodeName = XML_FIRSTNAME_TAG) Then

       currentReadLocation = ReadLocation.inFirstName

      ElseIf (nodeName = XML LASTNAME_TAG) Then

       currentReadLocation = ReadLocation.inLastName

      End If

     End Select

    End Sub

    End Class

    Примеры к главе 11 (производительность и графика)

    Листинг 11.1. Заполнение данными и очистка от них элементов управления TreeView с использованием альтернативных стратегий

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

    'Примечание #1: В этом примере используется класс PerformanceSampling,

    ' определённый ранее в данной книге. Убедитесь в том, что

    ' вы включили этот класс в свой проект.

    'Примечание #2: Этот код необходимо включить в класс Form, содержащий элемент

     ' управления TreeView и кнопки Button, к которым подключены

    ' приведенные ниже функции xxx_Click.

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

    'Количество элементов, которые необходимо поместить в элемент

    'управления TreeView

    Const NUMBER_ITEMS As Integer = 800


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

    'Код для кнопки "Fill: Baseline"

    'Использование неоптимизированного подхода для заполнения данными элемента

    'управления TreeView

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

    Private Sub UnOptimizedFill_Click(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles UnOptimizedFill.Click


     'Очистить массив для создания одинаковых условий тестирования

     If (TreeView1.Nodes.Count > 0) Then

      TreeView1.BeginUpdate()

      TreeView1.Nodes.Clear()

      TreeView1.EndUpdate()

      TreeView1.Update()

     End If


     'Для повышения корректности тестирования предварительно выполнить

     'операцию сборки мусора. В реальных кодах этого делать не следует!

     System.GC.Collect()


     'Запустить таймер

     PerformanceSampling.StartSample(0, "TreeViewPopulate")


     'Заполнить данными элемент управления TreeView

     Dim i As Integer

     For i = 1 To NUMBER_ITEMS

      TreeView1.Nodes.Add("TreeItem" + CStr(i))

     Next


     'Остановить таймер и отобразить результат

     PerformanceSampling.StopSample(0)

     MsgBox(PerformanceSampling.GetSampleDurationText(0))

    End Sub


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

    'Код для кнопки "Clear: Baseline"

    'Использование неоптимизированного подхода для заполнения данными элемента

    'управления TreeView

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

    Private Sub UnOptimizedClear_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles UnOptimizedClear.Click

     'Для повышения корректности тестирования предварительно выполнить

     'операцию сборки мусора

     System.GC.Collect()


     'Запустить таймер

     PerformanceSampling.StartSample(1, "TreeViewClear")

     TreeView1.Nodes.Clear()

     PerformanceSampling.StopSample(1)

     MsgBox(PerformanceSampling.GetSampleDurationText(1))

    End Sub


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

    'Код для кнопки "Fill: BeginUpdate"

    'Подход, в котором используется метод BeginUpdate()

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

    Private Sub UseBeginEndUpdateForFill_Click(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles UseBeginEndUpdateForFill.Click

     'Очистить массив для создания одинаковых условий тестирования

     If (TreeView1.Nodes.Count > 0) Then

      TreeView1.BeginUpdate()

      TreeView1.Nodes.Clear()

      TreeView1.EndUpdate()

      TreeView1.Update()

     End If


     'Для повышения корректности тестирования предварительно выполнить

     'операцию сборки мусора. В РЕАЛЬНЫХ КОДАХ ЭТОГО ДЕЛАТЬ НЕ СЛЕДУЕТ!

     System.GC.Collect()


     'Запустить таймер

     PerformanceSampling.StartSample(2, _

      "Populate - Use BeginUpdate")

     'Заполнить данными элемент управления TreeView

     TreeView1.BeginUpdate()

     Dim i As Integer

     For i = 1 To NUMBER_ITEMS

      TreeView1.Nodes.Add("TreeItem" + i.ToString())

     Next

     TreeView1.EndUpdate()


     'Остановить таймер и отобразить результат

     PerformanceSampling.StopSample(2)

     MsgBox(PerformanceSampling.GetSampleDurationText(2))

    End Sub


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

    'Код для кнопки "Clear: BeginUpdate"

    'Подход, в котором используется метод BeginUpdate()

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

    Private Sub UseBeginEndUpdateForClear_Click(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles UseBeginEndUpdateForClear.Click

     'Для повышения корректности тестирования предварительно выполнить

     'операцию сборки мусора. В РЕАЛЬНЫХ КОДАХ ЭТОГО ДЕЛАТЬ НЕ СЛЕДУЕТ!

     System.GC.Collect()


     'Запустить таймер

     PerformanceSampling.StartSample(3, "Clear - Use BeginUpdate")

     TreeView1.BeginUpdate()

     TreeView1.Nodes.Clear()

     TreeView1.EndUpdate()


     'Остановить таймер и отобразить результат

     PerformanceSampling.StopSample(3)

     MsgBox(PerformanceSampling.GetSampleDurationText(3))

    End Sub


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

    'Код для кнопки "Fill: Use Array"

    'Подход, в котором используется массив

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

    Private Sub FillArrayBeforeAttachingToTree_Click(ByVal _

     sender As System.Object, ByVal e As System.EventArgs) _

     Handles FillArrayBeforeAttachingToTree.Click

     'Очистить массив для создания одинаковых условий тестирования

     If (TreeView1.Nodes.Count > 0) Then

      TreeView1.BeginUpdate()

      TreeView1.Nodes.Clear()

      TreeView1.EndUpdate()

      TreeView1.Update()

     End If


     'Для повышения корректности тестирования предварительно выполнить

     'операцию сборки мусора. В РЕАЛЬНЫХ КОДАХ ЭТОГО ДЕЛАТЬ НЕ СЛЕДУЕТ!

     System.GC.Collect()


     'Запустить таймер

     PerformanceSampling.StartSample(4, "Populate - Use Array")


     'Распределить память для нашего массива узлов дерева

     Dim newTreeNodes() As System.Windows.Forms.TreeNode

     ReDim newTreeNodes(NUMBER_ITEMS - 1)


     'Заполнить массив

     Dim i As Integer

     For i = 0 To NUMBER_ITEMS - 1

      newTreeNodes(i) = _

       New System.Windows.Forms.TreeNode("TreeItem" + _

       i.ToString())

     Next


     'Связать массив с элементом управления TreeView

     TreeView1.BeginUpdate()

     TreeView1.Nodes.AddRange(newTreeNodes)

     TreeView1.EndUpdate()


     'Остановить таймер и отобразить результат

     PerformanceSampling.StopSample(4)

     MsgBox(PerformanceSampling.GetSampleDurationText(4))

    End Sub

    Листинг 11.2. Динамическое заполнение данными элемента управления TreeView

    'Фиктивный текст для размещения в заполнителях дочерних узлов

    Const dummy_node As String = "_dummynode"

    'Метка, которую мы будем использовать для обозначения узла

    Const node_needToBePopulated As String = "_populateMe"

    'Текст, который мы будем использовать для наших узлов высшего уровня

    Const nodeText_Neighborhoods As String = "Neighborhoods"

    Const nodeText_Prices As String = "Prices"

    Const nodeText_HouseType As String = "HouseTypes"


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

    'Обработчик события щелчка для кнопки

    'Настраивает наш элемент управления TreeView для отображения процесса

    'последовательного заполнения дерева

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     Dim tnNewNode As TreeNode

     'Отключить обновление ПИ до тех пор, пока дерево не будет заполнено

     TreeView1.BeginUpdate()

     'Избавиться от устаревших данных

     TreeView1.Nodes.Clear()


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

     'Узел "Neighborhoods"

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

     'Добавить узел "Neighborhoods" верхнего уровня.

     tnNewNode = TreeView1.Nodes.Add("Neighborhoods")


     'Установить для узла метку, указывающую на то, что узел

     'будет заполняться динамически

     tnNewNode.Tag = node_needToBePopulated


     'Этот фиктивный дочерний узел существует лишь для того, чтобы

     'узел имел, по крайней мере, один дочерний узел и поэтому

     'был расширяемым.

     tnNewNode.Nodes.Add(dummy_node)


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

     'Узел "Price"

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

     tnNewNode = TreeView1.Nodes.Add("Price")


     'Установить для узла метку, указывающую на то, что узел

     'будет заполняться динамически

     tnNewNode.Tag = node_needToBePopulated


     'Этот фиктивный дочерний узел существует лишь для того, чтобы

     'узел имел, по крайней мере, один дочерний узел и поэтому

     'был расширяемым

     tnNewNode.Nodes.Add(dummy_node)


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

     'Узел "HouseType"

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

     tnNewNode = TreeView1.Nodes.Add("HouseType")

     'Установить для узла метку, указывающую на то, что узел

     'будет заполняться динамически

     tnNewNode.Tag = node_needToBePopulated


     'Этот фиктивный дочерний узел существует лишь для того, чтобы

     'узел имел, по крайней мере, один дочерний узел и поэтому

     'был расширяемым.

     tnNewNode.Nodes.Add(dummy node)


     'Восстанавливаем обновление ПИ

     TreeView1.EndUpdate()

    End Sub


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

    ''Обработчик событий BeforeExpand для нашего элемента управления TreeView

    ''ПРИМЕЧАНИЕ: В отличие от C#, данный обработчик

    ''      НЕ требует от вас связываться дорабатывать код

    ''      "InitializeComponent()" (не делайте этого!)

    ''      Вы можете просто выбрать событие обычным путем

    ''      выпадающего списка событий в редакторах VB

    ''

    ''Вызывается при запросе пользователем расширения узла, у которого имеется,

    ''по крайней мере, один дочерний узел. Этот вызов осуществляется до отображения

    ''дочерних узлов данного узла и дает нам возможность динамически заполнить

    ''данными элемент управления TreeView.

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

    Private Sub TreeView1_BeforeExpand(ByVal sender As Object, _

     ByVal e As System.Windows.Forms.TreeViewCancelEventArgs) _

     Handles TreeView1.BeforeExpand

     'Получить узел, который будет расширяться

     Dim tnExpanding As System.Windows.Forms.TreeNode

     tnExpanding = e.Node


     'Если узел не отмечен как "нуждающийся в заполнении данными",

     'то он устраивает нас в том виде, "как он есть".

     If Not (tnExpanding.Tag Is node needToBePopulated) Then

      Return 'Разрешить беспрепятственное продолжение выполнения

     End If


     'Требуется динамическое заполнение дерева данными.

     'Мы знаем, что узел должен быть заполнен данными; определить,

     'что это за узел

     If (tnExpanding.Text = nodeText_Neighborhoods) Then

      PopulateTreeViewNeighborhoods(tnExpanding)

      Return 'done adding items!

     Else

      'Проверить другие возможности для узлов дерева, которые мы должны

      'добавить.

      MsgBox("HE СДЕЛАНО: Добавьте код для динамического заполнения этого узла")


      'Снять отметку с этого узла, чтобы мы не могли вновь выполнить

      'этот код

      tnExpanding.Tag = ""

     End If

    End Sub


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

    'Эта функция вызывается для динамического добавления дочерних узлов

    'в узел "Neighborhood"

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

    Sub PopulateTreeViewNeighborhoods(ByVal tnAddTo As TreeNode)

     Dim tvControl As TreeView

     tvControl = tnAddTo.TreeView

     tvControl.BeginUpdate()

     'Очистить имеющийся фиктивный узел

     tnAddTo.Nodes.Clear()


     'Объявить четыре узла, которые мы хотим сделать дочерними узлами

     'того узла, который был передан.

     Dim newNeighborhoodNodes() As TreeNode

     ReDim newNeighborhoodNodes(3)

     newNeighborhoodNodes(0) = New TreeNode("Capitol Hill")

     newNeighborhoodNodes(1) = New TreeNode("Chelsea")

     newNeighborhoodNodes(2) = New TreeNode("Downtown")

     newNeighborhoodNodes(3) = New TreeNode("South Bay")

     'Добавить дочерние узлы в элемент управления TreeView

     tnAddTo.Nodes.AddRange(newNeighborhoodNodes)


     tvControl.EndUpdate()

    End Sub

    Листинг 11.3. Запуск обработчика событий при изменении содержимого элемента TextBox программным путем

    Private m_eventTriggerCount As Integer


    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As  System.EventArgs) Handles Buttonl.Click

     'Запускает событие TextChanged так же,

     'как если бы текст был введен пользователем

     TextBox1.Text = "Привет, мир"

    End Sub


    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles TextBox1.TextChanged

     m_eventTriggerCount = m_eventTriggerCount + 1

     'Обновить надпись для отображения количества событий

     Label1.Text = "Событий: #" + CStr(m_eventTriggerCount)

     'Внести каждое событие в список

     ListBox1.Items.Add(m_eventTriggerCount.ToString() + TextBox1.Text)

    End Sub

    Листинг 11.4. Использование модели состояний для обновления интерфейса и контроль запуска событий с целью более глубокого изучения процесса обработки событий и управления им

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

    'Для активизации контроля запуска событий:

    ' #Const EVENTINSTRUMENTATION = 1

    'Для отмены контроля запуска событий:

    ' #Const EVENTINSTRUMENTATION = 0

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

    #Const EVENTINSTRUMENTATION = 1


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

    'Флаг, указывающий обработчикам событий, должен ли из них осуществляться

    'выход без выполнения каких-либо действий

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

    Private m_userInterfaceUpdateOccuring As Boolean


    'Счетчики событий

    Private m_radioButton1ChangeEventCount As Integer

    Private m_textBox1ChangeEventCount As Integer


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

    'Код, который следует включать лишь в том случае, если приложение

    'выполняется в режиме контроля запуска событий. Этот код характеризуется

    'относительно высокими накладными расходами, и его следует компилировать и

    'выполнять только тогда, когда выполняется диагностика.

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

    #If EVENTINSTRUMENTATION <> 0 Then

    Private m_instrumentedEventLog As System.Collections.ArrayList


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

    'Заносит записи о возникновении событий в массив, который мы

    'можем просмотреть

    'Примечание: Не делается никаких попыток ограничить размерность массива

    '  регистрационных записей, поэтому, чем дольше выполняется приложение,

    '  тем больше становится размер массива

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

    Private Sub instrumented_logEventOccurrence(ByVal eventData _

     As String)

     'Создать журнал событий, если он еще не был создан

     If (m_instrumentedEventLog Is Nothing) Then

      m_instrumentedEventLog = _

       New System.Collections.ArrayList

     End If


     'Зарегистрировать событие

     m_instrumentedEventLog.Add(eventData)

    End Sub


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

    'Отобразить список возникших событий

    'Примечание: Этот вариант реализации довольно груб.

    ' Целесообразнее отображать список событий

    ' в отдельном диалоговом окне, которое специально выводится

    ' для этого на экран.

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

    Private Sub instrumentation_ShowEventLog() Dim listItems As _

     System.Windows.Forms.ListBox.ObjectCollection

     listItems = listBoxEventLog.Items


     'Очистить список элементов

     listItems.Clear()

     'При отсутствии событий - выход

     If (m instrumentedEventLog Is Nothing) Then

      listItems.Add("0 событий")

      Return

     End If


     'Отобразить поверх списка общее количество

     'подсчитанных нами событий

     listItems.Add(m_instrumentedEventLog.Count.ToString() + _

      " событий")


     'Перечислить элементы списка в обратном порядке, чтобы

     'первыми отображались самые последние из них

     Dim logItem As String

     Dim listIdx As Integer

     For listIdx = _

      m_instrumentedEventLog.Count - 1 To 0 Step -1

      logItem = CStr(m_instrumentedEventLog(listIdx))

      listItems.Add(logItem)

     Next

    End Sub

    #End If


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

    'Событие изменения состояния переключателя RadioButton1

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

    Private Sub RadioButton1_CheckedChanged(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles RadioButton1.CheckedChanged

     'Если обновление данных в пользовательском интерфейсе осуществляется

     'приложением, то мы не хотим обрабатывать его так же, как если бы

     'это событие было запущено пользователем. Если это именно так,

     'то осуществить выход из функции без выполнения каких-либо действий.

     If (m userInterfaceUpdateOccuring = True) Then

      Return

     End If


     'Подсчитать, сколько раз выполнена обработка данного события

     m_radioButtonlChangeEventCount = _

      m_radioButtonlChangeEventCount + 1


    #If (EVENTINSTRUMENTATION <> 0) Then

     'Зарегистрировать наступление события

     instrumented_logEventOccurrence("radioButton1.Change:" + _

      m_radioButton1ChangeEventCount.ToString() + ":" + _

      RadioButton1.Checked.ToString()) 'value

    #End If

    End Sub


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

    'Событие щелчка на кнопке Button1

    'Имитирует обновление пользовательского интерфейса программным

    'кодом, что может приводить к запуску обработчика события

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     'Указать на то, что мы не хотим, чтобы обработчики сразу же

     'обрабатывали события, поскольку мы обновляем

     'пользовательский интерфейс.


     'm_userInterfaceUpdateOccuring = true;


     RadioButton1.Checked = True

     TextBox1.Text = "Hello World"


     'Обновление пользовательского интерфейса закончено

     m_userInterfaceUpdateOccuring = False

    End Sub


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

    'Обработчик события изменения состояния элемента управления TextBox

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

    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles TextBox1.TextChanged

     'Если обновление данных в пользовательском интерфейсе осуществляется

     'приложением, то мы не хотим обрабатывать его так же, как если бы

     'это событие было запущено пользователем. Если это именно так,

     'то осуществить выход из функции без выполнения каких-либо действий.

     If (m_userInterfaceUpdateOccuring = True) Then

      Return

     End If


     'Подсчитать, сколько раз выполнена обработка данного события

     m_textBox1ChangeEventCount = m_textBox1ChangeEventCount + 1

    #If EVENTINSTRUMENTATION <> 0 Then

     'Занести событие в журнал

     instrumented_logEventOccurrence("textBox1.Change:" + _

      m_textBoxlChangeEventCount.ToString() + ":" + _

      TextBox1.Text.ToString()) 'Value

    #End If

    End Sub


    Private Sub buttonShowEventLog_Click(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles buttonShowEventLog.Click

    #If EVENTINSTRUMENTATION <> 0 Then

     instrumentation_ShowEventLog()

    #End If

    End Sub

    Листинг 11.5. Вызов метода Update() элемента управления для отображения пояснительного текста, информирующего о ходе выполнения задачи

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

    'Этот код принадлежит форме, содержащей по одному элементу управления

    'Button (button1) и Label (label1)

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     'Отобразить курсор ожидания

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.WaitCursor

     Dim testString As String

     Dim loop3 As Integer

     For loop3 = 1 To 100 Step 10

      Label1.Text = loop3.ToString() + "% Done..."

      '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      'Чтобы отобразить информацию о процессе обновления,!

      'удалите символы комментария в строке ниже         !

      '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      'Label1.Update()

      testString = ""

      Dim loop2 As Integer

      For loop2 = 1 To 1000

       testString = testString + "тест"

      Next

     Next

     Label1.Text = "Готово!"


     'Удалить курсор ожидания

     System.Windows.Forms.Cursor.Current = _

      System.Windows Forms.Cursors.Default

    End Sub

    Листинг 11.6. Создание изображения на внеэкранной растровой поверхности и передача его в элемент управления PictureBox

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

    'Создать рисунок на растровой поверхности. Переслать его в PictureBox

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click


     'Создать новую битовую карту

     Dim myBitmap As System.Drawing.Bitmap

     myBitmap = New System.Drawing.Bitmap(PictureBox1.Width, _

      PictureBox1.Height)


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

     'Создать объект Graphics, чтобы иметь возможность рисовать на битовой карте

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

     Dim myGfx As System.Drawing.Graphics

     myGfx = System.Drawing.Graphics.FromImage(myBitmap)


     'Закрасить нашу битовую карту желтым цветом

     myGfx.Clear(System.Drawing.Color.Yellow)


     'Создать перо

     Dim myPen As System.Drawing.Pen

     rayPen = New System.Drawing.Pen(System.Drawing.Color.Blue)


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

     'Нарисовать эллипс

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

     myGfx.DrawEllipse(myPen, 0, 0, myBitmap.Width - 1, _

      myBitmap.Height - 1)

     'Создать сплошную кисть

     Dim myBrush As System.Drawing.Brush


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

     'Нарисовать текст кистью

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

     myBrush = New System.Drawing.SolidBrush( _

      System.Drawing.Color.Black)

     'Примечание: мы используем объект Font из формы

     myGfx.DrawString("Привет!", Me.Font, myBrush, 2, 10)


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

     'Важно! Очистить все после себя

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

     myGfx.Dispose()

     myPen.Dispose()

     myBrush.Dispose()


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

     'Указать объекту pictureBox, на необходимость отображения растрового

     'изображения, которое мы только что создали и нарисовали.

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

     PictureBox1.Image = myBitmap

    End Sub

    Листинг 11.7. Создание объекта Graphics для формы

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

    'Создает объект Graphics для формы и осуществляет рисование

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     'Создать объект Graphics для формы

     Dim myGfx As System.Drawing.Graphics

     myGfx = Me.CreateGraphics()


     'Создать кисть

     Dim myBrush As System.Drawing.Brush

     myBrush = New System.Drawing.SolidBrush( _

      System.Drawing.Color.DarkGreen)

     'Заполнить прямоугольник

     myGfx.FillRectangle(myBrush, 4, 2, 60, 20)


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

     'Важно: Выполнить очистку!

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

     myBrush.Dispose()

     myGfx.Dispose()

    End Sub

    Листинг 11.8. Подключение к функции Paint формы

    'Кисти, которые мы хотим кэшировать, чтобы избавить себя от необходимости

    'все время создавать их и уничтожать

    Private m_brushBlue As System.Drawing.Brush

    Private m_brushYellow As System.Drawing.Brush


    'Ради интереса подсчитаем, сколько раз осуществлялся вызов

    Private m_paintCount As Integer


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

    'Мы перекрываем обработчики событий Paint наших базовых классов. Это означает,

    'что каждый раз, когда форма вызывается для перерисовки самой себя, будет

    'вызываться эта функция.

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

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)

     'ВАЖНО: Вызвать базовый класс и дать ему возможность

     'выполнить всю необходимую работу по рисованию

     MyBase.OnPaint(e)


     'Увеличить на 1 значение счетчика вызовов

     m_paintCount = m_paintCount + 1


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

     'Важно:

     'Вместо того чтобы создавать объект Graphics, мы получаем его

     'на время данного вызова. Это означает, что освобождать память путем вызова

     'метода .Dispose() объекта - не наша забота

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

     Dim myGfx As System.Drawing.Graphics

     myGfx = e.Graphics


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

     'Поскольку эту операцию рисования необходимо выполнить быстро,

     'кэшируем кисти, чтобы избавить себя от необходимости создавать их и

     'уничтожать при каждом вызове

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

     If (m_brushBlue Is Nothing) Then

      m_brushBlue = New System.Drawing.SolidBrush( _

       System.Drawing.Color.Blue)

     End If

     If (m_brushYellow Is Nothing) Then

      m_brushYellow = New System.Drawing.SolidBrush( _

       System.Drawing.Color.Yellow)

     End If


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

     'Выполнить рисование

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

     myGfx.FillRectangle(m_brushBlue, 2, 2, 100, 100)

     myGfx.DrawString("PaintCount: " + CStr(m_paintCount), _

      Me.Font, m_brushYellow, 3, 3)


     'Выход: Объекты, для которых мы должны были бы вызывать метод

     '.Dispose(), отсутствуют.

    End Sub

    Листинг 11.9. Простой пользовательский элемент управления, который изменяет цвета и запускает событие, определяемое пользователем

    'Простейший пользовательский элемент управления

    Public Class myButton

    Inherits System.Windows.Forms.Control

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

    'Объекты, необходимые нам для рисования

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

    Private m_RectangleBrush As System.Drawing.Brush

    Private m_TextBrush As System.Drawing.Brush

    Private m_RectangleColor As System.Drawing.Color


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

    'Событие, которое мы хотим предоставить на обработку. Это - общедоступный

    'делегат.

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

    Public Event EventButtonTurningBlue(ByVal sender As Object, _

     ByVal e As System.EventArgs)


     'Конструктор

     Public Sub New()

      MyBase.New()


      'ПРИМЕЧАНИЕ: Мы должны написать функцию "Dispose()" и

      'деструктор, который освобождает память от этих объектов

      'Создать необходимые кисти

      m_RectangleColor = System.Drawing.Color.Black

      m_RectangleBrush = New System.Drawing.SolidBrush( _

       m_RectangleColor)

      m_TextBrush = New System.Drawing.SolidBrush( _

       System.Drawing.Color.White)

    End Sub


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

    'Внутренним откликом на щелчок является

    'повторение трех различных цветов кнопки в цикле

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

    Protected Overrides Sub OnClick(ByVal e As System.EventArgs)


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

     'Важно: Вызвать базовую реализацию. Это

     'обеспечит возможность вызова любого обработчика событий,

     'подключенного к данному элементу управления

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

     MyBase.OnClick (e)


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

     'Выбрать цвет новой кисти, исходя из цвета старой кисти

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

     If (m_RectangleColor.Equals(System.Drawing.Color.Black)) Then

      m_RectangleColor = System.Drawing.Color.Blue

      '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      'Запустить событие!

      '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      'Возбудить событие без передачи аргумента

      RaiseEvent EventButtonTurningBlue(Me, Nothing)

     ElseIf (m_RectangleColor.Equals(System.Drawing.Color.Blue)) Then

      m_RectangleColor = System.Drawing.Color.Red

     Else

      m_RectangleColor = System.Drawing.Color.Black

     End If


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

     'Освободить старую кисть

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

     m_RectangleBrush.Dispose()


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

     'Создать новую кисть, которую мы собираемся использовать для фона

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

     m_RectangleBrush = _

      New System.Drawing.SolidBrush(m_RectangleColor)


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

     'Сообщить операционной системе, что наш элемент управления

     'должен быть перерисован, как только представится возможность

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

     Me.Invalidate()

    End Sub


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

    'Ради интереса подсчитаем, сколько раз осуществлялась перерисовка

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

    Private m_paintCount As Integer

    Protected Overrides Sub OnPaint( _

     ByVal e As System.Windows.Forms.PaintEventArgs)

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

     'ВАЖНО: Вызвать базовый класс и позволить ему

     'выполнить работу по рисованию

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

     MyBase.OnPaint(e)


     'Увеличить на единицу значение счетчика вызовов

     m_paintCount = m_paintCount + 1


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

     'Важно:

     'Вместо того чтобы создавать объект Graphics, мы получаем его

     'на время данного вызова. Это означает, что освобождать память путем вызова

     'метода .Dispose() объекта - не наша забота

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

     Dim myGfx As System.Drawing.Graphics

     myGfx = e.Graphics


     'Нарисовать прямоугольник

     myGfx.FillRectangle(m_RectangleBrush, 0, 0, _

      Me.Width, Me.Height)


     'Нарисовать текст

     myGfx.DrawString("Button! Paint: " + m_paintCount.ToString(), _

      Me.Parent.Font, m_TextBrush, 0, 0)

    End Sub

    End Class

    Листинг 11.10. Код, который должен быть помещен в форму для создания экземпляра пользовательского элемента управления

    'Наша новая кнопка

    Private m_newControl As myButton


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

    'Этот код будет подключен в качестве нашего обработчика событий

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

    Private Sub CallWhenButtonTurningBlue(ByVal sender As Object, _

     ByVal e As System.EventArgs)

     MsgBox("Кнопка становится синей!")

    End Sub


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

    'Эта функция подключается для обработки событий

    'щелчка на кнопке Button1

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click


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

     'Для простоты мы допускаем существование только

     'одного экземпляра элемента управления,

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

     If Not (m_newControl Is Nothing) Then Return

      'Создать экземпляр нашей кнопки

      m_newControl = New myButton

      'Указать ему его местоположение внутри родительского объекта

      m_newControl.Bounds = New Rectangle(10, 10, 150, 40)


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

     'Присоединить обработчик событий

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

     AddHandler m_newControl.EventButtonTurningBlue, _

      AddressOf CallWhenButtonTurningBlue

     'Добавить его в список элементов управления данной формы.

     'Это сделает его видимым

     Me.Controls.Add(m_newControl)

    End Sub

    Листинг 11.11. Три полезных способа кэширования графических ресурсов

    Imports System

    Imports System.Drawing


    Friend Class GraphicsGlobals

    '=======================================================================

    'Подход 1: Создать ресурс по требованию

    '         и кэшировать его для последующего использования.

    '

    'Внешний код получает доступ к общедоступным свойствам для их просмотра,

    'но сами переменные остаются внутренними переменными класса

    '=======================================================================

    Private Shared s_bluePen As Pen

    Public Shared ReadOnly Property globalBluePen() As Pen

     Get

      'Если перо еще не было создано

      If (s_bluePen Is Nothing) Then

       s_bluePen = New System.Drawing.Pen( _

        System.Drawing.Color.Blue)

      End If

      Return s_bluePen

     End Get

    End Property

    '========================================================

    'Подход 2:

    'Загрузить глобально и кэшировать все

    'используемые объекты Pen, ImageAttribute, Font и Brush

    '

    'Внешний код получает доступ ко всем общедоступным членам,

    'так что никакие функции доступа не нужны.

    '=========================================================

    Public Shared g_blackPen As Pen

    Public Shared g_whitePen As Pen

    Public Shared g_ImageAttribute As Imaging.ImageAttributes

    Private Shared s_alreadyInitialized As Boolean

    Public Shared g_boldFont As Font

    Public Shared g_smallTextFont As Font

    Public Shared g_greenBrush As Brush

    Public Shared g_yellowBrush As Brush

    Public Shared g_redBrush As Brush

    Public Shared g_blackBrush As Brush


    '==============================================================

    'Эта функция должна быть вызвана до попыток доступа к любому из

    'вышеперечисленных глобальных объектов

    '==============================================================

    Public Shared Sub InitializeGlobals()

     If (s_alreadyInitialized = True) Then Return

     g_blackPen = New Systera.Drawing.Pen(Color.Black)

     g_whitePen = New System.Drawing.Pen(Color.White)

     g_ImageAttribute = New _

      System.Drawing.Imaging.ImageAttributes

     g_ImageAttribute.SetColorKey(Color.White, Color.White)

     g_boldFont = New Font(FontFamily.GenericSerif, _

      10, FontStyle.Bold)

     g_smallTextFont = New Font(FontFamily.GenericSansSerif, _

      8, FontStyle.Regular)

     g_blackBrush = New SolidBrush(System.Drawing.Color.Black)

     g_greenBrush = New SolidBrush(System.Drawing.Color.LightGreen)

     g_yellowBrush = New SolidBrush(System.Drawing.Color.Yellow)

     g_redBrush = New SolidBrush(System.Drawing.Color.Red)

     s_alreadyInitialized = True

    End Sub

    '====================================================

    'Подход 3: Возвратить массив связанных ресурсов.

    ' Кэшировать ресурсы локально, чтобы при многократных

    ' запросах не загружались (напрасно) их дубликаты

    '====================================================

    Private Shared m_CaveMan_Bitmap1 As Bitmap

    Private Shared m_CaveMan_Bitmap2 As Bitmap

    Private Shared m_CaveMan_Bitmap3 As Bitmap

    Private Shared m_CaveMan_Bitmap4 As Bitmap

    Private Shared m_colCaveManBitmaps As _

     System.Collections.ArrayList


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

    'Создать и загрузить массив изображений для спрайта

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

    Public Shared Function g_CaveManPictureCollection() As _

     System.Collections.ArrayList

     'Изображения загружаются лишь в том случае, если мы их еще не загрузили

     If (m_CaveManBitmap1 Is Nothing) Then

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

      'Загрузить изображения. Эти изображения хранятся в виде

      'встроенных ресурсов в нашем двоичном приложении

      '

      'Загрузка изображений из внешних файлов осуществляется аналогичным

      'образом, но выполнить ее проще (нам достаточно лишь указать

      'имя файла в конструкторе растровых изображений).

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


      'Получить ссылку на нашу двоичную сборку

      dim thisAssembly as System.Reflection.Assembly = _

       System.Reflection.Assembly.GetExecutingAssembly()


      'Получить имя сборки

      Dim thisAssemblyName As System.Reflection.AssemblyName = _

       thisAssembly.GetName()

      Dim assemblyName As String = thisAssemblyName.Name


      'Загрузить изображения в виде двоичных потоков из нашей сборки

      m_CaveMan_Bitmap1 = New System.Drawing.Bitmap( _

       thisAssembly.GetManifestResourceStream( _

       assemblyName + ".Hank_RightRun1.bmp"))

      m_CaveMan_Bitmap2 = New System.Drawing.Bitmap( _

       thisAssembly.GetManifestResourceStream( _

       assemblyName + ".Hank_RightRun2.bmp"))

      m_CaveMan_Bitmap3 = New System.Drawing.Bitmap( _

       thisAssembly.GetManifestResourceStream( _

       assemblyName + ".Hank_LeftRunl.bmp"))

      m_CaveMan_Bitmap4 = New System.Drawing.Bitmap( _

       thisAssembly.GetManifestResourceStream( _

       assemblyName + ".Hank_LeftRun2.bmp"))


      'Добавить их в коллекцию

      m_colCaveManBitmaps = New System.Collections.ArrayList

      m_colCaveManBitmaps.Add(m_CaveMan_Bitmap1)

      m_colCaveManBitmaps.Add(m_CaveMan_Bitmap2)

      m_colCaveManBitmaps.Add(m_CaveMan_Bitmap3)

      m_colCaveManBitmaps.Add(m_CaveMan_Bitmap4)

     End If


     'Возвратить коллекцию

     Return m_colCaveManBitmaps

    End Function

    End Class

    Примеры к главе 13 (проектирование пользовательского интерфейса)

    Листинг 13.1. Использование конечного автомата для экспериментов с двумя различными вариантами компоновки пользовательского интерфейса

    #Const PLAYFIELD_ON_BOTTOM = 0 'Отобразить ПОЛЕ ИГРЫ под ПИ

    '#Const PLAYFIELD_ON_BOTTOM = 1 'Отобразить ПОЛЕ ИГРЫ над ПИ

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

    'ОБРАБОТЧИК СОБЫТИЙ: Вызывается при загрузке формы

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

    Private Sub Form1_Load(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles MyBase.Load


     'Задать совместно используемые свойства нашего визуального интерфейса

     SetStartControlPositionAndState()

     'Задать динамические свойства, исходя из того, в какое состояние

     'игры мы входим

     StateChangeForGameUI(GameUIState.startScreen)

    End Sub


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

    'Конечный автомат, который управляет отображением кнопок, скрываемых вручную

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

    Private Enum GameUIState

     startScreen = 1

     waitForNextQuestion = 2

     waitForUserToStateKnowledge = 4

     waitForUserToAnswerMultipleChoice = 8

    End Enum


    'Текущее состояние игры

    Private m_GameUIState As GameUIState


    '==========================================================================

    'Конечный автомат, используемый для управления пользовательским интерфейсом

    '==========================================================================

    Private Sub StateChangeForGameUI(ByVal newGameUIState As _

     GameUIState)

     m_GameUIState = newGameUIState

     Select Case (newGameUIState)

     Case GameUIState.startScreen

      buttonAskQuestion.Visible = True

      buttonAskQuestion.Text = "Start"


      'Скрыть текстовое окно

      textBoxAskQuestion.Visible = False

      SetAnswerButtonVisibility(False)

      SetDifficultyButtonVisibility(False)

     Case GameUIState.waitForNextQuestion

      setQuestionText("List answer details here... " + vbCrLf + _

       "Lots of space to write..." + vbCrLf + _

       "Waiting for user to select next question...")

      textBoxAskQuestion.Visible = True


      buttonAskQuestion.Text = "Next"

      buttonAskQuestion.Visible = True

      'Убедиться в том, что кнопка отображается на переднем плане

      buttonAskQuestion.BringToFront()

      SetAnswerButtonVisibility(False)

      SetDifficultyButtonVisibility(False)

    #If PLAYFIELD_ON_BOTTOM <> 0 Then 'ПОЛЕ ИГРЫ располагается под ПИ

      textBoxAskQuestion.Height = pictureBoxGameBoard.Top - 2

    #Else 'ПОЛЕ ИГРЫ располагается над пользовательскими элементами управления

      textBoxAskQuestion.Top = pictureBoxGameBoard.Top + _

       pictureBoxGameBoard.Height + 2

      textBoxAskQuestion.Height = Me.Height - _

       textBoxAskQuestion.Top

    #End If

     Case GameUIState.waitForUserToStateKnowledge

      SetTextForVocabularyQuestion()

      textBoxAskQuestion.Visible = True

      buttonAskQuestion.Visible = False

      SetAnswerButtonVisibility(False)

      SetDifficultyButtonVisibility(True)

    #If PLAYFIELD_ON_BOTTOM <> 0 Then 'ПОЛЕ ИГРЫ располагается под ПИ

      textBoxAskQuestion.Height = _

       buttonShowAnswers_AdvancedVersion.Top - 2

    #Else 'ПОЛЕ ИГРЫ располагается над пользовательскими элементами управления

      textBoxAskQuestion.Top = _

       buttonShowAnswers_AdvancedVersion.Top + _

       buttonShowAnswers_AdvancedVersion.Height + 2

      textBoxAskQuestion.Height = Me.Height - _

       textBoxAskQuestion.Top

    #End If

     Case GameUIState.waitForUserToAnswerMultipleChoice

      buttonAskQuestion.Visible = False

      SetDifficultyButtonVisibility(False)

      'Сделать кнопки доступными, чтобы пользователь мог щелкать на них

      SetAnswerButtonEnabled(True)

      SetAnswerButtonVisibility(True)

    #If PLAYFIELD_ON_BOTTOM <> 0 Then

      'ПОЛЕ ИГРЫ располагается под ПИ

      textBoxAskQuestion.Height = buttonAnswer0.Top - 2

    #Else 'ПОЛЕ ИГРЫ располагается над пользовательскими элементами управления

      'Разместить текстовое окно таким образом, чтобы экран использовался

      'эффективно

      textBoxAskQuestion.Top = buttonAnswer5.Top + _

       buttonAnswer5.Height + 2

      textBoxAskQuestion.Height = Me.Height - _

       textBoxAskQuestion.Top

    #End If

     End Select

    End Sub


    '========================================================================

    'Задать статическую компоновку нашего пользовательского интерфейса.

    'Сюда входят все элементы, позиции которых остаются фиксированными.

    'Изменения в остальные свойства внесет конечный автомат пользовательского

    'интерфейса

    '========================================================================

    Private Sub SetStartControlPositionAndState()

     pictureBoxGameBoard.Width = 240

     pictureBoxGameBoard.Height = 176


     'Установить размеры кнопок множественного выбора вариантов ответов

     Const answerButtons_dx As Integer = 117

     Const answerButtons_dy As Integer = 18


     buttonAnswer0.Width = answerButtons_dx

     buttonAnswer0.Height = answerButtons_dy

     buttonAnswer1.Size = buttonAnswer0.Size

     buttonAnswer2.Size = buttonAnswer0.Size

     buttonAnswer3.Size = buttonAnswer0.Size

     buttonAnswer4.Size = buttonAnswer0.Size

     buttonAnswer5.Size = buttonAnswer0.Size

     buttonShowAnswers_AdvancedVersion.Width = answerButtons_dx

     buttonShowAnswers_AdvancedVersion.Height = 24

     buttonShowAnswers_SimpleVersion.Size = _

      buttonShowAnswers_AdvancedVersion.Size


     'Расстояние (в пикселях) между соседними кнопками

     Const dx_betweenButtons As Integer = 3

     Const dy betweenButtons As Integer = 2

     Const answerbuttons_beginX As Integer = 3


     'Создать задний план для нашего изображения, чтобы мы видели

     'его в процессе тестирования

     Dim gameBoard As System.Drawing.Bitmap

     gameBoard = New System.Drawing.Bitmap( _

      pictureBoxGameBoard.Width, pictureBoxGameBoard.Height)


     Dim gameboard_gfx As System.Drawing.Graphics

     gameboard_gfx = System.Drawing.Graphics.FromImage(gameBoard)

     gameboard_gfx.Clear(System.Drawing.Color.Yellow)


     Dim myPen As System.Drawing.Pen = New System.Drawing.Pen( _

      System.Drawing.Color.Blue)

     gameboard_gfx.DrawRectangle(myPen, 2, 2, _

      gameBoard.Width - 4, gameBoard.Height - 6)

     myPen.Dispose()

     gameboard_gfx.Dispose()

     pictureBoxGameBoard.Image = gameBoard


     'Разместить текстовое окно, в котором содержатся задаваемые вопросы,

     'а также подробные ответы для пользователей

     textBoxAskQuestion.Left = 0

     textBoxAskQuestion.Width = 240


     buttonAskQuestion.Width = 64

     buttonAskQuestion.Height = 20

    #If PLAYFIELD_ON_BOTTOM <> 0 Then 'ПОЛЕ ИГРЫ располагается под ПИ

     Const answerbuttons_beginY As Integer = 42

     Const showanswers_beginY As Integer = 77

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

     'Задать кнопки выбора вариантов "Easy" или "Hard" режима игры

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

     buttonShowAnswers_AdvancedVersion.Top = showanswers_beginY

     buttonShowAnswers_SimpleVersion.Top = showanswers_beginY


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

     'Задать набор вариантов ответов

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

     'Задать элемент управления, по которому будут выравниваться

     'все остальные элементы управления

     buttonAnswer0.Top = answerbuttons_beginY


     'Поместить PictureBox под элементами управления

     pictureBoxGameBoard.Top = _

      (answerButtons dy + dy betweenButtons) * 3 + _

      answerbuttons_beginY


     buttonAskQuestion.Top = 0

     buttonAskQuestion.Left = 174

     textBoxAskQuestion.Top = 0

    #Else 'ПОЛЕ ИГРЫ располагается над пользовательскими элементами управления

     Const answerbuttons_beginY As Integer = 174

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

     'Задать кнопки выбора вариантов "Easy" или "Hard" режима игры

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

     buttonShowAnswers_AdvancedVersion.Top = answerbuttons_beginY

     buttonShowAnswers_SimpleVersion.Top = answerbuttons_beginY


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

     'Задать набор вариантов ответа

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

     'Задать элемент управления, по которому будут выравниваться

     'все остальные элементы управления

     buttonAnswer0.Top = answerbuttons_beginY

     pictureBoxGameBoard.Top = 0

     buttonAskQuestion.Top = answerbuttons_beginY

     buttonAskQuestion.Left = 174

    #End If

     buttonShowAnswers AdvancedVersion.Left = answerbuttons_beginX

     buttonShowAnswers_SimpleVersion.Left = _

      buttonShowAnswers_AdvancedVersion.Left + _

      answerButtons dx + dx_betweenButtons


     pictureBoxGameBoard.Left = 0

     pictureBoxGameBoard.Width = 240

     pictureBoxGameBoard.Height = 172

     buttonAnswer0.Left = answerbuttons_beginX

     buttonAnswer1.Left = buttonAnswer0.Left + answerButtons_dx + _

      dx_betweenButtons

     buttonAnswer1.Top = buttonAnswer0.Top


     'Следующий ряд

     buttonAnswer2.Left = buttonAnswer0.Left

     buttonAnswer2.Top = buttonAnswer0.Top + answerButtons_dy + _

      dy_betweenButtons


     buttonAnswer3.Left = buttonAnswer2.Left + answerButtons_dx + _

      dx_betweenButtons

     buttonAnswer3.Top = buttonAnswer2.Top


     'Следующий ряд

     buttonAnswer4.Left = buttonAnswer2.Left

     buttonAnswer4.Top = buttonAnswer2.Top + answerButtons_dy + _

      dy_betweenButtons


     buttonAnswer5.Left = buttonAnswer4.Left + answerButtons_dx + _

      dx_betweenButtons

     buttonAnswer5.Top = buttonAnswer4.Top

    End Sub


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

    'Вспомогательная функция, которая позволяет задавать состояние видимости

    'кнопок, отображающих ответы из словаря

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

    Private Sub SetAnswerButtonVisibility(ByVal visibleState _

     As Boolean)

     buttonAnswer0.Visible = visibleState

     buttonAnswer1.Visible = visibleState

     buttonAnswer2.Visible = visibleState

     buttonAnswer3.Visible = visibleState

     buttonAnswer4.Visible = visibleState

     buttonAnswer5.Visible = visibleState

    End Sub


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

    'Вспомогательная функция, вызываемая для задания свойств видимости

    'некоторых элементов управления

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

    Private Sub SetDifficultyButtonVisibility(ByVal visibleState _

     As Boolean)

     buttonShowAnswers_AdvancedVersion.Visible = visibleState

     buttonShowAnswers_SimpleVersion.Visible = visibleState

    End Sub


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

    'Вспомогательная функция, которая позволяет задавать состояние видимости

    'кнопок, отображающих ответы из словаря

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

    Private Sub SetAnswerButtonEnabled(ByVal enabledState _

     As Boolean)

     buttonAnswer0.Enabled = enabledState

     buttonAnswer1.Enabled = enabledState

     buttonAnswer2.Enabled = enabledState

     buttonAnswer3.Enabled = enabledState

     buttonAnswer4.Enabled = enabledState

     buttonAnswer5.Enabled = enabledState

    End Sub


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

    'Задает текст в текстовом окне и кнопках,

    'необходимых для формулирования вопросов.

    '

    'В случае практической реализации эта функция должна просматривать

    'вопросы динамически

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

    Private Sub SetTextForVocabularyQuestion()

     setQuestionText("What is the English word for 'der Mensch'?")

     buttonAnswer0.Text = "Four"

     buttonAnswer1.Text = "Person"

     buttonAnswer2.Text = "Three"

     buttonAnswer3.Text = "To Jump"

     buttonAnswer4.Text = "Newspaper"

     buttonAnswer5.Text = "Brother"

    End Sub


    'Вызывается для оценки варианта ответа, выбранного пользователем

    Private Sub evaluateMultipleChoiceAnswer(ByVal buttonClicked _

     As Button, ByVal selection As Integer)

     'Примечание: В практической реализации правильный номер ответа

     'определяется динамически и не всегда соответствует "кнопке #1"

     'Если выбранный пользователем вариант ответа не является правильным,

     'отменить доступ к нажатой кнопке

     If (selection <> 1) Then

      'Выбранный вариант ответа является неправильным

      buttonClicked.Enabled = False

     Else

      'Пользователь выбрал правильный ответ, продолжить игру

      StateChangeForGameUI(GameUIState.waitForNextQuestion)

     End If

    End Sub


    'Абстракция, задающая текст вопросов

    Sub setQuestionText(ByVal textIn As String)

     textBoxAskQuestion.Text = textIn

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ: Пользователь желает увидеть следующий вопрос

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

    Private Sub buttonAskQuestion_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonAskQuestion.Click

     SetTextForVocabularyQuestion()

     StateChangeForGameUI(GameUIState.waitForUserToStateKnowledge)

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ:

    'Пользователь желает ответить на отображенный вопрос и сообщить, какой

    'наиболее сложный уровень является для него приемлемым

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

    Private Sub buttonShowAnswers AdvancedVersion_Click( _

     ByVal sender As Object, ByVal e As System.EventArgs) _

     Handles buttonShowAnswers_AdvancedVersion.Click

     'Установить состояние игры для отображения вариантов выбора

     StateChangeForGameUI( _

      GameUIState.waitForUserToAnswerMultipleChoice)

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ:

    'Пользователь желает ответить на отображенный вопрос и сообщить, какой

    'наиболее легкий уровень является для него приемлемым

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

    Private Sub buttonShowAnswers_SimpleVersion_Click( _

     ByVal sender As Object, ByVal e As System.EventArgs) _

     Handles buttonShowAnswers_SimpleVersion.Click

     'Установить состояние игры для отображения вариантов выбора

     StateChangeForGameUI( _

      GameUIState.waitForUserToAnswerMultipleChoice)

    End Sub


    'ОБРАБОТЧИК СОБЫТИЙ: Был выполнен щелчок на кнопке выбора варианта ответа

    Private Sub buttonAnswer0_Click(ByVal sender As Object, ByVal _

     e As System.EventArgs) Handles buttonAnswer0.Click

     evaluateMultipleChoiceAnswer(buttonAnswer0, 0)

    End Sub


    'ОБРАБОТЧИК СОБЫТИЙ: Был выполнен щелчок на кнопке выбора варианта ответа

    Private Sub buttonAnswer1_Click(ByVal sender As Object, ByVal _

     e As System.EventArgs) Handles buttonAnswer1.Click

     evaluateMultipleChoiceAnswer(buttonAnswer1, 1)

    End Sub


    'ОБРАБОТЧИК СОБЫТИЙ: Был выполнен щелчок на кнопке выбора варианта ответа

    Private Sub buttonAnswer2_Click(ByVal sender As Object, ByVal _

     e As System.EventArgs) Handles buttonAnswer2.Click

     evaluateMultipleChoiceAnswer(buttonAnswer2, 2)

    End Sub


    'ОБРАБОТЧИК СОБЫТИЙ: Был выполнен щелчок на кнопке выбора варианта ответа

    Private Sub buttonAnswer3_Click(ByVal sender As Object, ByVal _

     e As System.EventArgs) Handles buttonAnswer3.Click

     evaluateMultipleChoiceAnswer(buttonAnswer3, 3)

    End Sub


    'ОБРАБОТЧИК СОБЫТИЙ: Был выполнен щелчок на кнопке выбора варианта ответа

    Private Sub buttonAnswer4_Click(ByVal sender As Object, ByVal _

     e As System.EventArgs) Handles buttonAnswer4.Click

     evaluateMultipleChoiceAnswer(buttonAnswer4, 4)

    End Sub


    'ОБРАБОТЧИК СОБЫТИЙ: Был выполнен щелчок на кнопке выбора варианта ответа

    Private Sub buttonAnswer5_Click(ByVal sender As Object, ByVal _

     e As System.EventArgs) Handles buttonAnswer5.Click

     evaluateMultipleChoiceAnswer(buttonAnswer5, 5)

    End Sub

    Листинг 13.2. Динамическое создание элементов управления на форме во время выполнения         

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

    'Счетчик количества создаваемых кнопок

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

    Private m_nextNewButtonIndex As Integer

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

    'ОБРАБОТЧИК СОБЫТИЙ: Обработчик щелчка на кнопке, которая

    ' имеется на нашей форме.

    '

    'Эта функция создает новую кнопку, присоединяет ее к нашей форме

    'и подключает обработчик события щелчка для нее

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

    Private Sub buttonCreateNewButtons_Click(ByVal sender As _

     System.Object, ByVal e As System.EventArgs) _

     Handles buttonCreateNewButtons.Click

     'Впоследствии мы начнем создавать новые кнопки, начиная

     'снизу экрана, поэтому ограничиваем их количество восемью

     If (m_nextNewButtonIndex > 8) Then

      Return

     End If


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

     'Создать кнопку (еще не присоединенную к нашей форме)

     'установить ее местоположение, размеры и текст

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

     Const newButtonHeight As Integer = 15

     Dim newButton As System.Windows.Forms.Button

     newButton = New System.Windows.Forms.Button

     newButton.Width = 100

     newButton.Height = newButtonHeight

     newButton.Left = 2

     newButton.Top = (newButtonHeight + 2) * m_nextNewButtonIndex

     newButton.Text = "New Button " + _

      m_nextNewButtonIndex.ToString()


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

     'Присоединить обработчик к событию щелчка для данного

     'элемента управления.

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

     AddHandler newButton.Click, _

      AddressOf Me.ClickHandlerForButtons


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

     'Присоединить эту кнопку к форме. По существу,

     'это создаст кнопку на форме!

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

     newButton.Parent = Me


     'Увеличить счетчик в соответствии с созданием очередной кнопки

     m_nextNewButtonIndex = m_nextNewButtonIndex + 1

    End Sub


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

    'Обработчик событий, который мы динамически подключаем

    'к нашим новым кнопкам

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

    Private Sub ClickHandlerForButtons(ByVal sender As Object, _

     ByVal e As System.EventArgs)

     Dim buttonCausingEvent As Button = _

      CType(sender, System.Windows.Forms.Button)


     'Вызвать окно сообщений, извещающее о том,

     'что мы получили событие

     MsgBox("Click event from:" + vbCrLf + buttonCausingEvent.Text)

    End Sub

    Листинг 13.3. Фильтрующее текстовое окно, принимающее текст в формате ###-##-####

    Option Strict On

    Imports System

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

    'Этот класс является элементом управления, производным от элемента управления

    'TextBox.

    'Он наследует все графические свойства TextBox, но добавляет фильтрацию

    'содержимого текстового окна, тем самым гарантируя,

    'что вводимый текст будет соответствовать формату:

    '###-##-####.

    'Этот формат соответствует формату номеров карточек социального страхования,

    'используемых в США.

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

    Public Class SocialSecurityTextBox

    Inherits System.Windows.Forms.TextBox

    Private m_inputIsFullValidEntry As Boolean

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

    'Указывает, получен ли

    'номер карточки социального страхования полностью

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

    Public ReadOnly Property IsFullValidInput() As Boolean

     Get

      Return m_inputIsFullValidEntry

     End Get

    End Property

    'Объект StringBuilder, которую мы будем часто использовать

    Private m_sb As System.Text.StringBuilder

    'Максимальная длина обрабатываемых строк

    Const SSNumberLength As Integer = 11


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

    'Конструктор

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

    Public Sub New()

     'Распределить память для нашего объекта StringBuilder и предоставить

     'место для нескольких дополнительных рабочих символов по умолчанию

     m_sb = New System.Text.StringBuilder(SSNumberLength + 5)

     m_inputIsFullValidEntry = False

    End Sub


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

    'Форматировать поступающий текст с целью установления его соответствия

    'нужному формату:

    '

    ' Формат номера карточки социального страхования: ###-##-####

    ' символы: 01234567890

    '

    ' [in] inString          : Текст, который мы хотим форматировать

    ' [in/out] selectionStart: Текущая точка вставки в тексте;

    '  она будет смещаться в связи с удалением

    '                           и добавлением нами символов

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

    Private Function formatText_NNN_NN_NNNN(ByVal inString As _

     String, ByRef selectionStart As Integer) As String

     Const firstDashIndex As Integer = 3

     Const secondDashIndex As Integer = 6


     'Удалить старые данные и поместить входную строку

     'в объект StringBuilder, чтобы мы могли с ней работать.

     m_sb.Length = 0

     m_sb.Append(inString)


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

     'Просмотреть каждый символ в строке, пока не будет

     'достигнута максимальная длина нашего форматированного текста

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

     Dim currentCharIndex As Integer

     currentCharIndex = 0

     While ((currentCharIndex < m_sb.Length) AndAlso _

      (currentCharIndex < SSNumberLength))

      Dim currentChar As Char

      currentChar = m_sb(currentCharIndex)

      If ((currentCharIndex = firstDashIndex) OrElse _

       (currentCharIndex = secondDashIndex)) Then

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

       'The character needs to be a "-"

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

       If (currentChar <> "-"c) Then 'Вставить дефис

        m_sb.Insert(currentCharIndex, "-")


        'Если мы добавили символ перед точкой вставки,

        'она должна быть смещена вперед

        If (currentCharIndex <= selectionStart) Then

         selectionStart = selectionStart + 1

        End If

       End If


       'Этот символ годится, перейти к следующему символу

       currentCharIndex = currentCharIndex + 1

      Else


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

       'Символ должен быть цифрой

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

       If (System.Char.IsDigit(currentChar) = False) Then

        'Удалить символ

        m_sb.Remove(currentCharIndex, 1)

        'Если мы добавили символ перед точкой вставки,

        'она должна быть смещена назад

        If (currentCharIndex < selectionStart) Then

         selectionStart = selectionStart - 1

        End If

        'He увеличивать значение счетчика символов, ибо мы должны

        'просмотреть символ, занявший место того символа,

        'который мы удалили

       Else

        'Символ является цифрой, все нормально.

        currentCharIndex = currentCharIndex + 1

       End If

      End If

     End While


     'Если превышена длина строки, усечь ее

     If (m_sb.Length > SSNumberLength) Then

      m_sb.Length = SSNumberLength

     End If

     'Возвратить новую строку

     Return m_sb.ToString()

    End Function


    Private m_in_OnChangeFunction As Boolean

    Protected Overrides Sub OnTextChanged(ByVal e As EventArgs)

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

     'Если мы изменим свойство .Text, то будет осуществлен повторный

     'вход в обработчик. В этом случае мы не хотим предпринимать никаких

     'действий и должны просто выйти из функции без передачи события

     'куда-то еще.

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

     If (m_in_OnChangeFunction = True) Then

      Return

     End If


     'Заметьте, что сейчас мы находимся в функции OnChanged,

     'поэтому мы можем обнаружить повторное вхождение (см. код выше)

     m_in_OnChangeFunction = True


     'Получить текущее свойство .Text

     Dim oldText As String = Me.Text


     'Получить текущий индекс SelectionStart

     Dim selectionStart As Integer = Me.SelectionStart


     'Форматировать строку, чтобы она удовлетворяла нашим потребностям

     Dim newText As String = formatText_NNN_NN_NNNN(oldText, _

      selectionStart)


     'Если текст отличается от исходного, обновить

     'свойство .Text

     If (oldText <> newText) Then

      'Это приведет к повторному вхождению

      Me.Text = newText

      'Обновить местоположение точки вставки

      Me.SelectionStart = selectionStart

     End If


     'Мы принудительно обеспечили соответствие введенного текста правильному

     'формату, поэтому, если длина строки согласуется с длиной номера

     'карточки социального страхования, то мы знаем что он имеет

     'формат ###-##-####.

     If (Me.Text.Length = SSNumberLength) Then

      'Да, мы имеем полный номер карточки социального страхования

      m_inputIsFullValidEntry = True

     Else

      'Нет, мы пока не получили полный номер карточки социального страхования

      m_inputIsFullValidEntry = False

     End If


     'Вызвать наш базовый класс и сообщить всем объектам, которых это может

     'интересовать, что текст изменился

     MyBase.OnTextChanged(e)


     'Заметьте, что сейчас мы покидаем наш код и хотим отключить

     'проверку повторных вхождений в него.

     m_in_OnChangeFunction = False

    End Sub


    Protected Overrides Sub OnKeyPress( _

     ByVal e As System.Windows.Forms.KeyPressEventArgs)

     'Поскольку нам известно, что никакие буквы при вводе нам не нужны,

     'то просто игнорировать их, если они встречаются.

     Dim keyPressed As Char = e.KeyChar

     If (System.Char.IsLetter(keyPressed)) Then

      'Сообщить системе о том, что событие обработано

      e.Handled = True

      Return

     End If

     'Обработать нажатие клавиши обычным способом

     MyBase.OnKeyPress(e)

     End Sub

    End Class

    Листинг 13.4. Код формы для создания пользовательского элемента управления TextBox

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

    'Переменная для хранения нашего нового элемента управления TextBox

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

    Private m_filteredTextBox As SocialSecurityTextBox

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

    'ОБРАБОТЧИК СОБЫТИЙ: Создать экземпляр нашего пользовательского элемента

    ' управления и поместить его в форму

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     'Создать, позиционировать и разместить элемент управления

     m_filteredTextBox = New SocialSecurityTextBox

     m_filteredTextBox.Bounds = _

      New System.Drawing.Rectangle(2, 2, 160, 20)


     'Подключить обработчик событий

     AddHandler m_filteredTextBox.TextChanged, _

      AddressOf Me.textBox_TextChanged


     'Задать родительский объект

     m_filteredTextBox.Parent = Me

     'Выделить элемент управления

     m_filteredTextBox.Focus()


     'Сделать данную кнопку недоступной, чтобы поверх данного объекта

     'не был создан второй объект

     SocialSecurityTextBox Button1.Enabled = False

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ: Этот обработчик подключается динамически при

    ' создании элемента управления

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

    Private Sub textBox_TextChanged(ByVal sender As Object, _

     ByVal e As System.EventArgs)

     If (m_filteredTextBox.IsFullValidInput = True) Then

      label1.Text = "FULL SOCIAL SECURITY NUMBER!!!"

     Else

      Label1.Text = "Not full input yet..."

     End If

    End Sub

    Листинг 13.5. код формы, демонстрирующий использование прозрачности '         

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

    'Размеры наших битовых образов и экранного изображения PictureBox

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

    Const bitmap_dx As Integer = 200

    Const bitmap_dy As Integer = 100

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

    'Создает и прорисовывает изображение заднего плана

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

    Private m_backgroundBitmap As System.Drawing.Bitmap

    Sub CreateBackground()

     If (m_backgroundBitmap Is Nothing) Then

      m_backgroundBitmap = New Bitmap(bitmap_dx, bitmap_dy)

     End If

     'Делаем битовую карту белой

     Dim gfx As System.Drawing.Graphics

     gfx = System.Drawing.Graphics.FromImage(m_backgrourdBitmap)

     gfx.Clear(System.Drawing.Color.White)


     'Рисуем текст черным

     Dim myBrush As System.Drawing.Brush

     myBrush = New System.Drawing.SolidBrush( _

      System.Drawing.Color.Black)

     Dim у As Integer

     For у = 0 To bitmap_dy Step 15

      gfx.DrawString("I am the BACKGROUND IMAGE...hello", Me.Font, myBrush, 0, y)

     Next


     'Очистить

     myBrush.Dispose()

     gfx.Dispose()

    End Sub


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

    'Создает и прорисовывает изображение заднего плана

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

    Private m_foregroundBitmap As System.Drawing.Bitmap

    Sub CreateForeground()

     If (m_foregroundBitmap Is Nothing) Then

      m_foregroundBitmap = New Bitmap(bitmap_dx, bitmap_dy)

     End If

     'Делаем всю битовую карту синей

     Dim gfx As System.Drawing.Graphics

     gfx = System.Drawing.Graphics.FromImage(m_foregroundBitmap)

     gfx.Clear(System.Drawing.Color.Blue)


     'Рисуем несколько фигур желтым

     Dim yellowBrush As System.Drawing.Brush

     yellowBrush = New System.Drawing.SolidBrush( _

      System.Drawing.Color.Yellow)

     gfx.FillEllipse(yellowBrush, 130, 4, 40, 70)

     gfx.FillRectangle(yellowBrush, 5, 20, 110, 30)

     gfx.FillEllipse(yellowBrush, 60, 75, 130, 20)


     'Очистить

     yellowBrush.Dispose()

     gfx.Dispose()

    End Sub


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

    'Устанавливает размеры и местоположение PictureBox с левой стороны

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

    Private Sub SetPictureBoxDimensions()

     PictureBox1.Width = bitmap_dx

     PictureBox1.Height = bitmap_dy

     PictureBox1.Left = 20

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ: Отобразить изображение ЗАДНЕГО ПЛАНА в PictureBox

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

    Private Sub buttonDrawBackground_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonDrawBackground.Click

     SetPictureBoxDimensions()

     CreateBackground()

     PictureBox1.Image = m_backgroundBitmap

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ: Отобразить изображение ПЕРЕДНЕГО ПЛАНА в PictureBox

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

    Private Sub buttonDrawForeground_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonDrawForeground.Click

     SetPictureBoxDimensions()

     CreateForeground()

     PictureBox1.Image = m_foregroundBitmap

    End Sub


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

    'ОБРАБОТЧИК СОБЫТИЙ: Наложить изображение ПЕРЕДНЕГО ПЛАНА на изображение

    ' ЗАДНЕГО ПЛАНА. Использовать МАСКУ ПРОЗРАЧНОСТИ, чтобы желтый

    ' цвет в изображении ПЕРЕДНЕГО ПЛАНА стал прозрачным и через

    ' него можно было видеть содержимое изображения

    ' ЗАДНЕГО ПЛАНА

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

    Private Sub buttonDrawBackgroundPlusForeground_Click(ByVal _

     sender As Object, ByVal e As System.EventArgs) _

     Handles buttonDrawBackgroundPlusForeground.Click

     SetPictureBoxDimensions()

     CreateForeground()

     CreateBackground()

     'Получить объект Graphics изображения ЗАДНЕГО ПЛАНА, поскольку

     'именно поверх него мы собираемся рисовать.

     Dim gfx As System.Drawing.Graphics

     gfx = System.Drawing.Graphics.FromImage(m_backgroundBitmap)


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

     'Создать класс ImageAttributes. Этот класс позволяет нам

     'задать прозрачный цвет на наших операций рисования

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

     Dim trasparencyInfo As System.Drawing.Imaging.ImageAttributes

     trasparencyInfo = New System.Drawing.Imaging.ImageAttributes

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

     'Задать прозрачный цвет

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

     trasparencyInfo.SetColorKey(System.Drawing.Color.Yellow, _

      System.Drawing.Color.Yellow)

     'Задать прямоугольник рисунка

     Dim rect As System.Drawing.Rectangle = _

      New System.Drawing.Rectangle(0, 0, _

      m_backgroundBitmap.Width, m_backgroundBitmap.Height)


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

     'Нарисовать изображение ПЕРЕДНЕГО ПЛАНА поверх изображения ЗАДНЕГО ПЛАНА

     'и использовать прозрачный цвет в ImageAttributes для создания окна

     'прозрачности, через которое виден задний план

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

     gfx.DrawImage(m_foregroundBitmap, rect, 0, 0, _

      m_foregroundBitmap.Width, m_foregroundBitmap.Height, _

      System.Drawing.GraphicsUnit.Pixel, trasparencyInfo)


     'Очистить

     gfx.Dispose()


     'Показать результат в виде растрового изображения

     PictureBox1.Image = m_backgroundBitmap

    End Sub

    Листинг 13.6. Код формы, демонстрирующий загрузку встроенных ресурсов

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

    'Загрузить изображение и отобразить его в объекте PictureBox

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     LoadImageFromResource()

     PictureBox1.Image = m_myBitmapImage

    End Sub


    Private m_myBitmapImage As System.Drawing.Bitmap

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

    'Загрузить изображение, которое хранится в виде встроенного ресурса

    'в нашей сборке

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

    Public Sub LoadImageFromResource()

     'Если изображение уже загружено,

     'то не имеет смысла делать это повторно.

     If Not (m_myBitmapImage Is Nothing) Then

      Return

     End If


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

     'Получить ссылку на двоичную сборку нашего приложения

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

     Dim thisAssembly As System.Reflection.Assembly = _

      System.Reflection.Assembly.GetExecutingAssembly()


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

     'Получить имя сборки

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

     Dim thisAssemblyName As System.Reflection.AssemblyName = _

      thisAssembly.GetName()

     Dim assemblyName As String = thisAssemblyName.Name

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

     'Извлечь поток изображения из нашей сборки и создать соответствующую ему

     'битовую карту в памяти

     'ПРИМЕЧАНИЕ: Имя потока ресурса ResourceStream ЧУВСТВИТЕЛЬНО К РЕГИСТРУ,

     '   поэтому имя изображения должно В ТОЧНОСТИ совпадать с именем

     '   файла изображения, который вы добавили в проект

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

     m_myBitmapImage = New System.Drawing.Bitmap( _

      thisAssembly.GetManifestResourceStream( _

      assemblyName + ".MyImage.PNG"))

    End Sub

    Примеры к главе 14 (данные)

    Листинг 14.1. Простой пример создания и использования объекта ADO.NET DataSet

    'Объект DataSet, который мы собираемся загрузить

    Private m_myDataSet As System.Data.DataSet

    'Константы, которые будут использоваться

    Const FILE_EMPTY_DATASET As String = "EmptyDataSet.xml"

    Const FILE_1TABLE_DATASET As String = "1TableDataSet.xml"

    Const dividerLine As String = _

     "-----------------------------" + vbCrLf


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

    'Загрузить содержимое файла и присоединить его к тексту,

    'содержащемуся в элементе управления textBox1

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

    Private Sub addFileContentsToTextBox(ByVal fileName As String)

     'Открыть файл и считать его содержимое

     Dim myStreamReader As System.IO.StreamReader

     myStreamReader = System.IO.File.OpenText(fileName)

     Dim fileText As String = myStreamReader.ReadToEnd()

     'Закрыть файл

     myStreamReader.Close()


     'Присоединить содержимое к тексту, находящемуся в текстовом окне

     TextBox1.Text = TextBox1.Text + _

      dividerLine + "FILE: '" + fileName + "'" + vbCrLf + _

      dividerLine + fileText + vbCrLf

    End Sub


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

    '1. Создает набор данных,

    ' сохраняет набор данных в виде XML,

    ' отображает результаты в текстовом окне

    '2.  Добавляет таблицу данных в набор данных,

    '  добавляет два типизированных столбца в таблицу данных,

    '  добавляет две строки в таблицу данных,

    '  сохраняет набор данных в виде XML,

    '  отображает результаты в текстовом окне

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

    Private Sub Button1_Click(ByVal sender As System.Object, _

     ByVal e As System.EventArgs) Handles Button1.Click

     'Очистить текстовое окно от содержимого

     TextBox1.Text = ""

     '===========================================

     '1. Создать новый набор данных

     '===========================================

     m_myDataSet = New System.Data.DataSet("HelloWorld-DataSet")


     'Записать содержимое ADO.NET DataSet в виде XML и отобразить

     'файл в текстовом окне

     m_myDataSet.WriteXml(FILE_EMPTY_DATASET)

     addFileContentsToTextBox(FILE_EMPTY_DATASET)


     '==================================================

     '2. Добавить таблицу данных в набор данных ADO.NET,

     ' а также 2 строки данных в таблицу данных

     '==================================================

     Dim myTestTable As System.Data.DataTable

     myTestTable = m_myDataSet.Tables.Add("TestTable")


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

     'Добавить 2 столбца в таблицу

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

     'Добавить столбец данных в таблицу DataTable набора DataSet

     myTestTable.Columns.Add("TestColumn0", _

      GetType(System.DateTime))

     'Добавить строковый столбец в таблицу DataTable набора DataSet

     myTestTable.Columns.Add("TestColumn1", GetType(String))


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

     'Добавить строки данных в таблицу

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

     'Добавить строку данных в таблицу данных

     Dim rowOfData() As Object

     ReDim rowOfData(1)

     'Столбец 0 - это тип данных

     rowOfData(0) = System.DateTime.Today

     'Столбец 1 — это строковый тип

     rowOfData(1) = "а string of data today"

     myTestTable.Rows.Add(rowOfData)


     'Добавить вторую строку данных в таблицу данных

     Dim rowOfData2() As Object

     ReDim rowOfData2(1) 'Столбец 0 — это тип данных

     rowOfData2(0) = System.DateTime.Today.AddDays(1)


     'Столбец 1 — это строковый тип

     rowOfData2(1) = "tomorrow's string"

     myTestTable.Rows.Add(rowOfData2)


     'Записать содержимое набора ADO.NET DataSet в виде XML и отобразить

     'файл в текстовом окне

     m_myDataSet.WriteXml(FILE_1TABLE_ DATASET)

     addFileContentsToTextBox(FILE_1TABLE_DATASET)

    End Sub

    Листинг 14.2. Использование параметра XMLWriteMode при сохранении объекта ADO.NET DataSet

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

    'Необходимость в этой функции возникает по той причине, что .NET Compact

    'Framework не поддерживает перегрузку:

    ' "public voidWriteXml(string, XmlWriteMode);"

    '

    'в качестве функции-члена "public" (только "private")

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

    Sub writeDataSetToFile(ByVal ds As System.Data.DataSet, _

     ByVal filename As String, _

     ByVal xmlWriteMode As System.Data.XmlWriteMode)

     'Создать объект XmlWriter для записи наших XML-данных

     Dim xmlWriter As System.Xml.XmlWriter

     xmlWriter = New System.Xml.XmlTextWriter(filename, _

      System.Text.Encoding.Default)


     'ПРИМЕЧАНИЕ: Эта перегруженная версия не является общедоступной (public)!

     'ds.WriteXml(filename, xmlWriteMode)

     'Вместо этого используем следующую функцию:


     ds.WriteXml(xmlWiiter, xmlWriteMode)

     xmlWriter.Close() 'Важно закрыть файл!

    End Sub

    Листинг 14.3. Сравнение производительности различных вариантов доступа к данным с использованием объектов DataSet

    Private m_myDataSet As System.Data.DataSet 'Набор данных для тестирования

    'Индексы столбцов и таблицы, подлежащие кэшированию

    Private m_indexesLookedUp As Boolean = False

    Private Const INVALID_INDEX As Integer = -1

    Private m_IndexOfTestColumn_CreditCard _

     As Integer = INVALID_INDEX

    Private m_IndexOfTestColumn_TravelDate _

     As Integer = INVALID_INDEX

    Private m_IndexOfTestTable As Integer = INVALID_INDEX


    'Столбцы данных и таблица, подлежащих кэшированию

    Private m_TestColumn_CreditCard As System.Data.DataColumn

    Private m_TestColumn_TravelDate As System.Data.DataColumn

    Private m_TableCustomerInfo As System.Data.DataTable


    Public Enum testType '3 вида тестов, которые мы можем выполнять

     textColumnLookup

     cachedIndexLookup

     cachedColumnObject

    End Enum


    'Эти константы определяют размерные характеристики тестов

    Const DUMMY_ROWS_OF_DATA As Integer = 100

    Const NUMBER_TEST_ITERATIONS As Integer = 500


    'Табличная информация

    Const TABLE_NAME_PASSENGERINFO As String = "CustomerTravelInfo"

    Const COLUMN_NAME_DATE_OF_TRAVEL As String = "DateOfTravel"

    Const COLUMN_NAME_PASSENGER_NAME As String = "PassengerName"

    Const COLUMN_NAME_PASSENGER_CREDIT_CARD As String = _

     "PassengerCreditCard"

    Const TEST_CREDIT_CARD As String = "IvoCard-987-654-321-000"


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

    'Создает набор данных

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

    Private Sub createDataSet()

     '1. Создать новый объект DataSet

     m_myDataSet = New System.Data.DataSet("TravelService Dataset")


     '2. Добавить объект DataTable в объект ADO.NET DataSet

     Dim myTestTable As System.Data.DataTable

     myTestTable = m_myDataSet.Tables.Add(TABLE_NAME_PASSENGERINFO)


     'Добавить 2 столбца в таблицу

     'Добавить столбец данных в таблицу DataTable набора данных DataSet

     myTestTable.Columns.Add(COLUMN_NAME_DATE_OF_TRAVEL, _

      GetType(System.DateTime))


     'Добавить столбец строк в таблицу DataTable набора данных DataSet

     myTestTable.Columns.Add(COLUMN_NAME_PASSENGER_NAME, _

      GetType(String))


     'Добавить столбец строк в таблицу DataTable набора данных DataSet

     myTestTable.Columns.Add(COLUMN_NAME_PASSENGER_CREDIT_CARD, _

      GetType(String))


     'Данные для размещения в строках данных

     Dim objArray() As Object ReDim objArray(2)


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

     'Добавить строки данных в таблицу

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

     Dim buildTestString As System.Text.StringBuilder

     buildTestString = New System.Text.StringBuilder

     Dim addItemsCount As Integer

     For addItemsCount = 1 To DUMMY_ROWS_OF_DATA

      'Выбрать день отъезда пассажира

      objArray(0) = System.DateTime.Today.AddDays(addItemsCount)


      'Выбрать имя пассажира

      buildTestString.Length = 0

      buildTestString.Append("TestPersonName")

      buildTestString.Append(addItemsCount)

      objArray(1) = buildTestString.ToString()


      'Связать с пассажиром текстовый номер кредитной карточки

      buildTestString.Length = 0

      buildTestString.Append("IvoCard-000-000-0000-")

      buildTestString.Append(addItemsCount)

      objArray(2) = buildTestString.ToString()


      'Добавить элементы массива в строку набора данных

      myTestTable.Rows.Add(objArray)

     Next


     'Добавить элемент, поиск которого мы хотим проводить при выполнении теста

     objArray(0) = System.DateTime.Today

     objArray(1) = "Ms. TestPerson"

     objArray(2) = ТЕST_CREDIT_CARD


     'Добавить элементы массива в строку набора данных

     myTestTable.Rows.Add(objArray)

    End Sub


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

    'Найти и кэшировать все индексы набора данных, которые нам нужны

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

    Private Sub cacheDataSetInfo()

     'Выйти из функции, если индексы уже загружены

     If (m_indexesLookedUp = True) Then Return


     'Кэшировать индекс таблицы

     m_IndexOfTestTable = _

      m_myDataSet.Tables.IndexOf(TABLE_NAME_PASSENGERINFO)


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

     'Итерировать по всем столбцам нашей таблицы

     'и кэшировать индексы нужных столбцов

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

     mTableCustomerInfo = m_myDataSet.Tables(m_IndexOfTestTable)

     Dim dataColumnCount As Integer

     dataColumnCount = m_TableCustomerInfo.Columns.Count

     Dim myColumn As System.Data.DataColumn

     Dim colIdx As Integer

     While (colIdx < dataColumnCount)

      myColumn = m_TableCustomerInfo.Columns(colIdx)


      'Предпринимать поиск, только если это еще не сделано

      If (m_IndexOfTestColumn_CreditCard = INVALID_INDEX) Then

       'Проверить, совпадает ли имя

       If (myColumn.ColumnName = _

        COLUMN_NAME_PASSENGER_CREDIT_CARD) Then


        'Кэшировать индекс

        m_IndexOfTestColumn_CreditCard = colIdx


        'Кэшировать столбец

        m_TestColumn_CreditCard = myColumn

        GoTo next_loop_iteration 'Опустить другие операции сравнения...

       End If 'Endif: сравнение строк

      End If


      If (m _IndexOfTestColumn_TravelDate = INVALID_INDEX) Then

       'Проверить, совпадает ли имя

       If (myColumn.ColumnName = _

        COLUMN_NAME_DATE_OF_TRAVEL) Then


        'Кэшировать индекс

        m_IndexOfTestColumn_TravelDate = colIdx

        'Кэшировать столбец

        m_TestColumn_TravelDate = myColumn

        GoTo next_loop_iteration 'Опустить другие операции сравнения

       End If 'Endif: сравнение строк

      End If

    next_loop_iteration:

      colIdx = colIdx + 1

     End While

     m_indexesLookedUp = True

    End Sub


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

    'Выполнить тест.

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

    Sub changeDayOfTravel_test(ByVal kindOfTest As testType)

     'Отобразить курсор ожидания

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.WaitCursor


     'Начать с известной даты

     Dim newDate As System.DateTime

     newDate = System.DateTime.Today

     changeDayOfTravel_textColumnLookup(TEST_CREDIT_CARD, newDate)


     'ДОПУСТИМО ТОЛЬКО ДЛЯ ТЕСТОВОГО КОДА!!!

     'Вызов сборщика мусора в коде ЗАМЕДЛИТ работу вашего приложения!

     System.GC.Collect()

     Const testNumber As Integer = 0


     'Настроить соответствующим образом в зависимости от вида выполняемого теста

     Select Case (kindOfTest)

     Case testType.textColumnLookup

      PerformanceSampling.StartSample(testNumber, _

       "Text based Column lookup.")

     Case testType.cachedIndexLookup

      PerformanceSampling.StartSample(testNumber, _

       "Cached Column Index lookup.")

     Case testType.cachedColumnObject

      PerformanceSampling.StartSample(testNumber, _

       "Cached Column objects")

     Case Else

      Throw New Exception("Unknown state!")

     End Select


     'Выполнить тест!

     Dim testCount As Integer

     For testCount = 1 To NUMBER_TEST_ITERATIONS

      'Передвинуть дату вперед на один день

      newDate = newDate.AddDays(1)

      Dim numberRecordsChanged As Integer = 0


      'Какой вид теста мы выполняем?

      Select Case (kindOfTest)

      Case testType.textColumnLookup

       'НИЗКАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Просмотреть все имена, используя СТРОКИ

       numberRecordsChanged = _

        changeDayOfTravel_textColumnLookup( _

        TEST_CREDIT_CARD, newDate)

      Case testType.cachedIndexLookup

       'ЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированные индексы

       numberRecordsChanged = _

        changeDayOfTravel_cachedColumnIndex( _

        TEST_CREDIT_CARD, newDate)

      Case testType.cachedColumnObject

       'НАИЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированные объекты

       numberRecordsChanged = _

        changeDayOfTravel_CachedColumns( _

        TEST_CREDIT_CARD, newDate)

      End Select

      'Убедиться в том, что тест выполняется, как и ожидалось

      If (numberRecordsChanged <> 1) Then

       MsgBox("No matching records found. Test aborted!")

       Return

      End If

     Next

     'Получить время, которое потребовалось для выполнения теста

     PerformanceSampling.StopSample(testNumber)


     'Обычный курсор

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.Default


     'Отобразить результаты выполнения теста

     Dim runInfo As String = NUMBER_TEST_ITERATIONS.ToString() + _

      "x" + DUMMY_ROWS_OF_DATA.ToString() + ": "

     MsgBox(runInfo + _

      PerformanceSampling.GetSampleDurationText(testNumber))

    End Sub


    'ФУНКЦИЯ ПОИСКА, ОБЛАДАЮЩАЯ НИЗКОЙ ПРОИЗВОДИТЕЛЬНОСТЬЮ

    Private Function changeDayOfTravel_textColumnLookup( _

     ByVal creditCardNumber As String, _

     ByVal newTravelDate As System.DateTime) As Integer

     Dim numberRecordsChanged As Integer


     'Найти имя таблицы

     Dim dataTable_Customers As System.Data.DataTable

     'НИЗКАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Осуществить поиск в таблице, используя

     'сравнение строк!

     dataTable_Customers = _

      m_myDataSet.Tables(TABLE_NAME_PASSENGERINFO)


     Dim currentCustomerRow As System.Data.DataRow

     For Each currentCustomerRow In dataTable_Customers.Rows

      Dim currentCreditCard As String


      'НИЗКАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Осуществить поиск в таблице, используя

      'сравнение строк!

      currentCreditCard = CType( _

       currentCustomerRow(COLUMN_NAME_PASSENGER_CREDIT_CARD), String)


      'Проверить, является ли данная кредитная карточка искомой

      If (creditCardNumber = currentCreditCard) Then

       'Изменить дату отъезда

       'НИЗКАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Осуществить поиск столбца, используя

       'сравнение строк!

       Dim currentTravelDate As System.DateTime = CType( _

        currentCustomerRow(COLUMN_NAME_DATE_OF_TRAVEL), _

        System.DateTime)

       If (currentTravelDate <> newTravelDate) Then

        'НИЗКАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Осуществить поиск столбца, используя

        'сравнение строк!

        currentCustomerRow(COLUMN_NAME_DATE_OF_TRAVEL) = _

         newTravelDate

        numberRecordsChanged = numberRecordsChanged + 1

       End If

      End If 'endif: сравнение строк

     Next 'end for each


     Return numberRecordsChanged 'Количество обновленных записей

    End Function


    'ФУНКЦИЯ, ХАРАКТЕРИЗУЮЩАЯСЯ НЕСКОЛЬКО ЛУЧШЕЙ ПРОИЗВОДИТЕЛЬНОСТЬЮ

    Private Function changeDayOfTravel_cachedColumnIndex( _

     ByVal creditCardNumber As String, ByVal newTravelDate _

     As DateTime) As Integer

     Dim numberRecordsChanged As Integer


     'Поиск имени таблицы

     Dim dataTable_Customers As System.Data.DataTable


     'ЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: использовать кэшированный индекс

     dataTable_Customers = _

      m_myDataSet.Tables(m_IndexOfTestTable)

     Dim currentCustomerRow As System.Data.DataRow

     For Each currentCustomerRow In dataTable_Customers.Rows

      Dim currentCreditCard As String


      'ЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: использовать кэшированный индекс столбца!

      currentCreditCard = CType(currentCustomerRow( _

       m_IndexOfTestColumn_CreditCard), String)

      'Проверить, совпадает ли номер кредитной карточки

      If (creditCardNumber = currentCreditCard) Then

       'Изменить дату отъезда

       'ЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированный индекс столбца!

       Dim currentTravelDate As System.DateTime = CType( _

        currentCustomerRow (m_IndexOfTestColumn_TravelDate), System.DateTime)


       If (currentTravelDate <> newTravelDate) Then

        'ЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированный индекс столбца!

        currentCustomerRow(m_IndexOfTestColumn_TravelDate) = _

         newTravelDate

        numberRecordsChanged = numberRecordsChanged + 1

       End If

      End If

     Next

     Return numberRecordsChanged 'Количество обновленных записей

    End Function


    'ФУНКЦИЯ, ОБЛАДАЮЩАЯ НАИЛУЧШЕЙ ПРОИЗВОДИТЕЛЬНОСТЬЮ

    Private Function changeDayOfTravel_CachedColumns( _

     ByVal creditCardNumber As String, _

     ByVal newTravelDate As System.DateTime) As Integer

     Dim numberRecordsChanged As Integer


     'Найти имя таблицы

     Dim dataTable_Customers As System.Data.DataTable = _

      m_TableCustomerInfo


     Dim currentCustomerRow As System.Data.DataRow

     For Each currentCustomerRow In dataTable_Customers.Rows

      Dim currentCreditCard As String

      'НАИЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированный индекс столбца!

      currentCreditCard = CType( _

       currentCustomerRow(m_TestColumn_CreditCard), _

       String)

      'Проверить, совпадает ли номер кредитной карточки

      If (creditCardNumber = currentCreditCard) Then

       'Изменить дату отъезда

       'НАИЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированный индекс столбца!

       Dim currentTravelDate As System.DateTime = CType( _

        currentCustomerRow(m_TestColumn_TravelDate), _

        System.DateTime)


       If (currentTravelDate <> newTravelDate) Then

        'НАИЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать кэшированный индекс столбца!

        currentCustomerRow(m_TestColumn_TravelDate) = _

         newTravelDate

        numberRecordsChanged = numberRecordsChanged + 1

       End If

      End If

     Next

     Return numberRecordsChanged 'Количество обновленных записей

    End Function


    'Событие щелчка на кнопке

    Private Sub buttonRunTest_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonRunTest.Click

     createDataSet()

     cacheDataSetInfo()


     'НИЗКАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать поиск по строкам

     changeDayOfTravel_test(testType.textColumnLookup)


     'ЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать поиск по целочисленным индексам

     changeDayOfTravel_test(testType.cachedIndexLookup)


     'НАИЛУЧШАЯ ПРОИЗВОДИТЕЛЬНОСТЬ: Использовать поиск по объектам столбцов

     changeDayOfTravel_test(testType.cachedColumnObject)

    End Sub

    Листинг 14.4. Результаты тестирования производительности при использовании пользовательского формата данных вместо объектов DataSet

    'Определение размерных характеристик теста

    Const DUMMY _ROWS_OF_DATA As Integer = 100

    Const NUMBER_TEST_ITERATIONS As Integer = 500


    Const TABLE_NAME_PASSENGERINFO As String = "CustomerTravelInfo"

    Const TEST_CREDIT_CARD As String = "IvoCard-987-654-321-000"


    Private m_data_creditCards() As String

    Private m_data_names() As String

    Private m_data_travelDates() As System.DateTime


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

    'Создает массив данных (вместо использования объектов DataSet)

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

    Private Sub createDataSet()

     '=============================================

     '1. Создать пространство для размещения данных

     '=============================================

     ReDim m_data_creditCards(DUMMY_ROWS_OF_DATA)

     ReDim m_data_names(DUMMY_ROWS_OF_DATA)

     ReDim m_data_travelDates(DUMMY_ROWS_OF_DATA)

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

     'Добавить строки данных

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

     Dim buildTestString As System.Text.StringBuilder

     buildTestString = New System.Text.StringBuilder

     Dim addItemsCount As Integer

     For addItemsCount = 0 To DUMMY_ROWS_OF_DATA

      'Выбрать день отъезда пассажира

      m_data_travelDates(addItemsCount) = _

       System.DateTime.Today.AddDays(addItemsCount)

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

      'Выбрать имя пассажира

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

      'Очистить строку

      buildTestString.Length = 0

      buildTestString.Append("TestPersonName")

      buildTestString.Append(addItemsCount)

      m_data_names(addItemsCount) = buildTestString.ToString()

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

      'Связать с пассажиром текстовый номер кредитной карточки

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

      'Строка значения третьего столбца набора данных

      buildTestString.Length = 0

      buildTestString.Append("IvoCard-000-000-0000-")

      buildTestString.Append(addItemsCount)

      m_data_creditCards(addItemsCount) = _

       buildTestString.ToString()

     Next


     'Добавить элемент, поиск которого мы хотим выполнить в нашем тесте.

     'Выбрать день для значения в первом столбце данных

     m_data_travelDates(DUMMY_ROWS_OF_DATA) = _

      System.DateTime.Today

     'Строка для второго столбца данных

     m_data_names(DUMMY_ROWS OF DATA) = "Ms. TestPerson"

     'Строка с идентификатором кредитной карточки

     m_data_creditCards(DUMMY_ROWS_OF_DATA) = TEST_CREDIT_CARD

    End Sub


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

    'Выполнить тест.

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

    Sub changeDayOfTravel_test()

     'Отобразить курсор ожидания

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.WaitCursor

     'Начать с известной даты.

     Dim newDate As System.DateTime newDate = System.DateTime.Today

     changeDayOfTravel_CustomArrays(TEST_CREDIT_CARD, newDate)


     'ТОЛЬКО В ЦЕЛЯХ ТЕСТИРОВАНИЯ!!!

     'HE СЛЕДУЕТ использовать вызовы сборщика мусора в готовом программном

     'коде. Это ЗАМЕДЛЯЕТ работу приложения.

     System.GC.Collect()

     Const testNumber As Integer = 0


     'Запустить таймер теста

     PerformanceSampling.StartSample(testNumber, "Custom Array implementation")


     'Запустить тест!

     Dim testCount As Integer

     For testCount = 1 To NUMBER_TEST_ITERATIONS

      'Передвинуть дату вперед на один день

      newDate = newDate.AddDays(1)

      Dim numberRecordsChanged As Integer


      'Просмотреть все имена, используя СТРОКИ

      numberRecordsChanged = _

       changeDayOfTravel_CustomArrays(ТЕST_CREDIT_CARD, newDate)


      'Убедиться в нормальном выполнении теста

      If (numberRecordsChanged <> 1) Then

       MsgBox("No matching records found. Test aborted!")

       Return

      End If

     Next


     'Получить время выполнения теста

     PerformanceSampling.StopSample(testNumber)


     'Обычный курсор

     System.Windows.Forms.Cursor.Current = _

      System.Windows.Forms.Cursors.Default


     'Отобразить результаты теста

     Dim runInfo As String = NUMBER_TEST_ITERATIONS.ToString() + _

      "x" + DUMMY_ROWS_OF_DATA.ToString() + ": " MsgBox(runInfo + _

      PerformanceSampling.GetSampleDurationText(testNumber))

    End Sub


    Private Function changeDayOfTravel_CustomArrays( _

     ByVal creditCardNumber As String, ByVal newTravelDate _

     As System.DateTime) As Integer

     Dim numberRecordsChanged As Integer


     'Просмотреть каждый элемент массива

     Dim index As Integer

     For index = 0 To DUMMY_ROWS_OF_DATA

      Dim currentCreditCard As String

      currentCreditCard = m_data_creditCards(index)


      'Обновить запись при наличии совпадения

      If (creditCardNumber = currentCreditCard) Then

       'Изменить дату поездки

       Dim currentTravelDate As System.DateTime = _

        m_data_travelDates(index)


       'Увеличить значение счетчика обновлений только при несовпадении данных

       If (currentTravelDate <> newTravelDate) Then

        m_data_travelDates(index) = _

         newTravelDate

        numberRecordsChanged = numberRecordsChanged + 1

       End If

      End If

     Next

     'Возвратить количество обновленных записей

     Return numberRecordsChanged

    End Function


    Private Sub buttonRunTest_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonRunTest.Click

     createDataSet()

     changeDayOfTravel_test()

    End Sub

    Листинг 14.5. Пример пользовательского управления данными — код, помещаемый в форму Form1.cs

    'Создает базу данных

    Private Sub buttonCreateDatabase_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonCreateDatabase.Click

     DatabaseAccess.CreateAndFillDatabase()

    End Sub


    'Загружает данные из базы данных и отображает их

    Private Sub buttonLoadGameData_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonLoadGameData.Click

     'Очистить текстовое окно

     TextBox1.Text = ""

     'Загрузить данные для слов

     GameData.InitializeGameVocabulary()


     'Обойти все слова и добавить их в текстовый список

     Dim thisStringBuilder As System.Text.StringBuilder

     thisStringBuilder = New System.Text.StringBuilder

     Dim thisWord As VocabularyWord

     For Each thisWord In GameData.AllWords

      thisStringBuilder.Append(thisWord.EnglishWord)

      thisStringBuilder.Append(" = ")

      thisStringBuilder.Append( _

       thisWord.GermanWordWithArticleIfExists)

      thisStringBuilder.Append(vbCrLf) 'Новая строка

     Next

     'Отобразить список слов в текстовом окне

     TextBox1.Text = thisStringBuilder.ToString()

    End Sub

    Листинг 14.6. Пример кода управления данными для DatabaseAccess.cs

    Option Strict On

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

    'Код доступа к базе данных: Этот класс управляет доступом в

    'базу данных наших приложений

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

    Imports System


    Friend Class DatabaseAccess

    Const DATABASE_NAME As String = "LearnGerman.sdf"

    Const CONNECT_STRING As String = _

     "Data Source = " + DATABASE_NAME + "; Password = ''"


    Const TRANSLATIONTABLE_NAME As String = "TranslationDictionary"

    Const TRANSLATIONTABLE_ENGLISH_COLUMN As String = "EnglishWord"

    Const TRANSLATIONTABLE_GERMAN_COLUMN As String = "GermanWord"

    Const TRANSLATIONTABLE_GERMANGENDER_COLUMN As String = "GermanGender"

    Const TRANSLATIONTABLE_WORDFUNCTION_COLUMN As String = "WordFunction"


    Friend Const DS_WORDS_COLUMNINDEX_ENGLISHWORD As Integer = 0

    Friend Const DS_WORDS_COLUMNINDEX_GERMANWORD As Integer = 1

    Friend Const DS_WORDS_COLUMNINDEX_GERMANGENDER As Integer = 2

    Friend Const DS_WORDS_COLUMNINDEX_WORDFUNCTION As Integer = 3


    Public Shared Function GetListOfWords() As _

     System.Data.IDataReader

     Dim conn As System.Data.SqlServerCe.SqlCeConnection = Nothing

     conn = New System.Data.Sq]ServerCe.SqlCeConnection( _

      CONNECT_STRING)

     conn.Open()


     Dim cmd As System.Data.SqlServerCe.SqlCeCommand = _

      conn.CreateCommand()


     cmd.CommandText = "select " + _

      TRANSLATIONTABLE_ENGLISH_COLUMN + ", " _

      + TRANSLATIONTABLE_GERMAN_COLUMN + ", " _

      + TRANSLATIONTABLE_GERMANGENDER_COLUMN + ", " _

      + TRANSLATIONTABLE_WORDFUNCTION_COLUMN + " " _

      + "from " + TRANSLATIONTABLE_NAME


     'Выполнить команду базы данных

     Dim myReader As System.Data.SqlServerCe.SqlCeDataReader = _

      cmd.ExecuteReader(System.Data.CommandBehavior.SingleResult)

     Return myReader

    End Function


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

    'Создает базу данных в случае необходимости

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

    Public Shared Sub CreateDatabaseIfNonExistant()

     If (System.IO.File.Exists(DATABASE_NAME) = False) Then

      CreateAndFillDatabase()

     End If

    End Sub


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

    'Создает и наполняет данными базу данных

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

    Public Shared Sub CreateAndFillDatabase()

     'Удалить базу данных, если она уже существует

     If (System.IO.File.Exists(DATABASE_NAME)) Then

      System.IO.File.Delete(DATABASE_NAME)

     End If

     'Создать новую базу данных

     Dim sqlCeEngine As System.Data.SqlServerCe.SqlCeEngine

     sqlCeEngine = New System.Data.SqlServerCe.SqlCeEngine( _

      CONNECT_STRING)

     sqlCeEngine.CreateDatabase()


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

     'Попытаться подключиться к базе данных

     'и наполнить ее данными

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

     Dim conn As System.Data.SqlServerCe.SqlCeConnection = Nothing

     Try

      conn = New System.Data.SqlServerCe.SqlCeConnection( _

       CONNECT_STRING)

      conn.Open()

      Dim cmd As System.Data.SqlServerCe.SqlCeCommand = _

       conn.CreateCommand()


      'Создает таблицу перевода

      'Поля:

      ' 1. Слова на английском языке (English)

      ' 2. Слова на немецком языке (German)

      ' 3. Грамматический род (Gender)

      ' 4. Тип слова

      cmd.CommandText = "CREATE TABLE " + TRANSLATIONTABLE_NAME _

       + " (" + _

       TRANSLATIONTABLE_ENGLISH_COLUMN + " ntext" + ", " + _

       TRANSLATIONTABLE_GERMAN COLUMN + " ntext" + ", " + _

       TRANSLATIONTABLE_GERMANGENDER_COLUMN + " int" + ", " + _

       TRANSLATIONTABLE_WORDFUNCTION_COLUMN + " int" + ")"

      cmd.ExecuteNonQuery()


      'Наполнить базу данных словами

      FillDictionary(cmd)

     Catch eTableCreate As System.Exception

      MsgBox("Error occured adding table :" + eTableCreate.ToString())

     Finally

      'Всегда закрывать базу данных по окончании работы

      conn.Close()

     End Try


     'Информировать пользователя о создании базы данных

     MsgBox("Created language database!")

    End Sub


    Private Shared Sub FillDictionary( _

     ByVal cmd As System.Data.SqlServerCe.SqlCeCommand)

     'Глаголы

     InsertEnglishGermanWordPair(cmd, "to pay", "zahlen", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Verb)

     InsertEnglishGermanWordPair(cmd, "to catch", "fangen", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Verb)

     'Добавить другие слова.


     'Местоимения

     InsertEnglishGermanWordPair(cmd, "What", "was", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Pronoun)

     'Добавить другие слова.


     'Наречия

     InsertEnglishGermanWordPair(cmd, "where", "wo", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Adverb)

     InsertEnglishGermanWordPair(cmd, "never", "nie", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Adverb)

     'Добавить другие слова.


     'Предлоги

      InsertEnglishGermanWordPair(cmd, "at the", "am", _

       VocabularyWord.WordGender.notApplicable, _

       VocabularyWord.WordFunction.Preposition)


     'Имена прилагательные

     InsertEnglishGermanWordPair(cmd, "invited", "eingeladen", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Verb)


     InsertEnglishGermanWordPair(cmd, "yellow", "gelbe", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Adjective)

     InsertEnglishGermanWordPair(cmd, "one", "eins", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Adjective)

     InsertEnglishGermanWordPair(cmd, "two", "zwei", _

      VocabularyWord.WordGender.notApplicable, _

      VocabularyWord.WordFunction.Adjective)


     'Имена существительные мужского рода

     InsertEnglishGermanWordPair(cmd, "Man", "Mann", _

      VocabularyWord.WordGender.Masculine, _

      VocabularyWord.WordFunction.Noun)

     InsertEnglishGermanWordPair(cmd, "Marketplace", "Marktplatz", _

      VocabularyWord.WordGender.Masculine, _

      VocabularyWord.WordFunction.Noun)

     InsertEnglishGermanWordPair(cmd, "Spoon", "Löffel", _

      VocabularyWord.WordGender.Masculine, _

      VocabularyWord.WordFunction.Noun)


     'Имена существительные женского рода

     InsertEnglishGermanWordPair(cmd, "Woman", "Frau", _

      VocabularyWord.WordGender.Feminine, _

      VocabularyWord.WordFunction.Noun)

     InsertEnglishGermanWordPair(cmd, "Clock", "Uhr", _

      VocabularyWord.WordGender.Feminine, _

      VocabularyWord.WordFunction.Noun)

     InsertEnglishGermanWordPair(cmd, "Cat", "Katze", _

      VocabularyWord.WordGender.Feminine, _

      VocabularyWord.KordFunction.Noun)


     'Имена существительные среднего рода

     InsertEnglishGermanWordPair(cmd, "Car", "Auto", _

      VocabularyWord.WordGender.Neuter, _

      VocabularyWord.WordFunction.Noun)

     InsertEnglishGermanWordPair(cmd, "Book", "Buch", _

      VocabularyWord.WordGender.Neuter, _

      VocabularyWord.WordFunction.Noun)

    End Sub


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

    'Помещает слово в базу данных

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

    Private Shared Sub InsertEnglishGermanWordPair( _

     ByVal cmd As System.Data.SqlServerCe.SqlCeCommand, _

     ByVal englishWord As String, ByVal germanWord As String, _

     ByVal germanWordGender As VocabularyWord.WordGender, _

     ByVal wordFunction As VocabularyWord.WordFunction)

     cmd.CommandText = "INSERT INTO " + TRANSLATIONTABLE NAME + _

      "(" + TRANSLATIONTABLE_ENGLISH_COLUMN + ", " + _

      TRANSLATIONTABLE_GERMAN_COLUMN + ", " + _

      TRANSLATIONTABLE_GERMANGENDER_COLUMN + ", " + _

      TRANSLATIONTABLE_WORDFUNCTION_COLUMN + _

      ") VALUES ('" _

      + englishWord + "', '" + germanWord + "', '" _

      + System.Convert.ToString(CType(germanWordGender, Integer)) + "', '"

      + System.Convert.ToString(CType(wordFunction, Integer)) + "')"


     cmd.ExecuteNonQuery()

    End Sub

    End Class

    Листинг 14.7. Пример кода управления данными для GameData.cs

    Option Strict On

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

    'Код управления данными в памяти

    '

    'Этот код предназначен для управления представлением кода в памяти

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

    Imports System


    Friend Class GameData

    'Массив списков для сохранения загружаемых данных

    Private Shared m_vocabularyWords_All As _

     System.Collections.ArrayList

    Private Shared m_vocabularyWords_Nouns As _

     System.Collections.ArrayList

    Private Shared m_vocabularyWords Verbs As _

     System.Collections.ArrayList

    Private Shared m_vocabularyWords_Adjectives As _

     System.Collections.ArrayList

    Private Shared m_vocabularyWords Adverbs As _

     System.Collections.ArrayList

    Private Shared m_vocabularyWords_Prepositions As _

     System.Collections.ArrayList


    Public Shared ReadOnly Property _

     isGameDataInitialized() As Boolean

     Get

      'Инициализация данных игры, если слова загружены

      Return Not (m_vocabularyWords_All Is Nothing)

     End Get

    End Property


    'Возвращает коллекцию всех имеющихся слов

    Public Shared ReadOnly Property _

     AllWords() As System.Collections.ArrayList

     Get

      'Загрузить данные, если они не были инициализированы

      If (m_vocabularyWords_All Is Nothing) Then

       InitializeGameVocabulary()

      End If

      Return m_vocabularyWords_All

     End Get

    End property


    'Возвращает коллекцию всех имеющихся имен существительных

    Public Shared ReadOnly Property _

     Nouns() As System.Collections.ArrayList

     Get

      'Загрузить данные, если они не были инициализированы

      If (m_vocabularyWords_Nouns Is Nothing) Then

       InitializeGameVocabulary()

      End If

      Return m_vocabularyWords_Nouns

     End Get

    End Property


    '==========================================================

    'Загружает данные из нашей базы данных

    '==========================================================

    Public Shared Sub InitializeGameVocabulary()

     'Создать новый массив списков для хранения наших слов

     m_vocabularyWords_All = New System.Collections.ArrayList

     m_vocabularyWords_Nouns = New System.Collections.ArrayList

     m_vocabularyWords_Verbs = New System.Collections.ArrayList

     m_vocabularyWords_Adjectives = _

      New System.Collections.ArrayList

     m_vocabularyWords Adverbs = _

      New System.Collections.ArrayList

     m_vocabularyWords_Prepositions = _

      New System.Collections.ArrayList


     Dim dataReader As System.Data.IDataReader

     dataReader = DatabaseAccess.GetListOfWords()


     Dim newWord As VocabularyWord

     'Обойти все записи

     While (dataReader.Read())

      Dim thisword_gender As VocabularyWord.WordGender

      Dim thisword_function As VocabularyWord.WordFunction

      thisword_gender = CType(dataReader.GetInt32( _

       DatabaseAccess.DS_WORDS_COLUMNINDEX_GERMANGENDER), _

       VocabularyWord.WordGender)

      thisword_function = CType(dataReader.GetInt32( _

       DatabaseAccess.DS_WORDS_COLUMNINDEX_WORDFUNCTION), _

       VocabularyWord.WordFunction)


      'Поместить данные для только что считанного слова в класс

      newWord = New VocabularyWord(dataReader.GetString( _

       DatabaseAccess.DS_WORDS_COLUMNINDEX_ENGLISHWORD), dataReader.GetString( _

       DatabaseAccess.DS_WORDS_COLUMNINDEX_GERMANWORD), _

       thisword_gender, thisword_function)


      'Добавить новое слово в массив списков

      m_vocabularyWords_All.Add(newWord)


      'Слова могут принадлежать нескольким группам, поэтому

      'необходимо выполнить проверку с использованием операции логического И

      'для проверки того, что слово относится к данной категории

      If ((newWord.getWordFunction And _

       VocabularyWord.WordFunction.Noun) <> 0) Then

       m_vocabularyWords_Nouns.Add(newWord)

      End If


      If ((newWord.getWordFunction And _

       VocabularyWord.WordFunction.Verb) <> 0)

       Then m_vocabularyWords_Verbs.Add(newWord)

      End If


      If ((newWord.getWordFunction And _

       VocabularyWord.WordFunction.Adjective) <> 0) Then

       m_vocabularyWords_Adjectives.Add(newWord)

      End If


      If ((newWord.getWordFunction And _

       VocabularyWord.WordFunction.Adverb) <> 0) Then

       m_vocabularyWords_Adverbs.Add(newWord)

      End If


      If ((newWord.getWordFunction And _

       VocabularyWord.WordFunction.Preposition) <> 0) Then

       m_vocabularyWords_Prepositions.Add(newWord)

      End If

     End While

     'Закрыть объект DataReader

     dataReader.Close()

    End Sub

    End Class

    Листинг 14.8. Пример кода управления данными для VocabularyWord.cs

    Option Strict On

    Imports System

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

    'Хранит данные слова из словаря

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

    Friend Class VocabularyWord


    <System.FlagsAttribute()> _

     Public Enum WordFunction

     Noun = 1

     Verb = 2

     Pronoun = 4

     Adverb = 8

     Adjective = 16

     Preposition = 32

     Phrase = 64

    End Enum


    Public Enum WordGender

     notApplicable = 0

     Masculine = 1

     Feminine = 2

     Neuter = 3

    End Enum


    Private m_englishWord As String

    Private m_germanWord As String

    Private m_germanGender As VocabularyWord.WordGender

    Private m_wordFunction As VocabularyWord.WordFunction


    Public ReadOnly Property EnglishWord() As String

     Get

      Return m_englishWord

     End Get

    End Property

    Public ReadOnly Property GermanWord() As String

     Get

      Return m_germanWord

     End Get

    End Property

    Public ReadOnly Property getWordFunction() As WordFunction

     Get

      Return m_wordFunction

     End Get

    End Property

    Public ReadOnly Property getWordGender() As WordGender

     Get

      Return m_germanGender

     End Get

    End Property


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

    'Возвращает слово на немецком языке, которому предшествует артикль

    '(например, 'der', 'die', 'das'), если он существует

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

    Public ReadOnly Property GermanWordWithArticleIfExists() As String

     Get

      If (m_germanGender = WordGender.notApplicable) Then

       Return Me.GermanWord

      End If

      Return Me.GenderArticle + " " + Me.GermanWord

     End Get

    End Property


    Public ReadOnly Property GenderArticle() As String

     Get

      Select Case (m_germanGender)

      Case WordGender.Masculine

       Return "der"

      Case WordGender.Feminine

       Return "die"

      Case WordGender.Neuter

       Return "das"

      End Select

      Return ""

     End Get

    End Property


    Public Sub New(ByVal enlgishWord As String, ByVal germanWord _

     As String, ByVal germanGender As WordGender, _

     ByVal wordFunction As WordFunction)

     m_englishWord = enlgishWord

     m_germanWord = germanWord

     m_germanGender = germanGender

     m_wordFunction = wordFunction

     End Sub

    End Class

    Примеры к главе 15 (передача данных)

    Листинг 15.1. Простой код файлового ввода-вывода, иллюстрирующий различия между локальной и удаленной передачей данных

    Этот код представляет собой всего лишь последовательность вызовов функций. Программистам на VB будет несложно написать его, используя в качестве образца код на C#.

    Листинг 15.2. Имитация сбоев при передаче данных для тестирования приложения

    'Флаги условной компиляции для нашего инструментированного кода

    #Const DEBUG_SIMULATE_FAILURES = 1 'Имитировать сбои

    '#Const DEBUG_SIMULATE_FAILURES = 0 'Не имитировать сбои


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

    'Глобальная переменная, которую мы хотим использовать для указания

    'необходимости генерации исключений в процессе передачи данных

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

    #If DEBUG_SIMULATE_FAILURES <> 0 Then

    'Переменная для хранения информация о следующем сбое

    Shared g_failureCode As SimulatedFailures = _

     SimulatedFailures.noFailurePending


    'Список сбоев, которые мы хотим имитировать

    public enum SimulatedFailures

     noFailurePending 'No test failures pending


     'Имитируемые сбои:

     failInNextWriteSocketCode

     failInNextWebServiceCall

     failInNextFileIODuringFileOpen

     failInNextFileIODuringFileRead

     'и так далее

    End Enum

    #End If 'DEBUG_SIMULATE_FAILURES


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

    'Функция, которую мы используем для передачи данных.

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

    Private Sub writeDataToSocket( _

     ByVal mySocket As System.Net.Sockets.Socket, _

     ByVal dataToSend() As Byte)

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

     'Этот код следует компилировать лишь при тестировании сетевых сбоев

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

    #If DEBUG_SIMULATE_FAILURES <> 0 Then

     'Если это сбой, который мы хотим тестировать, генерировать исключение

     If (g_failureCode = _

      SimulatedFailures.failInNextWriteSocketCode) Then

      'Сбросить этот сбой, чтобы он не возник

      'при следующем вызове этой функции

      g_failureCode = SimulatedFailures.noFailurePending


      Throw New Exception("Test communications failure: " + _

       g_failureCode.ToString())

     End If

    #End If


     'Передать данные обычным образом.

     mySocket.Send(dataToSend)

    End Sub

    Листинг 15.3. Тестовый код, который необходимо поместить в класс формы для тестирования передачи и приема данных посредством механизма IrDA

    'Имя, которое мы хотим присвоить сокету IrDA

    Const myIrDASocketName As String = "IrDaTestFileTransmit"


    Private Sub buttonTestFileSend_Click(ByVal sender As Object, _

     ByVal e As System.EventArgs) Handles buttonTestFileSend.Click

     'Создать простой текстовый файл, который мы хотим передать

     Const fileName As String = "\myTestSendFile.txt"

     Dim textFileStream As System.IO.StreamWriter

     textFileStream = System.IO.File.CreateText(fileName)

     textFileStream.WriteLine("Today...")

     textFileStream.WriteLine("is а nice day")

     textFileStream.WriteLine("to go swim")

     textFileStream.WriteLine("in the lake")

     textFileStream.Close()


     Dim irdaFileSender As IrDAFileSend

     irdaFileSender = New IrDAFileSend(fileName, myIrDASocketName)

     'Имеется 2 режима: 1 - Sync (синхронный), 2 — Async (асинхронный)


     '1. Вызвать функцию в синхронном режиме

     'и блокировать поток выполнения до тех пор,

     'пока файл не будет передан


     '1a. Информировать пользователя о том, что мы пытаемся передать данные

     Me.Text = "Trying to send..."


     'Подождать, пока клиент не будет найден, а затем передать файл

     irdaFileSender.LoopAndAttemptIRSend()


     '1c. Информировать пользователя о том, что файл передан

     MsgBox("File sent!")

     Me.Text = "IrDA: Sent!"


     '2. Вызвать функцию в асинхронном режиме и поручить

     'передачу файла фоновому потоку

     'irdaFileSend.LoopAndAttemptIRSendAsync()

     'ПРИМЕЧАНИЕ: Если мы вызываем функцию в асинхронном режиме, то должны

     'периодически проверять, не завершила ли она выполнение, путем

     'вызова метода 'irdaFileSend.Status'

    End Sub


    Private Sub buttonTestFileReceive_Click(ByVal sender As Object, _

     ByVal e As EventArgs) Handles buttonTestFileReceive.Click

     'Если файл назначения уже существует, уничтожить его

     Const fileName As String = "\myTestReceiveFile.txt"

     If (System.IO.File.Exists(fileName)) Then

      System.IO.File.Delete(fileName)

     End If


     Dim irdaFileReceiver As IrDAFileReceive

     irdaFileReceiver = New IrDAFileReceive(fileName, _

      myIrDASocketName)

     'Имеется 2 режима: 1 — Sync (синхронный), 2 - Async (асинхронный)


     '1. Вызвать функцию в синхронном режиме

     ' блокировать поток выполнения до тех пор, пока

     'файл не будет получен


     '1a. Информировать пользователя о том, что мы ожидаем получения файла

     Me.Text = "Waiting to receive..."

     '1b. Ожидать, пока не будет сделана попытка установления с нами связи

     'и передачи файла

     irdaFileReceiver.WaitForIRFileDownload()

     '1с. Информировать пользователя о том, что мы получили переданный файл

     Me.Text = "IrDA: received!"

     MsgBox("File received!")


     '2. Вызвать функцию в асинхронном режиме и поручить

     'получение файла фоновому потоку

     'irdaFileReceive.WaitForIRFileDownloadAsync()

     'ПРИМЕЧАНИЕ: Если мы вызываем функцию в асинхронном режиме, то должны

     'периодически проверять, не завершила ли она выполнение, путем

     'вызова метода 'irdaFileReceive.Status'

    End Sub

    Листинг 15.4. Класс IrDAFileSend

    Option Strict On

    '====================================================================

    'Этот класс является клиентом IrDA. Он осуществляет поиск сервера

    'IrDA, имя которого совпадает с именем службы IrDA, и после того, как

    'он найден, направляет ему поток данных файла,

    '====================================================================

    Class IrDAFileSend

    Private m_descriptionOfLastSendAttempt As String

    Private m_IrDAServiceName As String

    Private m_fileToSend As String

    Private m_wasSenderStopped As Boolean


    Public Enum SendStatus

     AttemptingToSend

     Finished_Successfully

     Finished_Aborted

     Finished_Error

    End Enum


    Private m_SendStatus As SendStatus

    Public ReadOnly Property Status() As SendStatus

     Get

      'Блокировка выполнения параллельных операций чтения/записи в m_SendStatus

      SyncLock (Me)

       Return m_SendStatus

      End SyncLock

     End Get

    End Property

    Private Sub setStatus(ByVal newStatus As SendStatus)

     'Блокировка выполнения параллельных операций чтения/записи в m SendStatus

     SyncLock (Me)

      m_SendStatus = newStatus

     End SyncLock

    End Sub


    Public ReadOnly Property ErrorText() As String

     Get

      Return m_descriptionOfLastSendAttempt

     End Get

    End Property


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

    'КОНСТРУКТОР

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

    Public Sub New(ByVal fileToSend As String, ByVal irdaServiceName As String)

     'Имя сокета IrDA, поиск которого мы хотим осуществить

     m_IrDAServiceName = irdaServiceName

     'Файл, который мы хотим передать

     m_fileToSend = fileToSend

    End Sub


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

    'Запускает новый поток для осуществления попытки отправки файла

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

    Public Sub LoopAndAttemptIRSendAsync()

     'Мы находимся в режиме передачи

     setStatus(SendStatus.AttemptingToSend)

     'Пользователь пока что не отменил выполнение операции

     m_wasSenderStopped = False


     'Это функция, которую должен запустить на выполнение новый поток

     Dim threadEntryPoint As System.Threading.ThreadStart

     threadEntryPoint = _

      New System.Threading.ThreadStart(AddressOf LoopAndAttemptIRSend)


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

     'Создать новый поток и запустить его

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

     Dim newThread As System.Threading.Thread = _

      New System.Threading.Thread(threadEntryPoint)


     newThread.Start()

     'Вперед!

    End Sub


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

    'Входит в цикл и пытается передать файл посредством IR

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

    Public Sub LoopAndAttemptIRSend()

     Dim irDASender As System.Net.Sockets.IrDAClient

     Dim streamOutToIrDA As System.IO.Stream

     Dim streamInFromFile As System.IO.Stream

     'Пользователь пока что не отменил выполнение операции

     m_wasSenderStopped = False

     setStatus(SendStatus.AttemptingToSend)


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

     'Непрерывное выполнение цикла, пока не удастся отправить сообщение

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

     While (True)

      'Значения всех этих переменных должны быть нулевыми до и после

      'вызова sendStream(...), если не было сгенерировано исключение!

      irDASender = Nothing

      streamOutToIrDA = Nothing

      streamInFromFile = Nothing


      'Попытаться передать поток

      Dim bSuccess As Boolean

      Try

       bSuccess = sendStream(mjdescriptionOfLastSendAttempt, _

        streamOutToIrDA, irDASender, streamInFromFile)

      Catch eUnexpected As System.Exception 'Неожиданная ошибка!!!

       setStatus(SendStatus.Finished_Error) 'Уведомить о сбое


       m_descriptionOfLastSendAttempt = _

        "Unexpected error in IR send loop. " + eUnexpected.Message


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

       'Освободить все распределенные нами ранее ресурсы

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

       If Not (streamOutToIrDA Is Nothing) Then

        Try

         streamOutToIrDA.Close()

        Catch

         'Поглотить любую ошибку

        End Try

        streamOutToIrDA = Nothing

       End If


       If Not (streamInFromFile Is Nothing) Then

        Try

         streamInFromFile.Close()

        Catch

         'Поглотить любую ошибку

        End Try

        streamInFromFile = Nothing

       End If


       If Not (irDASender Is Nothing) Then

        Try

         irDASender.Close()

        Catch

         'Поглотить любую ошибку

        End Try

        irDASender = Nothing

       End If

       Return 'Выход

      End Try


      'Проверить успешность выполнения

      If (bSuccess = True) Then

       m_descriptionOfLastSendAttempt = "Success!"

       setStatus(SendStatus.Finished Successfully)

       Return

      End If


      'Проверить, не была ли операция отменена пользователем

      If (m_wasSenderStopped = True) Then

       m_descriptionOfLastSendAttempt = "User Aborted."

       setStatus(SendStatus.Finished_Aborted)

       Return

      End If


      'В противном случае... Нам пока не удалось обнаружить сервер IrDA,

      'имя которого совпадает с именем службы. Мы продолжим выполнение цикла

      'и попытаемся найти сервер.

     End While

     'Мы никогда не попадем в это место программы при выполнении

    End Sub


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

    'Попытаться передать поток ввода-вывода (например, файл) посредством IR

    '[возвращаемое значение]:

    ' true: успешная передача файла

    ' false: файл не был успешно передан

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

    Private Function sendStream(ByRef errorDescription As String, _

     ByRef streamOutToIrDA As System.IO.Stream, _

     ByRef irDASender As System.Net.Sockets.IrDAClient, _

     ByRef streamInFromFile As System.IO.Stream) As Boolean

     errorDescription = ""

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

     'Создание нового клиента IRDA

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

     Try

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

      'Возврат произойдет довольно быстро. Клиент будет выбран

      'и возвращен, если прослушивающие клиенты отсутствуют.

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

      irDASender = _

       New System.Net.Sockets.IrDAClient(m_IrDAServiceName)


      Catch eCreateClient As System.Exception

       'В данном случае могли возникнуть несколько ситуаций:

       '#1: отсутствуют прослушивающие устройства

       '#2: прослушивающее устройство существует, но не реагирует

       ' (может отказаться от разговора)

       errorDescription = eCreateClient.Message

       Return False

      End Try


      'В данном случае могли возникнуть несколько ситуаций:

      '#1: Мы получили соединение от приемного устройства IR

      '#2: IR-запрос был отменен (кто-то вызвал функцию STOP).

      If (m_wasSenderStopped = True) Then

       irDASender.Close()

       irDASender = Nothing

       Return False

      End If


     '==========================================

     'ПЕРЕДАТЬ ДАННЫЕ!

     '==========================================

     'Открыть файл, который мы хотим передать

     streamInFromFile = System.IO.File.OpenRead(m_fileToSend)

     'Открыть сокет IrDA, которому мы хотим передать данные

     streamOutToIrDA = irDASender.GetStream()


     Const BUFFER_SIZE As Integer = 1024

     Dim inBuffer() As Byte

     ReDim inBuffer(BUFFER_SIZE)

     Dim bytesRead As Integer

     Dim iTestAll As Integer

     Dim iTestWrite As Integer

     ' Цикл...

     Do

      'Считать байты из файла

      bytesRead = streamInFromFile.Read(inBuffer, 0, BUFFER_SIZE)

      iTestAll = iTestAll + 1


      'Записать байты в наш выходной поток

      If (bytesRead > 0) Then

       streamOutToIrDA.Write(inBuffer, 0, bytesRead)

       iTestWrite = iTestWrite + 1

      End If


     Loop While (bytesRead > 0)

     'Сбросить выходной поток

     streamOutToIrDA.Flush() 'Закончить запись любых данных

     streamOutToIrDA.Close() 'Закрыть поток

     streamOutToIrDA = Nothing


     'Освободить локальный файл

     streamInFromFile.Close()

     streamOutToIrDA = Nothing


     'Освободить порт IrDA

     irDASender.Close()

     irDASender = Nothing

     'Успешное завершение!!!

     Return True

    End Function

    End Class

    Листинг 15.5. Класс IrDAFileReceive

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

    'Обеспечивает прием файла через IrDA (инфракрасный порт)

    'Этот класс НЕ является реентерабельным и не должен вызываться более

    'чем одной функцией за один раз. Если необходимо иметь несколько

    'сеансов связи через IR, это необходимо делать путем создания

    'нескольких различных экземпляров данного класса.

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

    Public Class IrDAFileReceive


    Private m_wasListenerStopped As Boolean

    Private m_IrDAServiceName As String

    Private m_fileNameForDownload As String

    Private m_errorDurmgTransfer As String

    Private m_irListener As System.Net.Sockets.IrDAListener

    Private m ReceiveStatus As ReceiveStatus


    Public ReadOnly Property ErrorText() As String

     Get

      Return m_errorDuringTransfer

     End Get

    End Property


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

    'Различные состояния приема

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

    Public Enum ReceiveStatus

     NotDone_SettingUp

     NotDone_WaitingForSender

     NotDone_Receiving

     Done_Success

     Done_Aborted

     Done_ErrorOccured

    End Enum


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

    ' Возвращает состояние передачи

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

    Public ReadOnly Property Status() As ReceiveStatus

     Get

      SyncLock (Me)

       Return m_ReceiveStatus

      End SyncLock

     End Get

    End Property


    Private Sub setStatus(ByVal newStatus As ReceiveStatus)

     'Обеспечить многопоточную безопасность для предотвращения

     'параллельного выполнения операций чтения/записи

     SyncLock (Me)

      m_ReceiveStatus = newStatus

     End SyncLock 'end lock

    End Sub


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

    ' (in) filename: желаемое имя для входного файла IR

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

    Public Sub New(ByVal filename As String, ByVal irdaServiceName As String)

     'Имя сокета IrDA, который мы хотим открыть

     m_IrDAServiceName = irdaServiceName

     'Имя файла, в котором мы хотим сохранить полученные данные

     m_fileNameForDownload = filename

    End Sub


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

    'Обеспечивает асинхронный прием файла через IR

    ' (in) filename: имя файла, в который осуществляется запись

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

    Public Sub WaitForIRFileDownloadAsync()

     'Заметьте, что сейчас мы находимся в режиме подготовки

     setStatus(ReceiveStatus.NotDone_SettingUp)

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

     'Создать новый поток

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

     Dim threadEntryPoint As System.Threading.ThreadStart

     threadEntryPoint = _

      New System.Threading.ThreadStart(AddressOf WaitForIRFileDownload)


     Dim newThread As System.Threading.Thread = _

      New System.Threading.Thread(threadEntryPoint)

     'Запустить поток на выполнение

     newThread.Start()

    End Sub


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

    'Открывает порт IR и ожидает загрузки файла

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

    Public Sub WaitForIRFileDownload()

     Dim outputStream As System.IO.Stream

     Dim irdaClient As System.Net.Sockets.IrDAClient

     Dim irStreamIn As System.IO.Stream


     Try

      '=========================================================

      'Задать и загрузить файл!

      '=========================================================

      internal_WaitForIRFileDownload(outputStream, irdaClient, irStreamIn)

     Catch 'Поглотить любые возникающие ошибки

      setStatus(ReceiveStatus.Done_ErrorOccured)

     End Try


     '=============================================

     'Освободить все ресурсы

     '=============================================

     'Закрыть наш входной поток

     If Not (irStreamIn Is Nothing) Then

      Try

       irStreamIn.Close()

      Catch 'Поглотить любые возникающие ошибки

      End Try

     End If

     'Закрытие клиента IrDA

     If Not (irdaClient Is Nothing) Then

      Try

       irdaClient.Close()

      Catch 'Поглотить любые возникающие ошибки

      End Try

     End If

     'Закрыть файл, в который осуществлялась запись

     If Not (outputStream Is Nothing) Then

      Try

       outputStream.Close()

      Catch 'Поглотить любые возникающие ошибки

      End Try

     End If

     'Закрыть прослушивающее устройство, если оно выполняется

     If Not (m_irListener Is Nothing) Then

      'Установить первым, чтобы код, выполняющийся другим потоком,

      'был отменен, если он установлен

      m_wasListenerStopped = True

      Try

       m_irListener.Stop()

      Catch 'Поглотить любые возникающие ошибки

      End Try

      m_irListener = Nothing

     End If

    End Sub


    Private Sub internal_WaitForIRFileDownload( _

     ByRef outputStream As System.IO.Stream, _

     ByRef irdaClient As System.Net.Sockets.IrDAClient, _

     ByRef irStreamIn As System.IO.Stream)

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

     'Открыть входной файл для направления в него потока данных

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

     outputStream = System.IO.File.Open( _

      m_fileNameForDownload, _

      System.IO.FileMode.Create)


     '==========================================

     'ОБНОВЛЕНИЕ СОСТОЯНИЯ

     '==========================================

     setStatus(ReceiveStatus.NotDone_WaitingForSender)


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

     'Открыть прослушивающее устройство

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

     Try

      m_wasListenerStopped = False

      m_irListener = _

       New System.Net.Sockets.IrDAListener(m_IrDAServiceName)

      m_irListener.Start()

     Catch eListener As System.Exception

      m_errorDuringTransfer = "Error creating listener - " + _

       eListener.Message

      GoTo exit_sub_with_error

     End Try

     'Проверить, не поступила ли команда отменить выполнение

     If (m_wasListenerStopped = True) Then

      GoTo exit_sub_with_abort

     End If


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

     'Принять соединение

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

     Try

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

      'Выполнение будет приостановлено здесь до тех пор, пока устройство не

      'начнет передавать информацию, или не будет остановлен объект

      'прослушивания, выполняющийся в другом потоке)

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

      irdaClient = m_irListener.AcceptIrDAClient()

     Catch eClientAccept As System.Exception

      'Если прослушивание остановлено другим потоком, инициировавшим отмену

      'выполнения, будет сгенерировано исключение и управление будет

      'передано сюда.

      If (m_wasListenerStopped = True) Then

       GoTo exit_sub_with_abort

      End If


      'Если прослушивание не было прекращено,

      'то произошло иное исключение. Обработать его.

      m_errorDuringTransfer = "Error accepting connection - " + _

       eClientAccept.Message

      GoTo exit_sub_with_error

     End Try


     'В этом месте возможны два состояния:

     '#1: Мы получили соединение от передающего устройства IR

     '#2: IR-запрос был отменен (кто-то вызвал функцию STOP)

     ' (в этом случае приведенный ниже код сгенерирует исключение)

     'Проверить, не было ли отменено выполнение

     If (m_wasListenerStopped = True) Then

      GoTo exit_sub_with_abort

     End If


     '==========================================

     'ОБНОВЛЕНИЕ СОСТОЯНИЯ

     '==========================================

     setStatus(ReceiveStatus.NotDone_Receiving)


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

     'Открыть принимающий поток

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

     Try

      irStreamIn = irdaClient.GetStream()

     Catch exGetInputStream As System.Exception

      m_errorDuringTransfer = "Error getting input stream - " + _

       exGetInputStream.Message

      GoTo exit_sub_with_error

     End Try


     'Приготовиться к получению данных!

     Const BUFFER_SIZE As Integer = 1024

     Dim inBuffer() As Byte

     ReDim inBuffer(BUFFER_SIZE)

     Dim bytesRead As Integer


     Do

      'Считать байты из порта IR

      bytesRead = irStreamIn.Read(inBuffer, 0, BUFFER_SIZE)

      'Записать байты в наш выходной поток

      If (bytesRead > 0) Then

       outputStream.Write(inBuffer, 0, bytesRead)

      End If

     Loop While (bytesRead > 0)


     outputStream.Flush() 'Закончить запись любых выходных данных


     '==========================================

     'ОБНОВЛЕНИЕ СОСТОЯНИЯ: УСПЕШНО ВЫПОЛНЕНО

     '==========================================

     setStatus(ReceiveStatus.Done_Success)

     Return 'No errors


     '==========================================

     'ОШИБКА.

     '==========================================

    exit_sub_with_abort:

     'ОБНОВЛЕНИЕ СОСТОЯНИЯ: Отменено (но не из-за ошибки)

     setStatus(ReceiveStatus.Done_Aborted)

     Return


    exit_sub_with_error:

     'ОБНОВЛЕНИЕ СОСТОЯНИЯ: ОШИБКА!!!!

     setStatus(ReceiveStatus.Done_ErrorOccured)

     End Sub

    End Class

    Листинг 15.6. Простая Web-служба

    'Этот код следует вставить в класс Service1, содержащийся

    'в файле "Service1.asmx.vb".

    '"[WebMethod]" - это атрибут метаданных, который указывает механизму

    'Web-службы на то, что данный метод должен быть доступным через Web

    <WebMethod()> _

    Public Function AddTwoNumbers(ByVal x As Integer, _

     ByVal у As Integer) As Integer

     Return x + у

    End Function

    Листинг 15.7. Вызовы Web-служб с передачей параметров только явным образом

    Этот код представляет собой всего лишь последовательность вызовов функций. Программистам на VB будет несложно написать его, используя в качестве образца код на С#.

    Листинг 15.8. Вызов Web-служб путем неявной передачи параметров посредством cookie-файлов

    Этот код представляет собой всего лишь последовательность вызовов функций. Программистам на VB будет несложно написать его, используя в качестве образца код на С#.

    Листинг 15.9. Неэффективная организация диалога с Web-службой, в которой используется множество вызовов

    Этот код представляет собой всего лишь последовательность вызовов функций. Программистам на VB будет несложно написать его, используя в качестве образца код на С#.

    Листинг 15.10. Группирование запросов в одном вызове Web-службы

    Этот код представляет собой всего лишь последовательность вызовов функций. Программистам на VB будет несложно написать его, используя в качестве образца код на С#.

    Листинг 15.11. Код для загрузки файла с Web-сервера

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

    'Осуществляет синхронную загрузку файла с Web-сервера

    'и сохраняет его в локальной файловой системе

    '[in] httpWhereFrom: URL-адрес файла

    ' (например, "http://someserver/somefile.jpg")

    '[in] filenameWhereTo: Место, куда необходимо записать файл

    ' (например, "\\localfile.jpg")

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

    Public Sub downloadFileToLocalStore(ByVal httpWhereFrom As _

     String, ByVal filenameWhereTo As String)

     Dim myFileStream As System.IO.FileStream = Nothing

     Dim myHTTPResponseStream As System.IO.Stream = Nothing

     Dim myWebRequest As System.Net.WebRequest = Nothing

     Dim myWebResponse As System.Net.WebResponse = Nothing


     'Если файл, который мы хотим записать, уже существует, удалить его

     If (System.IO.File.Exists(filenameWhereTo) = True) Then

      System.IO.File.Delete(filenameWhereTo)

     End If

     Try

      'Создать Web-запрос

      myWebRequest = _

       System.Net.HttpWebRequest.Create(httpWhereFrom)

      'Получить ответ

      myWebResponse = myWebRequest.GetResponse()

      'Получить поток для ответа

      myHTTPResponseStream = myWebResponse.GetResponseStream()

      'Создать локальный файл, в который необходимо направить поток ответа

      myFileStream = System.IO.File.OpenWrite(filenameWhereTo)


      'Этот размер буфера является настраиваемым

      Const buffer_length As Integer = 4000

      Dim byteBuffer() As Byte

      ReDim byteBuffer(buffer_length)

      Dim bytesIn As Integer


      'Считать файл и направить поток данных в локальный файл

      Do

       'Считать данные

       bytesIn = myHTTPResponseStream.Read(byteBuffer, _

        0, buffer_length)

       'Записать данные

       If (bytesIn <> 0) Then

        myFileStream.Write(byteBuffer, 0, bytesIn)

       End If

      Loop While (bytesIn <> 0)

     Catch myException As Exception 'Сбой при загрузке!

      'Что-то случилось. Освободить ресурс

      attemptCleanup ThrowNoExceptions(myFileStream, _

       myHTTPResponseStream, myWebResponse)

      'Теперь, когда ресурс освобожден, повторно сгенерируем исключение,

      'чтобы сообщить приложению о том, что произошел сбой!

      Throw myException

     End Try


     'Загрузка прошла успешно!


     'Закрыть все ресурсы.

     Try

      'Стандартная процедура закрытия ресурсов.

      myFileStream.Close()

      myFileStream = Nothing


      myHTTPResponseStream.Close()

      myHTTPResponseStream = Nothing


      myWebResponse.Close()

      myWebResponse = Nothing

     Catch myException As Exception 'Сбой в процессе закрытия ресурса!

      'Что-то случилось. Освободить ресурс

      attemptCleanup_ThrowNoExceptions(myFileStream, _

       myHTTPResponseStream, myWebResponse)

      'Теперь, когда ресурс освобожден, повторно сгенерируем исключение,

      'чтобы сообщить приложению о том, что произошел сбой!

      Throw myException

     End Try

     'Успешное выполнение!

    End Sub


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

    'Пытается закрыть и освободить все объекты

    'Перехватывает любое вырабатываемое исключение.

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

    Sub attemptCleanup_ThrowNoExceptions( _

     ByVal myFileStream As System.10.FileStream, _

     ByVal myHTTPResponseStream As System.IO.Stream, _

     ByVal myWebResponse As System.Net.WebResponse)


     If Not (myFileStream Is Nothing) Then

      Try

       myFileStream.Сlose()

      Catch 'He выполнять никаких действий.

      End Try

     End If


     If Not (myHTTPResponseStream Is Nothing) Then

      Try

       myHTTPResponseStream.Close()

      Catch 'He выполнять никаких действий.

      End Try

     End If


     If Not (myWebResponse Is Nothing) Then

     Try

      myWebResponse.Close()

     Catch 'He выполнять никаких действий.

     End Try

    End If

    End Sub







     


    Главная | В избранное | Наш E-MAIL | Добавить материал | Нашёл ошибку | Наверх