Das deutsche QBasic- und FreeBASIC-Forum :: Thema anzeigen - ^^The ProggiGame

Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!

FAQ

Suchen

Mitgliederliste

Benutzergruppen

Profil

Einloggen, um private Nachrichten zu lesen

Login

Zur Begleitseite des Forums / Chat / Impressum

Aktueller Forenpartner:

^^The ProggiGame

Neues Thema eröffnen

Neue Antwort erstellen

Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Off-Topic-Forum

Vorheriges Thema anzeigen :: Nächstes Thema anzeigen

Autor

Nachricht

d1rty.h4rry

Anmeldungsdatum: 05.10.2006
Beiträge: 116
Wohnort: Cassel

Verfasst am: 09.10.2006, 19:25 Titel: ^^The ProggiGame

Antworten mit Zitat

hmmm. gestern abend ist mir etwas eingefallen was man bei OffTopic mal fun-mäßig machen könnte..
nachdem es PicOwnage, oder die Witze Sektion gibt, wäre es doch ganz lustig so etwas mit einem Programm
zu machen.. jemand gibt ein Programm vor und andere bauen immer wieder was dazu.. das Resultat könnte
ein lustiges oder auch sinnfreies Proggi sein.. bin mal gespannt, ob sich jemand anschließt happy

happy

Nich so schlimm wenn keiner will.. is ja nur mal so ne idee^^

Ich geb einfach mal was vor:

Code:

Screenres 640, 480, 32
Do

Loop until multikey( &h1 ) 'Escape -> Beenden

an jeder stelle dürfen befehle hinzugefügt und Parameter verändert werden... nur der Grundbefehl muss erhalten bleiben

(lame wäre jetzt natürlich in die erste zeile END zu schreiben happy

happy

)

bin gespannt happy

happy

d1rty

happy

h4rry
_________________
"Das Fernsehen ist so etwas wie eine geistige Neutronenbombe, das Gehirn wird weggestrahlt. Nur der Kopf bleibt da!" -Olliver Kalkhofe
-> http://fernsehkritik.tv/tv-magazin/
"Wenn alle Stricke reißen, dann häng ich mich auf", Karl Kreiss lächeln

lächeln

Zuletzt bearbeitet von d1rty.h4rry am 09.10.2006, 20:19, insgesamt einmal bearbeitet

Private Nachricht senden

MSN Messenger

A.K.

Anmeldungsdatum: 02.05.2005
Beiträge: 467
Wohnort: HH

Verfasst am: 09.10.2006, 20:17 Titel:

Antworten mit Zitat

joa, mal ausprobieren happy

happy

Code:

Screenres 640, 480, 32
Do
PRINT "Hello World"

Loop until multikey( &h1 ) 'Escape -> Beenden

_________________

http://forum.IconSoft.de
http://www.pnpbb.de - hol dir jetzt dein eigenes kostenloses Forum *NEU*

Private Nachricht senden

E-Mail senden

Website dieses Benutzers besuchen

Yahoo Messenger

MSN Messenger

Jojo
alter Rang

Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

Verfasst am: 09.10.2006, 20:26 Titel:

Antworten mit Zitat

ich verkleinre das ganze mal:

Code:

screen 18,32
do
? "Hello World!"
Loop until multikey(1)

_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.

Private Nachricht senden

Website dieses Benutzers besuchen

Mao

Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1

Verfasst am: 09.10.2006, 20:30 Titel:

Antworten mit Zitat

Hm, was könnte man da machen? grinsen

grinsen

Code:

screen 18,32
do
? "Hello World!"
sleep 500,1
Loop until multikey(1)

_________________
Eine handvoll Glück reicht nie für zwei.
--

Private Nachricht senden

Michael712
aka anfänger, programmierer

Anmeldungsdatum: 26.03.2005
Beiträge: 1593

Verfasst am: 09.10.2006, 20:31 Titel:

Antworten mit Zitat

Code:

Screen 18, 32
Do
Screenlock
Print "Hello World"
Screenunlock
Sleep 500,1
Loop until Multikey(1)

_________________

Code:

#include "signatur.bi"

Private Nachricht senden

E-Mail senden

d1rty.h4rry

Anmeldungsdatum: 05.10.2006
Beiträge: 116
Wohnort: Cassel

Verfasst am: 09.10.2006, 20:37 Titel:

Antworten mit Zitat

so verleihen wir dem ganzen mal ein wenig farbe.. happy

happy

Code:

screen 18,32
n=5
do
I=I+n
If I>100 then n=-n
If I<0 then n=-n
color RGB(100+I,200-I,50+I)
Screenlock
Print "Hello World!"
Screenunlock
Sleep 500,1
loop until multikey(1)

_________________
"Das Fernsehen ist so etwas wie eine geistige Neutronenbombe, das Gehirn wird weggestrahlt. Nur der Kopf bleibt da!" -Olliver Kalkhofe
-> http://fernsehkritik.tv/tv-magazin/
"Wenn alle Stricke reißen, dann häng ich mich auf", Karl Kreiss lächeln

lächeln

Private Nachricht senden

MSN Messenger

Kai Bareis

Anmeldungsdatum: 10.09.2004
Beiträge: 545
Wohnort: Baden Würtemberg

Verfasst am: 09.10.2006, 20:47 Titel:

Antworten mit Zitat

Code:

screen 18,32
dim as integer n, i
n=5
do
I=I+n
If I>100 then n=-n
If I<0 then n=-n
color RGB(100+I,200-I,50+I)
Screenlock
Print "Hello World!"
Screenunlock
Sleep 500,1
loop until multikey(1)

so sollte es funktionieren damit sich die farbe ändert
_________________
MfG Kai Bareis
Es ist noch kein Meister vom Himmel gefallen! Warum einfach wens auch umständlich geht!

Private Nachricht senden

E-Mail senden

Website dieses Benutzers besuchen

Jojo
alter Rang

Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

Verfasst am: 09.10.2006, 20:52 Titel:

Antworten mit Zitat

jetzt spiel ich "Hacker"

Code:

screen 18,32
dim as integer n, i
n=5
const helloSTR = "Hello "
do
I=I+n
If I>100 then n=-n
If I<0 then n=-n
color RGB(100+I,200-I,50+I)
Screenlock
Print helloSTR + chr(asc("W")) + "orld!"
? "OWNED!"
Screenunlock
Sleep 500,1
loop until multikey(1)

_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.

Private Nachricht senden

Website dieses Benutzers besuchen

Michael712
aka anfänger, programmierer

Anmeldungsdatum: 26.03.2005
Beiträge: 1593

Verfasst am: 09.10.2006, 20:52 Titel:

Antworten mit Zitat

Damit das vergessen von deklarationen nicht mehr vorkommt:

Code:

Option Explicit
screen 18,32
dim as integer n, i
n=5
const helloSTR = "Hello "
do
I=I+n
If I>100 then n=-n
If I<0 then n=-n
color RGB(100+I,200-I,50+I)
Screenlock
Print helloSTR + chr(asc("W")) + "orld!"
? "OWNED!"
Screenunlock
Sleep 500,1
loop until multikey(1)

_________________

Code:

#include "signatur.bi"

Private Nachricht senden

E-Mail senden

d1rty.h4rry

Anmeldungsdatum: 05.10.2006
Beiträge: 116
Wohnort: Cassel

Verfasst am: 09.10.2006, 21:05 Titel:

Antworten mit Zitat

pimp my Hello_World happy

happy

sleep changed
Special effekts

Code:

Option Explicit
const helloSTR = "Hello "
const scrX = 640
const scrY = 480
const SDep = 32
screenres scrX,ScrY,SDep
dim as integer n, i, a
n=5

do
a=a+1
I=I+n
If I>100 then n=-n
If I<0 then n=-n
color RGB(100+I,200-I,50+I)
Screenlock
Print helloSTR + chr(asc("W")) + "orld!"
? "OWNED!"
Screenunlock
Sleep 100,1
Circle (ScrX/2,ScrY/2),a,RGB(100+I,200-I,50+I)
If a>100 then a=0
loop until multikey(1)

d1rty

happy

h4rry
_________________
"Das Fernsehen ist so etwas wie eine geistige Neutronenbombe, das Gehirn wird weggestrahlt. Nur der Kopf bleibt da!" -Olliver Kalkhofe
-> http://fernsehkritik.tv/tv-magazin/
"Wenn alle Stricke reißen, dann häng ich mich auf", Karl Kreiss lächeln

lächeln

Private Nachricht senden

MSN Messenger

Jojo
alter Rang

Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

Verfasst am: 09.10.2006, 21:24 Titel:

Antworten mit Zitat

much better!

Code:

Option Explicit
const helloSTR = "Hello "
const scrX = 640
const scrY = 480
const SDep = 32
screenres scrX,ScrY,SDep
dim as integer n, i, a
n=5

do
a=a+1
I=I+n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
Print helloSTR + chr(asc("W")) + "orld!"
? "OWNED!"
Screenunlock
Sleep 100,1
Circle (ScrX/2,ScrY/2),a,RGB(100+I,200-I,50+I)
If a>100 then a=0
loop until multikey(1)

_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.

Private Nachricht senden

Website dieses Benutzers besuchen

Kai Bareis

Anmeldungsdatum: 10.09.2004
Beiträge: 545
Wohnort: Baden Würtemberg

Verfasst am: 09.10.2006, 21:39 Titel:

Antworten mit Zitat

Code:

Option Explicit
const helloSTR = "Hello "
const scrX = 640
const scrY = 480
const SDep = 32
screenres scrX,ScrY,SDep
dim as integer n, i, a
n=5

do
a=a+1
I=I+n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 1,1
Print helloSTR + chr(asc("W")) + "orld!"
locate 60,75
? "OWNED!";
Screenunlock
Sleep 100,1
Circle (ScrX/2,ScrY/2),a,RGB(100+I,200-I,50+I)
If a>100 then a=0
loop until multikey(1)

damit der kreis besser zu geltung kommt ein paar locates
_________________
MfG Kai Bareis
Es ist noch kein Meister vom Himmel gefallen! Warum einfach wens auch umständlich geht!

Private Nachricht senden

E-Mail senden

Website dieses Benutzers besuchen

Jojo
alter Rang

Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

Verfasst am: 09.10.2006, 21:56 Titel:

Antworten mit Zitat

noch ein paar fb-optimierungen gemacht (variabel = variable + 1 zu variable +=1)

Code:

Option Explicit
const helloSTR = "Hello "
const scrX = 640
const scrY = 480
const SDep = 32
screenres scrX,ScrY,SDep
dim as integer n, i, a
n=5

do
a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 1,1
Print helloSTR + chr(asc("W")) + "orld!"
locate 60,75
? "OWNED!";
Screenunlock
Sleep 100,1
Circle (ScrX/2,ScrY/2),a,RGB(100+I,200-I,50+I)
If a>100 then a=0
loop until multikey(1)

_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.

Private Nachricht senden

Website dieses Benutzers besuchen

ebrady

Anmeldungsdatum: 06.07.2005
Beiträge: 45

Verfasst am: 09.10.2006, 22:24 Titel:

Antworten mit Zitat

Gimme more FX!!

Code:

Option Explicit
const helloSTR = "Hello "
const scrX = 640
const scrY = 480
const SDep = 32
screenres scrX,ScrY,SDep
dim as integer n, i, a
n=5

do
a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 3,1
Print helloSTR + chr(asc("W")) + "orld!"
locate 60,75
? "OWNED!";
Screenunlock
Sleep 10,1
Circle (ScrX/2,ScrY/2),a,RGB(100+I,200-I,50+I)
Line (a,i)-(i,a),RGB(100+I,200-I,50+a)
If a>100 then a=0
loop until multikey(1)

Private Nachricht senden

Michael712
aka anfänger, programmierer

Anmeldungsdatum: 26.03.2005
Beiträge: 1593

Verfasst am: 09.10.2006, 22:56 Titel:

Antworten mit Zitat

Code:

Option Explicit
const scrX = 640
const scrY = 480
const SDep = 32
screenres scrX,ScrY,SDep
dim as integer n, i, a
n=5

Declare Function randtext(rand As Uinteger, lenght As uInteger) As String

do
a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 3,1
#ifdef __FB_WIN32__
Print randtext(2183834, 5);" ";randtext(23465344, 5) 'hoffe, das RND auf allen WIN version gleich geht happy

happy

#else
Print randtext(5148121, 5);" ";randtext(2262436, 5)
#endif
locate 60,75
? "OWNED!";
Screenunlock
Sleep 10,1
Circle (ScrX/2,ScrY/2),a,RGB(100+I,200-I,50+I)
Line (a,i)-(i,a),RGB(100+I,200-I,50+a)
If a>100 then a=0
loop until multikey(1)

Function randtext(rand As Uinteger, lenght As uInteger) As String
DIm i As Integer
Dim text As String
Randomize rand

For i = 1 to lenght
text += Chr(Rnd*(122-97+1)+97)
Next i

Return text
End Function

_________________

Code:

#include "signatur.bi"

Private Nachricht senden

E-Mail senden

Paul
aka ICC, HV-Freak

Anmeldungsdatum: 11.09.2004
Beiträge: 588
Wohnort: Uelzen

Verfasst am: 10.10.2006, 01:49 Titel:

Antworten mit Zitat

durchgeknallt

durchgeknallt

durchgeknallt

Code:

Option Explicit
Declare Function randtext(rand As Uinteger, lenght As uInteger) As String
const scrX = 640
const scrY = 480
const SDep = 32
dim as integer n=5, i, a, Angle=1, Farbe = 1, scrX2 = scrX, scrY2 = scrY, Angle2=5, Radius=1, DeltaRadius=2, DeltaAngle=2,Drehradius=1
DIM as SINGLE SINTable(0 to 359), COSTable(0 to 359)
CONST Pi = 4 * ATN(1)
FOR a = 0 to 359
SINTable(a) = SIN(a * (Pi / 180))
COSTable(a) = COS(a * (Pi / 180))
next a

a=1

screenres scrX,ScrY,SDep

do
Radius=Radius+DeltaRadius
Angle=Angle + DeltaAngle
Drehradius=Drehradius+SINTable(Angle)*2
If Angle > 300 or Angle < 0 then DeltaAngle=-DeltaAngle : Angle=Angle+DeltaAngle: DeltaRadius=-DeltaRadius: scrX2 = scrX + SINTable(Angle2) * Drehradius: scrY2 = scrY - COSTable(Angle2) * Drehradius: Angle2=Angle2+45
if Angle2 > 300 then Angle2=Angle2-360:
if Angle2 < 0 then Angle2=Angle2+360:

a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 3,1
#ifdef __FB_WIN32__
Print randtext(2183834, 5);" ";randtext(23465344, 5) 'hoffe, das RND auf allen WIN version gleich geht
#else
Print randtext(5148121, 5);" ";randtext(2262436, 5)
#endif
locate 60,75
? "OWNED!";
Screenunlock
Sleep 10,1
Circle (ScrX2/2-COSTable(int(Angle))*Radius,ScrY2/2+SINTable(int(Angle))*Radius),Angle / 3, RGB(Radius, Radius, Radius)
Line (a,i)-(i,a),RGB(100+I,200-I,50+a)
If a>100 then a=0
loop until multikey(1)
end

Function randtext(rand As Uinteger, lenght As uInteger) As String
DIm i As Integer
Dim text As String
Randomize rand

For i = 1 to lenght
text += Chr(Rnd*(122-97+1)+97)
Next i

Return text
End Function

_________________

Private Nachricht senden

E-Mail senden

Website dieses Benutzers besuchen

The real Agent D

Anmeldungsdatum: 24.11.2005
Beiträge: 605
Wohnort: Hall i. T.

Verfasst am: 10.10.2006, 21:08 Titel:

Antworten mit Zitat

Code:

'Überflüssige, sinnlose Komentarzeile

Option Explicit
Declare Function randtext(rand As Uinteger, lenght As uInteger) As String
const scrX = 640
const scrY = 480
const SDep = 32
dim as integer n=5, i, a, Angle=1, Farbe = 1, scrX2 = scrX, scrY2 = scrY, Angle2=5, Radius=1, DeltaRadius=2, DeltaAngle=2,Drehradius=1
DIM as SINGLE SINTable(0 to 359), COSTable(0 to 359)
CONST Pi = 4 * ATN(1)
FOR a = 0 to 359
SINTable(a) = SIN(a * (Pi / 180))
COSTable(a) = COS(a * (Pi / 180))
next a

a=1

screenres scrX,ScrY,SDep

do
Radius=Radius+DeltaRadius
Angle=Angle + DeltaAngle
Drehradius=Drehradius+SINTable(Angle)*2
If Angle > 300 or Angle < 0 then DeltaAngle=-DeltaAngle : Angle=Angle+DeltaAngle: DeltaRadius=-DeltaRadius: scrX2 = scrX + SINTable(Angle2) * Drehradius: scrY2 = scrY - COSTable(Angle2) * Drehradius: Angle2=Angle2+45
if Angle2 > 300 then Angle2=Angle2-360:
if Angle2 < 0 then Angle2=Angle2+360:

a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 3,1
#ifdef __FB_WIN32__
Print randtext(2183834, 5);" ";randtext(23465344, 5) 'hoffe, das RND auf allen WIN version gleich geht
#else
Print randtext(5148121, 5);" ";randtext(2262436, 5)
#endif
locate 60,75
? "OWNED!";
Screenunlock
Sleep 10,1
Circle (ScrX2/2-COSTable(int(Angle))*Radius,ScrY2/2+SINTable(int(Angle))*Radius),Angle / 3, RGB(Radius, Radius, Radius)
Line (a,i)-(i,a),RGB(100+I,200-I,50+a)
If a>100 then a=0
loop until multikey(1)
end

Function randtext(rand As Uinteger, lenght As uInteger) As String
DIm i As Integer
Dim text As String
Randomize rand

For i = 1 to lenght
text += Chr(Rnd*(122-97+1)+97)
Next i

Return text
End Function

Private Nachricht senden

Website dieses Benutzers besuchen

ytwinky

Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

Verfasst am: 11.10.2006, 00:09 Titel:

Antworten mit Zitat

ICC hat Folgendes geschrieben:

durchgeknallt

durchgeknallt

durchgeknallt

Code:

Option Explicit
Declare Function randtext(rand As Uinteger, lenght As uInteger) As String
Declare Function MenuChar(s As String, First=1, nVG=4+8)As String
const scrX = 640
const scrY = 480
const SDep = 32
dim as integer n=5, i, a, Angle=1, Farbe = 1, scrX2 = scrX, scrY2 = scrY, Angle2=5, Radius=1, DeltaRadius=2, DeltaAngle=2,Drehradius=1
DIM as SINGLE SINTable(0 to 359), COSTable(0 to 359)
CONST Pi = 4 * ATN(1)
FOR a = 0 to 359
SINTable(a) = SIN(a * (Pi / 180))
COSTable(a) = COS(a * (Pi / 180))
next a

a=1

screenres scrX,ScrY,SDep

do
Radius=Radius+DeltaRadius
Angle=Angle + DeltaAngle
Drehradius=Drehradius+SINTable(Angle)*2
If Angle > 300 or Angle < 0 then DeltaAngle=-DeltaAngle : Angle=Angle+DeltaAngle: DeltaRadius=-DeltaRadius: scrX2 = scrX + SINTable(Angle2) * Drehradius: scrY2 = scrY - COSTable(Angle2) * Drehradius: Angle2=Angle2+45
if Angle2 > 300 then Angle2=Angle2-360:
if Angle2 < 0 then Angle2=Angle2+360:

a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n

color rgb(255*rnd,255*rnd,I)
Screenlock
locate 3,1
#ifdef __FB_WIN32__
Print randtext(2183834, 5);" ";randtext(23465344, 5) 'hoffe, das RND auf allen WIN version gleich geht
#else
Print randtext(5148121, 5);" ";randtext(2262436, 5)
#endif
locate 60,75
? "OWNED!";
Screenunlock
Sleep 10,1
Circle (ScrX2/2-COSTable(int(Angle))*Radius,ScrY2/2+SINTable(int(Angle))*Radius),Angle / 3, RGB(Radius, Radius, Radius)
Line (a,i)-(i,a),RGB(100+I,200-I,50+a)
If a>100 then a=0
loop until multikey(1)
end

Function MenuChar(s As String, Erster=1, nVG=4+8)As String
Dim cVG=LoWord(Color), cHG=HiWord(Color)
If Erster<>1 Then ?Mid(s, 1, Erster-1);
Color nVG
?Mid(s, Erster, 1);
Color cVG, cHG
Return Mid(s, Erster+1)
End Function

Function randtext(rand As Uinteger, lenght As uInteger) As String
DIm i As Integer
Dim text As String
Randomize rand

For i = 1 to lenght
text += Chr(Rnd*(122-97+1)+97)
Next i

Return text
End Function

Falls jemand ein Menü basteln möchte:
Mit MenuChar() wird ein wählbarer Buchstabe eines Strings hellrot dargestellt..
z.B:

Code:

?MenuChar("Speichern")

Gruß
ytwinky
_________________

v1ctor hat Folgendes geschrieben:

Yeah, i like INPUT$(n) as much as PRINT USING..

..also ungefähr so, wie ich GOTO..

Private Nachricht senden

E-Mail senden

Website dieses Benutzers besuchen

d1rty.h4rry

Anmeldungsdatum: 05.10.2006
Beiträge: 116
Wohnort: Cassel

Verfasst am: 14.10.2006, 11:42 Titel:

Antworten mit Zitat

dass nenn ich ein "hallo welt"-Programm sowas sollte man anfängern zeigen happy

happy

neue features:
-Mauseinbindung (xy,buttons)
-DoubleBuffering durchgeknallt

durchgeknallt

-Sinuskurven happy

happy

-rotierendes kästchen Zunge rausstrecken

Zunge rausstrecken

-Fadenkreuz auf rechter maustaste cool

cool

-kreis auf linker maustaste
...

viel spass happy

happy

Code:

Option Explicit
Declare Function randtext(rand As Uinteger, lenght As uInteger) As String
Declare Function MenuChar(s As String, First=1, nVG=4+8)As String
const scrX = 640
const scrY = 480
const SDep = 32
dim as integer n=5, i, a, Angle=1,e, Farbe = 1, scrX2 = scrX, scrY2 = scrY, Angle2=5, Radius=1, DeltaRadius=2, DeltaAngle=2,Drehradius=1,X1,Y1,RL,Bb,U
DIM as SINGLE SINTable(0 to 359),X2(100),Y2(100), COSTable(0 to 359),X(4), Y(4), T(4),W
CONST Pi = 4 * ATN(1)
FOR a = 0 to 359
SINTable(a) = SIN(a * (Pi / 180))
COSTable(a) = COS(a * (Pi / 180))
next a

RL=30
a=1
W=6.3
FOR U = 1 TO 4
T(U)=U*(W/4)
next
For e = 1 to 50
X2(e)=e
next
For e = 51 to 100
X2(e)=ScrX-e
next
screenres scrX,ScrY,SDep,2
ScreenSet 0,1

setmouse ,,0
do
Radius=Radius+DeltaRadius
Angle=Angle + DeltaAngle
Drehradius=Drehradius+SINTable(Angle)*2
If Angle > 300 or Angle < 0 then DeltaAngle=-DeltaAngle : Angle=Angle+DeltaAngle: DeltaRadius=-DeltaRadius: scrX2 = scrX + SINTable(Angle2) * Drehradius: scrY2 = scrY - COSTable(Angle2) * Drehradius: Angle2=Angle2+45
if Angle2 > 300 then Angle2=Angle2-360:
if Angle2 < 0 then Angle2=Angle2+360:
a+=1
I+=n
If I>100 then n=-n
If I<0 then n=-n
color rgb(255*rnd,255*rnd,I)
Screenlock
locate 3,1
#ifdef __FB_WIN32__
Print randtext(2183834, 5);" ";randtext(23465344, 5) 'hoffe, das RND auf allen WIN version gleich geht
#else
Print randtext(5148121, 5);" ";randtext(2262436, 5)
#endif
locate 60,75
? "OWNED!";
Screenunlock
Sleep 10,1
Circle (ScrX2/2-COSTable(int(Angle))*Radius,ScrY2/2+SINTable(int(Angle))*Radius),Angle / 3, RGB(Radius, Radius, Radius)
Line (a,i)-(i,a),RGB(100+I,200-I,50+a)
GetMouse X1,Y1,,Bb
if X1 < 0 or Y1 < 0 then
X1 = ScrX/2
Y1 = ScrY/2
endif
For e = 51 to 100
X2(e)=X2(e)-1
IF X2(e) < 0 then X2(e)=ScrX
Y2(e)=Sin(X2(e)/20)*100
Pset(X2(e),Y2(e)+(ScrY/2)),RGB(255,(e*1.5)+80,255)
next
for e=1 to 50
X2(e)=X2(e)+1
IF X2(e) > ScrX then X2(e)=0
Y2(e)=Sin(X2(e)/20)*100
Pset(X2(e),Y2(e)+(ScrY/2)),RGB((e*1.5)+100,255,255)
next e
FOR U = 1 to 4
T(U) = T(U) + (W/360)
IF T(U) > W then T(U) = 0
X(U)=SIN(T(U))*((RL))
Y(U)=COS(T(U))*((RL))
IF Bb=1 then
Circle(X1,Y1),RL,RGB(255,255,255)
Paint(X1,Y1),RGB(20,20,100),RGB(255,255,255)
elseIF Bb=2 then
Circle(X1,Y1),10,RGB(255,255,255)
'Circle(X1,Y1),6,RGB(255,255,255)
Circle(X1,Y1),4,RGB(255,255,255)
Line(X1,Y1)-(X1,0),RGB(255,255,255)
Line(X1,Y1)-(X1,SCRY),RGB(255,255,255)
Line(X1,Y1)-(0,Y1),RGB(255,255,255)
Line(X1,Y1)-(ScrX,Y1),RGB(255,255,255)
else
Line(X(1)+X1,Y(1)+Y1)-(X(2)+X1,Y(2)+Y1),RGB(255,255,255)
Line(X(2)+X1,Y(2)+Y1)-(X(3)+X1,Y(3)+y1),RGB(255,255,255)
Line(X(3)+X1,Y(3)+Y1)-(X(4)+X1,Y(4)+Y1),RGB(255,255,255)
Line(X(4)+X1,Y(4)+Y1)-(X(1)+X1,Y(1)+Y1),RGB(255,255,255)
Paint(X1,Y1),RGB(20,20,100),RGB(255,255,255)
endif
NEXT
ScreenCopy 0,1
cls
If a>100 then a=0
loop until multikey(1)
end

Function MenuChar(s As String, Erster=1, nVG=4+8)As String
Dim cVG=LoWord(Color), cHG=HiWord(Color)
If Erster<>1 Then ?Mid(s, 1, Erster-1);
Color nVG
?Mid(s, Erster, 1);
Color cVG, cHG
Return Mid(s, Erster+1)
End Function

Function randtext(rand As Uinteger, lenght As uInteger) As String
DIm i As Integer
Dim text As String
Randomize rand

For i = 1 to lenght
text += Chr(Rnd*(122-97+1)+97)
Next i

Return text
End Function

_________________
"Das Fernsehen ist so etwas wie eine geistige Neutronenbombe, das Gehirn wird weggestrahlt. Nur der Kopf bleibt da!" -Olliver Kalkhofe
-> http://fernsehkritik.tv/tv-magazin/
"Wenn alle Stricke reißen, dann häng ich mich auf", Karl Kreiss lächeln

lächeln

Private Nachricht senden

MSN Messenger

Beiträge der letzten Zeit anzeigen:

	Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Off-Topic-Forum	Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

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