Springender Ball

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag von Andreas_S »

Blitze, der Ball dreht sich ...... :shock:
Geil!!!
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag 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: !
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Beitrag 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
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag 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.
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Beitrag 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 :)
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag 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?
Benutzeravatar
onny
Beiträge: 400
Registriert: 27.04.2005 17:50
Kontaktdaten:

Beitrag von onny »

programmier grad ein ping pong clon, ziemlich einfach!
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag 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.
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

Geil, die Rotation hat auch einfluß auf die Bewegung
I´a dllfreak2001
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag von Andreas_S »

Ist aber glaub ich noch nicht korrekt
Antworten