Тема: 2d сетка
Показать сообщение отдельно
Старый 20.08.2015, 20:30   #23
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: 2d сетка

Ну и в нагрузку облако тегов с определением по ближней полусфере.
time = CreateTimer(60)
Dim CosA#(3600)
Dim SinA#(3600)

For i# = 0 To 3600 Step 0.1
CosA(i)= Cos(i)
SinA(i)= Sin(i)
Next 

Graphics 800,600,32,2
SetBuffer BackBuffer()

numpnt=200
radius =200

Dim x#(numpnt) ,y#(numpnt) ,z#(numpnt) ,name$(numpnt)

c# = 0 : a# = 0 : b# =0 : q#=1 
p# = numpnt * Pi
	For n=1 To numpnt
		f#=ACos(-1+ (n* Pi) / numpnt*q)
		t# = Sqr(p)  *f
		
		x(n) = (radius * Sin(f) * Cos(t)); 
		y(n) = (radius * Sin(f) * Sin(t));
		z(n) = (radius * Cos(f));				
		name(n) = "target_"+Str(n) 		
	Next
While Not KeyHit(1)
Cls 
mx# =MouseX() : my#= MouseY()	

WaitTimer(time)	
	For n=1To numpnt	
	sa#=Sin(a):ca#=Cos(a):sb#=Sin(b):cb#=Cos(b):sc#=Sin(c): cc#=Cos(c)

	xx# = x(n)*cb*cc - y(n)*cb*sc+ z(n)*sb;
	yy# = x(n)*(cc*sa*sb+ca*sc)+y(n)*(ca*cc-sa*sb*sc)- z(n)*(cb*sa);
	zz# =-x(n)*(ca*cc*sb+sa*sc)+y(n)*(cc*sa+ca*sb*sc)+ z(n)*(ca*cb);

	vv = Int(zz/3)

	Color 128+vv,128+vv,128+vv
	If RectsOverlap ((xx+400),(yy+300),StringWidth(name(n) ),StringHeight(name(n) )  ,(mx),(my),1,1) And zz>0
	 Color 0,0,255
	Rect 	400+ xx-4 , 300+ yy ,50,15 ,0
	EndIf 
		Text 400+ xx , 300+ yy, name(n) 
			
		
	
	Next
	

	If b=360 b=0
	b=b+1
	c=b*0.1
Flip 
Wend
FreeTimer(time)
End
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием