Basketballspiel

xDerPaddix · 27. Juni 2013, 10:43

Hey Leute,

wir machen gerade in der Schule visual basic und ich wollte fragen, wie man eine kugel in einen basket ball korb (als image im hintergrund) reinwerfen kann, und wie man der Kugel je nach Mausbewegung eine andere Flugbahn geben kann. Man soll mit der Maus den Ball ziehen und wieder loslassen so dass er in die gewählte Richtung fliegt.

Vielen Dank schon im vorraus,

xDerPaddix

VincentTB · 27. Juni 2013, 10:51

Ihr lernt in der Schule ernsthaft VB 6?! *faceplam*
Wenn das dein ernst ist, würde ich anfangen, keine Pictureboxen zu nehmen sondern, sofern in VB 6 vorhanden, irgend eine Grafikengine (GDI(+) ?) zu nutzten.

xDerPaddix · 27. Juni 2013, 10:55

Ja tun wir, Frag mein Lehrer xD ne das sogar visual basic 5.0 xD unsere pcs sind zu lame...

Ich hab kein Plan von dem Zeug:DD

BlackNetworkBit · 27. Juni 2013, 14:47

wie wäre es dann es zu lernen ?
dafür bist du ja in der Schule.

MFG BlackNetworkBit

Neptun · 27. Juni 2013, 14:53

Hallo xDerPaddix,
für einen Einsteiger ist das ein bisschen schwierig.
Hier mal ein Ansatz:

Visual Basic-Quellcode

' Controls: 1 * Timer, 1 * Picturebox
Option Explicit
Private XBall&, YBall&, Rad&, Speed&, XV&, YV&
Private Sub Form_Load()
Me.ScaleMode = vbPixels
Me.BackColor = RGB(128, 128, 128)
Me.WindowState = vbMaximized
End Sub
Private Sub Form_Activate()
DoEvents
Rad = 40 ' Ballgrösse
With Picture1
.BorderStyle = vbBSNone
.ScaleMode = vbPixels
.Move 100, 100, Me.ScaleWidth - 200, Me.ScaleHeight - 100
.BackColor = RGB(221, 155, 44)
.AutoRedraw = True
Picture1.Line (0, .ScaleHeight / 2)-(.ScaleWidth, 0), RGB(222, 222, 222), BF
Set .Picture = .Image
XBall = .ScaleWidth / 2
YBall = 0
End With
Speed = 1
Timer1.Interval = 12
Timer1.Enabled = True
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dx&, dy&
dx = XBall - X
dy = YBall - Y
If dx * dx + dy * dy <= Rad * Rad Then
Timer1.Enabled = False
XV = XBall - X
YV = YBall - Y
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
XBall = X + XV
YBall = Y + YV
Call DrawBall
Picture1.Refresh
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Speed = 1
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
If YBall + Rad + Speed < Picture1.ScaleHeight - 1 Then
YBall = YBall + Speed
Speed = Speed + 1
Else
YBall = Picture1.ScaleHeight - 1 - Rad
Timer1.Enabled = False
Beep
End If
Call DrawBall
End Sub
Private Sub DrawBall()
With Picture1
.Cls
.FillStyle = vbFSSolid
.FillColor = RGB(255, 128, 0) ' Ballfarbe
Picture1.Circle (XBall, YBall), Rad
.FillStyle = vbDiagonalCross
.FillColor = vbBlack
Picture1.Circle (XBall, YBall), Rad, vbBlack
.FillStyle = vbTransparent
End With
End Sub

xDerPaddix · 1. Juli 2013, 12:02

Hi Neptun,

danke, dass du dir soviel Mühe für mein Projekt gemacht hast

Neptun · 1. Juli 2013, 13:33

Hallo xDerPaddix,
war noch ein Bug drin. Hab's noch mal überarbeitet:

Visual Basic-Quellcode

' Controls: 1 * Timer, 3 * Picturebox
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function TransparentBlt& Lib "msimg32.dll" (ByVal hdcDest&, _
ByVal nXOriginDest&, ByVal nYOriginDest&, ByVal nWidthDest&, ByVal nHeightDest&, _
ByVal hdcSrc&, ByVal nXOriginSrc&, ByVal nYOriginSrc&, ByVal nWidthSrc&, _
ByVal nHeightSrc&, ByVal crTransparent&)
Private XBall&, YBall&, Rad&, Speed&, XV&, YV&
Private SW&, SH&, flgMove As Boolean
Private Sub Form_Load()
With Me
.ScaleMode = vbPixels
.BackColor = RGB(128, 128, 128)
.WindowState = vbMaximized
End With
End Sub
Private Sub Form_Activate()
DoEvents
Rad = 40 ' Ballgrösse
SW = Me.ScaleWidth - 200
SH = Me.ScaleHeight - 100
With Picture1 ' Sichtbares Bild
.BorderStyle = vbBSNone
.ScaleMode = vbPixels
.Move 100, 100, SW, SH
.AutoRedraw = True
End With
With Picture3 ' Hintergrundbild
.Visible = False
.BorderStyle = vbBSNone
.ScaleMode = vbPixels
.BackColor = RGB(221, 155, 44)
.Move 0, 0, SW, SH
.AutoRedraw = True
Picture3.Line (0, SH / 2)-(SW, 0), RGB(222, 222, 222), BF
End With
With Picture2 ' Ball
.Visible = False
.BorderStyle = vbBSNone
.ScaleMode = vbPixels
.BackColor = vbCyan
.Move 0, 0, 2 * Rad, 2 * Rad
.AutoRedraw = True
.FillStyle = vbFSSolid
.FillColor = RGB(255, 128, 0)
Picture2.Circle (Rad, Rad), Rad - 1, vbBlack
.FillStyle = vbFSTransparent
End With
Picture2.Circle (Rad, Rad), Rad - 1, vbBlack, , , 10
Picture2.Circle (Rad, Rad), Rad - 1, vbBlack, , , 1.7
XBall = SW \ 2
YBall = 0
Speed = 1
flgMove = False
Timer1.Interval = 12
Timer1.Enabled = True
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim DX&, DY&
DX = XBall - x
DY = YBall - y
If DX * DX + DY * DY <= Rad * Rad Then
Timer1.Enabled = False
XV = XBall - x
YV = YBall - y
flgMove = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton And flgMove = True Then
XBall = x + XV
YBall = y + YV
Call DrawBall
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Speed = 2
flgMove = False
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
If YBall + Rad + Speed < SH - 1 Then
YBall = YBall + Speed
Speed = Speed + 1
Else
YBall = SH - 1 - Rad
Timer1.Enabled = False
Beep
End If
Call DrawBall
End Sub
Private Sub DrawBall()
With Picture1
Call BitBlt(.hdc, 0, 0, SW, SH, Picture3.hdc, 0, 0, vbSrcCopy)
Call TransparentBlt(.hdc, XBall - Rad, YBall - Rad, 2 * Rad, 2 * Rad, _
Picture2.hdc, 0, 0, 2 * Rad, 2 * Rad, vbCyan)
.Refresh
End With
End Sub

Basketballspiel

Basketballspiel

Visual Basic-Quellcode

Danke für deine Antworrt!

Visual Basic-Quellcode

Benutzer online 1

Tags

4 Benutzer haben hier geschrieben