PureBoard

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

Springender Ball

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

Seite 4 von 8

Verfasst: 22.04.2007 16:47
von Andreas_S
Blitze, der Ball dreht sich ...... :shock:
Geil!!!

Verfasst: 22.04.2007 19:52
von Andreas_S
Hier noch ein Code (nicht so gut wie der von dllfreak2001):

Code: Alles auswählen

Procedure MouseOver(Sprite2,x2,y2,TransparentColor=-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
   StartDrawing(SpriteOutput(Sprite2))
    RGB=Point(MouseX(),MouseY())
   StopDrawing()
    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.f
 y.f
 Radius.d
 R.l
 G.l
 B.l
EndStructure
NewList spur.spur()

#Width=1280
#Height=800

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

Mx=DesktopMouseX()
My=DesktopMouseY()
MouseLocate(Mx,My)
Bx.d=#Width/2-15
By.d=#Height/2-15
dirX.d:dirY.d:fY.d:GrabX=-1:GrabX=-1:Wind.d:G.d=0.25

CreateSprite(0,30,30,#PB_Sprite_Texture)
 StartDrawing(SpriteOutput(0))
  Circle(15,15,15,RGB(255,0,0))
 StopDrawing()
CreateSprite(1,10,10)
 StartDrawing(SpriteOutput(1))
  LineXY(0,0,5,9,RGB(200,200,255))
  LineXY(0,0,9,5,RGB(200,200,255))
  Plot(2,2,RGB(255,255,255))
  FillArea(9,9,-1,RGB(255,255,255))
  LineXY(5,9,9,9,RGB(200,200,255))
  LineXY(9,5,9,9,RGB(200,200,255))
 StopDrawing()

Repeat
 ExamineMouse()
 ExamineKeyboard()
 Mx=MouseX()
 My=MouseY()
  If MouseButton(#PB_MouseButton_Left) And (MouseOver(0,Bx,By,0) Or Klick=1)
   Bx=Mx-15
   By=My-15
   dirX=0
   dirY=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 StKlick=1
   If Not (MouseButton(#PB_MouseButton_Left) And Kilck)
    Bx+dirX
    By+dirY
    dirY+G
    dirX+Wind
   EndIf
  EndIf
  If Bx<0:Bx=0:dirX*-0.9:EndIf
  If By<0:By=0:dirY*-1.20:EndIf
  If Bx>#Width-30:Bx=#Width-30:dirX*-0.9:EndIf
  If By>#Height-30:By=#Height-30:TipY=1:dirX*0.9:Else:TipY=0:EndIf
  If TipY=1
   If dirY>2.60
    dirY*-0.80
   Else
    lowSpeedY=1
   EndIf
  EndIf
  If lowSpeedY=1
   fY+0.001
    If fY<0.80
      If TipY=1
       dirY*-(0.80-fY)
       dirX*0.99
      EndIf
     dirX*0.999
    Else
     dirY=0
      If dirX<=0.1 Or dirX>=-0.1
       dirX*0.5
      EndIf
     By=#Height-30
    EndIf
  EndIf
  If Klick=0 And StKlick=1
   AddElement(spur())
   spur()\x=Bx+15
   spur()\y=By+15
   spur()\Radius=2
   spur()\R=255
   spur()\G=255
   spur()\B=0
  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

 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)
 StopDrawing()

 DisplayTransparentSprite(0,Bx,By)
 DisplayTransparentSprite(1,Mx,My)

 FlipBuffers()
 Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
Mit dem Mausrad kann man den Wind verändern. Wenn man Str und das Mausrad verwndet kann man die Gravitation verändern. Um die Gravitation schneller zu verändern kannst du Alt verwenden und ums ganz schnell zu mache Alt + Str <) .

Viel Spaß :mrgreen: !

Verfasst: 22.04.2007 19:57
von RSBasic
@PBprogger
Bei mir ist dieser Bereich bisschen verschoben, also der Ball ist bisschen weiter unten am Boden, so dass ich ihn nicht mehr sehen kann :lol:
Ich lach dich nicht für deine Arbeit aus, sondern ich lache mit dir

Verfasst: 22.04.2007 20:00
von Andreas_S
Was soll das "Ich lach dich nicht für deine Arbeit aus, sondern ich lache mit dir" heißen, ernst :lol: ?

Zum Thema probiers mit einer anderen Auflösung aus.

Verfasst: 22.04.2007 20:05
von RSBasic
@PBprogger
>Was soll das "Ich lach dich nicht für deine Arbeit aus, sondern ich lache >mit dir" heißen, ernst :lol:
Antwort: Kleiner Scherz :lol:

Ok ich versuch mal ne andere Auflösung :allright:

\\Edit:
Danke :allright: mit der Bildschirmauflösung 1280x1024 fuinktioniert es perfekt :)

Verfasst: 22.04.2007 20:09
von Andreas_S
RSBasic hat geschrieben:@PBprogger
>Was soll das "Ich lach dich nicht für deine Arbeit aus, sondern ich lache >mit dir" heißen, ernst :lol:
Antwort: Kleiner Scherz :lol:
Will ich hoffen :lol:

Wie ist es so?

Verfasst: 23.04.2007 21:29
von onny
programmier grad ein ping pong clon, ziemlich einfach!

Verfasst: 27.04.2007 18:59
von Andreas_S
Hier noch ein neuer Code:

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

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.285:Wind.d

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

 FlipBuffers()
 Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
Könnte noch ein paar Fehler haben aber sonst finde ich ihn ganz gut, und ihr?

PS. gleiche Steuerung wie bei meinem alten.

Verfasst: 27.04.2007 20:07
von dllfreak2001
Geil, die Rotation hat auch einfluß auf die Bewegung

Verfasst: 27.04.2007 20:16
von Andreas_S
Ist aber glaub ich noch nicht korrekt
Alle Zeiten sind UTC+02:00
Seite 4 von 8

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de