📄 form1.frm
字号:
'A negative value indicates that it will pull
' Note: pulling is more like a real muscle ;) some other 2d robot
' programs whose names I will not mention only support pushing
LengthTotal = .linklength
If ClockPause = False Then LengthTotal = LengthTotal + .Push
'The link's apparent length will temporarily be changed according to
'.push
T1 = .target1_id: T2 = .target2_id
xer = (vertex(T2).X + vertex(T2).momentum_x) - (vertex(T1).X + vertex(T1).momentum_x)
yer = (vertex(T2).y + vertex(T2).momentum_y) - (vertex(T1).y + vertex(T1).momentum_y)
Leng = Sqr(Abs(xer ^ 2 + yer ^ 2))
'This will calculate the links 'true' length. That is the distance
'between its 2 vertices. The length stored in .linklength is
'the length that the link 'should' be. The link will push or pull
'to bring the vertices back to that distance.
Leng2Go_x = ((Leng - LengthTotal) / Leng) * xer
Leng2Go_y = ((Leng - LengthTotal) / Leng) * yer
Leng2Go_x = Leng2Go_x
Leng2Go_y = Leng2Go_y
'Calculate how far in each direction the vertices must go
'in order to get the link back to its regular length
vertex(T1).momentum_x = vertex(T1).momentum_x + (Leng2Go_x / 2) * .linktension
vertex(T1).momentum_y = vertex(T1).momentum_y + (Leng2Go_y / 2) * .linktension
vertex(T2).momentum_x = vertex(T2).momentum_x + (Leng2Go_x / 2) * -1 * .linktension
vertex(T2).momentum_y = vertex(T2).momentum_y + (Leng2Go_y / 2) * -1 * .linktension
'These lines actually add the neccessary momentum to the Link's
'two vertices to make them snap into place.
'It factors in the amount of tension the link has
'If the link has a .linktension value of 1, it will snap back
'into place almost instantly.
'If it has a value of 0, it will not try to re-establish its
'length.
End If
End With
Next i
'-------------------------------------------------------------------
'Calculate Vertex Momentum and Implement Movement ------------------
For i = 1 To MaxVertices
With vertex(i)
If .used = True Then
If .y > 0.1 Then .momentum_y = .momentum_y - (Gravity * 1.5)
If .justreleased = True Then .momentum_x = 0: .momentum_y = 0: .justreleased = False
'Gravity: decrease the y momentum by the value of Gravity
' each turn
.momentum_x = .momentum_x + (LeftWind / 10)
'Wind: Increase the x momentum by the value of Leftwind.
' To make wind that blows from the right, make
' Lefwind negative.
.momentum_x = .momentum_x * (1 - Atmosphere)
.momentum_y = .momentum_y * (1 - Atmosphere)
'Slow down the vertices based on how much air resistance
'there is.
If DragDot = i And SubMode = 2 Then .momentum_x = 0: .momentum_y = 0
'Put the vertex that's being dragged to the mouse location
.LastX = .X
.Lasty = .y
.X = .X + .momentum_x
.y = .y + .momentum_y
newx = .X + .momentum_x
newy = .y + .momentum_y
'Now actually make the vertices move, base on how much
'momentum they have. Everything up till this section
'has changed the momentum in some way, even the code
'to change the links. Now we simply add the value of the
'momentum to the position of the vertex.
'If the vertex goes thru the wall, floor or ceiling,
'it will be corrected below:
Fric = WallFriction
If .Radius < 0 Then .Radius = Abs(.Radius)
If .Radius > 0 Then .wheel = True
If .wheel = True Then Fric = 0
If .y - .Radius < 0.1 Then 'floor
.y = 0 + .Radius
.momentum_x = .momentum_x * (1 - Fric)
.momentum_y = (.momentum_y * WallBounce) * -1
If .wheel = True Then .momentum_c = -1 * .momentum_x
End If
If .X - .Radius < 0.1 Then 'left wall
.X = 0 + .Radius
.momentum_x = (.momentum_x * WallBounce) * -1
.momentum_y = .momentum_y * (1 - Fric)
If mnuAutoRev.Checked Then
If AutoReverseCycle = 0 Then AutoReverseCycle = 2: ClockSpeed = ClockSpeed * -1: INDspd = "Spd: " & ClockSpeed
If AutoReverseCycle = 1 Then AutoReverseCycle = 2: ClockSpeed = ClockSpeed * -1: INDspd = "Spd: " & ClockSpeed
End If
If .wheel = True Then .momentum_c = .momentum_y
End If
If .X + .Radius > (RightWall - 0.1) Then 'right wall
.X = RightWall - .Radius
.momentum_x = (.momentum_x * WallBounce) * -1
.momentum_y = .momentum_y * (1 - Fric)
If mnuAutoRev.Checked Then
If AutoReverseCycle = 0 Then AutoReverseCycle = 1: ClockSpeed = ClockSpeed * -1: INDspd = "Spd: " & ClockSpeed
If AutoReverseCycle = 2 Then AutoReverseCycle = 1: ClockSpeed = ClockSpeed * -1: INDspd = "Spd: " & ClockSpeed
End If
If .wheel = True Then .momentum_c = -1 * .momentum_y
End If
If .y + .Radius > (Ceiling - 0.1) And CHKTop.Value = 1 Then 'ceiling
.y = Ceiling - .Radius
.momentum_y = (.momentum_y * WallBounce) * -1
.momentum_x = .momentum_x * (1 - Fric)
If .wheel = True Then .momentum_c = .momentum_x
End If
'Wow that was big.
'Basically, if the vertex goes thru a floor or wall, it is
'stopped, put directly on the surface, and its momentum is
'reflected and reduced by the WallBounce variable.
'If WallBounce = 1 then all of the vertex's momentum will
'be reflected.
'If WallBounce = 0 then the vertex will be stripped of its
'momentum in that direction. (the object will not bounce at all)
'Also this section calculates the momentum added to the
'vertex's wheel (if there is a wheel) as it rubs against
'the floor or ceiling. Wheels ignore wall friction.
'Note: as a side effect of link correction, some objects will
' bounce even if WallBounce = 0. Because when it hits
' the ground, the momentum of the upper vertex will make
' the link(s) compress, and when they spring back the
' upper vertex will retain some of the momentum of the
' link correcting, and carry the object upward.
.heading = .heading + .momentum_c
If .heading > 360 Then .heading = .heading - 360
If .heading < 0 Then .heading = .heading + 360
'momentum_c is clockwise momentum. If the wheel has momentum
'it will turn
End If
End With
Next i
'-------------------------------------------------------------------
Cycle_Physics = True 'hey, it worked!
End Function
Sub File_Read(infile As String)
'This reads a file into memory
Dim msg As String
msg = " "
Dim Buffer As Variant
Open infile For Binary As 1
Do While Not EOF(1)
Get #1, , msg
If msg = ";" Then
File_Parse Trim(Buffer)
Buffer = ""
Else
Buffer = Buffer & msg
End If
Loop
Close 1
INDspd = "Spd: " & ClockSpeed
ClearMultiSelect
Slider1.Value = LeftWind
Slider1_Click
Slider2.Value = Atmosphere
Slider2_click
Slider3.Value = Gravity * 100
Slider3_Click
End Sub
Sub File_Save(outfile As String)
'This saves all the vertices and links and their properties to a file.
'It also saves all Global variables such as gravity and atmosphere
'I wrote this subroutine and the File_Read Subroutine so that new
'Variables can easily be added to vertexes and links without losing
'backward compatability with older files
'However, I didn't write it to be easily understood by others so
'you should probably leave this stuff alone.
Open outfile For Output As 1
Print #1, "G" & Gravity & ";";
Print #1, "A" & Atmosphere & ";";
Print #1, "F" & WallFriction & ";";
Print #1, "B" & WallBounce & ";";
Print #1, "W" & LeftWind & ";";
Print #1, "T" & Tension & ";";
Print #1, "C" & ClockSpeed & ";";
Print #1, "M" & mode & ";";
For i = 1 To MaxVertices
With vertex(i)
If .used = True Then
Print #1, "V";
Print #1, "X" & .X & "|";
Print #1, "Y" & .y & "|";
Print #1, "D" & i & "|";
Print #1, "H" & .momentum_x & "|";
Print #1, "U" & .momentum_y & "|";
Print #1, "C" & .momentum_c & "|";
Print #1, "R" & .Radius & "|";
Print #1, "P" & .phase & "|";
Print #1, ";"; 'terminate
End If
End With
Next i
For i = 1 To MaxLinks
With Link(i)
If .used = True Then
Print #1, "L";
Print #1, "A" & .target1_id & "|";
Print #1, "B" & .target2_id & "|";
Print #1, "L" & .linklength & "|";
Print #1, "T" & .linktension & "|";
Print #1, "S" & .pushspan & "|";
Print #1, "P" & .Push & "|";
Print #1, "N" & .pushstrength & "|";
Print #1, "E" & .lastlen & "|";
Print #1, "M" & .pushtiming & "|";
Print #1, "P" & .phase & "|";
Print #1, ";"; 'terminate
End If
End With
Next i
Close 1
End Sub
Sub ToggleSelction(applies)
vertex(applies).Selected = Not vertex(applies).Selected
End Sub
Private Sub antigrav_Click()
End Sub
Private Sub btnAddwheel_Click()
For i = 1 To MaxVertices
With vertex(i)
If .Selected = True Then
AddWheel i, 25
End If
End With
Next i
focusdummy.SetFocus
End Sub
Private Sub btnDelete_Click()
'delete whatever is selected, be it a link or vertex
'if a vertex is deleted, all links it is attached to must go as well
'because a link needs 2 vertices to function
focusdummy.SetFocus
If SelVertex > 0 Then
For i = 1 To MaxVertices
If vertex(i).Selected = True Then
vari = DeleteVertex(i)
End If
Next i
End If
If SelLink > 0 Then
Link(SelLink).used = False
'deleting a link is much simpler than deleting a vertex
'because a vertex does not need to be attached to a link
'in order to function
End If
End Sub
Sub btnNew_Click()
'Delete all links and vertices.
'this does not reset the global variables
Dim msg, Style, Title, Response
msg = "Destroy Current Scene?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "New Scene"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
CycleTime = 0
Call BTNpicCon_Click
DoEvents
For i = 1 To MaxVertices
vertex(i).used = False
Next i
For i = 1 To MaxLinks
Link(i).used = False
Next i
VertexCount = 0
LinkCount = 0
mode = 0
SubMode = 0
focusdummy.SetFocus
Else
focusdummy.SetFocus
Exit Sub
End If
End Sub
Private Sub BTNGlobals_Click()
focusdummy.SetFocus
Globals.Show
End Sub
Private Sub btnOpen_Click()
Call mnuOpen_Click
focusdummy.SetFocus
End Sub
Private Sub btnPause_Click()
ClockPause = Not ClockPause
If ClockPause = True Then
btnPause.BackColor = &HE0E0E0
Else
btnPause.BackColor = &H8000000F
End If
focusdummy.SetFocus
End Sub
Private Sub BTNpicCon_Click()
CurrentPhase = 1
BTNpicCon.Picture = BTNpicCon.DownPicture
BTNpicSim.Picture = BTNpicSim.DisabledPicture
btnAddwheel.Enabled = True
btnDelete.Enabled = True
ModeIND = " Construct Mode Click to create vertexes and links. Click and drag to move vertexes. Right click to cancel a link."
focusdummy.SetFocus 'FocusDummy is the name of an option button
'thats off the left side of the form.
'Usually when you click a button, it makes
'what I think is a very ugly selection rectangle
'around the button's caption.
'By setting the focus elsewhere, the ugly
'rectangle goes away :)
'FocusDummy itself goes nowhere and does nothing.
mode = 0 'switch to construct mode
End Sub
Private Sub BTNpicSim_Click()
BTNpicCon.Picture = BTNpicCon.DisabledPicture
BTNpicSim.Picture = BTNpicSim.DownPicture
btnAddwheel.Enabled = False
btnDelete.Enabled = False
ModeIND = " Simulate Mode: Click and drag to move vertexes."
INDspd = "Spd: " & ClockSpeed
focusdummy.SetFocus
mode = 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -