[polopok]

Мышью :
левой выделить
правой указать цель

Код сырой ,иногда попадают в одну точку следования
может тормозить ,из-за говнокода

Const wait =0 ,move = 1 ,attack =2 
Dim formX(200) : Dim formY(200)

Global selectionFlag =0 , groupFlag  = 0 , TargetFlag = 0 
Global mx#,my#,oldx# ,oldy# ,group ,sel 
Global bx0, by0, bx1, by1 , middleX# , middleY# ,tx#,ty# 

Type Unit
Field x# ,tx# ,vx# , angl# , distance#
Field y# ,ty# ,vy# ,speed# , size
Field name$
Field group
Field isSelected =0 
Field action =wait ; wait =0 move = 1 attack =2 
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
	this\speed = 5
	this\size = 10
End Function 

Function SelectionMove()
	If MouseDown(2)=True And TargetFlag = 0 Then 
		tx# = MouseX()
		ty# = MouseY()
		
		For Un.Unit = Each Unit	
		If un\isSelected = 1 	
		TargetFlag = 1 
		un\tx#  =tx
		un\ty# = ty
		If sel >1 Then MathMove(un)
		
		d2# = dis( un\x, un\y,un\tx,un\ty)	
		If d2<>0
			un\vx# = (un\tx -un\x)/d2
			un\vy#  =  (un\ty - un\y )/d2	
		EndIf 
		
		un\action = move
		EndIf
		Next
	EndIf 
	If MouseDown(2)=fale And TargetFlag = 1 Then 
		TargetFlag = 0 
	EndIf 	
End Function 

Function MathMove#(this.Unit)
	
	Local position = 0 
	
	;While position = 0
	Repeat 
	For Un2.Unit = Each Unit	
		If un2<>this
		If un2\isSelected = 1
		size2# = (this\size + un2\size) 
			If dis( this\tx, this\ty ,un2\tx , un2\ty)<this\size Then  
			;	position = 0
				p = Rnd (0,7)
				Select p
				Case 0 :this\tx = this\tx -size2
				Case 1 :this\tx = this\tx + size2
				Case 2 :this\ty = this\ty -size2
				Case 3 :this\ty = this\ty +size2
				Case 4 :this\tx = this\tx - size2 : this\ty = this\ty -size2
				Case 5 :this\tx = this\tx+ size2 : this\ty = this\ty -size2
				Case 6 :this\tx = this\tx -size2 : this\ty = this\ty + size2
				Case 7 :this\tx = this\tx +size2 : this\ty = this\ty +size2
				Default :this\tx = this\tx : this\ty = this\ty
				End Select  
			Else  				
				position = 1
			EndIf 
			
		EndIf :EndIf 
	Next 
	Until position = 1;Wend

End Function 

Function MoveUnit(this.Unit)
	this\x = this\x + this\vx*this\speed
	this\y = this\y + this\vy*this\speed
	Line this\x ,this\y, this\tx ,this\ty 
End Function 

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

For Un.Unit = Each Unit		
Selection_Mouse(un)	
	If un\isSelected = 1
	
	Line un\x ,un\y, un\tx ,un\ty 
	EndIf 
	If un\action = move Then 
	If Dis(un\x ,un\y ,  un\tx , un\ty)  <= un\speed+0.1 Then un\action = wait
	MoveUnit(un)
	EndIf 	
	;Text un\x#+12,un\y#+12, un\tx +"  "+ un\ty +"  "+ un\x +"  "+ un\y 
Next 
DrawUnit()


Flip 
Wend
Delete Each Unit
FreeFont cyr
End 



Function Selection_Mouse(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
		this\isSelected = 0
		
		oldx= MouseX()
		oldy= MouseY()
	EndIf
	If MouseDown(1) = False Then selectionFlag = 0 
	If MouseHit (1) And RectsOverlap(mx#,my#,1,1,500,400,40,40) Then NewUnit("sold" , Rnd(600),Rnd(400))	
	If selectionFlag = 1 Then	
		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
	EndIf
	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#)<this\size
		this\isSelected = 1
	EndIf
End Function

Function DrawUnit()
	For Un.Unit = Each Unit
	If un\isSelected = 1 
		Text un\x#,un\y#-18,"S"
	Color 2,200,200	
	Oval middleX#-3 , middleY# -3 , 6 ,6
	Color 255,255,255
		If un\group >-1
			Text un\x#-4,un\y#+8, un\group	
		EndIf
	EndIf 	
	If un\action = move Then Text un\x#+4,un\y#+8,"M"
	If un\action = wait Then Text un\x#+4,un\y#+8,"W"
	
	Rect un\x#-5,un\y#-5,10,10,1 ; Unit
		
	Color 2,200,200
		If selectionFlag = 1	Then Rect bx0, by0, bx1-bx0, by1-by0,0	
	Color 255,255,255
		; -- button --
		Rect 500,400,40,40,0
		; -- info --
		Text 20,20,"mx = "+mx+"  my = "+my+"  oldx = "+oldx+"  oldy = "+oldy+"  group "+group
		Text 20,40,"Selected : "+ sel
	Next
End Function

Function MiddleSelect()
lowX# = 999999
lowY# = 999999
hightX# = 0
hightY# = 0
sel =0
For Un.Unit = Each Unit
	If un\isSelected = 1
	sel = sel +1 
		If un\x <= lowX Then lowX = un\x
		If un\y <= lowY Then lowY = un\y
		If un\x > hightX Then hightX = un\x
		If un\y > hightY Then hightY = un\y
	EndIf 
Next 
middleX = lowX + (hightX-lowX  )/2
middleY = lowY + (hightY-lowY  )/2
End Function