 |
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 |
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
 Verfasst am: 01.09.2007, 17:52 Titel: Mein Flusi |
 |
|
Ich schreibe gerade (naja... seid fasst einem Jahr) einen Flugsimulator in
QuickBasic. Wer mehr wissen will klickt auf "Bildschirm Drehen" in
"Algemeine Fragen zu QBasic" |
|
| Nach oben |
|
 |
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
|
| Nach oben |
|
|
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 01.09.2007, 19:21 Titel: |
|
|
Oder edit-Funktion. 
Wie sieht's aus? Fehler gefunden und behoben?
Vllt. kannst du uns noch ein bisschen mehr zum Programm erzählen und ggf. eine lauffähige EXE hochladen.
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 01.09.2007, 21:21 Titel: |
|
|
...uuuuund, da der source ziemlich lange ist, ihn zukünftig bei fb:porticula hochladen
wegen einer dubiosen variable names "byte" konnte ich das programm nicht unter FB kompilieren (nenne die variable um, weil das ist in FB ein datentyp), also konnte ich das programm auch nicht testen (qb macht probleme).
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 03.09.2007, 06:24 Titel: |
|
|
also da bedarf es noch einer ueberarbeitung, ich wollte das ganze mal FB Kopatibel machen (naechtliche langeweile  ) aber blick bei ein paar sachen nicht so wirklich durch....
erklaer mir mal zB diese SUB
| Code: | SUB VerschiebeFACETRI3D (Dreieck AS FACETRI3D, Vektor AS VEKTOR3D, NeuDreieck AS FACETRI3D)
VerschiebePUNKT3D Dreieck(GG).p1, Vektor, Dreieck(GG).p1
VerschiebePUNKT3D Dreieck(GG).p2, Vektor, Dreieck(GG).p2
VerschiebePUNKT3D Dreieck(GG).p3, Vektor, Dreieck(GG).p3
VerschiebePUNKT3D Dreieck(GG).p4, Vektor, Dreieck(GG).p4
VerschiebePUNKT3D Dreieck(GG).p5, Vektor, Dreieck(GG).p5
VerschiebePUNKT3D Dreieck(GG).p6, Vektor, Dreieck(GG).p6
VerschiebePUNKT3D Dreieck(GG).p7, Vektor, Dreieck(GG).p7
VerschiebePUNKT3D Dreieck(GG).p8, Vektor, Dreieck(GG).p8
END SUB |
was ist GG, wo kommt GG her ????
hab es hier mal als ausfuehrbare EXE,
http://home.arcor.de/eternal_pain/Files/fusselsieb.exe
waere nett wenn mir sagen koenntest ob das in QB auch so flimmert...
ausserdem bewegt sich da nichts
_________________
 |
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 03.09.2007, 18:32 Titel: |
|
|
GG ist eine Variable aus einer FOR X Schleife und wird der SUB
übergeben, da ich 90 "Dreiecke" habe. Nur so neben bei...
Mario Zechner hat diese SUB geschrieben! ICH NICHT
Ich verwände sie nur.
Wo hat jemand eine Variable namend byte gefunden??
Ich weiß nichts davon.
Eigentlich sollten sich die Bäume ja bewegen.... ABER ich habs für QB
geschrieben nicht für FB!
Und bei mir flimmerts nicht! ALSO nicht so stark |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 03.09.2007, 19:18 Titel: |
|
|
wenn man fremden sourcecode verwendet, sollte man imho ihn wenigstens ansatzweise verstehen... GG wird nämlich NICHT an die sub übergeben...
Steht eindeutig in der Deklaration. und die variable is auch NICHT shared, das heißt, die SUB kenn sie gar nicht! deswegen ist es auch immer 0... es immer gut, Option Explicit zu verwenden, was aber in QB nicht geht -> schlechter stil.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 03.09.2007, 19:25 Titel: |
|
|
Sorry  
Mein code ist jetzt (hoffentlich) im FB-Portal unter Downloads - Spiele als .EXE zu finden.
Sorry, aber find die Stelle aber nicht |
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 03.09.2007, 19:32 Titel: |
|
|
Oh...
Habs gefunden
Ist das nicht dein Code? (makejmp)???
Egal... |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 03.09.2007, 19:41 Titel: |
|
|
makeJMP, das verwendet wirklich jemand?
siehste, wie sich mein code verändert hat...
imo ist Size² bzw Size² für FB viel praktischer...  (lange nicht mehr upgedated, kann sein, dass das nicht mehr ohne änderungen unter FB0.18 läuft).
EDIT: Doppelposts vermeiden, EDIT verwenden 
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 06.09.2007, 18:16 Titel: |
|
|
@Eternal_pain:
Wie hast du das "Index außerhalb des Bereichs"-Problem gelöst????????? |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 07.09.2007, 05:13 Titel: |
|
|
Sooooo..... ich hab nu fast 2 stunden damit verbracht das ganze etwas zu strukturieren, die variablen soweit alle zu deklarieren ect pp... das ganze ist jetzt allerdings FB (compilieren mit der -exx option ist nicht moeglich wegen einer bufferueberschreibung (?)) das wird vielleicht helfen die restlichen Fehler zu finden.... btw: bring erstmal die Reihenfolge der Grafiken in ordnung... (siehe unten ScreenShot) da fehlt sonst naemlich alles.....
hier der source...
| Code: |
'//-------------------------- KONSTANTEN ----------------------------
Const FOCUS = 200 '255 ' Entfernung Betrachter->Projektionsfläche
Const DEGtoRAD = (Atn(1)*4) / 180 ' "Grad in Bogenmaß"-Konstante
'//-------------------------- DATENTYPEN ---------------------------
Type PUNKT3D
x As Single
y As Single
z As Single
End Type
Type VEKTOR3D
x As Single
y As Single
z As Single
End Type
Type FACETRI3D
p1 As PUNKT3D
p2 As PUNKT3D
p3 As PUNKT3D
p4 As PUNKT3D
p5 As PUNKT3D
p6 As PUNKT3D
p7 As PUNKT3D
p8 As PUNKT3D
End Type
Type KAMERA3D
Position As PUNKT3D
Xrot As Single
Yrot As Single
Zrot As Single
End Type
'\\-------------------------------------------------------------------
Declare Sub BOOM ()
Declare Sub Motor (Byval Geschwindigkeit As Integer)
Declare Sub DrawFlugzeug (Byval Geschwindigkeit As Integer, _
Byval Neigung1 As Integer, _
Byval Hoehe As Integer, _
Byval starttime As Integer, _
Byval Stroemungsabriss As Integer, _
Byval Variometer As Integer)
Declare Sub Tag (Byval y1 As Integer, Byval y2 As Integer)
Declare Sub Nacht (Byval y1 As Integer)
Declare Sub VerschiebeKameraFACETRI3D (Byval Dreieck As FACETRI3D, _
Byval kamera As KAMERA3D, _
Byref NeuDreieck As FACETRI3D)
Declare Sub VerschiebeFACETRI3D (Byval Dreieck As FACETRI3D, _
Byval Vektor As VEKTOR3D, _
Byref NeuDreieck As FACETRI3D)
Declare Sub SkaliereFACETRI3D (Byval Dreieck As FACETRI3D, _
Byval Skalarx As Single, _
Byval Skalary As Single, _
Byval Skalarz As Single, _
Byref NeuDreieck As FACETRI3D)
Declare Sub ZeichneFACETRI3D (Byval Dreieck As FACETRI3D, _
Byval Farbe As Integer)
Declare Sub RotiereXYZFACETRI3D (Byval Dreieck As FACETRI3D, _
Byval Alpha As Single, _
Byval Beta As Single, _
Byval Gamma As Single, _
Byref NeuDreieck As FACETRI3D)
Declare Sub VerschiebePUNKT3D (Byval Punkt As PUNKT3D, _
Byval Vektor As VEKTOR3D, _
Byref NeuPunkt As PUNKT3D)
Declare Sub SkalierePUnkt3D (Byval Punkt As PUNKT3D, _
Byval Skalarx As Single, _
Byval Skalary As Single, _
Byval Skalarz As Single, _
Byref NeuPunkt As PUNKT3D)
Declare Sub RotiereXPUNKT3D (Byval Punkt As PUNKT3D, _
Byval Beta As Single, _
Byref NeuPunkt As PUNKT3D)
Declare Sub RotiereYPUNKT3D (Byval Punkt As PUNKT3D, _
Byval Gamma As Single, _
Byref NeuPunkt As PUNKT3D)
Declare Sub RotiereZPUNKT3D (Byval Punkt As PUNKT3D, _
Byval Alpha As Single, _
Byref NeuPunkt As PUNKT3D)
Declare Sub RotiereXYZPuNKT3D (Byval Punkt As PUNKT3D, _
Byval Alpha As Single, _
Byval Beta As Single, _
Byval Gamma As Single, _
Byref NeuPunkt As PUNKT3D)
Declare Sub Wolke1 (Byval x As Integer, Byval y As Integer)
Declare Sub Neigung (Byval Wert As Integer)
Declare Sub Variomet (Byval Wert As Integer)
Declare Sub Speed (Byval Wert As Integer)
Declare Sub Alt (Byval Wert As Integer)
Declare Sub LoadJMP (Byval file As String)
Declare Sub DrawHilfen (Byval Geschwindigkeit As Integer, _
Byval Neigung1 As Integer, _
Byval Hoehe As Integer, _
Byval Variometer As Integer, _
Byval Stroemungsabriss As Integer)
'// ------------------------ VARIABLEN FÜR DEMO ----------------------
Dim Shared MaxBaeume As Integer=900
Dim Shared kamera As KAMERA3D ' unsere Kamera...
Dim Shared Dreieck(MaxBaeume) As FACETRI3D ' Dreieck im Objektraum
Dim Shared TransDreieck(MaxBaeume) As FACETRI3D ' Datenstruktur fr transformiertes Dreieck
Dim Shared Alpha As Single ' Rotationswinkel um den Dreieck im Objektraum gedreht werden soll
Dim Shared Taste As String ' hier speichern wir die von INKEY$ erhaltene Taste
'DIM SHARED starttime ' Startzeit des Flugsimulators
Dim Shared Vektor As VEKTOR3D
Dim Shared Neigung1 As Integer ' Die Neigung des Flugzeugs
Dim Shared Variometer As Integer ' Steigung
Dim Shared vorher(MaxBaeume) As Integer
'starttime = TIMER ' Startzeit des Flugsimulators
Dim Shared AnzahlDerBaeume As Integer=90
Dim Shared Genug As Integer
Dim y1 as Integer
Dim y2 as Integer
'// Die Start x1 und y1 Koordinaten fr den Horizont
y1 = 50
y2 = 50
'################################INTRO#######################################
'CLS
'WIDTH 80, 50
'SCREEN 13
'CLS
'LoadJMP "C:\FFSSetup\I2.jmp"
'PRINT "Das ist der Flughafen Seattle"
'SLEEP
'LoadJMP "C:\FFSSetup\I1.jmp"
Locate 24, 1
'PRINT "Steigen Sie in ihre neue Cessna ein und fliegen Sie los."
'SLEEP
'// Videomodus fr Doublebuffering initialisieren
Dim Shared Geschwindigkeit as Integer
Dim Shared Hoehe as Integer
Dim Shared starttime as Integer
Dim Shared Stroemungsabriss as Integer
Dim Shared mehr as Integer
Dim Beta as Integer
Dim ErsteRunde as Integer
Dim Max as Integer
Dim Max2 as integer
Dim Max3 as integer
Dim z as Integer
Dim mehrBaeume as integer
Dim Runde as integer
Dim Hallo as Integer
Dim Wetter as String
Dim Rechts as Integer
Dim Unten as Integer
Dim Ende as Integer
Screen 7, , 0, '1
'// Hauptschleife
Do
screenlock
cls
'// Rotationswinkel um die Y-Achse erh”hen
'// und vermeiden, dass wir einen šberlauf kriegen
'Alpha = Alpha + 1 'Stillgelegt
'IF Alpha >= 360 THEN Alpha = 0
'// Dreieck im Objektraum drehen
'FOR bb = 1 TO AnzahlDerBaeume
'RotiereXYZFACETRI3D Dreieck(bb), Alpha, Beta, Gamma, TransDreieck(bb)
'NEXT bb
'// Transformiertes Dreieck in den Kameraraum transformieren
For BBB as integer= 1 To AnzahlDerBaeume
VerschiebeKameraFACETRI3D TransDreieck(BBB), kamera, TransDreieck(BBB)
Next BBB
'// Projizieren und Zeichnen
'
'Das ist ein bisschen kompliziert. Eine kleine Erl„uterung:
' P2
' /\
' / \
' / \
' / \
' / \
'P1----------P3
' P5| |P4
' | |
' | |
' | |
' | |
' P7--P6
'
'Das soll ein BAUM sein. Die ganzen Ps sind die Punkte
'Die Verteilung der Baume geschieht per Zufallszahlen
If genug < AnzahlDerBaeume Then
'Max = INT((10000 - 1000 + 1) * RND + 1000)
If ErsteRunde = 0 Then
Max = Int((3 - 2) + 1) * Rnd + 2
ErsteRunde = 1
Else
If Max3 = 1 Then
Max = 2
Max2 = 0
End If
If Max2 = 1 Then
Max = 3
Max3 = 0
End If
If Max = 3 Then
Max = 1000
Max3 = 1
Max2 = 0
End If
If Max = 2 Then
Max = 100
Max2 = 1
Max3 = 0
End If
End If
For B as integer = genug To AnzahlDerBaeume
Dreieck(B).p1.x = Max 'INT((Max - -Max + 1) * RND + -Max) 'INT(RND * 10000) + -10000
Dreieck(B).p1.y = Int(Rnd * 100) + -100
Dreieck(B).p1.z = Int(Rnd * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 40
Dreieck(B).p2.y = Dreieck(B).p1.y + 80
Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80
Dreieck(B).p3.y = Dreieck(B).p1.y
Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48
Dreieck(B).p4.y = Dreieck(B).p1.y
Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40
Dreieck(B).p5.y = Dreieck(B).p1.y
Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48
Dreieck(B).p6.y = Dreieck(B).p1.y - 40
Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40
Dreieck(B).p7.y = Dreieck(B).p1.y - 40
Dreieck(B).p7.z = Dreieck(B).p1.z
If Err = 9 Then
Print "Leider ist ein Technischer Fehler aufgetreten"
Sleep 2
'RUN
End If
'ZeichneFACETRI3D Dreieck(B), 4
genug = genug + 1
z = z + 1
Next B
End If
If genug >= AnzahlDerBaeume Then
For ba as integer = 1 To AnzahlDerBaeume
Dreieck(ba).p2.x = Dreieck(ba).p1.x + 40: Dreieck(ba).p2.y = Dreieck(ba).p1.y + 80: Dreieck(ba).p2.z = Dreieck(ba).p1.z
Dreieck(ba).p3.x = Dreieck(ba).p1.x + 80: Dreieck(ba).p3.y = Dreieck(ba).p1.y: Dreieck(ba).p3.z = Dreieck(ba).p1.z
Dreieck(ba).p4.x = Dreieck(ba).p1.x + 48: Dreieck(ba).p4.y = Dreieck(ba).p1.y: Dreieck(ba).p4.z = Dreieck(ba).p1.z
Dreieck(ba).p5.x = Dreieck(ba).p1.x + 40: Dreieck(ba).p5.y = Dreieck(ba).p1.y: Dreieck(ba).p5.z = Dreieck(ba).p1.z
Dreieck(ba).p6.x = Dreieck(ba).p1.x + 48: Dreieck(ba).p6.y = Dreieck(ba).p1.y - 40: Dreieck(ba).p6.z = Dreieck(ba).p1.z
Dreieck(ba).p7.x = Dreieck(ba).p1.x + 40: Dreieck(ba).p7.y = Dreieck(ba).p1.y - 40: Dreieck(ba).p7.z = Dreieck(ba).p1.z
ZeichneFACETRI3D Dreieck(ba), 4
Next ba
End If
'Und hier wird berprft, ob die B„ume berhaupt zu sehen sind
For B as integer = 1 To AnzahlDerBaeume
If Dreieck(B).p1.z <= 0 Then
'genug = genug - 1
Dreieck(B).p1.x = Int((1000 - -1000 + 1) * Rnd + -5000)
Dreieck(B).p1.y = Int(Rnd * 100) + -100
Dreieck(B).p1.z = Int(Rnd * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 30
Dreieck(B).p2.y = Dreieck(B).p1.y + 70
Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80
Dreieck(B).p3.y = Dreieck(B).p1.y
Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48
Dreieck(B).p4.y = Dreieck(B).p1.y
Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40
Dreieck(B).p5.y = Dreieck(B).p1.y
Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48
Dreieck(B).p6.y = Dreieck(B).p1.y - 40
Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40
Dreieck(B).p7.y = Dreieck(B).p1.y - 40
Dreieck(B).p7.z = Dreieck(B).p1.z
End If
If Dreieck(B).p1.x = -1500 Or Dreieck(B).p1.z < 30 Then
genug = genug - 1
Dreieck(B).p1.x = Int((1000 - -1000 + 1) * Rnd + -5000)
Dreieck(B).p1.y = Int(Rnd * 100) + -100
Dreieck(B).p1.z = Int(Rnd * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 40
Dreieck(B).p2.y = Dreieck(B).p1.y + 80
Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80
Dreieck(B).p3.y = Dreieck(B).p1.y
Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48
Dreieck(B).p4.y = Dreieck(B).p1.y
Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40
Dreieck(B).p5.y = Dreieck(B).p1.y
Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48
Dreieck(B).p6.y = Dreieck(B).p1.y - 40
Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40
Dreieck(B).p7.y = Dreieck(B).p1.y - 40
Dreieck(B).p7.z = Dreieck(B).p1.z
End If
If Dreieck(B).p1.y = -10 Or Dreieck(B).p1.y = 50 Then
genug = genug - 10
Dreieck(B).p1.x = Int((1000 - -1000 + 1) * Rnd + -5000)
Dreieck(B).p1.y = Int(Rnd * 100) + -100
Dreieck(B).p1.z = Int(Rnd * 0) + 10000
'Dreieck.p1.x = -40: Dreieck.p1.y = -40: Dreieck.p1.z = 0
Dreieck(B).p2.x = Dreieck(B).p1.x + 40
Dreieck(B).p2.y = Dreieck(B).p1.y + 80
Dreieck(B).p2.z = Dreieck(B).p1.z
Dreieck(B).p3.x = Dreieck(B).p1.x + 80
Dreieck(B).p3.y = Dreieck(B).p1.y
Dreieck(B).p3.z = Dreieck(B).p1.z
Dreieck(B).p4.x = Dreieck(B).p1.x + 48
Dreieck(B).p4.y = Dreieck(B).p1.y
Dreieck(B).p4.z = Dreieck(B).p1.z
Dreieck(B).p5.x = Dreieck(B).p1.x + 40
Dreieck(B).p5.y = Dreieck(B).p1.y
Dreieck(B).p5.z = Dreieck(B).p1.z
Dreieck(B).p6.x = Dreieck(B).p1.x + 48
Dreieck(B).p6.y = Dreieck(B).p1.y - 40
Dreieck(B).p6.z = Dreieck(B).p1.z
Dreieck(B).p7.x = Dreieck(B).p1.x + 40
Dreieck(B).p7.y = Dreieck(B).p1.y - 40
Dreieck(B).p7.z = Dreieck(B).p1.z
End If
Next B
If mehrBaeume = 1 Then
'LOCATE 1, 1: PRINT "Mehr Baeume"
'AnzahlDerBaeume = AnzahlDerBaeume + 90
If Runde = 10 Then
Hallo = 1
Runde = Runde + 1
End IF
If Runde > 10 Then
Runde = 1
End If
End If
If Hallo = 1 Then
AnzahlDerBaeume = AnzahlDerBaeume + 90
End If
If AnzahlDerBaeume >= MaxBaeume Then
AnzahlDerBaeume = MaxBaeume
End If
DrawFlugzeug(Geschwindigkeit, Neigung1, Hoehe, starttime, Stroemungsabriss, Variometer)
Line (1, 1)-(400, 35), 0, BF
Alt (Hoehe)
Speed (Geschwindigkeit)
Neigung (Neigung1)
Variomet (Variometer)
'// Wetterdaten auswerten
Wetter = "Tag"
If Wetter = "Tag" Then
Tag(y1, y2)
Else
Nacht(y1)
End If
'// Wolken zeichnen
Wolke1(100, y1 - 25)
Wolke1(150, y1 - 20)
Wolke1(200, y1 - 40)
Line (0, 150)-(320, 150), 8
Line (20, 150)-(0, 0), 8
Line (300, 150)-(320, 0), 8
Line (160, 150)-(120, 0), 8
Line (160, 150)-(200, 0), 8
Line (0, 1)-(320, 1), 8
Paint (10, 149), 8
Paint (160, 147), 8
Paint (310, 148), 8
Paint (3, 0), 8
Paint (122, 0), 8
Paint (222, 0), 8
Paint (5, 151), 8, 15
'LINE (1, y1)-(400, y1), 0, BF
DrawHilfen(Geschwindigkeit, Neigung1, Hoehe, Variometer, Stroemungsabriss)
'// Hier nehmen wir die Tastatureingabe
'// vom Benutzer entgegen. Derzeit noch mit INKEY$
For f as integer = 1 To AnzahlDerBaeume
vorher(f) = Dreieck(f).p1.z
Next f
Taste = Inkey
'// Bewegung entlang positiver Z-Achse (vorw„rts)?
If (Taste = Chr(255) + Chr(62)) Then 'F4-Taste
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z + 1
'NEXT j
mehr = mehr + AnzahlDerBaeume
Geschwindigkeit = 200
Vektor.z = 200
End If
'// Bewegung entlang der negativen Z-Achse (rckw„rts)?
If (Taste = Chr(255) + Chr(59)) Then 'F1-Taste ?
Geschwindigkeit = 0
Vektor.z = 0
End If
If (Taste = Chr(255) + Chr(61)) Then 'F3-Taste
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z + 1
'NEXT j
mehr = mehr + AnzahlDerBaeume
If Geschwindigkeit < 200 Then
Geschwindigkeit = Geschwindigkeit + 1
Vektor.z = Vektor.z + 1
End If
If Geschwindigkeit < 0 Then Geschwindigkeit = 0
End If
'// Bewegung entlang negativer Z-Achse (rckw„rts)?
'// Dies ist eine unbeschriebene Funktion, die in
'// der Wirklichkein nicht stattfindet
If (lcase(Taste) = "s") Then
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z + 1
'NEXT j
Geschwindigkeit = Geschwindigkeit - 1
Vektor.z = Vektor.z - 1
End If
If (Taste = Chr(255) + Chr(60)) Then 'F2-Taste
'FOR j = 1 TO 9
' Dreieck(j).p1.z = Dreieck(j).p1.z - 1
'NEXT j
Geschwindigkeit = Geschwindigkeit - 1
Vektor.z = Vektor.z - 1
If Geschwindigkeit < 0 Then Geschwindigkeit = 0
End If
'// Bewegung entlang positiver X-Achse (Rechts%)?
If (Taste = Chr(255) + Chr(77)) Then '
'FOR j = 1 TO 9
' Dreieck(j).p1.x = Dreieck(j).p1.x - 1
'NEXT j
Beta = Beta + 10
Neigung1 = Neigung1 + 10
Rechts = Rechts + 10
Vektor.x = Vektor.x + 10
If Rechts > 360 Then Rechts = 0
End If
'// Bewegung entlang negativer X-Achse (links)?
If (Taste = Chr(255) + Chr(75)) Then
'FOR j = 1 TO 9
' Dreieck(j).p1.x = Dreieck(j).p1.x + 1
'NEXT j
Beta = Beta - 10
Neigung1 = Neigung1 - 10
Rechts = Rechts - 10
Vektor.x = Vektor.x - 10
If Rechts < -360 Then Rechts = 0
End If
'// Bewegung entlang positiver Y-Achse (unten)?
If (Taste = Chr(255) + Chr(80)) Then
'FOR j = 1 TO 9
' Dreieck(j).p1.y = Dreieck(j).p1.y - 1
'NEXT j
'Unten = Unten - 10
Variometer = Variometer - 1
'Vektor.y = Vektor.y - 10
If Unten < 0 Then Unten = 0
y1 = y1 - 1
y2 = y2 - 1
If y1 < 0 Then y1 = 0
If y2 < 0 Then y2 = 0
End If
'// bewegung entlang negativen Y-Achse (oben)?
If (Taste = Chr(255) + Chr(72)) Then
'FOR j = 1 TO 9
' Dreieck(j).p1.y = Dreieck(j).p1.y + 1
'NEXT j
'Unten = Unten + 10
Variometer = Variometer + 1
Vektor.y = Vektor.y + 10
y1 = y1 + 1
y2 = y2 + 1
If Unten < 0 Then Unten = 0
End If
'//Str”mungsabriss?
If Variometer > 50 Or Variometer < -50 Then
Stroemungsabriss = 1
Else
Stroemungsabriss = 0
End If
If lcase(Taste) = "o" Then
Variometer = 0
End If
If (Taste = Chr(27)) Then '//Wenn Escape-Taste
Ende = 1 ' gedrckt dann
End If ' Ende = 1
Hoehe = Hoehe + Variometer
If Hoehe = 0 And Variometer < -10 Then
BOOM
End If
If Hoehe < 0 Then
Hoehe = 0
Variometer = 0
End If
y1 = y1 + Variometer
If y1 < 0 Then
y1 = 0
End If
'// [("Alle")] Baume verschieben
For GG as integer = 1 To AnzahlDerBaeume
Vektor.z = Geschwindigkeit
Vektor.x = Rechts
Vektor.y = Hoehe
kamera.Position.z = Geschwindigkeit
kamera.Position.x = Rechts
kamera.Position.y = Hoehe
'CALL VerschiebeFACETRI3D(Dreieck(GG), Vektor, Dreieck(GG))
'CALL VerschiebeKameraFACETRI3D(Dreieck(GG), kamera, Dreieck(GG))
Dreieck(GG).p1.z = Dreieck(GG).p1.z - Geschwindigkeit
Dreieck(GG).p1.x = Dreieck(GG).p1.x - Rechts
Dreieck(GG).p1.y = -Hoehe 'Dreieck(GG).p1.Y - Hoehe
'y2 = y2 + Unten
If vorher(GG) <> Dreieck(GG).p1.z Then
mehrBaeume = 1
Else
mehrBaeume = 0
End If
If Hoehe < 252 And Dreieck(GG).p1.z = 0 Then
BOOM
End If
Next GG
'LOCATE 1, 1
'PRINT "AnzahlDerBaeume:";
'PRINT AnzahlDerBaeume
'PRINT "Hallo:" + STR$(Hallo) + " ";
'PRINT "MehrBaeume:" + STR$(mehtBaeume%) + " ";
'PRINT "Runde: " + STR$(Runde) + " ";
'Bitte etwas Warten...
'time! = TIMER
'DO: LOOP UNTIL TIMER - time! = .05
'// Good old Doublebuffering...
'Pcopy 0, 1
'//Abbruch bei Druck auf Escape-Taste
ScreenUnlock
Loop Until Ende = 1
Ende:
'// zurck in den Textmodus (sch”ne Variante)
Screen 0
Width 80, 25
End
Sub Alt (byval Wert as integer)
Dim a as integer
Dim w as integer
Dim h as integer
Dim y as integer
Dim x as integer
dim o as integer
Dim B as integer
dim f as integer
dim dx as integer
dim dy as integer
dim i as integer
dim BYTES as Integer
dim FOM as integer
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = Int((BYTES + 1) / 1)
o = 0
Dim frame(FOM - 1, 1 To 11) As Integer
Open "Alt.qaa" For Input As #1
Do
Input #1, a, B, f
Pset (a, B), f
Loop Until Eof(1)
Close #1
'SLEEP
'FOR ax = 1 TO 10
'LINE (16, 384)-(336, 416), 0, BF
'NEXT
For x = 17 To (16 * 17) + 32 Step 32
o = o + 1
Line (x - 16, y - 16)-(x + 16, y + 16), 0, B
Get (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
Next x
dx = 0
dy = 0
o = 1
i = 5
'--------|
x = 50 '|
'....... |
y = 170 '|
'--------|
'DO
' a$ = ""
' WHILE a$ = ""
' a$ = INKEY$
'WEND
If Wert > 9 And Wert < 100 Then Wert = Wert / 10
If Wert > 100 And Wert < 1000 Then Wert = Wert / 100
dx = 0
dx = 1: o = Wert + 1: i = 0
'If a = Chr(27) Then End
If o > 9 Then o = 1
If i > 9 Then i = 1
If dx = 1 Then Put (x - 16, y - 16), frame(0, o), Pset
If dx = -1 Then Put (x - 16, y - 16), frame(0, i), Pset
x = x - dx * 0
'IF INKEY$ = CHR$(27) THEN EXIT SUB
'LOOP
End Sub
Sub BOOM
Cls
Screen 0
Color 0, 4
Cls
Width 80, 25
For y as integer = 1 To 25
For x as integer = 1 To 80
Locate y, x
Print "BOOM "
Next x
Next y
Sleep
Cls
For Farbe as integer = 1 To 15
Color Farbe
If Farbe = 4 Then
Color 19
End If
Print "Bitte Drcken Sie eine Taste zum berspringen"
Print "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
Print ""
Print ""
Print "ÛÛÛ ÛÛÛ ÛÛÛ ÛÛ ÛÛ"
Print "Û Û Û Û Û Û Û Û Û Û"
Print "Û Û Û Û Û Û Û Û Û Û"
Print "Û Û Û Û Û Û Û Û Û"
Print "ÛÛÛ Û Û Û Û Û Û Û"
Print "Û Û Û Û Û Û Û Û"
Print "Û Û Û Û Û Û Û Û"
Print "Û Û Û Û Û Û Û Û"
Print "ÛÛÛ ÛÛÛ ÛÛÛ Û Û"
Sleep 1
Next Farbe
Sleep
End
End Sub
Sub DrawFlugzeug (Byval Geschwindigkeit As Integer, _
Byval Neigung1 As Integer, _
Byval Hoehe As Integer, _
Byval starttime As Integer, _
Byval Stroemungsabriss As Integer, _
Byval Variometer As Integer)
'LINE (0, 150)-(320, 150), 8
'LINE (20, 150)-(0, 0), 8
'LINE (300, 150)-(320, 0), 8
'LINE (160, 150)-(120, 0), 8
'LINE (160, 150)-(200, 0), 8
'LINE (0, 1)-(320, 1), 8
'PAINT (10, 149), 8
'PAINT (160, 147), 8
'PAINT (310, 148), 8
'PAINT (160, 160), 8
'PAINT (3, 0), 8
'PAINT (122, 0), 8
'PAINT (222, 0), 8
Color 10', 8
Locate 25, 12
'PRINT "Geschwindigkeit: ";
Print Geschwindigkeit
Locate 25, 18
'PRINT "Neigung: ";
'PRINT Rechts!;
Print Neigung1
Locate 25, 6
'PRINT "H”he: ";
Print Hoehe
Locate 25, 24
'PRINT "Variometer:";
Print Variometer
'LOCATE 1, 24
'COLOR 4, 0
'PRINT "Start: ";
'PRINT starttime / 60 ^ 2
Locate 23, 1
If Stroemungsabriss = 1 Then
Locate 22, 26
Color 4, 0
Print "Str”mungsabriss"
Stroemungsabriss = 0
End If
'CALL Motor(Geschwindigkeit)
Color 15, 0
End Sub
Sub DrawHilfen (Byval Geschwindigkeit As Integer, _
Byval Neigung1 As Integer, _
Byval Hoehe As Integer, _
Byval Variometer As Integer, _
Byval Stroemungsabriss As Integer)
Locate 25, 12
'PRINT "Geschwindigkeit: ";
Print Geschwindigkeit
Locate 25, 18
'PRINT "Neigung: ";
'PRINT Rechts!;
Print Neigung1
Locate 25, 6
'PRINT "H”he: ";
Print Hoehe
Locate 25, 24
'PRINT "Variometer:";
Print Variometer
'LOCATE 1, 24
'COLOR 4, 0
'PRINT "Start: ";
'PRINT starttime / 60 ^ 2
Locate 23, 1
If Stroemungsabriss = 1 Then
Locate 22, 26
Color 4, 0
Print "Str”mungsabriss"
Stroemungsabriss = 0
End If
End Sub
Sub LoadJMP (Byval file As String)
'+------SYNTAX-------+
'| F$ - Eingabedatei |
'+-------------------+
Dim FF as Integer=FreeFile
Dim bByte As String*1
Dim id As String*8
Dim Farbe1 as Integer
Dim Anzahl as integer
Dim Start as Integer
Dim XSize as Integer
Dim YSize as Integer
Dim Row as String
Open file For Binary As #FF
Get #FF, 1, id
If id = "JMP10QB" + Chr(4) Then 'Standard: Farben 0-15 bzw. 0-255
Get #FF, 9, bByte '<== Cursorposition in Datei setzen fr lesen der Palette
Farbe1 = 0
Anzahl = Asc(bByte) ' und Farbanzahl festsetzen
Elseif id = "JMP10QB" + Chr(1) Then 'NEU: Farben, die ver„ndert werden sollen, k”nnen festgelegt werden
Get #FF, , bByte: Farbe1 = Asc(bByte) 'Farbe 1
Get #FF, , bByte: Anzahl = Asc(bByte) 'Farbe 2
Elseif id = "JMP10QB" + Chr(2) Then 'Graue Palette (Normal) Syntax wie oben
Get #FF, 9, bByte
Farbe1 = 0
Anzahl = Asc(bByte)
Elseif id = "JMP10QB" + Chr(3) Then 'Graue Palette (Extra) Syntax wie oben
Get #FF, , bByte: Farbe1 = Asc(bByte) 'Farbe 1
Get #FF, , bByte: Anzahl = Asc(bByte) 'Farbe 2
Else
Cls : Locate 1: Color 15: Print "No JMP-File!": End
End If
'Lese Palette
If id = "JMP10QB" + Chr(2) Or id = "JMP10QB" + Chr(3) Then
For Attr as integer = Farbe1 To Anzahl
Out &H3C8, Attr
Get #FF, , bByte
For RGB1 as integer = 1 To 3
Out &H3C9, Asc(bByte)
Next RGB1
Next Attr
Else
For Attr as integer = Farbe1 To Anzahl
Out &H3C8, Attr
For RGB1 as integer = 1 To 3: Get #1, , bByte
Out &H3C9, Asc(bByte)
Next RGB1
Next Attr
End If
If id = "JMP10QB" + Chr$(4) Then
If Anzahl = 15 Then Start = 60 Else Start = 800
Elseif id = "JMP10QB" + Chr$(2) Then
If Anzahl = 15 Then Start = 26 Else Start = 266
Elseif id = "JMP10QB" + Chr$(3) Then
Start = 10 + (Anzahl - Farbe1 + 1) + 5
Else
Start = 10 + (Anzahl - Farbe1 + 1) * 3 + 5
End If
'Bitmap
Get #FF, Start, Xsize
Get #FF, , Ysize
Get #FF, Start + 9, bByte '<== Cursorposition in Datei setzen fr lesen der Farben
For x as integer = 0 To Xsize
Row = Space(Ysize + 1): Get #FF, , Row
For y as integer = 0 To Ysize
Pset (x, y), Asc(Mid(Row, y + 1, 1))
Next y
Next x
Close #FF
End Sub
Sub Motor (Byval Geschwindigkeit As Integer)
'Das ist ein Versuch ein anst„ndiges Motorenger„usch
'zu erzeugen. Is'n bischen Nervig, deswegen habe ich es
'auch herausgenommen. Wer lust hat es fertig zu Programmieren
'kann dies auch tun. Es w„hre nett wenn man's mir zu Mailen
'wrde. Viel Spaá :-D
'SELECT CASE Geschwindigkeit
' CASE 0 TO 50
' SOUND 65.5, 1
' CASE 50 TO 100
' SOUND 98, 1
' CASE 100 TO 150
' SOUND 147, 1
' CASE 150 TO 200
' SOUND 196, 1
'END SELECT
'Zweiter versuch:
If Geschwindigkeit > 0 Then
'SOUND Geschwindigkeit + 50, 2
End If
End Sub
Sub Nacht (Byval y1 As Integer)
Dim AnzahlDerSterne as Integer
Dim sternX as Integer
Dim sternY as Integer
View Screen (1, 1)-(319, 199)
AnzahlDerSterne = 1000
For Sterne as integer = 1 To AnzahlDerSterne
'sternX = INT(RND * 400) + 1
'sternY = INT(RND * y1) + 1
Pset (sternX, sternY), 15
Next Sterne
View
End Sub
Sub Neigung (Byval Wert As Integer)
Dim w as integer
Dim h as integer
Dim y as integer
Dim x as integer
Dim o as Integer
Dim a as Integer
Dim B as Integer
Dim f as Integer
Dim i as Integer
Dim dx as integer
Dim dy as integer
Dim BYTES as Integer
Dim FOM as Integer
Dim FF as Integer=FreeFile
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = Int((BYTES + 1) / 1)
o = 0
Dim frame(FOM - 1, 1 To 11) As Integer
Open "Neigung.qaa" For Input As #FF
Do
Input #FF, a, B, f
Pset (a, B), f
Loop Until Eof(FF)
Close #FF
'SLEEP
'FOR ax = 1 TO 10
Line (16, 384)-(336, 416), 0, BF
'NEXT
For x = 17 To (16 * 17) + 32 Step 32
o = o + 1
Line (x - 16, y - 16)-(x + 16, y + 16), 0, B
Get (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
Next x
dx = 0
dy = 0
o = 1
i = 5
'--------|
x = 150 '|
'....... |
y = 170 '|
'--------|
'DO
' a$ = ""
' WHILE a$ = ""
' a$ = INKEY$
'WEND
If Wert > 9 And Wert < 100 Then Wert = Wert / 10
If Wert > 100 And Wert < 1000 Then Wert = Wert / 100
If Wert < 0 Then Wert = Wert * -1
If Wert < -9 And Wert < -100 Then Wert = (Wert / 10) * -1
If Wert < -100 And Wert < -1000 Then Wert = (Wert / 100) * -1
dx = 0
dx = 1: o = Wert + 1: i = 0
If o > 9 Then o = 1
If i > 9 Then i = 1
If dx = 1 Then Put (x - 16, y - 16), frame(0, o), Pset
If dx = -1 Then Put (x - 16, y - 16), frame(0, i), Pset
x = x - dx * 0
'IF INKEY$ = CHR$(27) THEN EXIT SUB
'LOOP
End Sub
'// Funktion: RotiereXPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um den Winkel Beta um die
'// X-Achse und speichert das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
Sub RotiereXPUNKT3D (Byval Punkt As PUNKT3D, _
Byval Beta As Single, _
Byref NeuPunkt As PUNKT3D)
NeuPunkt.x = Punkt.x
NeuPunkt.y = Punkt.y * Cos(DEGtoRAD * Beta) - Punkt.z * Sin(DEGtoRAD * Beta)
NeuPunkt.z = Punkt.y * Sin(DEGtoRAD * Beta) + Punkt.z * Cos(DEGtoRAD * Beta)
End Sub
'// Funktion: RotiereXYZFACETRI3D
'//
'// Beschreibung: Rotiert das bergebene Dreieck um die Winkel Alpha, Beta und
'// Gamma um die Z-, X- und Y-Achse und speichert das Ergebnis
'// in NeuDreieck
'//---------------------------------------------------------------------------
Sub RotiereXYZFACETRI3D (byval Dreieck As FACETRI3D, _
byval Alpha As Single, _
byval Beta As Single, _
byval Gamma As Single, _
byref NeuDreieck As FACETRI3D)
RotiereXYZPuNKT3D Dreieck.p1, Alpha, Beta, Gamma, NeuDreieck.p1
RotiereXYZPuNKT3D Dreieck.p2, Alpha, Beta, Gamma, NeuDreieck.p2
RotiereXYZPuNKT3D Dreieck.p3, Alpha, Beta, Gamma, NeuDreieck.p3
RotiereXYZPuNKT3D Dreieck.p4, Alpha, Beta, Gamma, NeuDreieck.p4
RotiereXYZPuNKT3D Dreieck.p5, Alpha, Beta, Gamma, NeuDreieck.p5
RotiereXYZPuNKT3D Dreieck.p6, Alpha, Beta, Gamma, NeuDreieck.p6
RotiereXYZPuNKT3D Dreieck.p7, Alpha, Beta, Gamma, NeuDreieck.p7
RotiereXYZPuNKT3D Dreieck.p8, Alpha, Beta, Gamma, NeuDreieck.p8
End Sub
'// Funktion: RotiereXYZPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um die Winkel Alpha, Beta und
'// Gamma um die Z-, X- und Y-Achse und speichert das Ergebnis
'// in NeuPunkt
'//---------------------------------------------------------------------------
Sub RotiereXYZPuNKT3D (byval Punkt As PUNKT3D, _
byval Alpha As Single, _
byval Beta As Single, _
byval Gamma As Single, _
byref NeuPunkt As PUNKT3D)
Dim ptemp1 As PUNKT3D
Dim ptemp2 As PUNKT3D
RotiereYPUNKT3D Punkt, Gamma, ptemp1
RotiereXPUNKT3D ptemp1, Beta, ptemp2
RotiereZPUNKT3D ptemp2, Alpha, NeuPunkt
End Sub
'// Funktion: RotiereYPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um den Winkel Gamma um die
'// Y-Achse und speichert das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
Sub RotiereYPUNKT3D (byval Punkt As PUNKT3D, _
byval Gamma As Single, _
byref NeuPunkt As PUNKT3D)
NeuPunkt.x = Punkt.z * Sin(DEGtoRAD * Gamma) + Punkt.x * Cos(DEGtoRAD * Gamma)
NeuPunkt.y = Punkt.y
NeuPunkt.z = Punkt.z * Cos(DEGtoRAD * Gamma) - Punkt.x * Sin(DEGtoRAD * Gamma)
End Sub
'// Funktion: RotiereZPUNKT3D
'//
'// Beschreibung: Rotiert den šbergebenen Punkt um den Winkel Alpha um die
'// Z-Achse und speichert das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
Sub RotiereZPUNKT3D (byval Punkt As PUNKT3D, _
byval Alpha As Single, _
byref NeuPunkt As PUNKT3D)
NeuPunkt.x = Punkt.y * Sin(DEGtoRAD * Alpha) + Punkt.x * Cos(DEGtoRAD * Alpha)
NeuPunkt.y = Punkt.y * Cos(DEGtoRAD * Alpha) - Punkt.x * Sin(DEGtoRAD * Alpha)
NeuPunkt.z = Punkt.z
End Sub
'// Funktion: SkaliereFACETRI3D
'//
'// Beschreibung: Skaliert das bergebene Dreieck um die Skalare Skalarx,
'// Skalary und Skalarz auf den drei Achsen und speichert
'// das Ergebnis in NeuDreieck
'//---------------------------------------------------------------------------
Sub SkaliereFACETRI3D (byval Dreieck As FACETRI3D, _
byval Skalarx As Single, _
byval Skalary As Single, _
byval Skalarz As Single, _
byref NeuDreieck As FACETRI3D)
SkalierePUnkt3D Dreieck.p1, Skalarx, Skalary, Skalarz, NeuDreieck.p1
SkalierePUnkt3D Dreieck.p2, Skalarx, Skalary, Skalarz, NeuDreieck.p2
SkalierePUnkt3D Dreieck.p3, Skalarx, Skalary, Skalarz, NeuDreieck.p3
SkalierePUnkt3D Dreieck.p4, Skalarx, Skalary, Skalarz, NeuDreieck.p4
SkalierePUnkt3D Dreieck.p5, Skalarx, Skalary, Skalarz, NeuDreieck.p5
SkalierePUnkt3D Dreieck.p6, Skalarx, Skalary, Skalarz, NeuDreieck.p6
SkalierePUnkt3D Dreieck.p7, Skalarx, Skalary, Skalarz, NeuDreieck.p7
SkalierePUnkt3D Dreieck.p8, Skalarx, Skalary, Skalarz, NeuDreieck.p8
End Sub
'// Funktion: SkaliereFACETRI3D
'//
'// Beschreibung: Skaliert den bergebenen Punkt um die Skalare Skalarx,
'// Skalary und Skalarz auf den drei Achsen und speichert
'// das Ergebnis in NeuPunkt
'//---------------------------------------------------------------------------
Sub SkalierePUnkt3D (byval Punkt As PUNKT3D, _
byval Skalarx As Single, _
byval Skalary As Single, _
byval Skalarz As Single, _
byref NeuPunkt As PUNKT3D)
NeuPunkt.x = Punkt.x * Skalarx
NeuPunkt.y = Punkt.y * Skalary
NeuPunkt.z = Punkt.z * Skalarz
End Sub
Sub Speed (byval Wert as integer)
Dim w as integer
dim h as integer
dim y as integer
dim x as integer
dim i as integer
dim o as integer
Dim a as integer
Dim B as integer
dim f as integer
dim dx as integer
dim dy as integer
dim BYTES as integer
Dim FOM as Integer
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = Int((BYTES + 1) / 1)
o = 0
Dim frame(FOM - 1, 1 To 11) As Integer
Dim FF as Integer=FreeFile
Open "Speed.qaa" For Input As #FF
Do
Input #FF, a, B, f
'PSET (a, B), f
Loop Until Eof(FF)
Close
'FOR ax = 1 TO 10
' LINE (16, 384)-(336, 416), 0, BF
'NEXT
For x = 17 To (16 * 17) + 32 Step 32
o = o + 1
'LINE (x - 16, y - 16)-(x + 16, y + 16), 0, B
Get (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
Next x
dx = 0
dy = 0
o = 1
i = 5
'---------|
x = 100 '|
'....... |
y = 170 '|
'---------|
If Wert > 9 And Wert < 100 Then Wert = Wert / 10
If Wert > 100 And Wert < 1000 Then Wert = Wert / 100
If Wert < 0 Then Wert = Wert * -1
If Wert < -9 And Wert < -100 Then Wert = (Wert / 10) * -1
If Wert < -100 And Wert < -1000 Then Wert = (Wert / 100) * -1
dx = 0
dx = 1: o = Wert + 1: i = 0
If o > 9 Then o = 1
If i > 9 Then i = 1
If dx = 1 Then Put (x - 16, y - 16), frame(0, o), Pset
If dx = -1 Then Put (x - 16, y - 16), frame(0, i), Pset
x = x - dx * 0
End Sub
Sub Tag (byval y1 as integer, byval y2 as integer)
'PRINT "SUB Tag aufgerufen"
y1 = y2
y2 = y1
If y1 And y2 <= 0 Then Exit Sub
Line (0, y1)-(400, y2), 1
Paint (1, 1), 1
Circle (10, y1 - 20), 16, 14
Paint (15, y1 - 30), 14
End Sub
Sub Variomet (byval Wert as integer)
Dim w as integer
dim h as integer
dim y as integer
dim x as integer
dim i as integer
dim o as integer
Dim a as integer
Dim B as integer
dim f as integer
dim dx as integer
dim dy as integer
dim BYTES as integer
Dim FOM as Integer
w = 30: h = 30: y = 17: x = 17
BYTES = 30 * 30 + 4
FOM = Int((BYTES + 1) / 1)
o = 0
Dim frame(FOM - 1, 1 To 11) As Integer
Dim FF as Integer=FreeFile
Open "Variomet.qaa" For Input As #FF
Do
Input #1, a, B, f
Pset (a, B), f
Loop Until Eof(FF)
Close #FF
'SLEEP
'FOR ax = 1 TO 10
'LINE (16, 384)-(336, 416), 0, BF
'NEXT
For x = 17 To (16 * 17) + 32 Step 32
o = o + 1
Line (x - 16, y - 16)-(x + 16, y + 16), 0, B
Get (x - 16, y - 16)-(x + 16, y + 16), frame(0, o)
Next x
dx = 0
dy = 0
o = 1
i = 5
'--------|
x = 200 '|
'....... |
y = 170 '|
'--------|
'DO
' a$ = ""
' WHILE a$ = ""
' a$ = INKEY$
'WEND
If Wert > 9 And Wert < 100 Then Wert = Wert / 10
If Wert > 100 And Wert < 1000 Then Wert = Wert / 100
If Wert < 0 Then Wert = Wert * -1
If Wert < -9 And Wert < -100 Then Wert = (Wert / 10) * -1
If Wert < -100 And Wert < -1000 Then Wert = (Wert / 100) * -1
dx = 0
dx = 1: o = Wert + 1: i = 0
If o > 9 Then o = 1
If i > 9 Then i = 1
If dx = 1 Then Put (x - 16, y - 16), frame(0, o), Pset
If dx = -1 Then Put (x - 16, y - 16), frame(0, i), Pset
x = x - dx * 0
'IF INKEY$ = CHR$(27) THEN EXIT SUB
'LOOP
End Sub
'// Funktion: VerschiebeFACETRI3D
'//
'// Beschreibung: Verschiebt das bergebene Dreieck um den angegebenen
'// Vektor und speichert das Ergebnis in NeuDreieck
'//
'//---------------------------------------------------------------------------
Sub VerschiebeFACETRI3D (byval Dreieck As FACETRI3D, _
byval Vektor As VEKTOR3D, _
byref NeuDreieck As FACETRI3D)
VerschiebePUNKT3D Dreieck.p1, Vektor, Dreieck.p1
VerschiebePUNKT3D Dreieck.p2, Vektor, Dreieck.p2
VerschiebePUNKT3D Dreieck.p3, Vektor, Dreieck.p3
VerschiebePUNKT3D Dreieck.p4, Vektor, Dreieck.p4
VerschiebePUNKT3D Dreieck.p5, Vektor, Dreieck.p5
VerschiebePUNKT3D Dreieck.p6, Vektor, Dreieck.p6
VerschiebePUNKT3D Dreieck.p7, Vektor, Dreieck.p7
VerschiebePUNKT3D Dreieck.p8, Vektor, Dreieck.p8
End Sub
'// Funktion: VerschiebeKameraFACETRI3D
'//
'// Beschreibung: Verschiebt das bergebene Dreieck um die inverse
'// Kameraposition in vom Weltraum in den Kameraraum
'// rotiert es um die negativen Rotationswinkel der
'// Kameraachsen und speichert das Ergebnis in NeuDreieck
'//---------------------------------------------------------------------------
Sub VerschiebeKameraFACETRI3D (byval Dreieck As FACETRI3D, _
byval kamera As KAMERA3D, _
byref NeuDreieck As FACETRI3D)
Dim KameraVektor As VEKTOR3D
'// den inversen Vektor aus der Kameraposition
'// erstellen um den das Dreieck verschoben wird
KameraVektor.x = -kamera.Position.x
KameraVektor.y = -kamera.Position.y
KameraVektor.z = -kamera.Position.z
'// Alle Punkte des Dreiecks verschieben...
VerschiebeFACETRI3D Dreieck, KameraVektor, NeuDreieck
'// ...und um den Ursprung um die negativen
'// Rotationswinkel rotieren. Beachtet das
'// wir die Winkel nach Alpha (z), Beta (x), Gamma(y) bergeben mssen!!!
RotiereXYZFACETRI3D NeuDreieck, -kamera.Zrot, -kamera.Xrot, -kamera.Yrot, NeuDreieck
End Sub
'// Funktion: VerschiebePUNKT3D
'//
'// Beschreibung: Verschiebt den bergebenen Punkt um den angegebenen
'// Vektor und speichert das Ergebnis in NeuPunkt
'//
'//---------------------------------------------------------------------------
Sub VerschiebePUNKT3D (byval Punkt As PUNKT3D, _
byval Vektor As VEKTOR3D, _
byref NeuPunkt As PUNKT3D)
NeuPunkt.x = Punkt.x + Vektor.x
NeuPunkt.y = Punkt.y + Vektor.y
NeuPunkt.z = Punkt.z + Vektor.z
End Sub
Sub Wolke (byval x as integer, byval y as integer)
Dim RadiusDerWolke1 as Integer
Dim RadiusDerWolke2 as Integer
Dim RadiusDerWolke3 as Integer
Dim xDerWolke2 as Integer
Dim xDerWolke3 as Integer
Dim yDerWolke2 as Integer
Dim yDerWolke3 as Integer
RadiusDerWolke1 = Int(Rnd * 16) + 8
RadiusDerWolke2 = Int(Rnd * 16) + 8
RadiusDerWolke3 = Int(Rnd * 16) + 8
xDerWolke2 = x - RadiusDerWolke1 + 9
yDerWolke2 = y '- RadiusDerWolke1 + 9
xDerWolke3 = x + RadiusDerWolke1 + 9
yDerWolke3 = y '+ RadiusDerWolke1 + 9
Circle (x, y), RadiusDerWolke1
Circle (xDerWolke2, yDerWolke2), RadiusDerWolke2
Circle (xDerWolke3, yDerWolke3), RadiusDerWolke3
Paint (x - 8, y - 8), 15
Paint (xDerWolke2 + 3, yDerWolke2 + 3), 15
Paint (xDerWolke3 + 3, yDerWolke3 + 3), 15
End Sub
Sub Wolke1 (byval x as integer, byval y as integer)
Dim RadiusDer1Wolke as Integer
Dim RadiusDer2Wolke as Integer
Dim RadiusDer3Wolke as Integer
Dim xDer2Wolke as Integer
Dim xDer3Wolke as Integer
Dim yDer2Wolke as Integer
Dim yDer3Wolke as Integer
RadiusDer1Wolke = 16
RadiusDer2Wolke = 8
RadiusDer3Wolke = 10
xDer2Wolke = x + 16
yDer2Wolke = y
xDer3Wolke = x - 10
yDer3Wolke = y
Circle (x, y), 15
Circle (xDer2Wolke, yDer2Wolke), RadiusDer2Wolke, 15
Circle (xDer3Wolke, yDer3Wolke), RadiusDer3Wolke, 15
Paint (x + 3, y + 3), 15
Paint (xDer2Wolke, yDer2Wolke), 15
Paint (xDer3Wolke, yDer3Wolke), 15
Paint (x + 14, y), 15
Paint (xDer3Wolke - 8, yDer3Wolke - 1), 15
End Sub
'// Funktion: ZeichneFACETRI3D
'//
'// Beschreibung: Projiziert die Punkte der ganzen B„ume auf die Projektions-
'// fl„che (Bildschirmkoordinatensystem) und zeichnet die
'// die Verbindungslinien zwischen den Punkten (Drahtgitter-
'// modell)
'//---------------------------------------------------------------------------
Sub ZeichneFACETRI3D (byval Dreieck As FACETRI3D, byval Farbe As Integer)
Dim as integer xp1, yp1
Dim as integer xp2, yp2
Dim as integer xp3, yp3
Dim as integer xp4, yp4
Dim as integer xp5, yp5
Dim as integer xp6, yp6
Dim as integer xp7, yp7
Dim as integer xp8, yp8
Dim as String xp1s, yp1s
Dim as String xp2s, yp2s
Dim as String xp3s, yp3s
Dim as String xp4s, yp4s
Dim as String xp5s, yp5s
Dim as String xp6s, yp6s
Dim as String xp7s, yp7s
Dim as String xp8s, yp8s
Dim as Integer xx, yy
xp1 = Dreieck.p1.x * FOCUS / (FOCUS + Dreieck.p1.z) + 160
yp1 = -Dreieck.p1.y * FOCUS / (FOCUS + Dreieck.p1.z) + 100
xp2 = Dreieck.p2.x * FOCUS / (FOCUS + Dreieck.p2.z) + 160
yp2 = -Dreieck.p2.y * FOCUS / (FOCUS + Dreieck.p2.z) + 100
xp3 = Dreieck.p3.x * FOCUS / (FOCUS + Dreieck.p3.z) + 160
yp3 = -Dreieck.p3.y * FOCUS / (FOCUS + Dreieck.p3.z) + 100
xp4 = Dreieck.p4.x * FOCUS / (FOCUS + Dreieck.p4.z) + 160
yp4 = -Dreieck.p4.y * FOCUS / (FOCUS + Dreieck.p4.z) + 100
xp5 = Dreieck.p5.x * FOCUS / (FOCUS + Dreieck.p5.z) + 160
yp5 = -Dreieck.p5.y * FOCUS / (FOCUS + Dreieck.p5.z) + 100
xp6 = Dreieck.p6.x * FOCUS / (FOCUS + Dreieck.p6.z) + 160
yp6 = -Dreieck.p6.y * FOCUS / (FOCUS + Dreieck.p6.z) + 100
xp7 = Dreieck.p7.x * FOCUS / (FOCUS + Dreieck.p7.z) + 160
yp7 = -Dreieck.p7.y * FOCUS / (FOCUS + Dreieck.p7.z) + 100
xp8 = Dreieck.p8.x * FOCUS / (FOCUS + Dreieck.p8.z) + 160
yp8 = -Dreieck.p8.y * FOCUS / (FOCUS + Dreieck.p8.z) + 100
xp1s = Str(Int(xp1)): yp1s = Str(Int(yp1))
xp2s = Str(Int(xp2)): yp2s = Str(Int(yp2))
xp3s = Str(Int(xp3)): yp3s = Str(Int(yp3))
xp4s = Str(Int(xp4)): yp4s = Str(Int(yp4))
xp5s = Str(Int(xp5)): yp5s = Str(Int(yp5))
xp6s = Str(Int(xp6)): yp6s = Str(Int(yp6))
xp7s = Str(Int(xp7)): yp7s = Str(Int(yp7))
'Neigung:
'IF Neigung1 > 360 THEN Neigung% = 0
'IF Neigung1 < -360 THEN Neigung = 0
'Neigung$ = STR$(Neigung%)
'DRAW "TA" + STR$(Neigung%)
'DRAW "TA60"
Line (xp1, yp1)-(xp2, yp2), 2
'DRAW "C4"
'DRAW "BM" + xp1$ + "," + yp1$ + ""
'DRAW "M" + xp2$ + "," + yp2$ + ""
Line (xp2, yp2)-(xp3, yp3), 2
'DRAW "C4"
'DRAW "BM" + xp2$ + "," + yp2$ + ""
'DRAW "M" + xp3$ + "," + yp3$ + ""
Line (xp3, yp3)-(xp1, yp1), 2
'DRAW "C4"
'DRAW "BM" + xp3$ + "," + yp3$ + ""
'DRAW "M" + xp1$ + "," + yp1$ + ""
Line (xp4, yp4)-(xp6, yp6), 6
'DRAW "C6"
'DRAW "BM" + xp4$ + "," + yp4$ + ""
'DRAW "M" + xp6$ + "," + yp6$ + ""
Line (xp5, yp5)-(xp7, yp7), 6
'DRAW "C6"
'DRAW "BM" + xp5$ + "," + yp5$ + ""
'DRAW "M" + xp7$ + "," + yp7$ + ""
Line (xp6, yp6)-(xp7, yp7), 6
'DRAW "BM" + xp6$ + "," + yp6$ + ""
'DRAW "M" + xp7$ + "," + yp7$ + ""
' LINE (xp7, yp7)-(xp8, yp8), 6
xx = xp1
yy = yp1 + 5
'PAINT (xx, yy), 2, 2 , CHR$(77)
End Sub
|
ScreenShot:
_________________
|
|
| Nach oben |
|
|
King-01
gesperrt
Anmeldungsdatum: 26.02.2007
Beiträge: 351
|
| Verfasst am: 07.09.2007, 12:25 Titel: |
|
|
wenn ich da die pfeil-hoch-taste drücke stürtzt das programm ab. und dann kommt diese windows-fehlermeldung.
_________________
[quote="IRC"](22:41:56)<PMedia>Jojo, hats nen Grund warum wir chatten obwohl du grad neben mir sitzt?
...
(23:00:59)<PMedia>USB war erst als Waffe geplant[/quote] |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 07.09.2007, 16:03 Titel: |
|
|
| Eternal_pain hat Folgendes geschrieben: | | Sooooo..... ich hab nu fast 2 stunden damit verbracht.. |
..sooo lange quäle ich mich mit diesem Programm aber nicht rum..
(das geht jetzt nicht gegen Eternal_Pain..)
Gerade bei großen Programmen(und dieses ist eines, deshalb gehört der Source-Code eigentlich nach NoPaste..)ist es wichtig,
die Berechnungen soweit als möglich zu reduzieren. Dazu einige Vorschläge: | Code: | ..
Const DEGtoRAD = (Atn(1)*4) / 180 ' "Grad in Bogenmaß"-Konstante |
..gut gelöst, aber hier wird eine unnötige (Double-)Berechnung durchgeführt.
Atn(1) wird mit 4 multipliziert und dann durch 180 geteilt. Warum das denn?
Kürzen heißt die Devise: | Code: | ..
Const DEGtoRAD = Atn(1) / 45 ' "Grad in Bogenmaß"-Konstante |
liefert ein identisches Ergebnis..
| Code: | | Max = Int((3 - 2) + 1) * Rnd + 2 |
..sieht sehr professionell aus, ist aber nur Augenwischerei, denn(wg. 3-2=1) liefertdasselbe..
(wer mag, kann ja mal ausgeben lassen, was bei Int(2) herauskommt  )
Richtig Bauchschmerzen bekam ich aber, als ich diesen | Code: | ..
Dreieck(B).p1.x = Int((1000 - -1000 + 1) * Rnd + -5000) |
gesehen habe, denn das ist nichts Anderes als | Code: | | Dreieck(B).p1.x = Int(2001 * Rnd -5000) |
..und hat mich letztendlich bewogen, diesen Code beiseite zu legen(und nicht mehr anzufassen).
Wohlgemerkt: Dies sind keine FreeBASIC- oder QuickBASIC-spezifischen Sachen!
(Es sind letztlich natürlich auch keine Fehler, aber ein umständlicher Programmierstil)
Das kann Absicht sein, um Programmiertricks zu verschleiern, da es sich wohl aber um eines der ersten Produkte von Ferdi
handeln dürfte, ist die Gefahr groß, daß er diesen Programmierstil beibehält.
Und das wäre nicht gut..
..für uns..
..aber erst recht nicht für ihn, denn wenn er in einem Jahr diesen Code nochmal ansieht, wird er sich sagen: *zensiert*
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 07.09.2007, 18:17 Titel: |
|
|
kleiner tipp:
du hast ja scheinbar schon wieder versucht das programm beim FB-Portal als Download einzustellen... Wie aus den vorherigen Beiträgen ersichtlich ist, ist das Programm alles andere als ausgereift, und die Download-Sektion ist eigentlich nicht für "gerade angefangene" Projekte gedacht... Verwende lieber Fb:Porticula zum Hochladen des Quellcodes, denn dort kannst Änderungen beliebig oft hochladen...
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 08.09.2007, 06:43 Titel: |
|
|
| King-01 hat Folgendes geschrieben: | | wenn ich da die pfeil-hoch-taste drücke stürtzt das programm ab. und dann kommt diese windows-fehlermeldung. |
Ich habe mich bisher nur darum bemueht ein wenig struktur in die ganze Sache zu bekommen, um es ein wenig uebersichtlicher zu gestalten, damit Fehler leichter gefunden werden koennen.
Leider muss ich mich aber ytwinky anschliessen und sagen, ich gebs auf 
Das ganze ist trotz allem noch sehr durcheinander und die einzelnen Funktionen/Subs schlecht aufeinander abgestimmt, so das man einige Zeit braucht um das ganze halbwegs vernuenftig zum laufen zu bekommen.
Aber vielleicht schafft es Ferdi ja, sein Programm bald ein wenig zu verbessern, denn ansich ist es kein schlechtes Projekt
_________________
|
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 10.09.2007, 16:51 Titel: |
|
|
Danke
Ich werd mal die ganzen unnüzen SUBs löschen, obwohl
ich die eigentlich drinn lassen wollte, da andere Programmierer
diese ewentuell zur verbesserung brauchen. Für alle sie brauchen:
Lest das Tuturial von MZ durch...
Ich ändere den Code schnellstmöglich (Unter der Woche darf
ich nicht an meinen PC[Schule{Heute Außnahme }).
Mehr Klammern gibt es nicht
Ich hoffe ich krieg das "Hauptproblem" ("Index Außerhalb
des Bereiches") in den Griff...(  )
Tschau... |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4699
Wohnort: ~/
|
| Verfasst am: 10.09.2007, 18:40 Titel: |
|
|
| Zitat: | | Mehr Klammern gibt es nicht |
<sicher?>
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 10.09.2007, 18:44 Titel: |
|
|
Zumals nen fetten Syntax Error gibt, denn du hast vergessen, die Klammer, die du bei "[PC' eingeleitet hast, nicht wieder geschlossen.
Index ausserhalb des Bereiches!
|
|
| Nach oben |
|
|
Ferdi
Anmeldungsdatum: 10.03.2007
Beiträge: 284
Wohnort: Berlin
|
| Verfasst am: 12.09.2007, 16:13 Titel: |
|
|
OK!
Die <> hatte ich vergessen damm mach ich:
Ich ändere den Code schnellstmöglich (Unter der Woche darf
ich nicht an meinen PC[Schule{Heute Außnahme<So mehr Klammern
gibt es wirklich nicht>}]).
Besser |
|
| 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
