Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

opti.bas

Uploader:MitgliedThePuppetMaster
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)