⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 这个是用Visual Basic写的一个机器人程序
💻 FRM
📖 第 1 页 / 共 5 页
字号:
     '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 + -