НОУ ИНТУИТ | Основы офисного программирования и документы Word. Лекция 6: Офисное программирование. Специфика и примеры

Опубликован: 13.09.2006 | Уровень: для всех | Доступ: платный | ВУЗ: Тверской государственный университет

Как посадить пассажира в лодку одним щелчком

Рассмотрим вначале самый простой способ посадки пассажира в лодку. Щелчок левой кнопки мыши на видимом объекте образе одного из наших героев будет перемещать его (образ) в лодку. При этом, естественно, для того, чтобы перемещение было допустимым, нужно чтобы герой и лодка находились на одном берегу. Программно перемещение объекта в лодку делается чрезвычайно просто, для этого достаточно изменить свойства Top и Left, дав им новые значения, зависящие от значения этих свойств объекта Boat. Приведем соответствующие обработчики события Click для каждого из героев игры:

Private Sub Man_Click()
	ManInBoat
	'Call IntoBoat(Me.Man, StateOfMan)
	
End Sub

Private Sub Wolf_Click()
	WolfInBoat
	'Call IntoBoat(Me.Wolf, StateOfWolf)
End Sub

Private Sub Goat_Click()
	GoatInBoat
	'Call IntoBoat(Me.Goat, StateOfGoat)
	
End Sub

Private Sub Cabbage_Click()
	CabbageInBoat
	'Call IntoBoat(Me.Cabbage, StateOfCabbage)
	
End Sub

Листинг 6.4.

Обработчики событий, как я и говорил ранее, очень простые, они вызывают соответствующую процедуру обработки события из стандартного модуля. Я реализовал две стратегии обработки, поэтому в теле обработчика предусмотрен вызов двух различных процедур. Один из этих вызовов закомментирован. Вот тексты процедур, соответствующие действующим (не закомментированным) вызовам:

Public Sub ManInBoat()
	'Посадка пассажиров в лодку
	If StateOfMan = StateOfBoat Then 'лодка и пассажир на одном берегу
		StateOfMan = "InBoat" 'изменяем состояние
		With WGCForm
			'Меняя координаты объекта, перемещаем его в лодку
			.Man.Top = .Boat.Top - 30
			.Man.Left = .Boat.Left + 25
			'увеличиваем число пассажиров
			CountInBoat = CountInBoat + 1
		End With
		TestingState 'Проверка корректности нового состояния
	End If
End Sub

Public Sub WolfInBoat()
	'Посадка пассажиров в лодку
	If StateOfWolf = StateOfBoat Then 'лодка и пассажир на одном берегу
		StateOfWolf = "InBoat" 'изменяем состояние
		With WGCForm
			'Меняя координаты объекта, перемещаем его в лодку
			.Wolf.Top = .Boat.Top - 5
			.Wolf.Left = .Boat.Left + 50
			'увеличиваем число пассажиров
			CountInBoat = CountInBoat + 1
		End With
		TestingState 'Проверка корректности нового состояния
	End If
End Sub

Public Sub GoatInBoat()
	'Посадка пассажиров в лодку
	If StateOfGoat = StateOfBoat Then 'лодка и пассажир на одном берегу
		StateOfGoat = "InBoat" 'изменяем состояние
		With WGCForm
			'Меняя координаты объекта, перемещаем его в лодку
			.Goat.Top = .Boat.Top - 20
			.Goat.Left = .Boat.Left + 100
			'увеличиваем число пассажиров
			CountInBoat = CountInBoat + 1
		End With
		TestingState 'Проверка корректности нового состояния
	End If
End Sub

Public Sub CabbageInBoat()
	'Посадка пассажиров в лодку
	If StateOfCabbage = StateOfBoat Then 'лодка и пассажир на одном берегу
		StateOfCabbage = "InBoat" 'изменяем состояние
		With WGCForm
			'Меняя координаты объекта, перемещаем его в лодку
			.Cabbage.Top = .Boat.Top + 5
			.Cabbage.Left = .Boat.Left + 5
			'увеличиваем число пассажиров
			CountInBoat = CountInBoat + 1
		End With
		TestingState 'Проверка корректности нового состояния
	End If
End Sub

Листинг 6.5.

Я написал четыре почти одинаковые процедуры для размещения каждого из героев в лодке. Каждому из них отведено постоянное место в лодке и координаты подобраны так, чтобы изображение казалось бы более правдоподобным. Однако с программистской точки зрения это решение может показаться не самым удачным, в особенности при большом числе объектов. Поэтому я приведу и второй вариант, когда размещение любого из объектов выполняется одной и той же процедурой, имеющей в этом случае два параметра - видимый образ объекта и его состояние:

Public Sub IntoBoat(Im As Image, ByRef St As String)

 'Посадка пассажиров в лодку
	If St = StateOfBoat Then 'лодка и пассажир на одном берегу
		St = "InBoat" 'изменяем состояние
		With WGCForm
			'Меняя координаты объекта, перемещаем его в лодку
			Im.Left = .Boat.Left + 5 + CountInBoat * 50
			Im.Top = .Boat.Top - CountInBoat * 30
			'увеличиваем число пассажиров
			CountInBoat = CountInBoat + 1
		End With
		TestingState 'Проверка корректности нового состояния
	End If
End Sub

Листинг 6.6.

Заметьте, теперь координаты, которые получает размещаемый объект, зависят не только от расположения лодки, но и от числа пассажиров в ней. Обращение к этой процедуре в обработчике событий закомментировано. При желании можно пользоваться любым из двух приведенных вариантов.

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

Для ребенка, играющего в эту игру, вряд ли на первых порах будет понятно, почему щелчок по объекту приводит к его перемещению в лодку. Интуитивно, более разумным действием, приводящим к посадке объекта в лодку, было бы прямое перетаскивание объекта в лодку из его текущего положения на берегу. Реализацией такого способа перемещения объекта мы сейчас и займемся. При этом мы не будем тащить сам объект, хотя и это не трудно было бы сделать, а используем технику, основанную на специальном объекте DataObject, входящем в состав библиотеки MSForms. Эта техника хороша тем, что она позволяет опустить перетаскиваемый объект точно в лодку. Всякая попытка опустить объект где-либо в другом месте приведет к неуспеху операции перетаскивания. Момент, когда цель перетаскивания достигнута, и можно отпустить нажатую до этого кнопку мыши, определяется тем, что изменяется внешний вид курсора (появляется значок "+"), что и позволяет точно опустить объект в нужное место. Реализацию этого довольно сложного сп особа перетаскивания обеспечивают обработчики трех событий. Первое из этих событий связано с самим перетаскиваемым объектом. В тот момент, когда над объектом нажимается левая кнопка мыши с целью начать его перетаскивать или копировать в точку назначения, возникает событие "MouseMove". В обработчике этого события и следует создать новый объект класса DataObject, определить некоторые его свойства и вызвать метод StartDrag. Этот метод работает совсем не так, как большинство обычных методов. Его действие оканчивается в тот момент, когда завершится операция перетаскивания. В качестве результата метод возвращает 0, если операция закончилась неуспехом, и ненулевое значение в противном случае. Заметьте, что во время перетаскивания, то есть еще до того, как StartDrag завершит работу, будут возникать другие события и, следовательно, будут работать другие обработчики событий. Два таких события будут возникать, когда перетаскиваемый объект достигает точки назначения, точнее, области назначения. В этот момент у целевого объекта возникает событие BeforeDragOver. Обработчик этого события изменяет внешний вид курсора, что является сигналом достижения цели назначения и позволяет отпустить нажатую кнопку мыши. Обработчик второго события у целевого объекта BeforeDropOrPaste и реализует операцию опускания объекта. Если все завершится благополучно, то успехом заканчивает свою работу и метод StartDrag, которому возвращается управление. Подробнее обо всех деталях работы с этим объектом можно прочитать в моей книге, ссылка на соответствующее место в которой была уже сделана. После всех этих пояснений можно привести и обработчики соответствующих событий, реализующих операции по перетаскиванию объектов в лодку:

Private Sub Man_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	Dim Effect As Integer
	'MyDataObject используется при перетаскивании объектов
	Dim MyDataObject As DataObject
	
	If Button = 1 Then
		Set MyDataObject = New DataObject
		MyDataObject.SetText "Man"
		Effect = MyDataObject.StartDrag
		If Effect = 0 Then 'перетаскиваемый объект не достиг цели
			'Сообщение о неуспехе
			MsgBox Prompt:=Mes1 + vbCrLf + Mes7 + Mes8 _
			+ vbCrLf + Mes12, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		End If
	End If
End Sub
Private Sub Wolf_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	Dim Effect As Integer
	'MyDataObject используется при перетаскивании объектов
	Dim MyDataObject As DataObject

	If Button = 1 Then
		Set MyDataObject = New DataObject
		MyDataObject.SetText "Wolf"
		Effect = MyDataObject.StartDrag
	If Effect = 0 Then 'перетаскиваемый объект не достиг цели
			'Сообщение о неуспехе
			MsgBox Prompt:=Mes1 + vbCrLf + Mes7 + Mes9 _
			+ vbCrLf + Mes12, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		End If
	End If
End Sub
Private Sub Goat_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	
	Dim Effect As Integer
	'MyDataObject используется при перетаскивании объектов
	Dim MyDataObject As DataObject

	If Button = 1 Then
		Set MyDataObject = New DataObject
		MyDataObject.SetText "Goat"
		Effect = MyDataObject.StartDrag
		If Effect = 0 Then 'перетаскиваемый объект не достиг цели
			'Сообщение о неуспехе
			MsgBox Prompt:=Mes1 + vbCrLf + Mes7 + Mes10 _
			+ vbCrLf + Mes12, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		End If
	End If
End Sub
Private Sub Cabbage_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	Dim Effect As Integer
	'MyDataObject используется при перетаскивании объектов
	Dim MyDataObject As DataObject

	If Button = 1 Then
		Set MyDataObject = New DataObject
		MyDataObject.SetText "Cabbage"
		Effect = MyDataObject.StartDrag
		If Effect = 0 Then 'перетаскиваемый объект не достиг цели
			'Сообщение о неуспехе
			MsgBox Prompt:=Mes1 + vbCrLf + Mes7 + Mes11 _
			+ vbCrLf + Mes12, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		End If
	End If
End Sub

Листинг 6.7.

Заметьте, для четырех перемещаемых объектов: человека, волка, козы и капусты написаны четыре обработчика события MouseMove. Каждый из них создает свой объект DataObject, запоминает в его свойстве Text название перемещаемого объекта и запускает метод StartDrag. Но цель у всех этих объектов одна - лодка. У объекта Boat два обработчика событий, вне зависимости от числа пассажиров лодки. Обработчик события BeforeDragOver для всех перемещаемых объектов один и тот же, поскольку его задача изменить вид курсора при попадании перемещаемого объекта в область назначения. Обработчик события BeforeDropOrPaste более сложный. Он должен произвести разбор случаев и определить, какой именно объект прибыл в точку назначения и соответствующим образом расположить его в лодке. Анализ свойства Text, объекта DataObject, переданного в качестве параметра обработчику событий, позволяет провести разбор случаев. После этих предварительных замечаний приведем тексты самих обработчиков:

Private Sub Boat_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
	'Достигнута цель перетаскиваемого объекта.Изменяется внешний вид курсора.
	Cancel = True
	Effect = fmDropEffectCopy
End Sub

Private Sub Boat_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
	'Достигнута цель перетаскиваемого объекта.Объект можно опустить в точку назначения.
	Cancel = True
	Effect = fmDropEffectCopy
	'Разбор случае. Анализ прибывшего объекта и вызов процедуры его размещения в лодке
	If Data.GetText = "Man" Then
		ManInBoat
	ElseIf Data.GetText = "Wolf" Then
		WolfInBoat
	ElseIf Data.GetText = "Goat" Then
		GoatInBoat
	Else: CabbageInBoat
	End If
End Sub

Листинг 6.8.

На этом закончим рассмотрение задачи посадки пассажиров в лодку и перейдем к рассмотрению следующей задачи.

Переправа. Берег Левый - Берег Правый

По ходу игры лодка с пассажирами должна переезжать с одного берега на другой. И опять-таки, я реализовал два варианта интерфейса. В первом, более простом варианте щелчок по лодке, заставляет ее переправиться на другой берег, если соблюдены все условия игры, в лодке есть человек и никто никого не кушает. В обработчике события Click объекта Boat вызывается соответствующая процедура, которая требуемым образом изменяет координаты, как самой лодки, так и находящихся в ней пассажиров. Вот текст обработчика и вызываемой в нем процедуры Crossing:

Private Sub Boat_Click()
	'Переправа на другой берег
	Crossing
End Sub

Public Sub Crossing()
	'Переправа на другой берег
	'Есть ли человек в лодке
	With WGCForm
	 
		If StateOfMan = "InBoat" Then
			If StateOfBoat = "LeftBank" Then
				'Едем на правый берег
				'Меняем координаты лодки и кормчего
				StateOfBoat = "RightBank"
				.Boat.Left = .Boat.Left + WidthOfRiver
				.Man.Left = .Man.Left + WidthOfRiver
				'Анализ присутствующих пассажиров
				If StateOfWolf = "InBoat" Then
					.Wolf.Left = .Wolf.Left + WidthOfRiver
				End If
				If StateOfGoat = "InBoat" Then
					.Goat.Left = .Goat.Left + WidthOfRiver
				End If
				If StateOfCabbage = "InBoat" Then
					.Cabbage.Left = .Cabbage.Left + WidthOfRiver
				End If
			Else
				'Едем на левый берег
				 'Меняем координаты лодки и кормчего
				 StateOfBoat = "LeftBank"
				.Boat.Left = .Boat.Left - WidthOfRiver
				.Man.Left = .Man.Left - WidthOfRiver
				'Анализ присутствующих пассажиров
				If StateOfWolf = "InBoat" Then
					.Wolf.Left = .Wolf.Left - WidthOfRiver
				End If
				If StateOfGoat = "InBoat" Then
					.Goat.Left = .Goat.Left - WidthOfRiver
				End If
				If StateOfCabbage = "InBoat" Then
					.Cabbage.Left = .Cabbage.Left - WidthOfRiver
				End If
			End If
		End If
		
	End With
End Sub

Листинг 6.9.

Более интересна техника перетаскивания лодки с берега на берега. Ранее лодка служила целью назначения перетаскиваемых в нее объектов. Теперь она сама станет перемещаемым объектом и, следовательно, для нее мы создадим обработчик события MouseMove, в котором и вызовем метод StartDrag объекта DataObject. В роли целевых будут выступать в зависимости от ситуации объекты LeftBank и RightBank, для каждого из которых будут написаны по два обработчика событий BeforeDragOver и BeforeDropOrPaste. О них позже пойдет более подробный разговор, а сейчас для лодки приведем текст обработчика события MouseMove, запускающего процесс перемещения:

Private Sub Boat_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Dim Effect As Integer
	'MyDataObject используется при перетаскивании объектов
	Dim MyDataObject As DataObject

	If Button = 1 Then
		Set MyDataObject = New DataObject
		MyDataObject.SetText "Boat" 'Запоминаем имя перемещаемого объекта
		Effect = MyDataObject.StartDrag 'запускаем процесс перемещения
		If Effect = 0 Then перетаскиваемый объект не достиг цели
			'Сообщение о неуспехе
			MsgBox Prompt:=Mes1 + vbCrLf + Mes7 + Mes15 _
			+ vbCrLf + Mes12, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		End If
	End If
End Sub

Листинг 6.10.

Как видите, ничего нового в этом обработчике нет в сравнении с уже рассмотренными подобными обработчиками, все они построены по одной схеме. Больший интерес представляет обработка событий для целевых объектов, представляющих левый или правый берег, куда причаливает лодка. Но эти объекты являются целевыми и при высадке пассажиров на берег, когда они высаживаются (перетаскиванием) на берег. Поэтому отложим их описание до следующего параграфа, где будет рассмотрена высадка пассажиров из лодки.

Высадка пассажиров из лодки на берег

Эта операция представляет процесс, обратный процессу посадки в лодку. Опять-таки, я реализовал две возможных стратегии. После того, как лодка причалила к берегу, одним щелчком по берегу можно высадить всех пассажиров из лодки. Вторая стратегия соответствует интуитивному поведению, когда пассажиров, не обязательно всех, можно высаживать по одному путем простого их перетаскивания на берег. Рассмотрим вначале более простую стратегию, реализованную в обработчиках событий Click для двух объектов LeftBank и RightBank:

Private Sub LeftBank_Click()
	'Все пассажиры из лодки высаживаются на левый берег
	ONLeftBank ("All")
End Sub
Private Sub RightBank_Click()
	'Все пассажиры из лодки высаживаются на правый берег
	OnRightBank ("All")
End Sub

Листинг 6.11.

Сами обработчики являются простыми, поскольку вся обработка спрятана в вызываемых процедурах стандартного модуля, которым в качестве параметра передается слово "All", указывающее на необходимость высадки на берег всех пассажиров. Эта же процедура будет использоваться и во второй стратегии, когда пассажиры высаживаются по одному. Давайте перейдем к ее рассмотрению. Для самих перетаскиваемых объектов обработчики события MouseMove, запускающие перетаскивание объекта, уже написаны. Мы рассматривали их, когда речь шла о перемещении объектов с берега в лодку. Теперь изменилась цель перетаскивания из лодки на берег, левый или правый в зависимости от того, куда причалила лодка. Поэтому нам надо лишь рассмотреть обработчики событий для целевых объектов LeftBank и RightBank. Напомним, эти объекты являются целевыми и при причаливании лодки к берегу. Вот тексты этих обработчиков:

Private Sub LeftBank_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
	'Достигнута цель перетаскиваемого объекта.Изменяется внешний вид курсора.
	Cancel = True
	Effect = fmDropEffectCopy
End Sub

Private Sub LeftBank_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
	'Достигнута цель перетаскиваемого объекта.Объект можно опустить в точку назначения.
	Cancel = True
	Effect = fmDropEffectCopy
	'Пассажир высаживается на левый берег или лодка причаливает к нему
	ONLeftBank (Data.GetText)
End Sub
Private Sub RightBank_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
	'Достигнута цель перетаскиваемого объекта.Изменяется внешний вид курсора.
	Cancel = True
	Effect = fmDropEffectCopy

End Sub

Private Sub RightBank_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
	'Достигнута цель перетаскиваемого объекта.Объект можно опустить в точку назначения.
Cancel = True
	Effect = fmDropEffectCopy
	'Пассажир высаживается на правый берег или лодка причаливает к нему
	OnRightBank (Data.GetText)
End Sub

Листинг 6.12.

Все программистские сложности спрятаны в процедурах стандартного модуля OnLeftBank и OnRightBank. Именно в них предусмотрен разбор случаев, то ли лодка причалила к берегу, то ли человек, то ли какой-либо из его спутников высаживается на берег. Здесь же предусмотрена проверка того, на какой берег в данный момент возможна высадка или причаливание.

Public Sub ONLeftBank(Who As String)
	If StateOfBoat = "LeftBank" Then
	'пассажиров из лодки можно высадить на левый берег
	With WGCForm
	If ((Who = "All") Or (Who = "Man")) And (StateOfMan = "InBoat") Then
		'можно высадить человека
		.Man.Top = .LeftBank.Top + 15: .Man.Left = .LeftBank.Left + 10
		StateOfMan = "LeftBank"
		CountInBoat = CountInBoat - 1
	End If
	If ((Who = "All") Or (Who = "Wolf")) And (StateOfWolf = "InBoat") Then
		'можно высадить волка
		.Wolf.Top = .LeftBank.Top + 80: .Wolf.Left = .LeftBank.Left + 10
		StateOfWolf = "LeftBank"
		CountInBoat = CountInBoat - 1
	End If
	If ((Who = "All") Or (Who = "Goat")) And (StateOfGoat = "InBoat") Then
		'можно высадить козу
		.Goat.Top = .LeftBank.Top + 140: .Goat.Left = .LeftBank.Left + 10
		StateOfGoat = "LeftBank"
		CountInBoat = CountInBoat - 1
	End If
	If ((Who = "All") Or (Who = "Cabbage")) And (StateOfCabbage = "InBoat") Then
		'можно высадить капусту
		.Cabbage.Top = .LeftBank.Top + 200: .Cabbage.Left = .LeftBank.Left + 10
		StateOfCabbage = "LeftBank"
		CountInBoat = CountInBoat - 1
	End If
	End With
	ElseIf (Who = "Boat") Then
		'Лодка переезжает на левый берег
		Crossing
	End If
	TestingState
End Sub

Public Sub OnRightBank(Who As String)
	If StateOfBoat = "RightBank" Then
	'пассажиров из лодки можно высадить на правый берег
	With WGCForm
	If ((Who = "All") Or (Who = "Man")) And (StateOfMan = "InBoat") Then
		'можно высадить человека
		.Man.Top = .RightBank.Top + 15: .Man.Left = .RightBank.Left + 10
		StateOfMan = "RightBank"
		CountInBoat = CountInBoat - 1
	End If
	If ((Who = "All") Or (Who = "Wolf")) And (StateOfWolf = "InBoat") Then
		'можно высадить волка
		.Wolf.Top = .RightBank.Top + 80: .Wolf.Left = .RightBank.Left + 10
		StateOfWolf = "RightBank"
		CountInBoat = CountInBoat - 1
	End If
	If ((Who = "All") Or (Who = "Goat")) And (StateOfGoat = "InBoat") Then
		'можно высадить козу
		.Goat.Top = .RightBank.Top + 140: .Goat.Left = .RightBank.Left + 10
		StateOfGoat = "RightBank"
		CountInBoat = CountInBoat - 1
	End If
	If ((Who = "All") Or (Who = "Cabbage")) And (StateOfCabbage = "InBoat") Then
		'можно высадить капусту
		.Cabbage.Top = .RightBank.Top + 200: .Cabbage.Left = .RightBank.Left + 10
		StateOfCabbage = "RightBank"
		CountInBoat = CountInBoat - 1
	End If
	End With
	ElseIf (Who = "Boat") Then
	'Лодка переезжает на правый берег
	Crossing
	End If
	TestingState
End Sub

Листинг 6.13.

Тестирование состояний и организация диалога

Нам осталось рассмотреть еще пару важных моментов, завершающих реализацию игры. Всякий раз, когда объекты игры изменяют свое состояние, необходимо проверять, является ли оно допустимым, не может ли съесть волк козу, или коза капусту. Многократно вызываемая по ходу дела процедура TestingState осуществляет все эти проверки:

Public Sub TestingState()
	'Тестирование состояний
	With WGCForm
	'Волк съел козу
	If (StateOfWolf = StateOfGoat) And (StateOfWolf <> StateOfMan) Then
		.Goat.Visible = False
		MsgBox Prompt:=Mes1 + vbCrLf + Mes3, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		InitialStates
	End If
	'Коза съела капусту
	If (StateOfCabbage = StateOfGoat) And (StateOfCabbage <> StateOfMan) Then
		.Cabbage.Visible = False
		MsgBox Prompt:=Mes1 + vbCrLf + Mes4, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		InitialStates
	End If
	'Слишком много пассажиров!
	If (CountInBoat > 2) Then
		If StateOfMan = "InBoat" Then .Man.Visible = False
		If StateOfWolf = "InBoat" Then .Wolf.Visible = False
		If StateOfGoat = "InBoat" Then .Goat.Visible = False
		If StateOfCabbage = "InBoat" Then .Cabbage.Visible = False
		MsgBox Prompt:=Mes1 + vbCrLf + Mes5, Buttons:=vbCritical + vbOKOnly, Title:=Mes13
		InitialStates
	End If
	'Конец игры - Все пассажиры собрались на правом берегу
	If (StateOfMan = "RightBank") And (StateOfWolf = "RightBank") And _
		(StateOfGoat = "RightBank") And (StateOfCabbage = "RightBank") Then
		MsgBox Prompt:=Mes2 + vbCrLf + Mes6, Buttons:=vbExclamation + vbOKOnly, Title:=Mes14
	End If
	End With
End Sub

Листинг 6.14.

При обнаружении критической ситуации, например, когда волк, оставленный без присмотра, съедает козу, образ козы исчезает с игрового поля и выдается соответствующее сообщение о том, что произошло ужасное событие и игра не может быть продолжена. Взгляните, как выглядит эта ситуация:

Рис. 6.2. Одна из критических ситуаций в игре "Волк, Коза и Капуста"

Заметим, что после нажатия кнопки "OK" в окне выдачи сообщения вызывается процедура InitialStates и игра возвращается в начальное состояние. Скажем еще несколько слов об организации диалога. Все константы, используемые в диалоге, собраны в разделе объявлений стандартного модуля WGCModule:

'Константы для организации диалогов
Public Const Mes1 = "Ужасно, нелепо и грустно! "
Public Const Mes2 = "Прекрасно, как славно, отлично! "
Public Const Mes3 = " Волк съел козу! "
Public Const Mes4 = " Коза съела капусту! "
Public Const Mes5 = " Лодка перевернулась, и все утонули! "
Public Const Mes6 = " Вам это удалось! Все переправились!"
Public Const Mes7 = " Не удалось дотащить "
Public Const Mes8 = " Человека! "
Public Const Mes9 = " Волка! "
Public Const Mes10 = " Козу! "
Public Const Mes11 = " Капусту! "
Public Const Mes12 = " Повторите попытку! "
Public Const Mes13 = " Беда!"
Public Const Mes14 = " Радость! "
Public Const Mes15 = " Лодку! "

Листинг 6.15.

Такой подход позволяет при необходимости легко перейти на другой язык диалога, или сделать выбор языка параметром игры. Разумно также, но я не стал этого делать, собрать все диалоги в специальной процедуре Dialogs. Я отказался также от использования объекта Assistant при ведении диалога, хотя он очень подходит для подобных игр. Последнее решение обусловлено тем, что мне хотелось в чистом виде сохранить концепцию документа - обложки, а объект Assistant является специфическим объектом Office 2000. Его использование не позволило бы перенести игру без всяких хлопот в чистый VB.

Завершающий шаг

Игра заканчивается, когда играющему удается перевезти всех путников на правый берег, и по этому случаю выдается радостное сообщение. Вот как оно выглядит:

Рис. 6.3. Окончание игры "Волк, Коза и Капуста"

Чтобы начать игру с начала, достаточно щелкнуть по объекту Shark, который до сих пор никак еще не использовался. В ответ на событие Click вызывается процедура InitialStates:

Private Sub Shark_Click()
	InitialStates
End Sub

Листинг 6.16.

Для того чтобы игра начиналась с открытием документа - обложки, зададим обработку события Open для этого документа:

Private Sub Document_Open()
	WGCForm.Show
End Sub

Листинг 6.17.

На этом я завершаю описание реализации этой игры. Конечно, моя цель состояла не в том, чтобы создать совершенную реализацию данной игры. Реализация игры, скорее побочный продукт моей работы. Я выбрал эту простую игру в качестве хорошего примера, на котором я постарался показать, как создаются документы - обложки, как можно создать и использовать визуальные объекты. Что же касается самой игры, то ее несомненно можно усовершенствовать. Вот несколько возможных направлений работы для тех, кто хотел бы довести эту игру до "товарного" вида:

Улучшить интерфейс игры. В частности, для организации диалогов использовать объект Assistant с подходящей анимацией.
Ввести учет времени на перевоз всех спутников человека.
Усложнить игру за счет введения новых героев. В частности, акула могла бы мешать переправе участников, и нужно было бы, например, брать ружье, чтобы отпугнуть ее.

Рассмотрим еще один вопрос, не связанный напрямую с реализацией игры, но относящиеся к нашей теме.

Дальше >>

Основы офисного программирования и документы Word

Основы офисного программирования и документы Word

Офисное программирование. Специфика и примеры

Как посадить пассажира в лодку одним щелчком

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

Переправа. Берег Левый - Берег Правый

Высадка пассажиров из лодки на берег

Тестирование состояний и организация диалога

Завершающий шаг

Вопросы и ответы

Студенты

Авторизоваться

Основы офисного программирования и документы Word

Основы офисного программирования и документы Word

Офисное программирование. Специфика и примеры

Как посадить пассажира в лодку одним щелчком

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

Переправа. Берег Левый - Берег Правый

Высадка пассажиров из лодки на берег

Тестирование состояний и организация диалога

Завершающий шаг

Вопросы и ответы

Студенты