Buchempfehlung

Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )

# fb:porticula NoPaste

## opti.bas

```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)```