• Главная
• В избранное
• Наш E-MAIL
• Добавить материал
• Нашёл ошибку
• Вниз

Споры между разработчиками программ на языках 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#, чтобы решить для себя, какой из них выбрать, сделать это не составит труда. Удачного программирования!

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

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

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

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

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

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

'Код, обрабатывающий событие щелчка на кнопке 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

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

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

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

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

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

'Примечание. В этом примере используется класс 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

'Весь этот код должен находиться внутри класса 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

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

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 'Конец класса

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

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

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

'Примечание #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

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

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

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

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

'Для активизации контроля запуска событий:

' #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