 |
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 |
Skilltronic
Anmeldungsdatum: 10.09.2004
Beiträge: 1148
Wohnort: Köln
|
 Verfasst am: 07.03.2008, 05:49 Titel: Mustergenerator |
 |
|
Hallo
Für eine Projektvorstellung reicht es nicht ganz, deshalb poste ich es hier. Ein kleines Programm, das basierend auf Langtons Ameise, zufällige Muster generiert. Oft entstehen nur chaotische, bunte Flecken, manchmal bilden sich aber auch komplexe Strukturen und überraschende Effekte.
| Code: | DEFINT A-Z
SCREEN 12
DIM weg(15)
RANDOMIZE TIMER
DO
CLS
FOR a = 0 TO 15
weg(a) = FIX(RND * 2) * 2 - 1
NEXT
x = 319
y = 239
DO
r = r + weg(POINT(x, y))
IF r = 4 THEN r = 0
IF r = -1 THEN r = 3
nf = POINT(x, y) + 1
IF nf = 16 THEN nf = 0
PSET (x, y), nf
IF r = 0 THEN x = x + 1
IF r = 1 THEN y = y + 1
IF r = 2 THEN x = x - 1
IF r = 3 THEN y = y - 1
IF x = 640 THEN x = 0
IF x = -1 THEN x = 639
IF y = 480 THEN y = 0
IF y = -1 THEN y = 479
taste$ = INKEY$
LOOP WHILE taste$ = ""
LOOP UNTIL taste$ = CHR$(27) |
Gruß
Skilltronic
_________________
Elektronik und QB? www.skilltronics.de ! |
|
| Nach oben |
|
 |
Elektronix
Anmeldungsdatum: 29.06.2006
Beiträge: 742
|
| Verfasst am: 07.03.2008, 16:41 Titel: |
|
|
Hübsche Sache- erinnert irgendwie an Kristallwachstum.
_________________
Und die Grundgebihr is aa scho drin- DOS is jo nett. |
|
| Nach oben |
|
|
DosCoder
Anmeldungsdatum: 02.03.2008
Beiträge: 25
|
| Verfasst am: 07.03.2008, 17:48 Titel: |
|
|
Klein aber fein - es könnte stundenlang den Fernseher ersetzen!!!  |
|
| Nach oben |
|
|
Random
Anmeldungsdatum: 09.03.2006
Beiträge: 47
|
| Verfasst am: 31.03.2008, 13:12 Titel: |
|
|
Ist es möglich, dieses Programm irgendwie auch in eine SUB einzubauen; denn das gäbe einen schönen Bildschirmschoner, nur will das bei mir nicht. Liegt wohl am DEFINT und der damit verbundenen "Parameterübergabe" oder so.  |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Random
Anmeldungsdatum: 09.03.2006
Beiträge: 47
|
| Verfasst am: 31.03.2008, 14:40 Titel: |
|
|
Vielen Dank. Das Programm allein hat bei mir auch funktioniert; doch konnte ich es eben leider nicht in ein anderes für den Schoner integrieren. Jetzt liegt es wahrscheinlich daran, dass man nicht zwei SUBs ineinander verschachteln kann, nehm ich mal an (hab da leider noch nicht ganz so den Durchblick). Hier sonst mal das Grundgerüst:
| Code: |
#include "windows.bi"
dim shared as integer mx_alt, my_alt, mx_neu, my_neu
dim shared as String Param
declare sub configurescreensaver
declare sub showscreensaver
if command(1) = "" then
if messagebox(0, "sreensaver testen?", " ", mb_iconquestion or mb_yesno) = idyes then
showscreensaver
end if
end
end if
param = Mid(Command(1), 2, 1)
select case param
case "s", "S"
showscreensaver
case "c", "C"
configurescreensaver
end select
end
sub configurescreensaver
messagebox(0, "Es gibt nichts zu konfigurieren! ", " ", mb_iconinformation)
end sub
sub showscreensaver
dim as integer xmouse,ymouse,mousex,mousey
Dim As Integer WinXMode, VollBild, WinBreite, WinHoehe, FarbTiefe
ScreenInfo WinBreite, WinHoehe
If WinBreite >= 512 Then WinXMode = 16 '512x384
If WinBreite >= 640 Then WinXMode = 17 '640x400
If WinHoehe >= 480 Then WinXMode = 18 '640x480
If WinBreite >= 800 Then WinXMode = 19 '800x600
If WinBreite >= 1024 Then WinXMode = 20 '1024x768
If WinHoehe >= 1280 Then WinXMode = 21 '1280x1024
Screen WinXMode+1,,,1
setmouse ,,0
getmouse mx_alt, my_alt
randomize timer
DO
...
getmouse mx_neu, my_neu
if mx_neu<>mx_alt or my_neu<>my_alt or inkey <> "" then exit sub
loop
end sub
|
Wenn du das irgendwie machen könntest, wäre ich dir dankbar. Die Koordinaten könnte ich dann der Bildschirmgrösse wohl schon selber anpassen, auch dass es automatisch neue Muster generiert etc.; doch müsste es eben erstmal lauffähig sein. Ich würde dann das "fertige Programm" hier natürlich auch "veröffentlichen". Ich sag schon mal herzlichen Dank!! |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Random
Anmeldungsdatum: 09.03.2006
Beiträge: 47
|
| Verfasst am: 31.03.2008, 17:54 Titel: |
|
|
Klappt leider immernoch nicht. Irgendwie ist das Array bei
r = r + weg(POINT(x, y))
nicht definiert und dann gibt es da wohl noch ein Problem mit der Klammer. Dann steht da noch was von Fehler-Nr. 68, was mir aber nichts sagt. Sonst lassen wir es doch einfach; es gibt ja noch genügend andere schöne Muster, die für einen Schoner geeignet sind. Aber trotzdem recht herzlichen Dank. |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Random
Anmeldungsdatum: 09.03.2006
Beiträge: 47
|
| Verfasst am: 31.03.2008, 18:24 Titel: |
|
|
0.15b. Für FBIde gibt's wohl leider noch nichts neueres. Ich hab zwar auch mal 0.18 installiert, hatte da aber absolut keinen Durchblick. 
Zuletzt bearbeitet von Random am 31.03.2008, 18:35, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Random
Anmeldungsdatum: 09.03.2006
Beiträge: 47
|
| Verfasst am: 31.03.2008, 19:04 Titel: |
|
|
Heureka! Ich hab's endlich begriffen. Das ist ja fast wie MS-DOS.  Das Programm funktioniert auch einwandfrei. Vielen Dank für deine Geduld mit mir!! 
EDIT: Hab herausgefunden, dass man das FBIde auch im Ordner von FB 0.18 installieren kann. Aber das wisst ihr sicher schon längst. |
|
| Nach oben |
|
|
Klößchn
1x verwarnt
Anmeldungsdatum: 22.03.2008
Beiträge: 77
Wohnort: Donauwörth
|
| Verfasst am: 14.04.2008, 13:04 Titel: |
|
|
Hab das mal bissl weitergesponnen:
| Code: | 'Bildschirmschoner:
' => Zufällige Muster basierend auf Langtons Ameise
'Basierend auf einem Programm von Skilltronic (07.03.2008),
' siehe http://forum.qbasic.at/viewtopic.php?t=5409
'Im Original als QB-Programm, hier als FreeBasic-Variante
'Bildschirmschonerquelltext von Sebastian
'Rest von Klößchn aka Wladimir.Klausberg
#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
'Unterprogramme:
Sub configurescreensaver
messagebox(0, "Es gibt nichts zu konfigurieren! ", " ", mb_iconinformation)
End Sub
Sub showscreensaver
Dim As Integer xm, ym, mx, my, mxo, myo, mk, mro,activ = 1, ag, af
Screeninfo xm, ym
'xm /= 2
'ym /= 2
Screenres Xm, Ym, 8,,1
Dim weg(255) As Integer
Dim As Integer a, r, nf,ad,ae, g, b, mr
Dim taste As String
Randomize Timer
Dim X As Integer
Dim Y As Integer
Do
' color rnd*255, rnd*255
Cls
ag = 2
af = 2
For a = 0 To Ubound(weg)
weg(a) = Fix(Rnd * ag) * af - 1
Next
'for a = 0 to rnd * 255
'pset (rnd*xm, rnd*ym), rnd*255
'next
'for a = 0 to 255
'line (a,a) - (xm-a, ym-a), rnd*a, bf
'next
ad = rnd*255
ae = rnd*255
Palette 255,255,255,255
Color 255
For a = 0 To 36
r = (a)/36*255
g = 0
b = 255
Palette a, r, g, b
Next
For a = 36 To 72
r = 255
g = 0
b = (36-(a-36))/36*255
Palette a, r, g, b
Next
For a = 72 To 108
r = 255
g = (a-72)/36*255
b = 0
Palette a, r, g, b
Next
For a = 108 To 144
r = (108-(a-108))/36*255
g = 255
b = 0
Palette a, r, g, b
Next
For a = 144 To 180
r = 0
g = 255
b = (a-144)/36*255
Palette a, r, g, b
Next
For a = 180 To 216
r = 0
g = (180-(a-180))/36*255
b = 255
Palette a, r, g, b
Next
For a = 216 To 255
g = 0
b = 255
Palette a, r, g, b
Next
x = xm/2
y = ym/2
Do
r = r + weg(Point(x, y))
If r >= 4 Then r = 0
If r <= -1 Then r = ae
nf = Point(x, y) + ad
If nf = Ubound(weg) Then nf = 0
Getmouse mx, my, , mk
If mro <> mr Then
Windowtitle Str(mr)
mro = mr
End If
If mk <> 0 Then
Line (mxo, myo) - (mx, my), mr
mxo = mx : myo = my
mr += 1
End If
If mk = 0 Then
mxo = mx : myo = my
End If
If activ = 1 Then
Pset (x, y), nf
If r = 0 Then x = x + 1
If r = 1 Then y = y + 1
If r = 2 Then x = x - 1
If r = 3 Then y = y - 1
If x = xm Then x = 0
If x = -1 Then x = xm-1
If y = ym Then y = 0
If y = -1 Then y = ym-1
End If
taste = Inkey$
If taste =Chr(32) Then activ = Not activ
Loop While taste = "" Or taste = Chr(32)
Loop Until taste = Chr$(27)
End Sub
|
(und ja, das ist mein erstes FB-Prog) |
|
| Nach oben |
|
|
Elektronix
Anmeldungsdatum: 29.06.2006
Beiträge: 742
|
| Verfasst am: 14.04.2008, 14:15 Titel: |
|
|
@Scilltronic, Klößchn
Ihr solltet das Prog mal einem Chaosforscher zeigen. Man sieht sehr schön, wie die anfangs (meistens) geordneten Muster allmählich ins Chaos abgleiten und dann dort bleiben.
_________________
Und die Grundgebihr is aa scho drin- DOS is jo nett. |
|
| Nach oben |
|
|
Skilltronic
Anmeldungsdatum: 10.09.2004
Beiträge: 1148
Wohnort: Köln
|
| Verfasst am: 15.04.2008, 11:25 Titel: |
|
|
Ein Chaosforscher wäre sicher nicht sehr beeindruckt, weil das Programm wie gesagt auf einem bekannten Prinzip beruht.
http://de.wikipedia.org/wiki/Ameise_(Turingmaschine)
Es scheint, als würden hier Klammern nicht als Teil einer Webadresse erkannt werden. Das _(Turingmaschine) gehört aber dazu, sonst landet man bei einem Artikel über Ameisen im Allgemeinen.
_________________
Elektronik und QB? www.skilltronics.de ! |
|
| Nach oben |
|
|
Random
Anmeldungsdatum: 09.03.2006
Beiträge: 47
|
|
| 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
