3D-Wellen - von Triton

Dieses Programm stellt 5 verschiedene Wellentypen dar, die in einer isometrischen 3D-Ansicht gezeichnet werden. Kann man einfach um eigene Kreationen erweitern.

;** 3D-Wellen, 28.03.2006 by Triton ;** am 11.02.2008 um Welle5 erweitert ;** http://www.silizium-net.de Graphics 1280,1024,32,1 SetBuffer BackBuffer() Const sizex = 50 Const sizey = 50 Global zoom=10 Global originx = GraphicsWidth()/2-sizex*zoom Global originy = GraphicsHeight()/2 Global lambdax=16 Global lambday=16 Global amp=10 Global fpsrate,loops, fpstime time1 = MilliSecs() Dim werte#(sizex,sizeY) ClsColor 64,64,64 a=1 While Not KeyDown(1) n#=n+5 If KeyDown(59) Then a=1 If KeyDown(60) Then a=2 If KeyDown(61) Then a=3 If KeyDown(62) Then a=4 If KeyDown(63) Then a=5 If a = 1 Then wellen1(n,255) If a = 2 Then wellen2(n,255) If a = 3 Then wellen3(n,255) If a = 4 Then wellen4(n,255) If a = 5 Then wellen5(n,255) Text 10, 10, fps()+" FPS F1-F5 für Wellentypen. Aktiv: Welle "+a Flip 0 Cls Wend WaitKey ;--- Function wellen1(n#,f) For x = 0 To sizex For y = 0 To sizey c#=Sin(x*lambdax-n)*amp-Cos(x*lambdax-n)*amp werte(x,y)=c+amp+amp xneu = x+y yneu = (y-x)/2 ;Color f,f,f ;Oval xneu*zoom+originx,yneu*zoom+originy+c,5,3 LockBuffer BackBuffer() WritePixelFast xneu*zoom+originx,yneu*zoom+originy+c,255*$1000000 + 255*$10000 + 255*$100 + 255 UnlockBuffer BackBuffer() Next Next End Function ;--- Function wellen2(n#,f) For x = 0 To sizex For y = 0 To sizey c#=Sin(x*lambdax-n)*amp+Sin(y*lambday+(2*n))*amp werte(x,y)=c+amp+amp xneu = x+y yneu = (y-x)/2 Color f,f,f ;Oval xneu*zoom+originx,yneu*zoom+originy+c,5,3 LockBuffer BackBuffer() WritePixelFast xneu*zoom+originx,yneu*zoom+originy+c,255*$1000000 + 255*$10000 + 255*$100 + 255 UnlockBuffer BackBuffer() Next Next End Function ;--- Function wellen3(n#,f) For x = 0 To sizex For y = 0 To sizey c#=Sin(x*lambdax-n)*amp+Cos(y*lambday-(2*n))*2*amp werte(x,y)=c+amp+amp xneu = x+y yneu = (y-x)/2 Color f,f,f ;Oval xneu*zoom+originx,yneu*zoom+originy+c,5,3 LockBuffer BackBuffer() WritePixelFast xneu*zoom+originx,yneu*zoom+originy+c,255*$1000000 + 255*$10000 + 255*$100 + 255 UnlockBuffer BackBuffer() Next Next End Function ;--- Function wellen4(n#,f) For x = 0 To sizex For y = 0 To sizey xneu = x+y yneu = (y-x)/2 abstand# = Sqr((xneu*xneu)+(yneu*yneu))-n#/amp c# = Sin(abstand#*amp*2)*amp*2 ;Color f,f,f ;Oval xneu*zoom+originx,yneu*zoom+originy+c,5,3 LockBuffer BackBuffer() WritePixelFast xneu*zoom+originx,yneu*zoom+originy+c,255*$1000000 + 255*$10000 + 255*$100 + 255 UnlockBuffer BackBuffer() Next Next End Function ;--- Function wellen5(n#,f) For x = 0 To sizex For y = 0 To sizey xneu = x+y yneu = (y-x)/2 lx = (sizex/2)-x ly = (sizey/2)-y abstand# = Sqr((lx*lx)+(ly*ly))-n#/amp c# = Sin(abstand#*amp*2)*amp*2 Color f,f,f ;Oval xneu*zoom+originx,yneu*zoom+originy+c,5,3 LockBuffer BackBuffer() WritePixelFast xneu*zoom+originx,yneu*zoom+originy+c,255*$1000000 + 255*$10000 + 255*$100 + 255 UnlockBuffer BackBuffer() Next Next End Function ;--- Function fps() loops = loops+1 If MilliSecs() - fpstime > 1000 Then fpsrate = loops loops = 0 fpstime = MilliSecs() End If Return fpsrate End Function