 |
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 |
bubu
Anmeldungsdatum: 21.02.2010
Beiträge: 13
|
 Verfasst am: 21.02.2010, 08:33 Titel: Kreisbahn |
 |
|
| Hallo Forum. Ich wollte gerne wissen wie ich z.B. den Mond in Form eines Punktes zeichnen kann, der sich um die Erde dreht, und diese wiederum um die Sonne. Mir geht es aber nur um den einen Punkt, der sich spiralförmig in einer Kreisbahn dreht. Ihr kennt doch sicher die beiden Zahnräder, die sich ineinander drehen und so ganz schöne Muster zeichnen. Ich habe da leider keine Ahnung, wie das gehen soll, bitte helft mir!! Danke. |
|
| Nach oben |
|
 |
Stueber
Anmeldungsdatum: 07.07.2008
Beiträge: 202
|
| Verfasst am: 21.02.2010, 11:16 Titel: |
|
|
Ganz einfach mit Sinus und Consinus. Mit den Formeln:
x = Radius * cos(Bogenmaß) + Mittelpunkt_X
und
y = Radius * sin(Bogenmaß) + Mittelpunkt_Y
bekommst du die X und Y Koordinaten für das angegebene Bogenmaß. Diesen Punkt speicherst du. Danach wendest du die gleiche Rechnung auf das Ergebniss an. Das ganze machst du in einer Schleife in der das Bogenmaß immer ein kleines Stück erhöht wird.
| Code: | screenres 600,600,24
dim as integer mx = 300,my = 300
dim as integer ex = 300,ey = 300
dim as double winkel1 = 0
dim as integer radius1 = 100
dim as double winkel2 = 0
dim as integer radius2 = 10
do
screenlock
cls
pset (mx,my),rgb(255,0,0)
pset (radius1*cos(winkel1)+mx,radius1*sin(winkel1)+my),rgb(0,255,0)
ex = radius1*cos(winkel1)+mx
ey = radius1*sin(winkel1)+my
pset (radius2*cos(winkel2)+ex,radius2*sin(winkel2)+ey),rgb(255,255,255)
screenunlock
winkel1 += 0.01
winkel2 += 0.1
sleep 10
loop until inkey <> ""
sleep |
|
|
| Nach oben |
|
|
bubu
Anmeldungsdatum: 21.02.2010
Beiträge: 13
|
| Verfasst am: 21.02.2010, 12:43 Titel: |
|
|
Vielen Dank, genau das habe ich gesucht.  Ich hab es erst mal so gemacht; werde aber schon noch etwas länger dran rumbasteln:
| 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 WinXMode, VollBild, WinBreite, WinHoehe, FarbTiefe
ScreenInfo WinBreite, WinHoehe
If WinBreite >= 512 Then WinXMode = 16
If WinBreite >= 640 Then WinXMode = 17
If WinHoehe >= 480 Then WinXMode = 18
If WinBreite >= 800 Then WinXMode = 19
If WinBreite >= 1024 Then WinXMode = 20
If WinHoehe >= 1280 then WinXMode = 21
Screen WinXMode+1,32,,1
setmouse ,,0
randomize timer
DIM AS INTEGER mx,ex,my,ey,radius1,radius2,d,r,g,b,a,n,m
DIM AS DOUBLE winkel1,winkel2
dim as integer mxalt,myalt,mxneu,myneu
DIM AS STRING taste
start:
mx=WinBreite/2
my=WinHoehe/2
ex=WinBreite/2
ey=Winhoehe/2
winkel1=0
winkel2=0
radius1=int(rnd*200)+100
radius2=int(rnd*100)+50
d=int(rnd*10)+1
r=int(rnd*255)+0
g=int(rnd*255)+0
b=int(rnd*255)+0
a=int(rnd*255)+0
m=0
n=10000
DO
ex=radius1*COS(winkel1)+mx
ey=radius1*SIN(winkel1)+my
circle (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),d,RGBA(r,g,b,a)
paint (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),RGBA(r,g,b,a),RGBA(r,g,b,a)
winkel1=winkel1+0.01
winkel2=winkel2+0.1
if m=n then sleep 1000:cls:goto start
m=m+1
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
end sub
|
|
|
| Nach oben |
|
|
Stueber
Anmeldungsdatum: 07.07.2008
Beiträge: 202
|
| Verfasst am: 21.02.2010, 13:47 Titel: |
|
|
Kleiner Tipp:
Die Zeilen
| Code: | SCREENINFO WinBreite, WinHoehe
IF WinBreite >= 512 THEN WinXMode = 16
IF WinBreite >= 640 THEN WinXMode = 17
IF WinHoehe >= 480 THEN WinXMode = 18
IF WinBreite >= 800 THEN WinXMode = 19
IF WinBreite >= 1024 THEN WinXMode = 20
IF WinHoehe >= 1280 THEN WinXMode = 21
SCREEN WinXMode+1,32,,1 |
kannst du viel leichter so schreiben:
| Code: | SCREENINFO WinBreite, WinHoehe
SCREENRES WinBreite,WinHoehe,32,,1 |
So ist jede Auflösung möglich die der Bildschirm erlaubt und nicht nur die höchste von FreeBASIC vorgegebene. |
|
| Nach oben |
|
|
bubu
Anmeldungsdatum: 21.02.2010
Beiträge: 13
|
| Verfasst am: 21.02.2010, 15:10 Titel: |
|
|
Guter Tipp, lieber Stueber; da spar ich doch gerne ein paar Zeilen.  Dankeschön
Edit: So, jetzt bin ich erstmal zufrieden, funktioniert wunderbar. 
Hier das Prog: http://pferdemist.pf.funpic.de/Umlauf2.exe
Es lässt sich mit den F-Tasten und den Zahlen steuern.
| Code: |
#include "keyboard.bi"
Dim As Integer WinBreite,WinHoehe
ScreenInfo WinBreite, WinHoehe
Screenres WinBreite,WinHoehe,32,,1
setmouse ,,0:randomize timer
DIM AS INTEGER mx,ex,my,ey,radius1,radius2,d,r,g,b,a,modus
DIM AS DOUBLE winkel1,winkel2
dim as single s,t
ex=WinBreite/2:ey=Winhoehe/2:mx=WinBreite/2:my=WinHoehe/2
winkel1=0:winkel2=0:radius1=100:radius2=100
d=5:r=120:g=120:b=120:a=120:s=timer:t=timer:modus=1
DO
IF MULTIKEY(FB.SC_enter) then
locate 2,5:print "x =";radius1,"y =";radius2
sleep 2000,1:sleep:cls
ex=WinBreite/2:ey=Winhoehe/2
mx=WinBreite/2:my=WinHoehe/2
winkel1=0:winkel2=0
radius1=int(rnd*200)+100
radius2=int(rnd*150)+50
d=int(rnd*10)+1
r=int(rnd*255)+0
g=int(rnd*255)+0
b=int(rnd*255)+0
a=int(rnd*255)+0
end if
IF MULTIKEY(FB.SC_escape) then end
IF MULTIKEY(FB.SC_space) then cls
IF MULTIKEY(FB.SC_backspace) then cls:modus=0
IF MULTIKEY(FB.SC_tab) then locate 2,5:print "x =";radius1,"y =";radius2:sleep 2000,1:cls
IF MULTIKEY(FB.SC_f1) and d>1 then d=d-1
IF MULTIKEY(FB.SC_f2) and d<10 then d=d+1
IF MULTIKEY(FB.SC_f3) then r=255:g=0:b=0:a=255
IF MULTIKEY(FB.SC_f4) then r=0:g=255:b=0:a=255
IF MULTIKEY(FB.SC_f5) then r=0:g=0:b=255:a=255
IF MULTIKEY(FB.SC_f6) then r=255:g=255:b=0:a=255
IF MULTIKEY(FB.SC_f7) then r=255:g=255:b=255:a=255
IF MULTIKEY(FB.SC_f8) then radius1=int(rnd*200)+100:radius2=int(rnd*150)+50:cls
IF MULTIKEY(FB.SC_f9) then winkel1=winkel1-0.01
IF MULTIKEY(FB.SC_f10) then winkel1=winkel1+0.01
IF MULTIKEY(FB.SC_f11) then winkel2=winkel2-0.01
IF MULTIKEY(FB.SC_f12) then winkel2=winkel2+0.01
IF MULTIKEY(FB.SC_1) then ex=ex-1
IF MULTIKEY(FB.SC_2) then ex=ex+1
IF MULTIKEY(FB.SC_3) then ey=ey-1
IF MULTIKEY(FB.SC_4) then ey=ey+1
IF MULTIKEY(FB.SC_5) then mx=mx-1
IF MULTIKEY(FB.SC_6) then mx=mx+1
IF MULTIKEY(FB.SC_7) then my=my-1
IF MULTIKEY(FB.SC_8) then my=my+1
IF MULTIKEY(FB.SC_9) then r=int(rnd*255)+0:g=int(rnd*255)+0:b=int(rnd*255)+0:a=int(rnd*255)+0
IF MULTIKEY(FB.SC_0) then sleep
if inkey>"" then s=timer:t=timer
if timer-s>.1 and modus=1 then
radius1=radius1+int(rnd*5)-2:radius2=radius2+int(rnd*5)-2
r=r+int(rnd*20)-8:g=g+int(rnd*20)-8:b=b+int(rnd*20)-8:a=a+int(rnd*20)-8
s=timer
end if
if timer-t>60 then
radius1=int(rnd*200)+100:radius2=int(rnd*150)+50:d=int(rnd*10)+1
r=int(rnd*255)+0:g=int(rnd*255)+0:b=int(rnd*255)+0:a=int(rnd*255)+0
s=timer:t=timer:cls
end if
ex=radius1*COS(winkel1)+mx:ey=radius1*SIN(winkel1)+my
circle (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),d,RGBA(r,g,b,a)
paint (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),RGBA(r,g,b,a),RGBA(r,g,b,a)
winkel1=winkel1+0.01:winkel2=winkel2+0.1
LOOP
|
|
|
| Nach oben |
|
|
bubu
Anmeldungsdatum: 21.02.2010
Beiträge: 13
|
| Verfasst am: 21.02.2010, 19:40 Titel: |
|
|
Der Schoner ist jetzt auch ok: http://pferdemist.pf.funpic.de/Umlauf.scr
| 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
SCREENINFO WinBreite, WinHoehe
SCREENRES WinBreite,WinHoehe,32,,1
SETMOUSE ,,0:randomize TIMER
dim as integer mxalt,myalt,mxneu,myneu
DIM AS INTEGER mx,ex,my,ey,radius1,radius2,d,r,g,b,a
DIM AS DOUBLE winkel1,winkel2
DIM AS SINGLE s,t
dim as string taste
ex=WinBreite/2:ey=Winhoehe/2:mx=WinBreite/2:my=WinHoehe/2
winkel1=0:winkel2=0:radius1=100:radius2=100
d=5:r=120:g=120:b=120:a=120:s=TIMER:t=TIMER
DO
IF TIMER-s>.1 THEN
radius1=radius1+INT(RND*5)-2:radius2=radius2+INT(RND*5)-2
r=r+INT(RND*20)-8:g=g+INT(RND*20)-8:b=b+INT(RND*20)-8:a=a+INT(RND*20)-8
s=TIMER
END IF
IF TIMER-t>60 THEN
radius1=INT(RND*200)+100:radius2=INT(RND*150)+50:d=INT(RND*10)+1
r=INT(RND*255)+0:g=INT(RND*255)+0:b=INT(RND*255)+0:a=INT(RND*255)+0
s=TIMER:t=TIMER:CLS
END IF
ex=radius1*COS(winkel1)+mx:ey=radius1*SIN(winkel1)+my
CIRCLE (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),RGBA(r,g,b,a),RGBA(r,g,b,a)
winkel1=winkel1+0.01:winkel2=winkel2+0.1
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
end sub
|
|
|
| Nach oben |
|
|
bubu
Anmeldungsdatum: 21.02.2010
Beiträge: 13
|
| Verfasst am: 21.02.2010, 20:40 Titel: |
|
|
Mal noch eine etwas verbesserte Version des Bildschirmschoners: http://pferdemist.pf.funpic.de/Super-Umlauf.scr
| 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
SCREENINFO WinBreite, WinHoehe
SCREENRES WinBreite,WinHoehe,32,,1
SETMOUSE ,,0:randomize TIMER
dim as integer mxalt,myalt,mxneu,myneu
DIM AS INTEGER mx,ex,my,ey,radius1,radius2,d,r,g,b,a,i
DIM AS DOUBLE winkel1,winkel2
DIM AS SINGLE s,t
dim as string taste
ex=WinBreite/2:ey=Winhoehe/2:mx=WinBreite/2:my=WinHoehe/2:s=TIMER:t=TIMER
winkel1=0:winkel2=0:radius1=INT(RND*100)+50:radius2=INT(RND*100)+50
d=INT(RND*10)+1:r=INT(RND*255)+0:g=INT(RND*255)+0:b=INT(RND*255)+0:a=INT(RND*255)+0
DO
IF TIMER-s>.1 THEN
radius1=radius1+INT(RND*5)-2:radius2=radius2+INT(RND*5)-2
r=r+INT(RND*20)-8:g=g+INT(RND*20)-8:b=b+INT(RND*20)-8:a=a+INT(RND*20)-8
s=TIMER
END IF
IF TIMER-t>60 THEN
radius1=INT(RND*100)+50:radius2=INT(RND*100)+50:d=INT(RND*10)+1
r=INT(RND*255)+0:g=INT(RND*255)+0:b=INT(RND*255)+0:a=INT(RND*255)+0
winkel1=0:winkel2=0:s=TIMER:t=TIMER
i=int(rnd*5)+1
if i=1 then CLS
END IF
ex=radius1*COS(winkel1)+mx:ey=radius1*SIN(winkel1)+my
CIRCLE (radius2*COS(winkel2)+ex-(WinBreite/3),radius2*SIN(winkel2)+ey-(WinBreite/3)),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex-(WinBreite/3),radius2*SIN(winkel2)+ey-(WinBreite/3)),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey-(WinBreite/3)),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey-(WinBreite/3)),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex+(WinBreite/3),radius2*SIN(winkel2)+ey-(WinBreite/3)),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex+(WinBreite/3),radius2*SIN(winkel2)+ey-(WinBreite/3)),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex-(WinBreite/3),radius2*SIN(winkel2)+ey),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex-(WinBreite/3),radius2*SIN(winkel2)+ey),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex+(WinBreite/3),radius2*SIN(winkel2)+ey),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex+(WinBreite/3),radius2*SIN(winkel2)+ey),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex-(WinBreite/3),radius2*SIN(winkel2)+ey+(WinBreite/3)),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex-(WinBreite/3),radius2*SIN(winkel2)+ey+(WinBreite/3)),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey+(WinBreite/3)),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex,radius2*SIN(winkel2)+ey+(WinBreite/3)),RGBA(r,g,b,a),RGBA(r,g,b,a)
CIRCLE (radius2*COS(winkel2)+ex+(WinBreite/3),radius2*SIN(winkel2)+ey+(WinBreite/3)),d,RGBA(r,g,b,a)
PAINT (radius2*COS(winkel2)+ex+(WinBreite/3),radius2*SIN(winkel2)+ey+(WinBreite/3)),RGBA(r,g,b,a),RGBA(r,g,b,a)
winkel1=winkel1+0.01:winkel2=winkel2+0.1
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
end sub
|
|
|
| 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.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
