'遥か彼方 ' Sets the graphics method GDI ' 描画方法を GDI に設定 SetEnviron("fbgfx=GDI") Const g As Single = 9.80665 Const g2 As Single = g * 2.0 Const gd2 As Single = g * 0.5 Const pi As Single = 3.141592654 Const pi2 As Single = pi * 2.0 Const onedegree As Single = pi/180.0 Const max_particles As Integer = 100000 Const last_particle As Integer = max_particles - 1 Type PARTICLE bt As Double 'birth time scrx As Integer scry As Integer posx As Integer posy As Integer v0 As Single 'speed at time 0 a As Single col As Integer End Type Dim Shared particles(max_particles) As PARTICLE Sub init_particle(ByVal i As Integer,ByVal t As Double) Static w As Single Dim As Single rc,gc,bc rc=Cos(w)*0.5+0.5 gc=Cos(w*1.25)*0.5+0.5 bc=Cos(w*1.5)*0.5+0.5 With particles(i) .posx=Int(Cos(w)*100) '.posy=int(sin(w)*240) .bt = t .v0 = Sin(w)*80 .a = Cos(w)*pi+pi2*Rnd .col=RGB(255*rc,255*gc,255*bc) End With w=w+(1.0/max_particles) End Sub Sub update_particles(ByVal t As Double) Dim As Single s,vs Dim i As Integer For i=0 To last_particle With particles(i) s=(t - .bt):vs=.v0*s .scrx=320 +.posx + Int(vs*Cos(.a)) .scry=240 -(.posy + Int(vs*Sin(.a)-gd2*(s*s))) End With Next End Sub Sub render_particles(ByVal t As Double) Dim i As Integer Dim pageptr As UInteger Ptr ScreenLock pageptr=ScreenPtr For i =0 To last_particle With particles(i) If .scry>479 Or .scrx<0 Or .scrx>639 Then init_particle i,t ElseIf .scry>-1 Then pageptr[.scrx+.scry*640]=.col End If End With Next ScreenUnlock End Sub '''main Dim As Integer page,index Dim As Double starttime,curtime,nowtime Dim As Single x,y starttime=Timer For index=0 To last_particle init_particle index,starttime Next ScreenRes 640,480,32,2 '''loop While InKey="" ScreenSet page,page Xor 1:page = page Xor 1 nowtime=Timer Cls update_particles nowtime render_particles nowtime Wend End