' Filmtest

Dim i As Integer, y As Integer, x As Integer
Dim kx(14) As Single, ky(14) As Single, kr(14) As Single
Dim Alpha As Single, f As Integer, j As Integer

Function quad(s As Single) As Single
	quad = s * s
End Function

Function FuehrNull(w As Integer, b As Integer)As String
	Dim h As String
	
	h = Str(w)
	FuehrNull = String(b - Len(h), "0") + h
End Function

ScreenRes 320, 240, 4

For i=1 To 500
	' Kreise definieren
	Alpha = 0.001 * CSng(i)
	For j=1 To 14
		kr(j) = 1.0 + 0.15 * CSng(i) + 3.2 * CSng(j) 
		kx(j) = 160.0 + (159.0 - 0.9 * kr(j)) * Cos(Alpha * j)
		ky(j) = 120.0 + (159.0 - 0.9 * kr(j)) * Sin(Alpha * j)
	Next j
	
	For y=0 To 239
		For x=0 To 319
			f = 0
			For j=14 To 1 Step -1
				If quad(CSng(x) - kx(j)) + quad(CSng(y) - ky(j)) < quad(kr(j)) Then
					f = j
				EndIf
			Next j
			PSet (x, y), f
		Next x
	Next y
	BSave "D:\TEMP\FILM\Bild" + FuehrNull(i, 4) + ".bmp", 0
Next i