Graphics 800,600

Global mausx,mausy                         ;die Mausposition

Data 78, 31, 14, 113, 58, 89, 51, 101      ;Hot-Bits werte
Dim geszaehl(8)
For i=1 To 8
	Read geszaehl(i)                       ;Alle Werte im Array speichern
Next
        

Global mitte_x = 500,mitte_y=300,radius=200            

Dim sinus#(360)
Dim cosinus#(360)

For i = 0 To 360                         ;Die Sinuswerte werden gespeichert, anstatt sie jedesmal auszurechnen (Speedvorteil)
	sinus(i) = Sin(i)
	cosinus(i) = Cos(i)
Next

Dim AlineTable(64)                       ;Für Antialiasing
InitAlineTable


;Die Bilder für die Scrollroutine erstellen
Global scrolldownpic=CreateImage(20,10)
SetBuffer ImageBuffer(scrolldownpic)
Text 0,0,"\/"
Global scrolluppic=CreateImage(20,10)
SetBuffer ImageBuffer(scrolluppic)
Text 0,0,"/\"
Global mauspic=CreateImage(20,20)
SetBuffer ImageBuffer(mauspic)
Color 255,255,0
Text 0,0,"+"



;Hauptschleife--------------------------------------------------------------------------------------
SetBuffer BackBuffer()
Repeat 
Cls 
;mauskoordinaten
mausx = MouseX() 
mausy = MouseY()



gesamtwert = 0
For i = 1 To 8
	gesamtwert = gesamtwert + geszaehl(i)   ;Alle Werte zusammenzählen
Next 

einzelwert# = Float 360/gesamtwert          ;der einzelwert sagt aus, wieviel Grad pro Winkel genommen werden. Bei 500 Werten werden 0.72° pro Wert genommen

i= 1
wert#  = geszaehl(i) * einzelwert           ;Für den ersten Wert wird errechnet, wieviel Platz (in °) er im Diagramm braucht

For winkel = 0 To 360 
	If winkel =Ceil(wert) Or winkel = Floor(wert)
		antiLine(  Sinus(winkel) * radius +mitte_x,Cosinus(winkel) * radius + mitte_y,mitte_x,mitte_y)
		i=i+1
		If i = 9 Then i = 1
		wert =Float wert+ geszaehl(i) * einzelwert
		
	EndIf 
Next 	

Oval mitte_x-radius,mitte_y-radius,radius*2,radius*2,0	


For i= 1  To 4
geszaehl(i) = scrollfeld(30,80*i+50,geszaehl(i),i+": "+geszaehl(i))  ;Die ersten 4 Werte als scrollfeld darstellen
Next 

For i = 5 To 8
geszaehl(i) = scrollfeld(110,80*i-270,geszaehl(i),i+": "+geszaehl(i)) ;Die letzten 4 Werte als Scrollfeld darstellen
Next

;Die Maus darstellen
DrawImage mauspic,mausx,mausy



Flip 
Until KeyHit(1)



;Antialiasingfunktion von Mike Keith-----------------------------------------------------------------


Function AntiLine(x1%, y1%, x2%, y2%)

xd = x2-x1
yd = y2-y1

If (xd = 0 Or yd = 0)
Line(x1,y1,x2,y2)
Return
EndIf

r = ColorRed() Shl 16
g = ColorGreen() Shl 8
b = ColorBlue()

WritePixel x1,y1,r+g+b
WritePixel x2,y2,r+g+b

If (Abs(xd) > Abs(yd))
If (x1 > x2)
tmp = x1: x1 = x2: x2 = tmp
tmp = y1: y1 = y2: y2 = tmp
xd = x2-x1
yd = y2-y1
EndIf

grad = yd*65536/xd
yf = y1*65536

For x=x1+1 To x2-1
yf = yf + grad 
w = (yf Sar 10) And $3f
y = yf Sar 16

MergePixel(x,y,r,g,b,63-w)
MergePixel(x,y+1,r,g,b,w)

Next
Else
If (y1 > y2)
tmp = x1: x1 = x2: x2 = tmp
tmp = y1: y1 = y2: y2 = tmp
xd = x2-x1
yd = y2-y1
EndIf

grad = xd*65536/yd
xf = x1*65536

For y=y1+1 To y2-1
xf = xf + grad 
w = (xf Sar 10) And $3f
x = xf Sar 16

MergePixel(x,y,r,g,b,63-w)
MergePixel(x+1,y,r,g,b,w)

Next
EndIf

End Function

;--------------------------------------------------------------------------
Function MergePixel(x,y,r,g,b,w)

w = AlineTable(w)
pix = ReadPixel(x,y)

ro = pix And $ff0000
go = pix And $ff00
bo = pix And $ff

rnew = (ro + ((w*(r-ro)) Sar 8)) And $ff0000
gnew = (go + ((w*(g-go)) Sar 8)) And $ff00
bnew = bo + ((w*(b-bo)) Sar 8)

WritePixel x,y,rnew+gnew+bnew

End Function

;--------------------------------------------------------------------------
Function InitAlineTable()

For i=0 To 63
ALineTable(i) = (Sqr(Float(4*i))*16)*.4 + (4*i)*.6
Next

End Function

;Scrollfelder----------------------------------------------------------------------------------------

Function scrollfeld(x,y,wert,head$=0,minwert=0,maxwert=999)
DrawImage scrolluppic,x-8,y-25
DrawImage scrolldownpic,x-8,y+15
Color 255,255,255
Rect x-25,y-10,50,20
Color 155,155,155
If MouseDown(1) 
If ImagesOverlap(mauspic,mausx,mausy,scrolluppic,x-8,y-25) Then wert=wert+1
If ImagesOverlap(mauspic,mausx,mausy,scrolldownpic,x-8,y+15) Then wert=wert-1
EndIf 
If wert>maxwert Then w=minwert
If wert<minwert Then w=maxwert
If head>0 Then Text x-20,y-50,head
Text x,y,wert,1,1
Return wert
End Function

Graphics 800,600
Dim FPS(4)
Dim geszaehl(90)
Menge= 8
Global MausX , MausY
For i=1 To 8 : Read geszaehl(i) : Next 
Data 78 , 31, 14, 113, 58, 89, 51, 101

Win_X1= 50
Win_Y1= 50
Win_X2= 700
Win_Y2 = 500

SetBuffer BackBuffer()
While Not KeyDown(1)
	MausX = MouseX()
	MausY = MouseY()
	Text 9,9,"F1 = Hilfe"
	
	If KeyHit(57) Then Art = Art Xor 1
	
	Menge = Menge + KeyHit(61) - KeyHit(60)
		If Menge <  2 Then Menge =  2
		If Menge > 90 Then Menge = 90
		
	Win_X1= Win_X1+ (KeyDown(205) - KeyDown(203))
		If Win_X1< 0 Then Win_X1= 0
		
	Win_Y1 = Win_Y1 + ( KeyDown(208) - KeyDown(200))
		If Win_Y1 < 25 Then Win_Y1 = 25
		
	Win_X2 = Win_X2 + (KeyDown(32) - KeyDown(30))
		If Win_X2 + Win_X1> 799 Then Win_X1= Win_X1-1
		
	Win_Y2  = Win_Y2  + (KeyDown(17) - KeyDown(31))
		If Win_Y2  + Win_Y1> 599 Then Win_Y1= Win_Y1- 1
		
	Diagramm ( 1 , Menge , Win_X1, Win_Y1, Win_X2 , Win_Y2  , Art )
	Color $FF,$FF,$FF
	If KeyHit(59)
		Color Rand($FF),Rand($FF),Rand($FF)
		Rect 80,80,265,170
		Color 0,0,0
		Text 90,90,"Steuertasten = Verschieben"
		Text 90,110,"Space = Ansicht ändern"
		Text 90,130,"W A S D = Größe ändern"
		Text 90,150,"F2 - F3 = Spaltenanzahl ändern"
		Text 90,170,"ESC = Beenden"
		Text 90,190,"Maustasten  =  Werte ändern"
		Text 150,210,">>Taste<<"
		Flip
		WaitKey
	End If
	Color 0,0,0
	Rect MausX ,MausY ,5,5
	Color $FF,$FF,$FF
	Rect MausX ,MausY ,5,5,0
	Text 700,9,"FPS:"+FPS(1):FPS(2)=FPS(2)+1:If MilliSecs()>FPS(3)+999 Then FPS(1)=FPS(2):FPS(2)=0:FPS(3)=MilliSecs()
	Flip 0
	Cls
Wend
End
Function Diagramm ( ArrayVon, ArrayBis, WinStartX, WinStartY, BreiteX#, HoeheY#, Art )
	IndexMenge = ArrayBis - ArrayVon + 1
	For t= ArrayVon To ArrayBis
		If MaxWert < geszaehl(t) Then  MaxWert = geszaehl(t)
	Next
	SeedRnd(1)
	Select Art 
	::Case 0
		BalkenX = BreiteX / IndexMenge
		Rect WinStartX -1 , WinStartY -1, BalkenX * IndexMenge +1,HoeheY +2
		Factor# = HoeheY / MaxWert
		While IndexMenge > Zeiger
			Rx1 = Zeiger * BalkenX + WinStartX
			Rx2 = BalkenX - 1
			Ry2 = geszaehl( Zeiger + ArrayVon ) * Factor
			Ry1 = WinStartY + HoeheY - Ry2
			Color Rand($FF),Rand($FF),Rand($FF)
			Rect Rx1 , Ry1 , Rx2 , Ry2
			Color 0,0,0
			Text Rx1 + BalkenX / 2 + 1 , Ry1 + 1 , geszaehl( Zeiger + ArrayVon ) , 1
			Color $FF,$FF,$FF
			Text Rx1 + BalkenX / 2 , Ry1 ,geszaehl( Zeiger + ArrayVon ),1
			If RectsOverlap( Rx1 , WinStartY , Rx2 , HoeheY , MausX , MausY , 4, 4) Then 
				Mf(Zeiger + ArrayVon)
			End If
			Zeiger = Zeiger + 1
		Wend
	::Case 1
		BalkenY = HoeheY / IndexMenge
		Rect WinStartX - 1 , WinStartY-1 , BreiteX+2 , BalkenY * IndexMenge + 2 , 1
		Factor# = BreiteX / MaxWert
		While IndexMenge > Zeiger
			Rx1 = WinStartX
			Ry1 = WinStartY + Zeiger * BalkenY
			Rx2 = geszaehl( Zeiger + ArrayVon ) * Factor
			Ry2 = BalkenY - 1
			Color Rand($FF),Rand($FF),Rand($FF)
			Rect Rx1 ,Ry1 , Rx2 , Ry2 , 1
			Color 0,0,0
			Text Rx1 +1 , Ry1 + BalkenY/2 +1, geszaehl(Zeiger + ArrayVon),0,1
			Color $FF,$FF,$FF
			Text Rx1 , Ry1 + BalkenY /2, geszaehl(Zeiger + ArrayVon),0,1
			If RectsOverlap ( Rx1 + 1, Ry1 + 1, BreiteX ,Ry2 ,  MausX , MausY ,4 ,4) Then 
				Mf( Zeiger + ArrayVon )
			End If
			Zeiger = Zeiger + 1
		Wend
	End Select
End Function

Function Mf(x)
	If MouseDown(1) Then geszaehl(x) = geszaehl(x) + 1
	If MouseDown(2) Then
		If geszaehl(x) > 0 Then
			geszaehl(x) = geszaehl(x) - 1
		End If
	End If
End Function