Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > Blitz3D > Полезные функции

Полезные функции Выкладываем полезные функции, чтоб не изобретать велосипед заново...

Ответ
 
Опции темы
Старый 22.11.2013, 23:13   #1
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
группировка юнитов Ctrl + (0 -9)

Часто в различных стратегиях мы группируем юнитов нажатием Ctrl + 1 или Ctrl + 2 , в общем любой цифрой от 0 до 9 , вот и привожу данный код в качестве примера . Конечно код можно( нужно) оптимизировать ,но наглядность в данном случае очевидна.
код:


Global selectionFlag =0 , groupFlag  = 0 ,mx#,my#,oldx# ,oldy# ,group 

Type Unit

Field  x# 
Field y# 
Field name$
Field group
Field isSelected =0 
End Type

Function Dis(X1,Y1, xx,yy)
Return Abs(((xx-X1)*(xx-X1)+(yy-Y1)*(yy-Y1))^0.5)
End Function

Function NewUnit.Unit(name$ , x#, y#  )
	this.Unit = New unit 
	this\x# = x#
	this\y# = y#
	this\name$ = name$ 
	this\group = -1
End Function 

Function SelectionMouse(this.Unit)
		If MouseDown(1) = True And selectionFlag = 0 Then
	selectionFlag = 1
		mx = MouseX()
		my = MouseY()
	EndIf
	If MouseDown(1) = True And selectionFlag = 1 Then
		oldx= MouseX()
		oldy= MouseY()
	EndIf
	If MouseDown(1) = False Then selectionFlag = 0 
	If selectionFlag = 1 Then
	Color 2,200,200
	
	If mx < oldx
		bx0 = mx
		bx1 = oldx
	Else
		bx0 = oldx
		bx1 =mx
	EndIf
	
	If my < oldy
		by0 = my
		by1 = oldy
	Else
		by0 = oldy
		by1 = my
	EndIf
	Line bx0, by0, bx1, by0
	Line bx0, by1, bx1, by1
	Line bx0, by0, bx0, by1
	Line bx1, by0, bx1, by1
	
	Color 255,255,255
	If this\x# > bx0 And this\x# < bx1 And this\y# > by0 And this\y# < by1 
		this\isSelected = 1
	ElseIf Dis(mx,my, this\x#,this\y#)<10
		this\isSelected = 1
	Else 
		this\isSelected = 0
	EndIf
	EndIf
End Function

Function Creating_Groups(this.Unit)
	
	groupFlag = 0
If KeyDown(29) Or KeyDown(157)  Then ;
		
		If KeyDown(2) 
		group = 1
		Else If KeyDown(3) 
		group = 2
		Else If KeyDown(4) 
		group = 3
		Else If KeyDown(5) 
		group = 4
		Else If KeyDown(6) 
		group = 5
		Else If KeyDown(7) 
		group = 6
		Else If KeyDown(8) 
		group = 7
		Else If KeyDown(9) 
		group = 8
		Else If KeyDown(10) 
		group = 9
		Else If KeyDown(11) 
		group = 0
		Else 
		group = -1
		EndIf 
	
	If group > -1 Then groupFlag = 1
	If this\isSelected = 1  And groupFlag = 1 Then  this\group = group 
EndIf 	 

	groupFlag = 0
		If KeyDown(2) 
		group = 1
		Else If KeyDown(3) 
		group = 2
		Else If KeyDown(4) 
		group = 3
		Else If KeyDown(5) 
		group = 4
		Else If KeyDown(6) 
		group = 5
		Else If KeyDown(7) 
		group = 6
		Else If KeyDown(8) 
		group = 7
		Else If KeyDown(9) 
		group = 8
		Else If KeyDown(10) 
		group = 9
		Else If KeyDown(11) 
		group = 0
		Else 
		group = -1
		EndIf 
		
	If group > -1 Then groupFlag = 1
		If groupFlag = 1
			If this\group = group
			 this\isSelected = 1
			Else
			 this\isSelected = 0
			EndIf
		EndIf	



End Function

Graphics 800,600,32,2
SetBuffer BackBuffer()
cyr = LoadFont("ArialCyr",14)
SetFont cyr
For d=0 To 7
NewUnit("sold" , Rnd(800),Rnd(400))
Next
While Not KeyHit(1)
Cls 


For Un.Unit = Each Unit
	SelectionMouse(un)
	Creating_Groups(un)
	If MouseHit (1) And RectsOverlap(mx#,my#,1,1,500,400,40,40) Then NewUnit("sold" , Rnd(800),Rnd(400))	
	
	Rect un\x#,un\y#,10,10,1
	
	If un\isSelected = 1 
	Text un\x#,un\y#-12,"Select"
	If un\group >-1
	Text un\x#,un\y#+12, un\group	
	EndIf
	EndIf
Next 

Text 20,20,"mx = "+mx+"  my = "+my+"  oldx = "+oldx+"  oldy = "+oldy+"  group "+group
Rect 400,500,40,40,0
Flip 
Wend
Delete Each Unit
FreeFont cyr
End
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 20:19.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com