Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
opti.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 25.06.2015 16:30:30 |
Const xmx=800
Const ymx=600
Type TB
As Integer typ,x,y,damage
End Type
Dim Shared As TB Box(1024)
Dim Shared As Integer azb,tim,p1x,p1y,p1l,p2x,p2y,p2l,axx,pwr,et,sht,e2,d,ar,adc,an,ma
p1l=100
p2l=100
Dim As Double ex,ey,ex2,ey2
Sub ADB(typ As Integer, x As Integer, y As Integer)
For i As Integer=1 To azb
With Box(i)
If .x>x And .x<x+9 And .y>y-9 And .y<y+9 And .y<y+9 Then
.typ=typ
.x=x
.y=y
End If
End With
Next
azb+=1
With Box(azb)
.typ=typ
.x=x
.y=y
End With
End Sub
Randomize
Dim i as integer
Dim tiv as double
For i=1 To xmx/20
For i2 As Integer=1 To 6
ADB(Int(Rnd()*3+3),(i-1)*20,ymx-i2*20)
Next
ADB(Int(Rnd()*2+1),(i-1)*20,ymx-140)
Next
Var rx=Int(Rnd()*xmx)
tiv=Int(Rnd()*3+3)
For i=1 To 10
ADB(Int(Rnd()*3+3),i*20+rx,ymx-140)
If i<9 Then ADB(tiv,(i+1)*20+rx,ymx-160)
If i<7 Then ADB(tiv,(i+2)*20+rx,ymx-180)
If i<5 Then ADB(tiv,(i+3)*20+rx,ymx-200): ADB(Int(Rnd()*2+1),(i+3)*20+rx,ymx-220)
Next
rx=Rnd()*xmx
For i=1 To 7
ADB(tiv,i*20+rx,ymx-140)
Next
rx=Rnd()*xmx
For i=1 To 6
ADB(tiv,i*20+rx,ymx-140)
If i<4 Then ADB(tiv,(i+1)*20+rx,ymx-160)
Next
rx=Rnd()*xmx
For i=1 To 6
ADB(tiv,i*20+rx,ymx-140)
If i<6 Then ADB(tiv,(i)*20+rx,ymx-160)
If i<5 Then ADB(tiv,(i+1)*20+rx,ymx-180)
If i<4 Then ADB(tiv,(i+1)*20+rx,ymx-200): ADB(tiv,(i+1)*20+rx,ymx-220): ADB(Int(Rnd()*2+1),(i+1)*20+rx,ymx-240)
Next
rx=Rnd()*xmx
For i=1 To 6
ADB(tiv,i*20+rx,ymx-140)
Next
ADB(Int(Rnd()*2+1),20+rx,ymx-160)
For i=1 To 5
ADB(tiv,(i)*20+rx,ymx-160)
ADB(tiv,(i)*20+rx,ymx-180)
If i<5 Then ADB(tiv,(i)*20+rx,ymx-200)
If i<4 Then ADB(tiv,(i+1)*20+rx,ymx-220)
If i<3 Then ADB(tiv,(i+1)*20+rx,ymx-240): ADB(tiv,(i+1)*20+rx,ymx-260): ADB(Int(Rnd()*2+1),(i+1)*20+rx,ymx-280)
Next
tiv=Int(Rnd()*2+1)
ADB(tiv,20+rx,ymx-160)
ADB(tiv,10*20+rx,ymx-160)
ADB(tiv,2*20+rx,ymx-180)
ADB(tiv,9*20+rx,ymx-180)
ADB(tiv,3*20+rx,ymx-200)
ADB(tiv,8*20+rx,ymx-200)
ADB(Int(Rnd()*2+1),20+rx,ymx-160)
p1x=Rnd()*xmx/3
p2x=xmx-Rnd()*xmx/3-30
For i=1 To azb
If Box(i).x>p1x-10 And Box(i).x<p1x+10 Then p1y=Box(i).y-20
If Box(i).x>p2x-10 And Box(i).x<p2x+10 Then p2y=Box(i).y-20
Next
ScreenRes xmx,ymx,32
Dim As Any Ptr s=ImageCreate(1,600)
Bload "a.bmp",s
Dim As Any Ptr img(6)
For i=1 to 6
img(i)=ImageCreate(20,20)
Next
Bload "s.bmp",img(1)
Bload "s2.bmp",img(2)
Bload "s3.bmp",img(3)
Bload "g.bmp",img(4)
Bload "g2.bmp",img(5)
Line img(6),(0,0)-(20,20),&H404040,BF
Dim As Any Ptr e=ImageCreate(10,10)
Line e,(0,0)-(10,10),&H404040,BF
Dim As Integer switcher,sh,pl,r,ps
Dim As Double shx,shy,grav
pl=1:ar=8:adc=5:an=1
Do
Sleep 1,1
ScreenLock
Cls
For i As Integer=1 To xmx
Put (i-1,0),s,Trans
Next
For i As Integer=1 To azb
With Box(i)
Select Case .typ
Case 1:Put(.x,.y),img(4),Trans
Case 2: Put(.x,.y),img(5),Trans
Case 3: Put(.x,.y),img(1),Trans
Case 4: Put(.x,.y),img(2),Trans
Case 5: Put(.x,.y),img(3),Trans
End Select
If .damage=1 And .typ<>0 Then Put(.x,.y),img(6),Alpha,128
End With
Next
Line (p1x,p1y)-(p1x+20,p1y+20),&HFF0000,BF
Line (p2x,p2y)-(p2x+20,p2y+20),&HFF,BF
Color &HFF0000
Draw String(p1x,p1y-20),Str(p1l)
Color &HFF
Draw String(p2x,p2y-20),Str(p2l)
Draw String(10,30),"[1] Stein",IIf(ps=1,&HFF0000,&HFFFFFF)
Draw String(10,40),"[2] Rakete("+Str(ar)+")",IIf(ps=2,&HFF0000,&HFFFFFF)
Draw String(10,50),"[3] Daisy Cutter("+Str(adc)+")",IIf(ps=3,&HFF0000,&HFFFFFF)
Draw String(10,60),"[4] Peacekeeper("+Str(an)+")",IIf(ps=4,&HFF0000,&HFFFFFF)
Line (10,10)-(10+pwr,20),&HFF0000,BF
Line (10,10)-(210,20),&HFF0000,B
If pl=1 And sh=0 Then
Line (p1x+10,p1y+10)-((p1x+10)+(COS(ma*3.141/180))*50,(p1y+10)+(SIN(ma*3.141/180))*50),&HFF0000
#macro MUK(a) Multikey(a) #endmacro
If MUK(&h11) And pwr<=200 And sh=0 Then pwr+=1
If MUK(&h1F) And pwr>=0 And sh=0 Then pwr-=1
If MUK(&h1E) And ma>=-180 And sh=0 Then ma-=1
If MUK(&h20) And ma<=0 And sh=0 Then ma+=1
If MUK(&h02) Then ps=1
If MUK(&h03) And ar>0 Then ps=2
If MUK(&h04) And adc>0 Then ps=3
If MUK(&h05) And an>0 Then ps=4
If (ps=2 And ar=0) Or (ps=3 And adc=0) Or (ps=4 And an=0) Then ps=1
If MUK(&h39) And sh=0 Then
shx=(p1x+10) + (COS(ma*3.141/180))*50
shy=(p1y+10) + (SIN(ma*3.141/180))*50
grav=0:sh=1:axx=ma:d=1:pl=2:sht=ps
If sht=2 Then ar-=1
If sht=3 Then adc-=1
If sht=4 Then an-=1
End If
ElseIf sh=0 Then
If r=1 Then sht=3
If r>1 Then sht=1
axx=-45:grav=0:sh=1:d=2:pl=1:r+=1
pwr=Rnd()*150+50
shx=(p2x+10)+(COS(axx*3.141/180))*50
shy=(p2y+10)+(SIN(axx*3.141/180))*50
End If
If sh=1 Then
grav+=0.01
Line (shx-3,shy-3)-(shx+3,shy+3),RGB(0,0,0),BF
If d=1 Then shx+=(10+pwr)/80*Cos(Abs(axx-1)*3.141/180)
If d=2 Then shx-=(10+pwr)/80*Cos(Abs(axx)*3.141/180)
shy-=(pwr/80-grav)*Sin(Abs(axx)*3.141/180)
If shy>ymx Or shy<0 Or shx>xmx Or shx<0 Then sh=0
If shx>p1x-21 And shx<p1x+41 And shy>p1y-21 And shy<p1y+41 And sht>3 Then
If sht=3 Then p1l-=10
If sht=4 Then p1l-=80
sh=0
End If
If shx>p2x-21 And shx<p2x+41 And shy>p2y-21 And shy<p2y+41 And sht>3 Then
If sht=3 Then p2l-=10
If sht=4 Then p2l-=80
sh=0
End If
If shx>p1x-21 And shx<p1x+21 And shy>p1y-11 And shy<p1y+21 Then
If sht=1 Then p1l-=15
If sht=2 Then p1l-=30
sh=0
End If
If shx>p2x-21 And shx<p2x+21 And shy>p2y-11 And shy<p2y+21 Then
If sht=1 Then p2l-=15
If sht=2 Then p2l-=30
sh=0
End If
For i As Integer=1 To azb
With Box(i)
If shx> .x-1 And shx< .x+20 And shy> .y-1 And shy< .y+20 And .typ<>0 Then
If sht=3 Or sht=4 Then
For i2 As Integer=1 To azb
With Box(i2)
If (sht=3 Or sht=4) And .x>shx-41 And .x<shx+61 And .y>shy-41 And .y<shy+61 Then .damage=1
If (sht=3 Or sht=4) And .x>shx-21 And .x<shx+41 And .y>shy-21 And .y<shy+41 Then .typ=0
End With
Next
End If
If (sht=1 Or sht=2) Then
If .typ=1 Or .typ=2 Then .typ=0
If .typ=3 Or .typ=4 Or .typ=5 Then If .damage=0 Then: .damage=1: Elseif .damage=1 Then: .typ=0: End If
End If
ex=shx:ey=shy:ex2=ex:ey2=ey:et=255:shx=0:shy=0:sh=0:grav=0:axx=0:pwr=0
End If
End With
Next
End If
If et<>0 Then
et-=1
ex-=0.05:ey-=0.05
ex2+=0.05:ey2+=0.05
Put (ex-5,ey-5),e,Alpha,et
If et>50 Then
Put (ex2+4,ey2-4),e,Alpha,et-50
Put (ex2-3,ey2+3),e,Alpha,et-50
End If
Put (ex+5,ey+5),e,Alpha,et
End If
If p2l<=0 Then Draw String (xmx/2,ymx/2),"Du hast gewonnen!"
ScreenUnlock
Loop Until Inkey=Chr(27)