| 
				
					|  | Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
 |  
 
	
		| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |  
		| Autor | Nachricht |  
		| Input 
 
 
 Anmeldungsdatum: 28.07.2014
 Beiträge: 59
 
 
 | 
			
				|  Verfasst am: 13.12.2014, 22:11    Titel: Schoner |   |  
				| 
 |  
				| Hallo liebes Forum.  Ich bin auf der Suche nach hübschen Bildschirmschonern. Zeigt doch mal, was ihr so zu bieten habt. Hier mal mein Favorit: 
  	  | Code: |  	  | #include "windows.bi"
 dim shared as String Param
 declare sub configurescreensaver
 declare sub showscreensaver
 if command(1)="" then
 if messagebox(0,"Bildschirmschoner testen?"," ",mb_iconquestion or mb_yesno)=idyes then
 showscreensaver
 end if
 end
 end if
 param=Mid(Command(1), 2, 1)
 select case UCASE(param)
 case "S": showscreensaver
 case "C": configurescreensaver
 end select
 end
 sub configurescreensaver
 messagebox(0, "Es gibt nichts zu konfigurieren! "," ",mb_iconinformation)
 end sub
 sub showscreensaver
 Dim As Integer WinBreite,WinHoehe,mxalt,myalt,mxneu,myneu,col,i,j,m,n,pause,r,g,b,a,x
 DIM AS STRING taste
 DIM AS SINGLE Durchgangslaenge,Laufzeit
 
 dim as integer aa,ab,ax,ay,az1,az2,az3,az4
 dim as integer ba,bb,bx,by,bz1,bz2,bz3,bz4
 dim as integer ca,cb,cx,cy,cz1,cz2,cz3,cz4
 dim as integer da,db,dx,dy,dz1,dz2,dz3,dz4
 dim as integer ea,eb,ex,ey,ez1,ez2,ez3,ez4
 dim as integer fa,fb,fx,fy,fz1,fz2,fz3,fz4
 dim as integer ga,gb,gx,gy,gz1,gz2,gz3,gz4
 dim as integer ha,hb,hx,hy,hz1,hz2,hz3,hz4
 
 ScreenInfo WinBreite, WinHoehe
 ScreenRes WinBreite,WinHoehe,32,,1
 setmouse ,,0
 randomize timer
 Durchgangslaenge=60
 
 DO
 
 aa=int(rnd*5)-2
 ab=int(rnd*5)-2
 ax=WinBreite/2
 ay=WinHoehe/2
 az1=int(rnd*255)+0
 az2=int(rnd*255)+0
 az3=int(rnd*255)+0
 az4=int(rnd*255)+0
 
 ba=int(rnd*5)-2
 bb=int(rnd*5)-2
 bx=WinBreite/2
 by=WinHoehe/2
 bz1=int(rnd*255)+0
 bz2=int(rnd*255)+0
 bz3=int(rnd*255)+0
 bz4=int(rnd*255)+0
 
 ca=int(rnd*5)-2
 cb=int(rnd*5)-2
 cx=WinBreite/2
 cy=WinHoehe/2
 cz1=int(rnd*255)+0
 cz2=int(rnd*255)+0
 cz3=int(rnd*255)+0
 cz4=int(rnd*255)+0
 
 da=int(rnd*5)-2
 db=int(rnd*5)-2
 dx=WinBreite/2
 dy=WinHoehe/2
 dz1=int(rnd*255)+0
 dz2=int(rnd*255)+0
 dz3=int(rnd*255)+0
 dz4=int(rnd*255)+0
 
 ea=int(rnd*5)-2
 eb=int(rnd*5)-2
 ex=WinBreite/2
 ey=WinHoehe/2
 ez1=int(rnd*255)+0
 ez2=int(rnd*255)+0
 ez3=int(rnd*255)+0
 ez4=int(rnd*255)+0
 
 fa=int(rnd*5)-2
 fb=int(rnd*5)-2
 fx=WinBreite/2
 fy=WinHoehe/2
 fz1=int(rnd*255)+0
 fz2=int(rnd*255)+0
 fz3=int(rnd*255)+0
 fz4=int(rnd*255)+0
 
 ga=int(rnd*5)-2
 gb=int(rnd*5)-2
 gx=WinBreite/2
 gy=WinHoehe/2
 gz1=int(rnd*255)+0
 gz2=int(rnd*255)+0
 gz3=int(rnd*255)+0
 gz4=int(rnd*255)+0
 
 ha=int(rnd*5)-2
 hb=int(rnd*5)-2
 hx=WinBreite/2
 hy=WinHoehe/2
 hz1=int(rnd*255)+0
 hz2=int(rnd*255)+0
 hz3=int(rnd*255)+0
 hz4=int(rnd*255)+0
 
 r=int(rnd*255)+0:g=int(rnd*255)+0:b=int(rnd*255)+0:a=int(rnd*255)+0
 line (0,0)-(WinBreite,WinHoehe),rgba(r,g,b,a),bf
 
 Laufzeit=TIMER:col=int(rnd*8)+1:m=0:n=int(rnd*5)+1:pause=int(rnd*5)+1:x=int(rnd*2)+1
 
 DO
 
 for i=(-(WinBreite/2)) to (WinBreite/2) step (WinBreite/4)
 for j=(-(WinBreite/2)) to (WinBreite/2) step (WinBreite/4)
 
 circle (ax+aa+i-(WinBreite/8),ay+ab+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax-aa+i-(WinBreite/8),ay-ab+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax+aa+i-(WinBreite/8),ay-ab+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax-aa+i-(WinBreite/8),ay+ab+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax+ab+i-(WinBreite/8),ay+aa+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax-ab+i-(WinBreite/8),ay-aa+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax+ab+i-(WinBreite/8),ay-aa+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 circle (ax-ab+i-(WinBreite/8),ay+aa+j-(WinBreite/8)),x,rgba(az1,az2,az3,az4),,,,f
 
 if col>0 then
 circle (bx+ba+i-(WinBreite/8),by+bb+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx-ba+i-(WinBreite/8),by-bb+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx+ba+i-(WinBreite/8),by-bb+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx-ba+i-(WinBreite/8),by+bb+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx+bb+i-(WinBreite/8),by+ba+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx-bb+i-(WinBreite/8),by-ba+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx+bb+i-(WinBreite/8),by-ba+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 circle (bx-bb+i-(WinBreite/8),by+ba+j-(WinBreite/8)),x,rgba(bz1,bz2,bz3,bz4),,,,f
 end if
 
 if col>2 then
 circle (cx+ca+i-(WinBreite/8),cy+cb+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx-ca+i-(WinBreite/8),cy-cb+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx+ca+i-(WinBreite/8),cy-cb+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx-ca+i-(WinBreite/8),cy+cb+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx+cb+i-(WinBreite/8),cy+ca+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx-cb+i-(WinBreite/8),cy-ca+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx+cb+i-(WinBreite/8),cy-ca+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 circle (cx-cb+i-(WinBreite/8),cy+ca+j-(WinBreite/8)),x,rgba(cz1,cz2,cz3,cz4),,,,f
 end if
 
 if col>4 then
 circle (dx+da+i-(WinBreite/8),dy+db+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx-da+i-(WinBreite/8),dy-db+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx+da+i-(WinBreite/8),dy-db+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx-da+i-(WinBreite/8),dy+db+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx+db+i-(WinBreite/8),dy+da+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx-db+i-(WinBreite/8),dy-da+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx+db+i-(WinBreite/8),dy-da+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 circle (dx-db+i-(WinBreite/8),dy+da+j-(WinBreite/8)),x,rgba(dz1,dz2,dz3,dz4),,,,f
 end if
 
 if col>1 then
 circle (ex+ea+i,ey+eb+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex-ea+i,ey-eb+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex+ea+i,ey-eb+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex-ea+i,ey+eb+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex+eb+i,ey+ea+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex-eb+i,ey-ea+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex+eb+i,ey-ea+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 circle (ex-eb+i,ey+ea+j),x,rgba(ez1,ez2,ez3,ez4),,,,f
 end if
 
 if col>3 then
 circle (fx+fa+i,fy+fb+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx-fa+i,fy-fb+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx+fa+i,fy-fb+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx-fa+i,fy+fb+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx+fb+i,fy+fa+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx-fb+i,fy-fa+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx+fb+i,fy-fa+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 circle (fx-fb+i,fy+fa+j),x,rgba(fz1,fz2,fz3,fz4),,,,f
 end if
 
 if col>5 then
 circle (gx+ga+i,gy+gb+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx-ga+i,gy-gb+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx+ga+i,gy-gb+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx-ga+i,gy+gb+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx+gb+i,gy+ga+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx-gb+i,gy-ga+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx+gb+i,gy-ga+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 circle (gx-gb+i,gy+ga+j),x,rgba(gz1,gz2,gz3,gz4),,,,f
 end if
 
 circle (hx+ha+i,hy+hb+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx-ha+i,hy-hb+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx+ha+i,hy-hb+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx-ha+i,hy+hb+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx+hb+i,hy+ha+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx-hb+i,hy-ha+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx+hb+i,hy-ha+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 circle (hx-hb+i,hy+ha+j),x,rgba(hz1,hz2,hz3,hz4),,,,f
 
 next j
 next i
 
 m=m+1:if m=n then sleep pause:m=0
 
 aa=aa+int(rnd*5)-2
 ab=ab+int(rnd*5)-2
 az1=az1+int(rnd*5)-2
 az2=az2+int(rnd*5)-2
 az3=az3+int(rnd*5)-2
 az4=az4+int(rnd*5)-2
 
 if az1<0 then az1=int(rnd*255)+0
 if az1>255 then az1=int(rnd*255)+0
 if az2<0 then az2=int(rnd*255)+0
 if az2>255 then az2=int(rnd*255)+0
 if az3<0 then az3=0
 if az3>255 then az3=int(rnd*255)+0
 if az4<0 then az4=int(rnd*255)+0
 if az4>255 then az4=int(rnd*255)+0
 
 ba=ba+int(rnd*5)-2
 bb=bb+int(rnd*5)-2
 bz1=bz1+int(rnd*5)-2
 bz2=bz2+int(rnd*5)-2
 bz3=bz3+int(rnd*5)-2
 bz4=bz4+int(rnd*5)-2
 
 if bz1<0 then bz1=int(rnd*255)+0
 if bz1>255 then bz1=int(rnd*255)+0
 if bz2<0 then bz2=int(rnd*255)+0
 if bz2>255 then bz2=int(rnd*255)+0
 if bz3<0 then bz3=int(rnd*255)+0
 if bz3>255 then bz3=int(rnd*255)+0
 if bz4<0 then bz4=int(rnd*255)+0
 if bz4>255 then bz4=int(rnd*255)+0
 
 ca=ca+int(rnd*5)-2
 cb=cb+int(rnd*5)-2
 cz1=cz1+int(rnd*5)-2
 cz2=cz2+int(rnd*5)-2
 cz3=cz3+int(rnd*5)-2
 cz4=cz4+int(rnd*5)-2
 
 if cz1<0 then cz1=int(rnd*255)+0
 if cz1>255 then cz1=int(rnd*255)+0
 if cz2<0 then cz2=int(rnd*255)+0
 if cz2>255 then cz2=int(rnd*255)+0
 if cz3<0 then cz3=int(rnd*255)+0
 if cz3>255 then cz3=int(rnd*255)+0
 if cz4<0 then cz4=int(rnd*255)+0
 if cz4>255 then cz4=int(rnd*255)+0
 
 da=da+int(rnd*5)-2
 db=db+int(rnd*5)-2
 dz1=dz1+int(rnd*5)-2
 dz2=dz2+int(rnd*5)-2
 dz3=dz3+int(rnd*5)-2
 dz4=dz4+int(rnd*5)-2
 
 if dz1<0 then dz1=int(rnd*255)+0
 if dz1>255 then dz1=int(rnd*255)+0
 if dz2<0 then dz2=int(rnd*255)+0
 if dz2>255 then dz2=int(rnd*255)+0
 if dz3<0 then dz3=int(rnd*255)+0
 if dz3>255 then dz3=int(rnd*255)+0
 if dz4<0 then dz4=int(rnd*255)+0
 if dz4>255 then dz4=int(rnd*255)+0
 
 ea=ea+int(rnd*5)-2
 eb=eb+int(rnd*5)-2
 ez1=ez1+int(rnd*5)-2
 ez2=ez2+int(rnd*5)-2
 ez3=ez3+int(rnd*5)-2
 ez4=ez4+int(rnd*5)-2
 
 if ez1<0 then ez1=int(rnd*255)+0
 if ez1>255 then ez1=int(rnd*255)+0
 if ez2<0 then ez2=int(rnd*255)+0
 if ez2>255 then ez2=int(rnd*255)+0
 if ez3<0 then ez3=0
 if ez3>255 then ez3=int(rnd*255)+0
 if ez4<0 then ez4=int(rnd*255)+0
 if ez4>255 then ez4=int(rnd*255)+0
 
 fa=fa+int(rnd*5)-2
 fb=fb+int(rnd*5)-2
 fz1=fz1+int(rnd*5)-2
 fz2=fz2+int(rnd*5)-2
 fz3=fz3+int(rnd*5)-2
 fz4=fz4+int(rnd*5)-2
 
 if fz1<0 then fz1=int(rnd*255)+0
 if fz1>255 then fz1=int(rnd*255)+0
 if fz2<0 then fz2=int(rnd*255)+0
 if fz2>255 then fz2=int(rnd*255)+0
 if fz3<0 then fz3=0
 if fz3>255 then fz3=int(rnd*255)+0
 if fz4<0 then fz4=int(rnd*255)+0
 if fz4>255 then fz4=int(rnd*255)+0
 
 ga=ga+int(rnd*5)-2
 gb=gb+int(rnd*5)-2
 gz1=gz1+int(rnd*5)-2
 gz2=gz2+int(rnd*5)-2
 gz3=gz3+int(rnd*5)-2
 gz4=gz4+int(rnd*5)-2
 
 if gz1<0 then gz1=int(rnd*255)+0
 if gz1>255 then gz1=int(rnd*255)+0
 if gz2<0 then gz2=int(rnd*255)+0
 if gz2>255 then gz2=int(rnd*255)+0
 if gz3<0 then gz3=0
 if gz3>255 then gz3=int(rnd*255)+0
 if gz4<0 then gz4=int(rnd*255)+0
 if gz4>255 then gz4=int(rnd*255)+0
 
 ha=ha+int(rnd*5)-2
 hb=hb+int(rnd*5)-2
 hz1=hz1+int(rnd*5)-2
 hz2=hz2+int(rnd*5)-2
 hz3=hz3+int(rnd*5)-2
 hz4=hz4+int(rnd*5)-2
 
 if hz1<0 then hz1=int(rnd*255)+0
 if hz1>255 then hz1=int(rnd*255)+0
 if hz2<0 then hz2=int(rnd*255)+0
 if hz3<0 then hz3=0
 if hz3>255 then hz3=int(rnd*255)+0
 if hz4<0 then hz4=int(rnd*255)+0
 if hz4>255 then hz4=int(rnd*255)+0
 
 getmouse mxneu, myneu
 taste = Inkey
 IF taste <> "" THEN
 SELECT CASE taste
 CASE CHR(32): EXIT DO
 CASE ELSE: EXIT SUB
 END SELECT
 END IF
 IF mxalt=0 THEN
 mxalt=mxneu
 myalt=myneu
 ELSE
 if mxneu<>mxalt or myneu<>myalt then exit sub
 END IF
 LOOP UNTIL TIMER>(laufzeit+durchgangslaenge)
 LOOP
 end sub
 
 | 
 |  |  
		| Nach oben |  |  
		|  |  
		| Input 
 
 
 Anmeldungsdatum: 28.07.2014
 Beiträge: 59
 
 
 | 
			
				|  Verfasst am: 30.12.2014, 20:37    Titel: |   |  
				| 
 |  
				| Hallo Liebesforum - äh: liebes Forum.   
 Hab da mal noch ein Problem. Blau und grün weisen einen Winkel von 90° auf. Jetzt hätte ich aber gerne einen Winkel von je 60°. Ich möchte also ein "gleichseitiges Dreieck" statt ein Quadrat. Hab das leider nicht hinbekommen. Vielen Dank für eure Hilfe!!
   
 
  	  | Code: |  	  | screenres 1024,1024,16,,1
 setmouse ,,0
 dim as integer col,i,j,n=1024
 dim as integer r(n,n),g(n,n),b(n,n)
 
 'rot
 col=0
 for i=0 to 255
 col+=1
 if col>255 then col=255
 for j=0 to 255
 r(i,j)=col
 r(i+512,j+512)=col
 next
 next
 
 col=255
 for i=255 to 512
 col-=1
 if col<0 then col=0
 for j=255 to 512
 r(i,j)=col
 r(i+512,j+512)=col
 next
 next
 
 'grün
 col=0
 for i=0 to 1024
 for j=0 to 255
 col+=1
 if col>255 then col=0
 g(i,i+j)=col
 g(i,i+j+512)=col
 next
 next
 
 col=0
 for i=0 to 1023
 for j=0 to 255
 col-=1
 if col<0 then col=255
 g(i,i+j+255)=col
 g(i,i+j+767)=col
 next
 next
 
 'blau
 col=0
 for i=0 to 1024
 for j=0 to 255
 col+=1
 if col>255 then col=0
 b(i,j-i)=col
 b(i,j-i+513)=col
 next
 next
 
 col=0
 for i=0 to 1024
 for j=0 to 255
 col-=1
 if col<0 then col=255
 b(i,j-i+255)=col
 b(i,j-i+768)=col
 next
 next
 
 'Darstellung
 for i=0 to 1024
 for j=0 to 1024
 pset (i,j),rgb(r(j,j),g(i,j),b(i,j))
 next
 next
 sleep
 
 | 
 EDIT: Hab das nun schon hinbekommen, jedoch ist das so leicht "verpixelt", d.h.: ich hab "schwarze Löcher" die nicht ganz so schön sind.
 
 Programmmässig mache ich das jetzt so:
 
 
  	  | Code: |  	  | m=.3
 g(i-(i*m),i+j+(j*m))=col
 
 | 
 
 EDIT: So, hab jetzt doch noch herausgefunden, wie das mit der Transparenz geht:
 
  	  | Code: |  	  | #include once "fbgfx.bi"
 screenres 1024,1024,32,1,FB.GFX_ALPHA_PRIMITIVES
 | 
 |  |  
		| Nach oben |  |  
		|  |  
		| Eternal_pain 
 
  
 Anmeldungsdatum: 08.08.2006
 Beiträge: 1783
 Wohnort: BW/KA
 
 | 
			
				|  Verfasst am: 08.01.2015, 09:13    Titel: |   |  
				| 
 |  
				| Hatte mal was gebastelt das man sicher zu einem netten Schoner verwerten könnte 
 
  	  | Code: |  	  | randomize timer
 
 Function HSV(Byval H as Single) as UInteger
 Static as Single  Hue, Saturation, Value
 Static as Single  Red, Green, Blue
 Static as Single  f, p, q, t
 Static as Integer Hs
 
 Hue        = ABS(H MOD 360) / 60
 Saturation = 1
 Value      = 1
 
 Hs = Int(Hue)
 f  = Frac(Hue)
 p  = Value * (1-Saturation)
 q  = Value * (1-(f*Saturation))
 t  = Value * (1-((1-f)*Saturation))
 
 Select Case as Const Hs
 Case 0 : Red = Value : Green = t     : Blue = p
 Case 1 : Red = q     : Green = Value : Blue = p
 Case 2 : Red = p     : Green = Value : Blue = t
 Case 3 : Red = p     : Green = q     : Blue = Value
 Case 4 : Red = t     : Green = p     : Blue = Value
 Case 5 : Red = Value : Green = p     : Blue = q
 End Select
 
 Red *= 255 : Green *= 255 : Blue *= 255
 
 Function = RGB(Red,Green,Blue)
 End Function
 
 Sub ScreenSoft()
 Dim as Integer scrWidth, scrHeight, scrPitch
 Dim as integer ptr scradr = screenptr
 ScreenInfo scrWidth, scrHeight,,,scrPitch
 scrPitch \= 4
 Dim as Integer pix(0 to 4)
 
 Dim as any ptr bufscr = imagecreate(scrWidth,scrHeight)
 Dim as Integer red, green, blue
 
 Dim as integer ptr bufadr
 Dim as integer bufpitch
 
 imageinfo bufscr,,,,bufpitch,bufadr
 bufpitch \= 4
 
 For y as Integer = 0 to scrHeight - 1
 For x as Integer = 0 to scrWidth -1
 red = 0 : green = 0 : blue = 0
 
 pix(0) = scradr[x + (y*scrPitch)]
 'if pix(0) and &h00FFFFFF Then
 If (y >          -1) andalso (x >          0) Then pix(1) = scradr[(x-1) + (y*scrPitch)] Else pix(1) = 0 'left
 If (y >           0) andalso (x >         -1) Then pix(2) = scradr[x + ((y-1)*scrPitch)] Else pix(2) = 0 'up middle
 If (y >          -1) andalso (x < scrWidth-1) Then pix(3) = scradr[(x+1) + (y*scrPitch)] Else pix(3) = 0 'right
 If (y < scrHeight-1) andalso (x >         -1) Then pix(4) = scradr[x + ((y+1)*scrPitch)] Else pix(4) = 0 'down middle
 
 For l as Integer = 0 to 4
 red   += lobyte(hiword(pix(l)))
 green += hibyte(loword(pix(l)))
 blue  += lobyte(loword(pix(l)))
 Next l
 
 red   \= 5
 green \= 5
 blue  \= 5
 
 bufadr[x + (y*bufPitch)] = rgb(red,green,blue)
 'pset bufscr,(x,y),rgb(red,green,blue)
 'else
 '    pset bufscr,(x,y),pix(0)
 'end if
 
 Next x
 Next y
 put(0,0),bufscr,pset
 imagedestroy(bufscr)
 End Sub
 
 
 Type ppoint
 as Single  dx, dy, ox, oy
 as Single  x, y
 as Integer c
 Declare Constructor()
 Declare Sub DrawPoint()
 End Type
 
 Constructor ppoint()
 Dim as Integer scrWidth, scrHeight
 ScreenInfo scrWidth, scrHeight
 x  = rnd * scrWidth : y = rnd * scrHeight
 dx = rnd * 20 -10
 dy = rnd * 20 -10
 c  = rnd * 360
 End Constructor
 
 Sub ppoint.DrawPoint()
 line (ox,oy)-(x,y),HSV(c)
 ox = x : oy = y
 x += dx : y += dy
 
 if x>639 Then dx = - rnd * 10
 If x<  0 Then dx = rnd * 10
 
 if y>479 Then dy = - rnd * 10
 If y<  0 Then dy = rnd * 10
 
 c += 1
 if c = 360 then c = 0
 End Sub
 
 screenres 640,480,32
 
 Dim as ppoint rainbowpoint(0 to 9)
 
 Do
 For l as Integer = 0 to 9
 rainbowpoint(l).DrawPoint()
 Next l
 
 screensoft()
 if multikey(&h01) then exit do
 Loop
 
 
 
 
 | 
 _________________
 
  |  |  
		| Nach oben |  |  
		|  |  
		|  |  
  
	| 
 
 | Du kannst keine Beiträge in dieses Forum schreiben. Du kannst auf Beiträge in diesem Forum nicht antworten.
 Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
 Du kannst deine Beiträge in diesem Forum nicht löschen.
 Du kannst an Umfragen in diesem Forum nicht mitmachen.
 
 |  |