 |
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 |
Domso
Anmeldungsdatum: 02.02.2011
Beiträge: 109
|
 Verfasst am: 31.03.2011, 09:59 Titel: Sinnfreie Programme |
 |
|
Hi
im laufe der Zeit sammeln sich so eine reihe an komplett sinnfreien Programmen an, die rein gar keinen Sinn bzw Nutzen haben 
1. Kurvenzeichner
Er zeichnet einen Graphen auf basis der Mausbewegung
| Code: | DIM AS INTEGER mx, my, mb, mx2, my2, mb2, wertx, werty, wertx2, werty2, imba
DIM AS INTEGER wert_achsex, wert_achsey, wert_achsey_vorher, wert_achsex_vorher
SCREENRES 1024, 768
wert_achsex = 10
Do
mx2=mx
my2=my
mb2=mb
GETMOUSE mx,my,,mb
wertx = mx - mx2
werty = my - my2
IF wertx <= 0 THEN
wertx *=(-1)
ELSEIF werty <= 0 THEN
werty *=(-1)
ENDIF
wert_achsey = wertx + werty
If imba=5 Then
LINE (wert_achsex, wert_achsey + 400) - (wert_achsex_vorher, wert_achsey_vorher + 400)
wert_achsex = wert_achsex + 1
wert_achsey_vorher = wert_achsey
wert_achsex_vorher = wert_achsex
EndIf
If imba>5 Then
imba=1
EndIf
imba+=1
SLEEP 10,1
LOOP UNTIL MultiKey(1) |
2. Hintergrundfarbprogramm
4 button zum Hintergrundfarbe ändern
| Code: | DIM AS INTEGER mx, my, mb
SCREEN 18
Do
LINE (200, 200)-(290, 220),, B
LINE (201, 201)-(289, 219),, B
DRAW STRING (205, 204), "Gelb"
LINE (200, 240)-(290, 220),, B
LINE (201, 241)-(289, 219),, B
DRAW STRING (205, 224), "Gruen"
LINE (200, 260)-(290, 220),, B
LINE (201, 261)-(289, 219),, B
DRAW STRING (205, 244), "Lila"
LINE (200, 280)-(290, 220),, B
LINE (201, 281)-(289, 219),, B
DRAW STRING (205, 264), "Rot"
Do
GETMOUSE mx, my,, mb
SLEEP 1
if mx>200 AND mx<290 AND my>200 AND my<220 AND mb=1 then
cls
PAINT (0, 0), 14, 14
elseif mx>200 AND mx<290 AND my>220 AND my<240 AND mb=1 then
cls
PAINT (0, 0), 10, 10
elseif mx>200 AND mx<290 AND my>240 AND my<260 AND mb=1 then
cls
PAINT (0, 0), 5, 5
elseif mx>200 AND mx<290 AND my>260 AND my<280 AND mb=1 then
cls
PAINT (0, 0), 12, 12
endif
loop until mx>200 AND mx<290 AND my>200 AND my<220 AND mb=1 OR mx>200 AND mx<290 AND my>220 AND my<240 AND mb=1 or mx>200 AND mx<290 AND my>240 AND my<260 AND mb=1 or mx>200 AND mx<290 AND my>260 AND my<280 AND mb=1
loop |
3. Konsole (WIN)
eine kleine Konsole für alle PC, auf denen die normale Winkonsole gesperrt ist
| Code: | print "Windows-Befehlskonsole"
Dim as string befehl
Do
shell "ver"
befehl = ""
shell "cd"
input "", befehl
shell befehl
loop |
4. Taskmanager
für alle Rechner wo der Taskmanager gesperrt ist
| Code: | Dim as string befehl
Do
shell "tasklist"
print ""
print ""
print "Welcher task soll beendet werden?"
input "", befehl
if befehl = "cls" then
shell "cls"
end if
shell "taskkill /im "+befehl+" /f"
'shell "cls"
loop |
5. ein Strichmännchen das mit der Leertaste hüpft
(total mies programmiert  )
| Code: | Dim shared as integer mx, my, mb ,Rad
Dim shared as integer FL ,FL1, FR, FR1, K, K1, KO, WA, WA1, WB, WB1, WC, WC1, WD,WD1,M, M2, M3, M4, M5, M6, M7, schuss12, schuss11, i
Declare sub schuss
Dim shared as string taste
Dim shared as integer y200, y190, y170, y160, y175
y200 = 200
y190 = 190
y170 = 170
y175 = 175
y160 = 160
Declare sub me
Declare sub la
screenres 420, 320
FL = 50
FL1 = 60
FR = 60
FR1 = 70
K = 60
K1 = 60
KO = 60
WA = 60
WA1 = 70
WB = 60
WB1 = 70
WC = 70
WC1 = 70
WD = 70
WD1 = 90
M = 100
M2 = 150
M3 = 200
M4 = 250
M5 = 300
M6 = 350
M7 = 400
sub me
line (0 ,200)- (420, 200)
line (FL,y200)-(FL1,y190)
LINE (FR,y190)-(FR1,y200)
line (K,y190)-(K1,y170)
CIRCLE (KO, y160), 10
line (WA,y170) - (WA1,y170)
line (WB,y170) - (WB1,y175)
line (WC,y170) - (WC1,y175)
line (WD,y170) - (WD1,y170)
end sub
schuss12= 170
sub schuss
GETMOUSE mx, my,, mb
if mb = 1 then
circle (M,schuss12),2,
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,0
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,0
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,0
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,0
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,0
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,
sleep 10
circle (M7,schuss12),2,0
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,
sleep 10
circle (M,schuss12),2,0
sleep 10
circle (M2,schuss12),2,0
sleep 10
circle (M3,schuss12),2,0
sleep 10
circle (M4,schuss12),2,0
sleep 10
circle (M5,schuss12),2,0
sleep 10
circle (M6,schuss12),2,0
sleep 10
circle (M7,schuss12),2,0
sleep 10
else
endif
end sub
sub la
Do
'if
taste = inkey
if taste=CHR (255, 77) then
cls
FL +=10
FL1 +=10
FR +=10
FR1 +=10
K +=10
K1 +=10
KO +=10
WA +=10
WA1 +=10
WB +=10
WB1 +=10
WC +=10
WC1 +=10
WD +=10
WD1 +=10
M +=10
M2 +=10
M3 +=10
M4 +=10
M5 +=10
M6 +=10
M7 +=10
me
schuss
elseif taste=CHR (255, 75) then
cls
FL -=10
FL1 -=10
FR -=10
FR1 -=10
K -=10
K1 -=10
KO -=10
WA -=10
WA1 -=10
WB -=10
WB1 -=10
WC -=10
WC1 -=10
WD -=10
WD1 -=10
M -=10
M2 -=10
M3 -=10
M4 -=10
M5 -=10
M6 -=10
M7 -=10
me
schuss
elseif taste=CHR (255, 72) then
cls
schuss11 = 0
do
cls
schuss11 += 1
y200 -= 10
y190 -= 10
y170 -= 10
y175 -= 10
y160 -= 10
schuss12 -= 10
me
for i = 10 TO 1 STEP -1
SCHUSS
sleep 1
next
loop until schuss11 = 3
schuss11 = 0
do
cls
schuss11 += 1
y200 += 10
y190 += 10
y170 += 10
y175 += 10
y160 += 10
schuss12 += 100
me
for i = 10 TO 1 STEP -1
SCHUSS
sleep 1
next
loop until schuss11 = 3
me
else
me
schuss
endif
loop
end sub
la
|
6. Ein mini funktionsplotter ohne input
| Code: | screenres 500,500
Dim as integer x=-250, y=-250, xx=-250, yy=-250
line (250,500)-(250,1)
line (500,250)-(1,250)
Do
y=1000/x
x+=1
y=y*(-1)
line(x+249, y+249)-(xx+249, yy+249)
xx=x
yy=y
'sleep 100,1
loop |
7. Ein Programm das zufällig auf ein 32x32 Feld mit weißen Punkten macht
| Code: |
Dim as integer hoehe, breite, zahl
screenres 100, 100
randomize timer
color 15, 13
Do
hoehe = int(rnd*32)
breite = int(rnd*32)
line (hoehe,breite)-(hoehe,breite)
zahl +=1
loop until zahl = 200
sleep |
Würde mich über mehr sinnloses freuen |
|
| Nach oben |
|
 |
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 31.03.2011, 14:43 Titel: |
|
|
habe noch tonnenweise sinloses in meinem "test" ordner .. aber, da kann ich ncithmal mehr sagen, wozu ich das geschrieben habe.
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
Michael712
aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005
Beiträge: 1593
|
| Verfasst am: 31.03.2011, 16:02 Titel: |
|
|
Ich hab auch noch Haufenweise Programme, wobei das von den sinnlosen noch das interessanteste ist. In dem Beispiel ist jetzt eine Partikelquelle die nur ein paar Sekunden Partikel aussendet, die andere nur bei Mausklick und die andere immer (jeweils andere Geschwindigkeiten, etc.).
Hab ich mal irgendwann ein Sylvesterprogramm draus gemacht (zufallsfarben und nur kurz Partikel aussenden, sieht super aus).
| Code: | #include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using FB
#endif
Randomize Timer
Dim Shared As Single tsin(1 To 4500)
For i As Integer = 1 To 4500
tsin(i) = sin(i / 3600 * 2 * 3.141592654)
Next i
Function decr (col As Integer, lt As Double, at As Double) As Integer 'lt = Lebensdauer, at = aktuelle Lebenszeit
Dim As UByte Ptr tmp
tmp = @col
For i As Integer = 0 To 3
tmp[i] = abs(tmp[i] * ((lt-at)/lt))
if inkey <> "" then end
Next i
'Print hex(col)
Return col
End Function
Function testdecr (col As Integer, lt As Double, at As Double) As Integer 'lt = Lebensdauer, at = aktuelle Lebenszeit
Dim As Ubyte ptr tmp
tmp = @col
Return rgba(tmp[2], tmp[1], tmp[0], abs(200*((lt-at)/lt)))
End Function
Function fire (col As Integer, lt As Double, at As Double) As Integer 'lt = Lebensdauer, at = aktuelle Lebenszeit
Dim As Ubyte ptr tmp
tmp = @col
Return rgba(tmp[2]*sqr((lt-at)/lt), tmp[1]*((lt-at)/lt), tmp[0], 255)
End Function
Type tpixel
x As Single
y As Single
sx As Single
sy As Single
t As Double
col As Integer
End Type
Type tpixel_source
Private:
grav_x As Single
grav_y As Single
speed As Single
col As Integer
x As Integer
y As Integer
amount As Integer 'pixel pro sek
lifetime As Single 'lebensdauer pro pixel
halttime As Double 'Stopzeit der quelle
lastcycle As Double
pixel As tpixel Ptr
max As Integer
colfunc As Function(a As Integer, b As Double, c As Double) As Integer
Public:
Declare Constructor (x As Integer, y As Integer, gx As Single, gy As Single, speed As Single, amount As Integer, col As Integer, lifetime As Single, halttime As Single, f As Function(a As Integer, b As Double, c As Double) As Integer =@decr)
Declare Destructor
Declare Sub cycle(emit As Integer = 1)
Declare Sub move(x As Integer, y As Integer)
End Type
Sub tpixel_source.move(x As Integer, y As Integer)
this.x = x
this.y = y
End Sub
Sub tpixel_source.cycle(emit As Integer = 1)
Dim As Double dtime
Dim As Double diff, pow
Dim As Integer counter, ang, m
diff = Timer - this.lastcycle
this.lastcycle = Timer
If this.halttime <> -1 AndAlso this.lastcycle > this.halttime Then this.amount = 0
counter = Int(this.amount*diff)
If emit = 0 Then counter = 0
m = counter
'If diff > 0.1 Then counter *= 0.5
For i As Integer = 0 To this.max-1
If this.pixel[i].col <> 0 Then
With this.pixel[i]
dtime = this.lastcycle - .t
'.sx += this.grav_x * diff
'.sy += this.grav_y * diff
'.y += .sy * diff * 25
If dtime > this.lifetime Then .col = 0
PSet (Int(.x + 15 * (this.grav_x * dtime^2 + .sx * dtime)), Int(.y + 15 * (this.grav_y * dtime^2 + .sy * dtime))), colfunc(.col, this.lifetime, dtime)
End With
End If
If this.pixel[i].col = 0 Then
counter -= 1
If counter >= 0 Then
With this.pixel[i]
.x = this.x
.y = this.y
.col = this.col
ang = Int(Rnd*3600 + 1)
pow = sqr(Rnd) '*0.8 + 0.2
.sx = this.speed * tsin(ang) * pow 'this.speed * (Rnd - 0.5)/2
.sy = this.speed * tsin(ang+900) * pow 'this.speed * (Rnd - 0.5)/2
'.sy = this.speed * (Rnd*2-1)
.t = this.lastcycle + 2*diff/m * (counter)
Pset(.x, .y), .col
End With
End If
End If
Next i
End Sub
Constructor tpixel_source (x As Integer, y As Integer, gx As Single, gy As Single, speed As Single, amount As Integer, col As Integer, lifetime As Single, halttime As Single, f As Function(a As Integer, b As Double, c As Double) As Integer =@decr)
this.x = x
this.y = y
this.grav_x = gx
this.grav_y = gy
this.speed = speed
this.col = col
this.amount = amount
this.lifetime = lifetime
If halttime = -1 Then this.halttime = -1 Else this.halttime = Timer + halttime
this.colfunc = f
this.max = amount * lifetime * 1
this.pixel = Callocate(this.max*SizeOf(tpixel))
this.lastcycle = Timer
End Constructor
Destructor tpixel_source()
DeAllocate(this.pixel)
End Destructor
ScreenRes 640, 480, 32, , GFX_ALPHA_PRIMITIVES
' x, y, gravity x, gravity y, speed, amount, color, lifetime, halttime, function
Dim As tpixel_source test = tpixel_source(300, 140, 0, 6, 10, 10000, rgba(255, 190, 0, 255), 2, -1, @fire)
Dim As tpixel_source test2 = tpixel_source(320, 240, 5, 0, 10, 100, rgba(255, 255, 255, 255), 8, -1)
Dim As tpixel_source test3 = tpixel_source(305, 130, -10, 0, 2, 10000, rgba(255, 0, 0, 255), 3, 5)
Dim as integer x, y, t
Do
getmouse x, y,,t
ScreenLock
Line (0,0) - (639, 479), rgba(0,0,0,255), bf
if t = 1 Then
test.move(x, y)
end if
test.cycle(t = 1)
test2.cycle
test3.cycle
ScreenUnLock
sleep 10,1
Loop Until InKey <> ""
|
_________________
| Code: | | #include "signatur.bi" |
|
|
| Nach oben |
|
|
Domso
Anmeldungsdatum: 02.02.2011
Beiträge: 109
|
| Verfasst am: 01.04.2011, 10:47 Titel: |
|
|
ein kleines Programm, dass einen 3d-körper erstellt und darstellt.
Komplett in FB und daher extrem langsam
| Code: | Dim shared as integer achse(1 to 500, 1 to 500, 1 to 500), xverschiebung=10, yverschiebung=10, verschiebungslaenge, zachse
screenres 500, 500
for i as integer = 1 to 50
for k as integer = 1 to 100
achse(150+i, 100, 150+k)=1
achse(150, 100+i, 150+k)=2
achse(200, 100+i, 150+k)=2
achse(150+i, 150, 150+k)=1
'ache(125, 125, 175)=1
achse(150+i, 100, 10+k)=3
achse(150, 100+i, 10+k)=4
achse(200, 100+i, 10+k)=4
achse(150+i, 150, 10+k)=3
'achse(120-i, 120, 120)=1
'achse(120, 120-i, 120)=2
'achse(120, 120, 120-i)=3
achse(150+i, 100, 300+k)=5
achse(150, 100+i, 300+k)=6
achse(200, 100+i, 300+k)=6
achse(150+i, 150, 300+k)=5
next
next
achse(300, 300, 300)=1
achse(301, 301, 300)=1
achse(300, 300, 300)=1
achse(301, 300, 300)=1
achse(300, 300, 302)=1
achse(301, 301, 302)=1
achse(300, 300, 302)=1
achse(301, 300, 302)=1
achse(300, 300, 303)=1
achse(301, 301, 303)=1
achse(300, 300, 303)=1
achse(301, 300, 303)=1
achse(300, 300, 100)=1
Do
verschiebungslaenge=((xverschiebung^2)+(yverschiebung^2))^0.5
zachse=verschiebungslaenge/500
cls
if multikey(&h50) then yverschiebung+=50
if multikey(&h48) then yverschiebung-=50
if multikey(&h4D) then xverschiebung+=50
if multikey(&h4B) then xverschiebung-=50
for i as integer = 1 to 500
for k as integer = 1 to 500
for j as integer= 1 to 500
if achse(i, k, j)=1 then
'line(i, k)-(i, k),4
'if (((((xverschiebung^2)+(yverschiebung^2))^0.5)/500)*j)
if j>=175 then
line (i-((xverschiebung/500)*j), k-((yverschiebung/500)*j))-(i-((xverschiebung/500)*j), k-((yverschiebung/500)*j)), 4
end if
if j<175 then
line (i+((xverschiebung/500)*j), k+((yverschiebung/500)*j))-(i+((xverschiebung/500)*j), k+((yverschiebung/500)*j)), 4
end if
end if
if achse(i, k, j)=2 then
'line(i, k)-(i, k),4
if j>=175 then
line (i-((xverschiebung/500)*j), k-((yverschiebung/500)*j))-(i-((xverschiebung/500)*j), k-((yverschiebung/500)*j)), 5
end if
if j<175 then
line (i+((xverschiebung/500)*j), k+((yverschiebung/500)*j))-(i+((xverschiebung/500)*j), k+((yverschiebung/500)*j)), 5
end if
end if
if achse(i, k, j)=3 then
'line(i, k)-(i, k),4
'if (((((xverschiebung^2)+(yverschiebung^2))^0.5)/500)*j)
if j>=175 then
line (i-((xverschiebung/500)*j), k-((yverschiebung/500)*j))-(i-((xverschiebung/500)*j), k-((yverschiebung/500)*j)), 6
end if
if j<175 then
line (i+((xverschiebung/500)*j), k+((yverschiebung/500)*j))-(i+((xverschiebung/500)*j), k+((yverschiebung/500)*j)), 6
end if
end if
if achse(i, k, j)=4 then
'line(i, k)-(i, k),4
if j>=175 then
line (i-((xverschiebung/500)*j), k-((yverschiebung/500)*j))-(i-((xverschiebung/500)*j), k-((yverschiebung/500)*j)), 7
end if
if j<175 then
line (i+((xverschiebung/500)*j), k+((yverschiebung/500)*j))-(i+((xverschiebung/500)*j), k+((yverschiebung/500)*j)), 7
end if
end if
if achse(i, k, j)=5 then
'line(i, k)-(i, k),4
'if (((((xverschiebung^2)+(yverschiebung^2))^0.5)/500)*j)
if j>=175 then
line (i-((xverschiebung/500)*j), k-((yverschiebung/500)*j))-(i-((xverschiebung/500)*j), k-((yverschiebung/500)*j)), 8
end if
if j<175 then
line (i+((xverschiebung/500)*j), k+((yverschiebung/500)*j))-(i+((xverschiebung/500)*j), k+((yverschiebung/500)*j)), 8
end if
end if
if achse(i, k, j)=6 then
'line(i, k)-(i, k),4
if j>=175 then
line (i-((xverschiebung/500)*j), k-((yverschiebung/500)*j))-(i-((xverschiebung/500)*j), k-((yverschiebung/500)*j)), 9
end if
if j<175 then
line (i+((xverschiebung/500)*j), k+((yverschiebung/500)*j))-(i+((xverschiebung/500)*j), k+((yverschiebung/500)*j)), 9
end if
end if
next
next
next
loop
|
|
|
| Nach oben |
|
|
Stephan
Anmeldungsdatum: 05.10.2004
Beiträge: 358
Wohnort: Hessen - 20km Nördlich von Frankfurt am Main
|
| Verfasst am: 06.04.2011, 09:49 Titel: |
|
|
Ein System,auf dem die Konsole gesperrt ist !
Und du bist dir sicher, das der SHELL Kommando auch ohne CMD Funktioniert,
da dieser doch intern die Windows Konsole (CMD) aufruft.
_________________
'Wir schätzen die Zeit erst, wenn uns nicht mehr viel davon geblieben ist.'
Leo Tolstoi |
|
| Nach oben |
|
|
28398
Anmeldungsdatum: 25.04.2008
Beiträge: 1917
|
| Verfasst am: 07.04.2011, 16:46 Titel: |
|
|
| Stephan hat Folgendes geschrieben: | Ein System,auf dem die Konsole gesperrt ist !
Und du bist dir sicher, das der SHELL Kommando auch ohne CMD Funktioniert,
da dieser doch intern die Windows Konsole (CMD) aufruft. |
Seltenst ist die cmd.exe/command.com entfernt worden, meistens geht nur Win+R nicht (Startmenüeinträge meistens auch nicht vorhanden).
Da ist aber ne Batchdatei mit der einzigen Zeile "cmd" wesentlich handlicher als irgendein Programm.
SHELL dürfte übrigens unter Windows CreateProcess() benutzen |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4712
Wohnort: ~/
|
| Verfasst am: 01.07.2011, 09:49 Titel: |
|
|
Manchmal sieht man die Bäume vor lauter Wald nicht mehr. Ohne Kommentar(zeilen)
| Code: | SCREENRES 800, 600, 32
DIM AS ANY PTR speicher
DIM AS INTEGER x, y, rot=0, gruen=0, blau=0
DIM AS INTEGER rplus=0, gplus=0, bplus=0
speicher = IMAGECREATE(50, 50, &hff00ff)
LINE speicher, (25, 0)-step(17, 17), &hffffff
LINE speicher, step(0, 0)-step(-10, 0), &hffffff
LINE speicher, step(0, 0)-step(17, 17), &hffffff
LINE speicher, step(0, 0)-step(-50, 0), &hffffff
LINE speicher, step(0, 0)-step(18, -18), &hffffff
LINE speicher, step(0, 0)-step(-10, 0), &hffffff
LINE speicher, step(0, 0)-step(17, -17), &hffffff
PAINT speicher, (24, 10), &hffffff, &hffffff
LINE speicher, (20, 36)-(30, 49), &h804000, bf
RANDOMIZE
DO
x = INT(RND*749)
y = INT(RND*549)
IF INT(RND*1000) = 0 THEN rplus = 1 - rplus
IF INT(RND*1000) = 0 THEN gplus = 1 - gplus
IF INT(RND*1000) = 0 THEN bplus = 1 - bplus
rot = INT(RND*127) + 1 + rplus*128
gruen = INT(RND*127) + 1 + gplus*128
blau = INT(RND*127) + 1 + bplus*128
PAINT speicher, (25, 20), RGB(rot, gruen, blau), &hff00ff
PUT (x, y), speicher, TRANS
SLEEP 1
LOOP UNTIL INKEY <> ""
IMAGEDESTROY speicher |
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
Luke
Anmeldungsdatum: 14.01.2009
Beiträge: 92
Wohnort: Ostfriesland !
|
| Verfasst am: 22.07.2011, 15:36 Titel: |
|
|
Hier ein Programm zum "Fenstergucken"
Erste versuche mit get und put...ist schon ein bisschen her
Erzeugt ein Bild aus mehreren verschiedenfarben Kugeln. Nach dem Tastendruck wird der Bildschirm gelöscht und es erscheint ein Fenster, das man mit der Maus bewegen kann, um das alte Bild teilweise anzuzeigen....
| Code: | dim shared g1(90000) as string
dim shared h(90000) as string
dim as integer x,y,i,i2
screen 20,32,3,1
screenset 1, 0
randomize timer
dim as integer r, g, b,ri, ab
ab =0
ri = 3
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (16, 16), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (16, 216), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (216, 16), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (216, 216), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 0 to 16
line (16, y)-(216, y), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 232 to 216 step-1
line (16, y)-(216, y), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for x = 0 to 16
line (x, 16)-(x, 216), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next x
r = 100
g = 10
b = 10
for x = 232 to 216 step-1
line (x, 16)-(x-ab, 216), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next x
line (17,17)-(215, 215),RGB(r,g,b),BF
'line (0,0)-(220,220),rgb(100,0,0),bf
get (0,0)-(232,232),h
cls
dim as integer t, c,c2,c3,an,ps,pz
for t = 1 to 50
an = rnd*255
c = rnd*(255-an)
c2 = rnd*(255-an)
c3 = rnd*(255-an)
ps = rnd*1024
pz = rnd*768
for i = an to 0 step-1
circle (ps, pz), i,RGB(c,c2,c3),,,,F
c = c+1
c2 = c2+1
c3 = c3+1
next
next
pcopy 1, 0
sleep
i = 1
i2 = 1
x = 256
y = 192
setmouse ,,0,1
do
getmouse x,y
if x > 823 then setmouse 823,y,0,1: x = 823
if y > 567 then setmouse x,567,0,1: y = 567
screenset 1, 0
get (x,y)-(x+200,y+200),g1
screenset 0, 2
cls
put (x-16,y-16),h
line (x,y)-(x+200,y+200),rgb(0,0,0),bf
line (x-1,y-1)-(x+201,y+201),rgb(100,0,0),b
put (x,y),g1
'x = x +i
'y = y+i2
'if x = 412 or x = 0 then i = i*-1
'if y = 284 or y = 0 then i2 = i2*-1
pcopy 0, 2
loop until inkey$ =CHR(27)
end |
_________________
ICH war mal schizophren, aber jetzt sind WIR okay. |
|
| Nach oben |
|
|
Sannaj
Anmeldungsdatum: 19.12.2010
Beiträge: 35
|
| Verfasst am: 29.09.2011, 20:30 Titel: |
|
|
| Das mit der Umgehungskonsole klappt nicht. hab ich schon mal versucht. |
|
| Nach oben |
|
|
28398
Anmeldungsdatum: 25.04.2008
Beiträge: 1917
|
| Verfasst am: 29.09.2011, 21:14 Titel: |
|
|
| 28398 hat Folgendes geschrieben: | | Stephan hat Folgendes geschrieben: | Ein System,auf dem die Konsole gesperrt ist !
Und du bist dir sicher, das der SHELL Kommando auch ohne CMD Funktioniert,
da dieser doch intern die Windows Konsole (CMD) aufruft. |
Seltenst ist die cmd.exe/command.com entfernt worden, meistens geht nur Win+R nicht (Startmenüeinträge meistens auch nicht vorhanden).
Da ist aber ne Batchdatei mit der einzigen Zeile "cmd" wesentlich handlicher als irgendein Programm.
SHELL dürfte übrigens unter Windows CreateProcess() benutzen |
Selfquote, Jippy-Yeah |
|
| Nach oben |
|
|
Westbeam
Anmeldungsdatum: 22.12.2009
Beiträge: 760
|
| Verfasst am: 06.11.2011, 21:09 Titel: |
|
|
Liest die Headerdaten einer GBA-Datei aus(Spielname, Version, Serial ...):
| Code: | 'GBA Header Viewer
'Offset 0xA0 - 0xAB = Game title
'Offset 0x108 - 0x11E = Alternative game title
'Offset 0xBC = Game version(always 1.0)
'Offset 0xAC - 0xAF = Game serial(starts alway with "AGB")
#Include "file.bi"
Type THeader
As String nam,shortnam
As Byte snamoffset(12),namoffset(23)
As String Serial
As Byte serialoffset(4)
As Integer nambit
End Type
Dim Shared As THeader Header
Dim Shared As String file
Dim As Integer ff = Freefile
Input "File: ",file
If Fileexists(file)=0 Then Print "File not found!":End
Print "Size: "+Str(Filelen(file))+" Bytes ("+Str(Filelen(file)/1024/1024)+"Mb)"
Open file For Binary As #ff
For i As Integer=1 To 12
Get #ff,&hA0+i,Header.snamoffset(i)
Header.shortnam+=Chr(Header.snamoffset(i))
Next
For i As Integer=1 To 23
Get #ff,&h108+i,Header.namoffset(i)
Header.nam+=Chr(Header.namoffset(i))
Next
If Header.namoffset(1)=112 Then Header.nambit=1
For i As Integer=1 To 4
Get #ff,&hAC+i,Header.Serialoffset(i)
Header.Serial+=Chr(Header.Serialoffset(i))
Next
Print "---------------------------------------"
Print "Shortname(Offset A0-AB): "+Header.shortnam
If Header.nambit=1 Then
Print "Longname(Offset 108-11E): "+Header.nam
Else
Print "Longname(Offset 108-11E): not found"
End If
Print "Version(Offset BC): 1.0"
Print ""
Print "Serial(Offset AC-AF): AGB-"+Header.Serial
Close #ff |
|
|
| Nach oben |
|
|
Sannaj
Anmeldungsdatum: 19.12.2010
Beiträge: 35
|
| Verfasst am: 06.11.2011, 22:11 Titel: |
|
|
Addiert zwei Zahlen (aber besonders langsam)
| Code: |
'Slow adder.
function add_uiui (a as uinteger, b as uinteger) as uinteger
while b > 0
a += 1
b -= 1
wend
return a
end function |
Zuletzt bearbeitet von Sannaj am 07.11.2011, 21:25, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4712
Wohnort: ~/
|
| Verfasst am: 06.11.2011, 22:14 Titel: |
|
|
Müsste das nicht "while b>0" sein? (Funktioniert dann natürlich nur für positive b  )
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
Sannaj
Anmeldungsdatum: 19.12.2010
Beiträge: 35
|
| Verfasst am: 07.11.2011, 21:29 Titel: |
|
|
Och manno, wiso hab ich das nicht selbst bemerkt.
Zu der Sache mit Prositiv. Ich hab nicht umsonst uinteger als Datentype gewählt. |
|
| Nach oben |
|
|
Michael712
aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005
Beiträge: 1593
|
| Verfasst am: 07.11.2011, 23:19 Titel: |
|
|
| Code: | 'Slow adder.
function add_ii (a as integer, b as integer) as integer
while b <> 0
a += 1
b -= 1
wend
return a
end function
|
Mit Integer als Datantyp und "b<>0" statt "b>0" klappts auch ohne weiteres, was allerdings an der Speicherart (Zweierkomplement) der Zahlen liegt:
| Code: | dim as integer c
c=2147483647
print c
c += 1
print c |
Bei add_ii(4, -1) kommt dann auch 3 raus, das dauert allerdings relativ lange.
_________________
| Code: | | #include "signatur.bi" |
|
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4712
Wohnort: ~/
|
| Verfasst am: 07.11.2011, 23:20 Titel: |
|
|
Ansonsten noch eine Variation:
| Code: | 'Slow adder.
function add_ii (a as integer, b as integer) as integer
do until b = 0
a += sgn(b)
b -= sgn(b)
loop
return a
end function |
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| 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
