Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Kreisum anderen Kreis drehen !!!!!!!!!
Gehe zu Seite Zurück  1, 2
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
Michael Frey



Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz

BeitragVerfasst am: 25.03.2006, 18:36    Titel: Antworten mit Zitat

Etwa so?
Code:
screen 20

dim X, Y as single
dim Radius as integer
DIM r AS DOUBLE
CONST PI AS DOUBLE = 3.1415926535897932

Radius = 100

m=500
n=300

do
for winkel = 0 to 1000000 step 1
    cls
    r = Winkel * PI / 180
    X = cos(r)*Radius+300
    Y = sin(r)*Radius+300
   
    circle (300,300),200
    circle (X,Y), 100
 
   
    if m=100 then
        down=1
    elseif m=500 then
        down=0
    end if

    if down then
        m=m+2.5
    else
        m=m-2.5
    end if
   
    n=y-sin(acos((m-x)/Radius))*Radius
    circle (m,n),4,4
    paint (m,n),4

    circle(300,300),4,4
    paint(300,300),4
    sleep 25
if inkey$=chr$(27) then exit do
next Winkel
loop

Wobei die Konstante bei m=m+2.5 noch nicht sauber ist.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
promille



Anmeldungsdatum: 19.07.2005
Beiträge: 18

BeitragVerfasst am: 25.03.2006, 23:46    Titel: Antworten mit Zitat

hmm

also der rote punkt soll nicht nur auf dem Umfang des kleinen Kreises liegen sondern auch auf der waagrechten Linie

und auf der soll er durch die Drehbewegung des kleinen Kreises von rechts nach links mitgenommen werden und wieder zurück

missbilligen
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
promille



Anmeldungsdatum: 19.07.2005
Beiträge: 18

BeitragVerfasst am: 25.03.2006, 23:47    Titel: Antworten mit Zitat

Code:

screen 20

dim X, Y as single
dim Radius as integer
DIM r AS DOUBLE
CONST PI AS DOUBLE = 3.1415926535897932

Radius = 100

m=500
n=300

do
for winkel = 0 to 1000000 step 1
    cls
    r = Winkel * PI / 180
    X = cos(r)*Radius+300
    Y = sin(r)*Radius+300
   
    circle (300,300),200
    circle (X,Y), 100
 
   
    if m=100 then
        down=1
    elseif m=500 then
        down=0
    end if

    if down then
        m=m+2
    else
        m=m-2
    end if
   
    n=y-sin(acos((m-x)/Radius))*Radius
    circle (m,n),4,4
    paint (m,n),4

   
    line (100,300)-(500,300)
    sleep 25
if inkey$=chr$(27) then exit do
next Winkel
loop
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
promille



Anmeldungsdatum: 19.07.2005
Beiträge: 18

BeitragVerfasst am: 25.03.2006, 23:54    Titel: Antworten mit Zitat

das ganze Problem is glaub ich:

es ist keine lineare Funktion, sondern logarithmisch traurig
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
OdinX



Anmeldungsdatum: 29.07.2005
Beiträge: 253
Wohnort: SG Schweiz

BeitragVerfasst am: 26.03.2006, 00:56    Titel: Antworten mit Zitat

durch den thread bin ich auf die idee gekommen die kreise mal kreisen zu lassen. sieht witzig aus finde ich.

Code:
DECLARE FUNCTION Farbe(R AS INTEGER,G AS INTEGER,B AS INTEGER)


DIM Winkel(9) AS SINGLE

DIM XPos(10) AS INTEGER
DIM YPos(10) AS INTEGER

DIM Radius(10) AS INTEGER


XPos(0) = 400
YPos(0) = 400

Radius(0) = 300
FOR A = 1 TO 9 STEP 1
    Radius(A) = Radius(A-1)/1.2
NEXT A

FOR B = 0 TO 8 STEP 1
    Winkel(B)=0
NEXT B

WINDOWTITLE "Circle"
SCREEN 20,32,2
SCREENSET 1,0
COLOR ,Farbe(255,255,255)
CLS



DO WHILE INKEY$ = ""
    FOR C = 0 TO 8 STEP 1
        Winkel(C) += .01*(C+1)
        IF Winkel(C) >= 360 THEN Winkel(C) = 0
    NEXT C
   
    FOR D = 1 TO 9 STEP 1
       YPos(D) = SIN(Winkel(D-1))*(Radius(D-1)-Radius(D))+YPos(D-1)
       XPos(D) = COS(Winkel(D-1))*(Radius(D-1)-Radius(D))+XPos(D-1)
    NEXT D
   
   
    FOR F = 0 TO 9 STEP 1
        CIRCLE (XPos(F),YPos(F)),Radius(F),Farbe(10*F,10*F,10*F)
        PAINT (XPos(F),YPos(F)),Farbe(10*F,10*F,10*F)
    NEXT F
   

    SCREENSYNC
    SCREENCOPY 1,0
    CLS:sleep 1
LOOP

SYSTEM




FUNCTION Farbe(R AS INTEGER,G AS INTEGER,B AS INTEGER)
    Farbe = (B+G*256+R*256*256)
END FUNCTION
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
MisterD



Anmeldungsdatum: 10.09.2004
Beiträge: 3071
Wohnort: bei Darmstadt

BeitragVerfasst am: 26.03.2006, 01:26    Titel: Antworten mit Zitat

für was brauchst du das CLS? Schluckt nur unnötige performance..
_________________
"It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
Edsger W. Dijkstra
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Michael Frey



Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz

BeitragVerfasst am: 26.03.2006, 08:20    Titel: Antworten mit Zitat

@OdinX
Wieso hast du eine Funktion Farbe?
In Freebasic gibt es ein fest eingebautes Macro mit dem genau gleichem Syntax:
Zitat:
Syntax

rgb(red, green, blue)

Description

Function to compute valid color value for hi/truecolor modes.

'Red', 'green' and 'blue' are components ranging 0-255.


@promille
Es ist sicher nicht logarithmisch.
Es ist eine Geometrische Funktion wie sin cos tan oder asin acos atan oder eine Kombination dieser Befehle.
Langsam sehe ich das Problem aber.
Kann man es so sagen?
Du willst, den Schnittpunkt von der Linie und dem kleinen Kreis markieren?

Ich versuchs nochmal zwinkern .
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Michael Frey



Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz

BeitragVerfasst am: 26.03.2006, 08:47    Titel: Antworten mit Zitat

So sollte es etwa gehen:
Code:
screen 20

DEFSNG a-z

dim X, Y as single
dim Radius as integer
DIM r AS DOUBLE
CONST PI AS DOUBLE = 3.1415926535897932

Radius = 100

m=500
n=300

do
for winkel = 0 to 1000000 step 1
    cls
    r = Winkel * PI / 180
    X = cos(r)*Radius+300
    Y = sin(r)*Radius+300
   
    circle (300,300),200
    circle (X,Y), 100
 
    locate 1,1
    a1=y-n
    ? a1
   
    b1=a1/Radius
    ? b1
   
    c1=cos(asin(b1))*Radius+x
    ? c1

    circle (c1,n),4,4
    paint (c1,n),4

    a1=y-n
    ? a1
   
    b1=a1/Radius
    ? b1
   
    c1=-cos(asin(b1))*Radius+x
    ? c1

    circle (c1,n),4,6
    paint (c1,n),6


    line (100,300)-(500,300)
    sleep 25
if inkey$=chr$(27) then exit do
next Winkel
loop

Viel Spass damit.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
promille



Anmeldungsdatum: 19.07.2005
Beiträge: 18

BeitragVerfasst am: 26.03.2006, 11:09    Titel: Antworten mit Zitat

Perfekt !

Klasse genau das wollte ich die ganze Zeit erklären grinsen

thx for all

MfG

promille
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
d.j.peters
Gast





BeitragVerfasst am: 26.03.2006, 21:31    Titel: Antworten mit Zitat

Hat es einen besondern Grund warum "Ihr" mit langserem Paint Kreise füllt und nicht direkt mit dem Flag F wie bei Line auch?

Circle (xpos,ypos),radius,farbe,,,,f

Grüsse Joshy
Nach oben
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite Zurück  1, 2
Seite 2 von 2

 
Gehe zu:  
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.

 Impressum :: Datenschutz