|
Option Explicit
Private Type Dot
PosX As Double
PosY As Double
SpeedX As Double
SpeedY As Double
Mass As Double
Radius As Double
End Type
Private Dots(4) As Dot
Private ViewPort As Long
Private myDrawMode As Long
Private Zeit
Private Sub Form_Load()
Dim i As Long
Randomize
myDrawMode = 13
For i = 0 To UBound(Dots)
Dots(i).PosX = Int(Rnd(1) * Picture1(0).ScaleWidth)
Dots(i).PosY = Int(Rnd(1) * Picture1(0).ScaleHeight)
Dots(i).Radius = 6 + Rnd(1) * 20
Dots(i).Mass = (Dots(i).Radius * 50) ^ 3
Next i
Dots(0).PosX = Picture1(0).ScaleWidth / 2 + 30
Dots(0).PosY = Picture1(0).ScaleHeight / 2
Dots(0).Radius = 28
Dots(0).Mass = (Dots(0).Radius * 50) ^ 3
Dots(0).SpeedY = 0.102
Dots(1).PosX = Picture1(0).ScaleWidth / 4
Dots(1).PosY = Picture1(0).ScaleHeight / 2
Dots(1).Radius = 4.7
Dots(1).Mass = (Dots(1).Radius * 50) ^ 3
Dots(1).SpeedY = -1.6
Dots(2).PosX = Picture1(0).ScaleWidth / 8 + _
Picture1(0).ScaleWidth / 2
Dots(2).PosY = Picture1(0).ScaleHeight / 2
Dots(2).Radius = 5
Dots(2).Mass = (Dots(2).Radius * 50) ^ 3
Dots(2).SpeedY = 2.15
Dots(3).PosX = Picture1(0).ScaleWidth / 2
Dots(3).PosY = Picture1(0).ScaleHeight / 16
Dots(3).Radius = 3
Dots(3).Mass = (Dots(3).Radius * 50) ^ 3
Dots(3).SpeedX = 2.2
Dots(4).PosX = Picture1(0).ScaleWidth / 2 - 30
Dots(4).PosY = Picture1(0).ScaleHeight / 2
Dots(4).Radius = 28
Dots(4).Mass = (Dots(4).Radius * 50) ^ 3
Dots(4).SpeedY = -0.102
Load Picture1(1)
Picture1(1).Visible = True
End Sub
Private Sub Form_Resize()
Picture1(0).Top = 0
Picture1(1).Top = 0
Picture1(0).Left = 0
Picture1(1).Left = 0
Picture1(0).Width = Form1.ScaleWidth
Picture1(1).Width = Form1.ScaleWidth
Picture1(0).Height = Form1.ScaleHeight
Picture1(1).Height = Form1.ScaleHeight
End Sub
Private Sub Picture1_KeyPress(Index As Integer, _
KeyAscii As Integer)
If Chr$(KeyAscii) = "+" Then myDrawMode = myDrawMode + 1
If Chr$(KeyAscii) = "-" Then myDrawMode = myDrawMode - 1
End Sub
Private Sub Timer1_Timer()
Dim i As Long, n As Long
Dim EntfernungX As Long, EntfernungY As Long
Dim Entfernung As Long
Dim Radius As Long
On Local Error Resume Next
For n = 0 To UBound(Dots)
For i = 0 To UBound(Dots)
If n <> i Then
EntfernungX = Abs(Dots(n).PosX - Dots(i).PosX)
EntfernungY = Abs(Dots(n).PosY - Dots(i).PosY)
If EntfernungX + EntfernungY <> 0 Then
If Dots(i).PosX > Dots(n).PosX Then
Dots(i).SpeedX = Dots(i).SpeedX - (Dots(n).Mass / _
((EntfernungX + EntfernungY) ^ 2)) / Dots(i).Mass
Else
Dots(i).SpeedX = Dots(i).SpeedX + (Dots(n).Mass / _
((EntfernungX + EntfernungY) ^ 2)) / Dots(i).Mass
End If
If Dots(i).PosY > Dots(n).PosY Then
Dots(i).SpeedY = Dots(i).SpeedY - (Dots(n).Mass / _
((EntfernungX + EntfernungY) ^ 2)) / Dots(i).Mass
Else
Dots(i).SpeedY = Dots(i).SpeedY + (Dots(n).Mass / _
((EntfernungX + EntfernungY) ^ 2)) / Dots(i).Mass
End If
End If
Entfernung = EntfernungX ^ 2 + EntfernungY ^ 2
Radius = (Dots(i).Radius + Dots(n).Radius) ^ 2
If Entfernung <= Radius Then Call Stoss(i, n)
End If
Next i
Next n
If ViewPort = 0 Then
Picture1(1).ZOrder 0
ViewPort = 1
For i = 0 To UBound(Dots)
Picture1(0).Circle (Dots(i).PosX, Dots(i).PosY), _
Dots(i).Radius, RGB(0, 0, 0)
Next i
Else
Picture1(0).ZOrder 0
ViewPort = 0
For i = 0 To UBound(Dots)
Picture1(1).Circle (Dots(i).PosX, Dots(i).PosY), _
Dots(i).Radius, RGB(0, 0, 0)
Next i
End If
For i = 0 To UBound(Dots)
Dots(i).PosX = Dots(i).PosX + Dots(i).SpeedX
If Dots(i).PosX < 0 Or Dots(i).PosX > Picture1(0).ScaleWidth _
Then Dots(i).SpeedX = Dots(i).SpeedX * -1
Dots(i).PosY = Dots(i).PosY + Dots(i).SpeedY
If Dots(i).PosY < 0 Or Dots(i).PosY > Picture1(0).ScaleHeight _
Then Dots(i).SpeedY = Dots(i).SpeedY * -1
Next i
If ViewPort = 0 Then
For i = 0 To UBound(Dots)
Picture1(0).Circle (Dots(i).PosX, Dots(i).PosY), _
Dots(i).Radius, RGB(255, 255, 255)
Next i
Me.Caption = "fps:" & Format(1 / (Timer - Zeit), "#0.0")
Zeit = Timer
Else
For i = 0 To UBound(Dots)
Picture1(1).Circle (Dots(i).PosX, Dots(i).PosY), _
Dots(i).Radius, RGB(255, 255, 255)
Next i
Me.Caption = "fps:" & Format(1 / (Timer - Zeit), "#0.0")
On Error GoTo 0
Zeit = Timer
End If
End Sub
Sub Stoss(i, n)
Dim u1x#, u1y#, u1x_#, u1y_#, u2x_#, u2y_#
Dim mr#, rx#, ry#, r_2#, d1#
rx = Dots(n).PosX - Dots(i).PosX
ry = Dots(n).PosY - Dots(i).PosY
r_2 = rx * rx + ry * ry
mr = Dots(n).Mass / Dots(i).Mass
u1x = Dots(i).SpeedX - Dots(n).SpeedX
u1y = Dots(i).SpeedY - Dots(n).SpeedY
d1 = 2 * (u1x * rx + u1y * ry) / ((mr + 1) * r_2)
If d1 < 0 Then Exit Sub
u2x_ = rx * d1
u2y_ = ry * d1
u1x_ = u1x - mr * u2x_
u1y_ = u1y - mr * u2y_
Dots(i).SpeedX = u1x_ + Dots(n).SpeedX
Dots(i).SpeedY = u1y_ + Dots(n).SpeedY
Dots(n).SpeedX = u2x_ + Dots(n).SpeedX
Dots(n).SpeedY = u2y_ + Dots(n).SpeedY
End Sub
Private Sub DrawLight(PosX, PosY, Size, Dest As Control)
Dim Factor As Double, X As Long, Y As Long, RGB As Long
Dim R As Long, B As Long, G As Long
Factor = Picture2.ScaleWidth / (Size * 4)
For X = 0 To Size * 4 - 4
For Y = 0 To Size * 4 - 4
RGB = Picture2.Point(X * Factor, Y * Factor)
B = (RGB And &HFF0000) / &H10000
G = (RGB And &HFF00&) / &H100&
R = (RGB And &HFF&)
RGB = Dest.Point(PosX - Size * 2 + X, PosY - Size * 2 + Y)
B = (RGB And &HFF0000) / &H10000 + B
G = (RGB And &HFF00&) / &H100& + G
R = (RGB And &HFF&) + R
If B > 255 Then B = 255
If G > 255 Then G = 255
If R > 255 Then R = 255
RGB = B * &H10000 + G * &H100& + R
Dest.PSet (PosX - Size * 2 + X, PosY - Size * 2 + Y), RGB
Next Y
Next X
End Sub
|
|