PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Springender Ball

https://www.purebasic.fr/german/viewtopic.php?t=12712

Seite 5 von 8

Verfasst: 27.04.2007 20:19
von Jilocasin
Das wird ja immer geiler hier :allright:

Verfasst: 27.04.2007 20:26
von DrShrek
Und damit es auch mal Spass macht hier mal 2 Beispiele für etwas FUN:


1) 'Basketball' bzw 'Prellball'

Der Ball muss mit der Maus durch ein 'Basket' geworfen werden.
Wenn es eine senkrechte Linie an der Wand wäre die mit den Ball getroffen werden soll 'Prellball'.


Hier nur der Grundriss mit noch vielen BUGs:

Code: Alles auswählen

Procedure MouseOver(Sprite2,x2,y2,TransparentColor=-1,MSO=1) 
 Img2W=SpriteWidth(Sprite2) 
 Img2H=SpriteHeight(Sprite2) 
  If TransparentColor=-1 
   If (x2<MouseX() And y2<MouseY()) And (MouseX()<x2+Img2W And MouseY()<y2+Img2H) 
    result=1 
   Else 
    result=0 
   EndIf 
  Else 
   If MSO=1 
    StartDrawing(SpriteOutput(Sprite2)) 
     RGB=Point(MouseX()-x2,MouseY()-y2) 
    StopDrawing() 
   Else 
    RGB=Point(MouseX()-x2,MouseY()-y2) 
   EndIf 
   If (x2<MouseX() And y2<MouseY()) And (MouseX()<x2+Img2W And MouseY()<y2+Img2H) And RGB<>TransparentColor 
    result=1 
   Else 
    result=0 
   EndIf 
  EndIf 
 ProcedureReturn result 
EndProcedure 

InitSprite() 
InitKeyboard() 
InitMouse() 

Structure spur 
 x.d 
 y.d 
 Radius.d 
 R.l 
 G.l 
 B.l 
EndStructure 

NewList spur.spur() 

ExamineDesktops()
Width=DesktopWidth(0)
Height=DesktopHeight(0) 
#Radius=40 
#Umkreis=2*#PI*#Radius 
#Lines=3 
#LinesPerCircle=360/#Lines 
#MouseWidth=20 
#MouseHeight=20 

OpenScreen(Width,Height,32,"Der springende Ball") 

Mx=DesktopMouseX() 
My=DesktopMouseY() 
MouseLocate(Mx,My) 
Bx.d=Width/2-#Radius 
By.d=Height/2-#Radius 
BxF.d=Bx.d 
ByF.d=By.d 
dirX.d:dirY.d:fY.d:alfa.d:roll.d:rollX.d:b.d 
GrabX=-1:GrabX=-1 
G.d=0.981:
Wind.d = 0.1

CreateSprite(0,#Radius*2+1,#Radius*2+1,#PB_Sprite_Texture) 
 StartDrawing(SpriteOutput(0)) 
  Circle(#Radius,#Radius,#Radius,RGB(255,0,0)) 
 StopDrawing() 
CreateSprite(1,#MouseWidth,#MouseHeight) 
 StartDrawing(SpriteOutput(1)) 
  LineXY(0,0,#MouseWidth/2,#MouseHeight-1,RGB(160,160,255)) 
  LineXY(0,0,#MouseWidth-1,#MouseHeight/2,RGB(160,160,255)) 
  FillArea(#MouseWidth-1,#MouseHeight-1,-1,RGB(255,255,255)) 
  LineXY(2,2,#MouseWidth,#MouseHeight,RGB(255,255,255)) 
  LineXY(#MouseWidth/2,#MouseHeight-1,#MouseWidth-1,#MouseHeight-1,RGB(160,160,255)) 
  LineXY(#MouseWidth-1,#MouseHeight/2,#MouseWidth-1,#MouseHeight-1,RGB(160,160,255)) 
 StopDrawing() 

Repeat 
 ExamineMouse() 
 ExamineKeyboard() 
 Mx=MouseX() 
 My=MouseY() 
  If MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By) Or Klick=1 Or MouseX()=0 Or MouseY()=0) 
   Bx=Mx-#Radius 
   By=My-#Radius 
   dirX=0 
   dirY=0 
   rollX=0 
   b=0 
   Klick=1 
   StKlick=1 
   lowSpeedY=0 
   fY=0 
   GrabX=Mx 
   GrabY=My 
  Else 
   Klick=0 
    If GrabX<>-1 And GrabY<>-1 
     dirX=(Mx-GrabX)/2 
     dirY=(My-GrabY)/2 
    EndIf 
   GrabX=-1 
   GrabX=-1 
  EndIf 
  If (Not (MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0)) Or MouseX()=0 Or MouseY()=0)) And StKlick=1 
   BxF=Bx 
   ByF=By 
   Bx+dirX+rollX 
   By+dirY+rollY 
   dirY+G 
   dirX+Wind 
    If Bx<=0:Bx=0:dirX*-0.5:rollX*-0.5:EndIf 
    If By<=0:By=0:dirY*-1.01:EndIf 
    If Bx>=Width-#Radius*2-1:Bx=Width-#Radius*2-1:dirX*-0.5:rollX*-0.5:EndIf 
    If By>=Height-#Radius*2-1:By=Height-#Radius*2-1:dirY*-0.5:dirY+0.1:dirX*0.9:EndIf 
    If Klick=0 And StKlick=1 
     AddElement(spur()) 
     spur()\x=Bx+#Radius 
     spur()\y=By+#Radius 
     spur()\Radius=#Radius 
     spur()\R=50 
     spur()\G=15 
     spur()\B=0 
    EndIf 
  EndIf 

  If Bx<=0:Bx=0:EndIf 
  If By<=0:By=0:EndIf 
  If Bx>=Width-#Radius*2-1:Bx=Width-#Radius*2-1:EndIf 
  If By>=Height-#Radius*2-1:By=Height-#Radius*2-1:EndIf 

  If MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftControl) And Not KeyboardPushed(#PB_Key_LeftAlt):Wind+0.001:EndIf 
  If MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftControl) And Not KeyboardPushed(#PB_Key_LeftAlt):Wind-0.001:EndIf 
  If KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftAlt):G+0.001:EndIf 
  If KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftAlt):G-0.001:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftControl):G+0.01:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftControl):G-0.01:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()>0:G+0.1:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()<0:G-0.1:EndIf 

  If (Not (MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0)) Or MouseX()=0 Or MouseY()=0)) And StKlick=1 
   reShow=(#Radius*#PI*alfa)/180 
    If By=Height-#Radius*2-1 
     rollX=reShow/2 
     b=dirX 
    EndIf 
    If By=0 
     rollX=reShow/2 
     b=dirX 
    EndIf 
    If Bx=Width-#Radius*2-1 
     rollY=reShow/2 
     b=-dirY 
    Else 
     rollY=0 
    EndIf 
    If Bx=0 
     rollY=reShow/2 
     b=dirY 
    Else 
     rollY=0 
    EndIf 
   alfa=(180*b)/(#Radius*#PI)+ADDTOalfa 
   roll-alfa 
    If roll>=360 
     roll=roll-360 
    EndIf 
    If Bx=Width-#Radius*2-1 And By=Height-#Radius*2-1 
     alfa=0 
     roll=0 
    EndIf 
    If Bx=0 And By=Height-#Radius*2-1 
     alfa=0 
     roll=0 
    EndIf 
  EndIf 

 ClearScreen(0) 

 StartDrawing(ScreenOutput()) 
  ResetList(spur()) 
   While NextElement(spur()) 
     If spur()\R>=0:spur()\R-1:EndIf 
     If spur()\R<0:spur()\R=0:EndIf 
     If spur()\G>=0:spur()\G-1:EndIf 
     If spur()\G<0:spur()\G=0:EndIf 
     If spur()\B>=0:spur()\B-1:EndIf 
     If spur()\B<0:spur()\B=0:EndIf 
;     If spur()\Radius>=0:spur()\Radius-0.1:EndIf 
;     If spur()\Radius<0:spur()\Radius=0:EndIf 
    Circle(spur()\x,spur()\y,spur()\Radius,RGB(spur()\R,spur()\G,spur()\B)) 
     If spur()\R=0 And spur()\G=0 And spur()\B=0; And spur()\Radius=0 
      DeleteElement(spur()) 
     EndIf 
   Wend 
   If Wind>0:lW=5:Else:lW=6:EndIf 
   If G>0:lG=5:Else:lG=6:EndIf 

  Circle(100,350,5,$FF0000)
  Circle(100,550,5,$FF0000)

  DrawText(10,10,"Wind="+Mid(StrD(Wind),1,lW),RGB(255,255,255),0) 
  DrawText(10,30,"Gravitation="+Mid(StrD(G),1,lG),RGB(255,255,255),0) 
  DrawText(10,50,"BallX="+Str(Bx),RGB(255,255,255),0) 
  DrawText(10,70,"BallY="+Str(By),RGB(255,255,255),0) 
  DrawText(10,100,"PUNKTE: "+Str(Punkte),RGB(255,0,0),0)
 StopDrawing() 

 StartDrawing(SpriteOutput(0)) 
  Box(0,0,#Radius*2,#Radius*2) 
  Ellipse(#Radius+1,#Radius,#Radius,#Radius,RGB(255,100,0)) 
  Circle(#Radius,#Radius,#Radius,RGB(255,100,0)) 
  ToNext=#LinesPerCircle 
   For rollADD=0 To 360 
     If MouseButton(#PB_MouseButton_Left) And MouseOver(0,Bx,By) 
      Klick=1 
     Else 
      Klick=0 
     EndIf 
    Kx=Sin(((roll+rollADD)*#PI)/180)*#Radius 
    Ky=Cos(((roll+rollADD)*#PI)/180)*#Radius 
    Plot(Kx+#Radius,Ky+#Radius,RGB(255,100,0)) 
     If rollADD>=ToNext 
      LineXY(#Radius,#Radius,Kx+#Radius,Ky+#Radius,RGB(1,1,1)) 
      ToNext+#LinesPerCircle 
     EndIf 
   Next 
 StopDrawing() 

 DisplayTransparentSprite(0,Bx,By) 
 DisplayTransparentSprite(1,Mx,My) 
 
 If bx < 90 
  If by > 350 And by < 550
    Punkte + 10 
  EndIf
 
 EndIf

 FlipBuffers() 
 Delay(1) 
Until KeyboardPushed(#PB_Key_Escape)

Verfasst: 27.04.2007 20:38
von DrShrek
Und hier das 2te Beispiel:


'Seilspringen':

Der Ball muss über ein Seil geworfen werden, darf aber die 'Decke' nicht berühren.

Code: Alles auswählen

Procedure MouseOver(Sprite2,x2,y2,TransparentColor=-1,MSO=1) 
 Img2W=SpriteWidth(Sprite2) 
 Img2H=SpriteHeight(Sprite2) 
  If TransparentColor=-1 
   If (x2<MouseX() And y2<MouseY()) And (MouseX()<x2+Img2W And MouseY()<y2+Img2H) 
    result=1 
   Else 
    result=0 
   EndIf 
  Else 
   If MSO=1 
    StartDrawing(SpriteOutput(Sprite2)) 
     RGB=Point(MouseX()-x2,MouseY()-y2) 
    StopDrawing() 
   Else 
    RGB=Point(MouseX()-x2,MouseY()-y2) 
   EndIf 
   If (x2<MouseX() And y2<MouseY()) And (MouseX()<x2+Img2W And MouseY()<y2+Img2H) And RGB<>TransparentColor 
    result=1 
   Else 
    result=0 
   EndIf 
  EndIf 
 ProcedureReturn result 
EndProcedure 

InitSprite() 
InitKeyboard() 
InitMouse() 

Structure spur 
 x.d 
 y.d 
 Radius.d 
 R.l 
 G.l 
 B.l 
EndStructure 

NewList spur.spur() 

ExamineDesktops()
Width=DesktopWidth(0)
Height=DesktopHeight(0) 
#Radius=40 
#Umkreis=2*#PI*#Radius 
#Lines=3 
#LinesPerCircle=360/#Lines 
#MouseWidth=20 
#MouseHeight=20 

OpenScreen(Width,Height,32,"Der springende Ball") 

Mx=DesktopMouseX() 
My=DesktopMouseY() 
MouseLocate(Mx,My) 
Bx.d=Width/2-#Radius 
By.d=Height/2-#Radius 
BxF.d=Bx.d 
ByF.d=By.d 
dirX.d:dirY.d:fY.d:alfa.d:roll.d:rollX.d:b.d 
GrabX=-1:GrabX=-1 
G.d=0.9:
Wind.d = 0

CreateSprite(0,#Radius*2+1,#Radius*2+1,#PB_Sprite_Texture) 
 StartDrawing(SpriteOutput(0)) 
  Circle(#Radius,#Radius,#Radius,RGB(255,0,0)) 
 StopDrawing() 
CreateSprite(1,#MouseWidth,#MouseHeight) 
 StartDrawing(SpriteOutput(1)) 
  LineXY(0,0,#MouseWidth/2,#MouseHeight-1,RGB(160,160,255)) 
  LineXY(0,0,#MouseWidth-1,#MouseHeight/2,RGB(160,160,255)) 
  FillArea(#MouseWidth-1,#MouseHeight-1,-1,RGB(255,255,255)) 
  LineXY(2,2,#MouseWidth,#MouseHeight,RGB(255,255,255)) 
  LineXY(#MouseWidth/2,#MouseHeight-1,#MouseWidth-1,#MouseHeight-1,RGB(160,160,255)) 
  LineXY(#MouseWidth-1,#MouseHeight/2,#MouseWidth-1,#MouseHeight-1,RGB(160,160,255)) 
 StopDrawing() 

level = 0


Repeat 
 ExamineMouse() 
 ExamineKeyboard() 
 Mx=MouseX() 
 My=MouseY() 
  If MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By) Or Klick=1 Or MouseX()=0 Or MouseY()=0) 
   Bx=Mx-#Radius 
   By=My-#Radius 
   dirX=0 
   dirY=0 
   rollX=0 
   b=0 
   Klick=1 
   StKlick=1 
   lowSpeedY=0 
   fY=0 
   GrabX=Mx 
   GrabY=My 
  Else 
   Klick=0 
    If GrabX<>-1 And GrabY<>-1 
     dirX=(Mx-GrabX)/2 
     dirY=(My-GrabY)/2 
    EndIf 
   GrabX=-1 
   GrabX=-1 
  EndIf 
  If (Not (MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0)) Or MouseX()=0 Or MouseY()=0)) And StKlick=1 
   BxF=Bx 
   ByF=By 
   Bx+dirX+rollX 
   By+dirY+rollY 
   dirY+G 
   dirX+Wind 
    If Bx<=0:Bx=0:dirX*-0.5:rollX*-0.5:EndIf 
    If By<=0:By=0:dirY*-1.01:EndIf 
    If Bx>=Width-#Radius*2-1:Bx=Width-#Radius*2-1:dirX*-0.5:rollX*-0.5:EndIf 
    If By>=Height-#Radius*2-1:By=Height-#Radius*2-1:dirY*-0.5:dirY+0.1:dirX*0.9:EndIf 
    If Klick=0 And StKlick=1 
     AddElement(spur()) 
     spur()\x=Bx+#Radius 
     spur()\y=By+#Radius 
     spur()\Radius=#Radius 
     spur()\R=50 
     spur()\G=15 
     spur()\B=0 
    EndIf 
  EndIf 

  If Bx<=0:Bx=0:EndIf 
  If By<=0:By=0:EndIf 
  If Bx>=Width-#Radius*2-1:Bx=Width-#Radius*2-1:EndIf 
  If By>=Height-#Radius*2-1:By=Height-#Radius*2-1:EndIf 

  If MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftControl) And Not KeyboardPushed(#PB_Key_LeftAlt):Wind+0.001:EndIf 
  If MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftControl) And Not KeyboardPushed(#PB_Key_LeftAlt):Wind-0.001:EndIf 
  If KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftAlt):G+0.001:EndIf 
  If KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftAlt):G-0.001:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftControl):G+0.01:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftControl):G-0.01:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()>0:G+0.1:EndIf 
  If KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()<0:G-0.1:EndIf 

  If (Not (MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0)) Or MouseX()=0 Or MouseY()=0)) And StKlick=1 
   reShow=(#Radius*#PI*alfa)/180 
    If By=Height-#Radius*2-1 
     rollX=reShow/2 
     b=dirX 
    EndIf 
    If By=0 
     rollX=reShow/2 
     b=dirX 
    EndIf 
    If Bx=Width-#Radius*2-1 
     rollY=reShow/2 
     b=-dirY 
    Else 
     rollY=0 
    EndIf 
    If Bx=0 
     rollY=reShow/2 
     b=dirY 
    Else 
     rollY=0 
    EndIf 
   alfa=(180*b)/(#Radius*#PI)+ADDTOalfa 
   roll-alfa 
    If roll>=360 
     roll=roll-360 
    EndIf 
    If Bx=Width-#Radius*2-1 And By=Height-#Radius*2-1 
     alfa=0 
     roll=0 
    EndIf 
    If Bx=0 And By=Height-#Radius*2-1 
     alfa=0 
     roll=0 
    EndIf 
  EndIf 

 ClearScreen(0) 

 StartDrawing(ScreenOutput()) 
  ResetList(spur()) 
   While NextElement(spur()) 
     If spur()\R>=0:spur()\R-1:EndIf 
     If spur()\R<0:spur()\R=0:EndIf 
     If spur()\G>=0:spur()\G-1:EndIf 
     If spur()\G<0:spur()\G=0:EndIf 
     If spur()\B>=0:spur()\B-1:EndIf 
     If spur()\B<0:spur()\B=0:EndIf 
;     If spur()\Radius>=0:spur()\Radius-0.1:EndIf 
;     If spur()\Radius<0:spur()\Radius=0:EndIf 
    Circle(spur()\x,spur()\y,spur()\Radius,RGB(spur()\R,spur()\G,spur()\B)) 
     If spur()\R=0 And spur()\G=0 And spur()\B=0; And spur()\Radius=0 
      DeleteElement(spur()) 
     EndIf 
   Wend 
   If Wind>0:lW=5:Else:lW=6:EndIf 
   If G>0:lG=5:Else:lG=6:EndIf 

  Line(0,400-level,Width,0,RGB($ff,0,0))

  DrawText(10,10,"Wind="+Mid(StrD(Wind),1,lW),RGB(255,255,255),0) 
  DrawText(10,30,"Gravitation="+Mid(StrD(G),1,lG),RGB(255,255,255),0) 
  DrawText(10,50,"BallX="+Str(Bx),RGB(255,255,255),0) 
  DrawText(10,70,"BallY="+Str(By),RGB(255,255,255),0) 
  DrawText(10,100,"PUNKTE: "+Str(Punkte),RGB(255,0,0),0)
 StopDrawing() 

 StartDrawing(SpriteOutput(0)) 
  Box(0,0,#Radius*2,#Radius*2) 
  Ellipse(#Radius+1,#Radius,#Radius,#Radius,RGB(255,100,0)) 
  Circle(#Radius,#Radius,#Radius,RGB(255,100,0)) 
  ToNext=#LinesPerCircle 
   For rollADD=0 To 360 
     If MouseButton(#PB_MouseButton_Left) And MouseOver(0,Bx,By) 
      Klick=1 
     Else 
      Klick=0 
     EndIf 
    Kx=Sin(((roll+rollADD)*#PI)/180)*#Radius 
    Ky=Cos(((roll+rollADD)*#PI)/180)*#Radius 
    Plot(Kx+#Radius,Ky+#Radius,RGB(255,100,0)) 
     If rollADD>=ToNext 
      LineXY(#Radius,#Radius,Kx+#Radius,Ky+#Radius,RGB(1,1,1)) 
      ToNext+#LinesPerCircle 
     EndIf 
   Next 
 StopDrawing() 

 DisplayTransparentSprite(0,Bx,By) 
 DisplayTransparentSprite(1,Mx,My) 
 
 If by < 10
  punkte -30
 ElseIf by < 200-level 
  Punkte +10 
 EndIf
 
 
 


 FlipBuffers() 
 Delay(1) 
Until KeyboardPushed(#PB_Key_Escape)

Verfasst: 27.04.2007 20:44
von Andreas_S
Ihr könnt die Größe des Balles auch ändern.

>#Radius=40

z.B.:

>#Radius=100

Verfasst: 27.04.2007 20:50
von Kaeru Gaman
ich überlege grade, ob man nicht im nachinein einen wettbewerb ohne preis draus machen sollte.

nur irgendwann dann alle geposteten codes nochmal extra präsentieren,
und ein voting dranhängen, wer den "publikumspreis" bekommt.....

Verfasst: 27.04.2007 21:00
von Andreas_S
lol, echt :lol:

Verfasst: 28.04.2007 08:43
von Andreas_S
Hier noch ein kleiner Spaß:

Code: Alles auswählen

Procedure MouseOver(Sprite2,x2,y2,TransparentColor=-1,MSO=1)
 Img2W=SpriteWidth(Sprite2)
 Img2H=SpriteHeight(Sprite2)
  If TransparentColor=-1
   If (x2<MouseX() And y2<MouseY()) And (MouseX()<x2+Img2W And MouseY()<y2+Img2H)
    result=1
   Else
    result=0
   EndIf
  Else
   If MSO=1
    StartDrawing(SpriteOutput(Sprite2))
     RGB=Point(MouseX()-x2,MouseY()-y2)
    StopDrawing()
   Else
    RGB=Point(MouseX()-x2,MouseY()-y2)
   EndIf
   If (x2<MouseX() And y2<MouseY()) And (MouseX()<x2+Img2W And MouseY()<y2+Img2H) And RGB<>TransparentColor
    result=1
   Else
    result=0
   EndIf
  EndIf
 ProcedureReturn result
EndProcedure

InitSprite()
InitKeyboard()
InitMouse()

Structure spur
 x.d
 y.d
 Radius.d
 R.l
 G.l
 B.l
EndStructure

NewList spur.spur()

#Width=1280
#Height=800
#Radius=40
#Umkreis=2*#PI*#Radius
#Lines=3
#LinesPerCircle=360/#Lines
#MouseWidth=20
#MouseHeight=20

#KorbW=100
#KorbH=5
#KorbX=(#Width-#KorbW)/2
#KorbY=((#Height-#KorbH)/3)*2
#KorbAlfa=0
#PointAreaY=20

OpenScreen(#Width,#Height,32,"Der springende Ball")

Mx=DesktopMouseX()
My=DesktopMouseY()
MouseLocate(Mx,My)
Bx.d=#Width/2-#Radius
By.d=#Height/2-#Radius
BxF.d=Bx.d
ByF.d=By.d
dirX.d:dirY.d:fY.d:alfa.d:roll.d:rollX1.d:rollX2.d:b.d
GrabX=-1:GrabX=-1
G.d=0.285:Wind.d
KorbX.d=#KorbX
KorbY.d=#KorbY
KAlfa=#KorbAlfa

CreateSprite(0,#Radius*2+1,#Radius*2+1)
 StartDrawing(SpriteOutput(0))
  Circle(#Radius,#Radius,#Radius,RGB(255,0,0))
 StopDrawing()
CreateSprite(1,#MouseWidth,#MouseHeight)
 StartDrawing(SpriteOutput(1))
  LineXY(0,0,#MouseWidth/2,#MouseHeight-1,RGB(160,160,255))
  LineXY(0,0,#MouseWidth-1,#MouseHeight/2,RGB(160,160,255))
  FillArea(#MouseWidth-1,#MouseHeight-1,-1,RGB(255,255,255))
  LineXY(2,2,#MouseWidth,#MouseHeight,RGB(255,255,255))
  LineXY(#MouseWidth/2,#MouseHeight-1,#MouseWidth-1,#MouseHeight-1,RGB(160,160,255))
  LineXY(#MouseWidth-1,#MouseHeight/2,#MouseWidth-1,#MouseHeight-1,RGB(160,160,255))
 StopDrawing()
CreateSprite(2,#KorbW,#KorbH)
 StartDrawing(SpriteOutput(2))
  For k=0 To #KorbH
   LineXY(0,k,#KorbW,k,RGB(255,0,0))
   LineXY(0,k,#KorbW/15,k,RGB(0,0,255))
   LineXY(#KorbW-#KorbW/15,k,#KorbW,k,RGB(0,0,255))
  Next
 StopDrawing()

Repeat
 ExamineMouse()
 ExamineKeyboard()
 Mx=MouseX()
 My=MouseY()
  If MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By) Or Klick=1 Or MouseX()=0 Or MouseY()=0) And NotOther=1
   Bx=Mx-#Radius
   By=My-#Radius
   dirX=0
   dirY=0
   rollX=0
   b=0
   Klick=1
   StKlick=1
   lowSpeedY=0
   fY=0
   GrabX=Mx
   GrabY=My
  Else
   Klick=0
    If GrabX<>-1 And GrabY<>-1
     dirX=(Mx-GrabX)/2
     dirY=(My-GrabY)/2
    EndIf
   GrabX=-1
   GrabX=-1
   NotOther=1
  EndIf
  If (Not (MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0)) Or MouseX()=0 Or MouseY()=0)) And StKlick=1
   BxF=Bx
   ByF=By
   Bx+dirX+rollX
   By+dirY+rollY1+rollY2
   dirY+G
   dirX+Wind
    If Bx<=0:Bx=0:dirX*-0.5:rollX*-0.5:EndIf
    If By<=0:By=0:dirY*-1.01:EndIf
    If Bx>=#Width-#Radius*2-1:Bx=#Width-#Radius*2-1:dirX*-0.5:rollX*-0.5:EndIf
    If By>=#Height-#Radius*2-1:By=#Height-#Radius*2-1:dirY*-0.5:dirY+0.1:dirX*0.9:EndIf
    If Klick=0 And StKlick=1
     AddElement(spur())
     spur()\x=Bx+#Radius
     spur()\y=By+#Radius
     spur()\Radius=#Radius
     spur()\R=50
     spur()\G=15
     spur()\B=0
    EndIf
  EndIf

  If MouseButton(#PB_MouseButton_Left) And (MouseOver(2,KorbX,KorbY,0) Or KlickKorb=1) And Klick=0
   KorbX=Mx-#KorbW/2
   KorbY=My-#KorbH/2
   KlickKorb=1
   NotOther=0
  Else
   KlickKorb=0
   NotOther=1
  EndIf
  If BX+#Radius>KorbX And Bx+#Radius<KorbX+#KorbW And By+#Radius>KorbY And By+#Radius<KorbY+#KorbH+#PointAreaY And dirY>0
    If Tip=1 And Times=1
     Times=0
    EndIf
   Tip=0
    If Times=0
     Points+1
     Times=1
    EndIf
  EndIf
  If Bx=0 Or Bx=#Width-#Radius*2-1 Or By=0 Or By=#Height-#Radius*2-1 Or KlickKorb=1 Or Klick=1
   Tip=1
  EndIf

  If Bx<=0:Bx=0:EndIf
  If By<=0:By=0:EndIf
  If Bx>=#Width-#Radius*2-1:Bx=#Width-#Radius*2-1:EndIf
  If By>=#Height-#Radius*2-1:By=#Height-#Radius*2-1:EndIf

  If MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftControl) And Not KeyboardPushed(#PB_Key_LeftAlt):Wind+0.001:EndIf
  If MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftControl) And Not KeyboardPushed(#PB_Key_LeftAlt):Wind-0.001:EndIf
  If KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftAlt):G+0.001:EndIf
  If KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftAlt):G-0.001:EndIf
  If KeyboardPushed(#PB_Key_LeftAlt) And MouseWheel()>0 And Not KeyboardPushed(#PB_Key_LeftControl):G+0.01:EndIf
  If KeyboardPushed(#PB_Key_LeftAlt) And MouseWheel()<0 And Not KeyboardPushed(#PB_Key_LeftControl):G-0.01:EndIf
  If KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()>0:G+0.1:EndIf
  If KeyboardPushed(#PB_Key_LeftAlt) And KeyboardPushed(#PB_Key_LeftControl) And MouseWheel()<0:G-0.1:EndIf

  If (Not (MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0)) Or MouseX()=0 Or MouseY()=0)) And StKlick=1
   reShow=(#Radius*#PI*alfa)/180
    If By=#Height-#Radius*2-1
     rollX=reShow/2
     b=dirX
    EndIf
    If By=0
     rollX=reShow/2
     b=dirX
    EndIf
    If Bx=#Width-#Radius*2-1
     rollY1=-reShow/2
     b=-dirY
    Else
     rollY1=0
    EndIf
    If Bx=0
     rollY2=reShow/2
     b=dirY
    Else
     rollY2=0
    EndIf
   alfa=(180*b)/(#Radius*#PI)+ADDTOalfa
   roll-alfa
    If roll>=360
     roll=roll-360
    EndIf
    If Bx=#Width-#Radius*2-1 And By=#Height-#Radius*2-1
     alfa=0
     roll=0
    EndIf
    If Bx=0 And By=#Height-#Radius*2-1
     alfa=0
     roll=0
    EndIf
  EndIf

 ClearScreen(0)

 StartDrawing(ScreenOutput())
  ResetList(spur())
   While NextElement(spur())
     If spur()\R>=0:spur()\R-1:EndIf
     If spur()\R<0:spur()\R=0:EndIf
     If spur()\G>=0:spur()\G-1:EndIf
     If spur()\G<0:spur()\G=0:EndIf
     If spur()\B>=0:spur()\B-1:EndIf
     If spur()\B<0:spur()\B=0:EndIf
;     If spur()\Radius>=0:spur()\Radius-0.1:EndIf
;     If spur()\Radius<0:spur()\Radius=0:EndIf
    Circle(spur()\x,spur()\y,spur()\Radius,RGB(spur()\R,spur()\G,spur()\B))
     If spur()\R=0 And spur()\G=0 And spur()\B=0; And spur()\Radius=0
      DeleteElement(spur())
     EndIf
   Wend
   If Wind>0:lW=5:Else:lW=6:EndIf
   If G>0:lG=5:Else:lG=6:EndIf
  DrawText(10,10,"Wind="+Mid(StrD(Wind),1,lW),RGB(255,255,255),0)
  DrawText(10,30,"Gravitation="+Mid(StrD(G),1,lG),RGB(255,255,255),0)
  DrawText(10,50,"BallX="+Str(Bx),RGB(255,255,255),0)
  DrawText(10,70,"BallY="+Str(By),RGB(255,255,255),0)
  DrawText(10,100,"Points="+Str(Points),RGB(255,0,0),0)
 StopDrawing()

 StartDrawing(SpriteOutput(0))
  Box(0,0,#Radius*2,#Radius*2)
  Ellipse(#Radius+1,#Radius,#Radius,#Radius,RGB(255,100,0))
  Circle(#Radius,#Radius,#Radius,RGB(255,100,0))
  ToNext=#LinesPerCircle
   For rollADD=0 To 360
     If MouseButton(#PB_MouseButton_Left) And MouseOver(0,Bx,By)
      Klick=1
     Else
      Klick=0
     EndIf
    Kx=Sin(((roll+rollADD)*#PI)/180)*#Radius
    Ky=Cos(((roll+rollADD)*#PI)/180)*#Radius
    Plot(Kx+#Radius,Ky+#Radius,RGB(255,100,0))
     If rollADD>=ToNext
      LineXY(#Radius,#Radius,Kx+#Radius,Ky+#Radius,RGB(1,1,1))
      ToNext+#LinesPerCircle
     EndIf
   Next
 StopDrawing()

 DisplayTransparentSprite(0,Bx,By)
 DisplayTransparentSprite(2,KorbX,KorbY)
 DisplayTransparentSprite(1,Mx,My)

 FlipBuffers()
 Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
Man kann den Korb verschieben.

PS. da war ein kleiner fehler den ich ausgebessert habe. Der ball hat am rechten Bildschirmrand nicht mir Drehung berücksichtigt.

Verfasst: 01.05.2007 18:54
von dige
Stark :allright:

Verfasst: 01.05.2007 20:02
von Andreas_S
danke <)

Verfasst: 21.05.2007 11:09
von Xaby
http://www.ezprezzo.com/videoclips/whit ... uture.html

Erweiterter CODE von AND51

Code: Alles auswählen

;/ Folker Linstedt

#breite=1600 
#hoehe=1200 

;/
#max_ball=28 ; Maximale Anzahl Bälle 
#schlaeger_breite=#breite/10 ; Je länger, desto leichter 
;/

InitSprite() 
InitKeyboard() 
InitMouse() 
OpenScreen(#breite, #hoehe, 32, "Der springende Ball - AND51") 

Structure structSpur 
  x.l 
  y.l 
  color.l 
  Owner.l 
EndStructure 
NewList spur.structSpur() 
Structure structBall 
  x.l 
  y.l 
  dirX.l 
  dirY.f 
  grav.f
  Wind.f
  Owner.l 
  Typ.l
EndStructure 
NewList ball.structBall() 
Structure structWand 
  x.l 
  y.l 
  xl.l 
  yl.f 
  winkel.f 
EndStructure 
NewList wand.structWand() 

CreateSprite(0, 30, 30) 
StartDrawing(SpriteOutput(0)) 
Circle(15, 15, 15, RGB(255,128,0)) 
Box(0,15,15,1,#Black)
StopDrawing() 

CreateSprite(1, #schlaeger_breite, 4) 
StartDrawing(SpriteOutput(1)) 
FillArea(1, 1, -1, #Blue) 
StopDrawing() 

CreateSprite(3,#breite,#hoehe,0) 
StartDrawing(SpriteOutput(3)) 
Box(0,0,#breite,#hoehe,RGB(90,80,0))
For x = 0 To 9000 
  Q=Random(50)
  A=Random(5)
  b=Random(30)
  Box(Random(#breite),Random(#hoehe),2+A,6+b,RGB(88+Q,88+Q,0)) 
  ;Circle(Random(sw),Random(sh),A+5,RGB(Q,Q,Q))
Next 
    
StopDrawing() 



For i=0 To 10-1
  AddElement(wand()) 
  wand()\x=(#breite/10)*i 
  wand()\y=#hoehe-50 
  wand()\xl=#schlaeger_breite
  wand()\yl=4
  
  AddElement(wand()) 
  wand()\x=100+i*100
  wand()\y=300+i*80
  wand()\xl=#schlaeger_breite
  wand()\yl=4
   
Next


Start=Date() 
Repeat 
  ;ClearScreen(0) ; 3.94 und früher: 0,0,0 
  DisplaySprite(3,0,0) ; Hintergrund
  ExamineKeyboard() 
  ExamineMouse() 
  
  
  If CountList(ball()) < #max_ball And Date() < Start+10 ; Only create ball in first 10 sec of a game 
    AddElement(ball()) 
    ball()\x=Random(#breite-31)+1 
    ball()\y=#hoehe/(Random(18)+2) 
    ball()\dirX=(Random(2)+2)*(Random(1)*2-1) ; Range: -4 to 4 
    ball()\dirY=-(Random(20)+75)/100 ; Range: -0.75 to -0.95 
    ball()\grav=20/100;(Random(15)+5)/100 ; Range: 0.05 to 0.20 
    ball()\Owner=ElapsedMilliseconds() 
    ;Delay(50) 
  EndIf 
  
  
  
  StartDrawing(ScreenOutput()) 
  ;DrawText(#breite/2, 0, "Game Duration: "+FormatDate("%hh:%ii:%ss", Date()-Start), $FFFFFF, 0) ; PB 4.00, 3.94+earlier: Use Locate() ! 
  
  ResetList(spur()) ; extra kein ForEach, sondern "3.94 und früher"-freundliche Programmierung =) 
  While NextElement(spur()) 
    spurX=spur()\x 
    spurY=spur()\y 
    spurOwner=spur()\Owner 
    spur()\color-2 
    *spur=@spur() 
    While NextElement(spur()) 
      If spur()\Owner = spurOwner 
        LineXY(spurX, spurY, spur()\x, spur()\y, spur()\color) 
        Break 
      EndIf 
    Wend 
    ChangeCurrentElement(spur(), *spur) 
    If spur()\color <= 0 
      DeleteElement(spur()) 
    EndIf 
  Wend 
  StopDrawing() 
  
  ResetList(ball()) 
  While NextElement(ball()) 
    If ball()\x <= 0 Or ball()\x >= #breite-30 
      ball()\dirX*-1 
      MessageBeep_(#MB_OK) 
    EndIf 
    
    ResetList(wand()) 
    While NextElement(wand()) 
    If SpritePixelCollision(0, ball()\x, ball()\y, 1, wand()\x, wand()\y) 
      ball()\y=wand()\y-30 ;/
      ball()\dirY*-0.50 ; Je näher an 1, desto LEICHTER wird der Ball und springt höher 
      
    EndIf 
    Wend
    
    
    ball()\x+ball()\dirX 
    ball()\y+ball()\dirY 
    ball()\dirY+ball()\grav 
    AddElement(spur()) 
    spur()\x=ball()\x+7 
    spur()\y=ball()\y+7 
    spur()\color=255 
    spur()\Owner=ball()\Owner 
    DisplayTransparentSprite(0, ball()\x, ball()\y) 
    If ball()\y >= #hoehe-30 
      
      DeleteElement(ball()) 
    EndIf 
  Wend 
  
  ResetList(wand()) 
  While NextElement(wand()) 
    DisplaySprite(1, wand()\x, wand()\y) 
  Wend
  
  
  If CountList(ball()) = 0 
    Break 
  EndIf 
  
  FlipBuffers() 
  Delay(10) 
Until KeyboardPushed(#PB_Key_Escape) 
CloseScreen()
:allright:
Alle Zeiten sind UTC+02:00
Seite 5 von 8

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de