form1.frm

这个是用Visual Basic写的一个机器人程序

Static Start As Long
Dim timedelay As Boolean
Dim Elapsed As Long
Dim actualdelay As Single

Start = GetTickCount
'Time Delay Code --------------------------------------------------
restarter:
If mode = 0 Then actualdelay = 15
If mode = 1 Then actualdelay = delay
                                       'This code will delay
  Do                                    'the amount of time in
    DoEvents                            'the delay Variable.
    Elapsed = GetTickCount              'since it compares itself
    DoEvents                            'with the system time
    
    If (Elapsed - Start) >= actualdelay Then  'this will be more
        timedelay = True                'accurate than a timer
        DoEvents                        'control.
        Start = 0
    Else: timedelay = False
    End If
    DoEvents
  Loop While timedelay = False
'------------------------------------------------------------------
Start = GetTickCount

'Perform Normal Operations ----------------------------------------
     DoEvents           'lots of these are neccessary or else
                        'the program will slow down other programs
     
     Cycle_Misc
     DoEvents
     If mode = 1 Then X = Cycle_Physics '-Only do the physics cycle
                                       'if we are in Simulate mode.
                                       'Physics do not need to be
                                       'simulated in construct mode.
     DoEvents
     Cycle_Display  'Display everything.
     DoEvents
'------------------------------------------------------------------

GoTo restarter 'loop!

End Sub

Sub ClearMultiSelect()

For i = 1 To MaxVertices
   vertex(i).Selected = False
Next i


SelVertex = 0

End Sub

Function DeleteVertex(id) As Boolean

'First, delete any links attached to this vertex

For i = 1 To MaxLinks
   With Link(i)
     If .target1_id = id Or .target2_id = id Then
     .used = False  'by setting .used to false,
                    'the link is no longer displayed, and it is
                    'exempted from the physics cycle
     End If
   End With
Next i
vertex(id).used = False 'Delete the vertex itself
DeleteVertex = True 'It worked.

End Function

Sub Cycle_Display()


'Check to see if the user has hit the maximize button
'instead of using F11 to go fullscreen.
If Me.WindowState = 2 And fs.Checked = False Then Call fs_Click
If Me.WindowState = 0 And fs.Checked = True Then Call fs_Click

    

'watch out, this subroutine will get confusing
'but not as confusing as the physics cycle ;)


Dim VX, VY, HT As Integer 'some temporary variables
Dim color1 As Long


Buffer.Picture = Nothing          'clear the buffer
HT = Buffer.Height - 3            '-for tweaking purposes




'Draw Links, Link Handles, etc. --------------------------------------
For i = 1 To MaxLinks
  With Link(i)
  
        .midx = vertex(.target2_id).X + ((vertex(.target1_id).X - vertex(.target2_id).X) / 2)
        .midy = vertex(.target2_id).y + ((vertex(.target1_id).y - vertex(.target2_id).y) / 2)
         'calculate link handles, those are the little +'s you'll see
         'in the middle of each link if you turn on View->Link Handles
         'it lets you know where to put your mouse to select a link
         'Also, I reused these calculations for determining whether the
         'mouse is over the link handle or not.
  
  If .used = True Then 'ignore unused links
     
     If SelLink = i Then color1 = RGB(0, 0, 255)
     If mnuLink.Checked = True Then Buffer.Line (vertex(.target1_id).X, HT - vertex(.target1_id).y)-(vertex(.target2_id).X, HT - vertex(.target2_id).y), Phase_Color(.phase)
     If mnuhandl.Checked = True And HoverLink <> i Then
         Buffer.Line (.midx, HT - .midy - 5)-(.midx, HT - .midy + 5), color1
         Buffer.Line (.midx + 5, HT - .midy)-(.midx - 5, HT - .midy), color1
     End If
     'this will only make visible a link if View->Links is checked
     'and only make visible a link handle if View->Link Handles is checked
     
     
     VX = (.midx) - (5 / 2)
     VY = (HT - .midy) - (5 / 2)
     If HoverLink = i Then vari = BitBlt(Buffer.hDC, VX - 2, VY - 2, 9, 9, VHoverVertex.hDC, 0, 0, SRCCOPY)
     'If the mouse is over this link then display a little blue
     'circle over it (stored in a picturebox named VHoverVertex).
     
         
     color1 = RGB(128, 128, 128)
     If SelLink = i Then color1 = RGB(0, 0, 255)
     If HoverLink = i Then color1 = RGB(255, 0, 0)
     CycleBuffer.Line (.pushtiming + 2, 19 - .pushstrength)-(.pushtiming - .pushspan, 19), color1
     CycleBuffer.Line (.pushtiming + 2, 19 - .pushstrength)-(.pushtiming + .pushspan, 19), color1
     'This draws the lines on the muscle cycle. (the rectangle under
     'the main area).  Grey for inactive, Blue for selected link,
     'Red for hovering link
     
     If .pushtiming + .pushspan > CycleSize Then CycleBuffer.Line (.pushtiming + 2 - CycleSize, 19 - .pushstrength)-(.pushtiming + .pushspan - CycleSize, 19), color1
     If .pushtiming - .pushspan < 0 Then CycleBuffer.Line (.pushtiming + 2 + CycleSize, 19 - .pushstrength)-(.pushtiming - .pushspan + CycleSize, 19), color1
     'draw lines that wrap around
     
  End If
  End With
Next i
'---------------------------------------------------------------------

DoEvents


'Verticies and Wheels ------------------------------------------------
If mnuVert.Checked = True Then  'only display this stuff if
For i = 1 To MaxVertices        'view->vertices is checked
  With vertex(i)
  If .used = True Then
      

    
      VX = (.X) - (2)
      VY = (HT - .y) - (2)
      'vari = BitBlt(Buffer.hdc, VX, VY, 5, 5, VDot.hdc, 0, 0, SRCCOPY)
      Buffer.FillStyle = 0
      Buffer.FillColor = Phase_Color(.phase)
      Buffer.Circle (VX + 2, VY + 2), 2, Phase_Color(.phase)
      'display the dot in the appropriate location
      
      If HoverVertex = i Then vari = BitBlt(Buffer.hDC, VX - 2, VY - 2, 9, 9, VHoverVertex.hDC, 0, 0, SRCCOPY)
      If SelVertex = i Then vari = BitBlt(Buffer.hDC, VX - 2, VY - 2, 9, 9, VSelVertex.hDC, 0, 0, SRCCOPY)
      

      If .Selected = True Then vari = BitBlt(Buffer.hDC, VX - 2, VY - 2, 9, 9, VSelVertex.hDC, 0, 0, SRCCOPY)
      'display the hovering dot image or the selected dot image
      'if the current vertex is selected or hovered over
      
      
      
      If .wheel = True Then
           Buffer.FillStyle = 1 'so the wheels won't be solid
           Buffer.Circle (VX + 2, VY + 2), .Radius, DrawColor
           Display_MakeCircleSpokes i, .heading, 3 '3 is the number of spokes
                                           'the wheel has
                                           'you can set this to any number
      End If
      'create the wheel image if there is a wheel

    
   End If
  End With
Next i
End If
'---------------------------------------------------------------------


DoEvents

'Display Everything --------------------------------------------------
If mode = 0 And SubMode = 1 Then Buffer.Line (vertex(SelVertex).X, HT - vertex(SelVertex).y)-(MouseX, MouseY)
    'if its ready to make a new link, draw a line from the
    'starting vertex to the mouse



vari = BitBlt(Main.hDC, 0, 0, BoardX, BoardY, Buffer.hDC, 0, 0, SRCCOPY)
    'blt from the buffer to the main screen

CycleBuffer.Line (0, 19)-(CycleSize, 19)
CycleBuffer.Line (CycleTime, 0)-(CycleTime, 40)
CycleBuffer.Line (CycleSize / 2, 0)-(CycleSize / 2, 40), RGB(128, 128, 128)
CycleBuffer.Line (CycleSize / 4, 0)-(CycleSize / 4, 40), RGB(128, 128, 128)
CycleBuffer.Line ((CycleSize / 4) + (CycleSize / 2), 0)-((CycleSize / 4) + (CycleSize / 2), 40), RGB(128, 128, 128)
    '-the lines on the muscle cycle

vari = BitBlt(cycleview.hDC, 0, 0, CycleSize, 40, CycleBuffer.hDC, 0, 0, SRCCOPY)
    'blt from the cycle buffer to the main cycle picturebox


Main.Refresh
cycleview.Refresh

    'Gotta refresh these or you won't see squat
'---------------------------------------------------------------------



End Sub

Function HowManySelected()

Dim counter As Integer

For i = 1 To MaxVertices
   If vertex(i).Selected = True And vertex(i).used = True Then
      counter = counter + 1
   End If
Next i
HowManySelected = counter


End Function

Sub Display_MakeCircleSpokes(dot, heading, spokenumber)

Dim xer, yer, HT As Double
Dim subheading As Double
Dim color1 As Long


HT = Buffer.Height - 3


color1 = RGB(0, 200, 100)

With vertex(dot)
For i = 0 To (spokenumber - 1)
    xer = 0: yer = 0
    subheading = heading + ((360 / spokenumber) * i)
    xer = Sin(subheading * (pi / 180)) * .Radius
    yer = Cos(subheading * (pi / 180)) * .Radius
    Buffer.Line (.X, HT - .y)-Step(xer, yer), color1
Next i
End With

End Sub

Sub Cycle_Misc()

'In this cycle we do everything that has nothing to do with display,
'but can't be put in the physics cycle because they have to happen
'when the program is in Construct mode

CycleBuffer.Picture = Nothing 'clear the muscle cycle buffer


'Show context items ------------------------------------------------------
If SubMode <> 4 Then SelLink = 0
    If SubMode = 4 Then
        With Link(SelLink)
        If .used = True Then
        LBOX.Visible = True
        VBOX.Visible = False
        If LBOX <> "Link " & SelLink Then LBOX = "Link " & SelLink
        If INDlen <> Link(SelLink).linklength Then INDlen = Link(SelLink).linklength: INDlen.Refresh
        vari = BitBlt(CycleBuffer.hDC, .pushtiming, 19 - .pushstrength - 2, 5, 5, VDot.hDC, 0, 0, SRCCOPY)
        End If
        End With
    Else
        If SelVertex = 0 Then
           VBOX.Visible = False
           LBOX.Visible = False
         Else
           If VBOX <> "Vertex " & SelVertex Then VBOX = "Vertex " & SelVertex
           VBOX.Visible = True
           LBOX.Visible = False
           mnuVert.Visible = True
           If mode = 0 Then txtX.Enabled = True: txtY.Enabled = True
           If mode = 1 Then txtX.Enabled = False: txtY.Enabled = False
           txtX = Int(vertex(SelVertex).X)
           txtY = Int(vertex(SelVertex).y)
           INDrad = vertex(SelVertex).Radius
        End If
    End If
'------------------------------------------------------------------------
    
    
If SelLink > 0 Then
   mnulinkthing.Visible = True
Else
   mnulinkthing.Visible = False
End If
'If the selected object is a link, then make the link menu visible

If SelVertex > 0 Then
   mnusel.Visible = True
Else
   mnusel.Visible = False
End If
'If the selected object is a vertex, then make the vertex menu visible


End Sub

Sub File_Parse(msg As Variant)

'This subroutine is used by the File_Read subroutine.

Dim A As String
Dim Buffer, VX, VY, VR, VC, VH, VU, VP
Dim id1, id2, Leng, Tens, pushr, pstren, pspan, ll, timing, phase

A = Left$(msg, 1)
If UCase(A) = "G" Then Gravity = Mid$(msg, 2)
If UCase(A) = "A" Then Atmosphere = Mid$(msg, 2)
If UCase(A) = "F" Then WallFriction = Mid$(msg, 2)
If UCase(A) = "B" Then WallBounce = Mid$(msg, 2)
If UCase(A) = "W" Then LeftWind = Mid$(msg, 2)
If UCase(A) = "T" Then Tension = Mid$(msg, 2)
If UCase(A) = "C" Then ClockSpeed = Mid$(msg, 2)
If UCase(A) = "M" Then mode = Mid$(msg, 2)

If mode = 0 Then BTNpicCon_Click
If mode = 1 Then BTNpicSim_Click

INDGrav = Gravity * 2

If UCase(A) = "V" Then
   VX = 0: VY = 0: VH = 0: VU = 0
   For i = 2 To Len(msg)
     A = Mid$(msg, i, 1)
     If A = "|" Then
        If Left$(Buffer, 1) = "X" Then VX = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "Y" Then VY = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "H" Then VH = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "U" Then VU = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "C" Then VC = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "R" Then VR = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "P" Then VP = Mid(Buffer, 2)
        Buffer = ""
     Else
        Buffer = Buffer & A
     End If
   Next i
   vari = AddVertex(VX, VY, VH, VU, VR, VC, VP)
End If

If UCase(A) = "L" Then
   phase = "blank"
   id1 = 0: id2 = 0: Leng = 0: Tens = 0
   For i = 2 To Len(msg)
     A = Mid$(msg, i, 1)
     If A = "|" Then
        If Left$(Buffer, 1) = "A" Then id1 = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "B" Then id2 = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "L" Then Leng = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "T" Then Tens = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "S" Then pspan = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "P" Then pushr = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "N" Then pstren = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "E" Then ll = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "M" Then timing = Mid(Buffer, 2)
        If Left$(Buffer, 1) = "P" Then phase = Mid$(Buffer, 2)
        Buffer = ""
     Else
        Buffer = Buffer & A
     End If
   Next i
   vari = AddLink2(id1, id2, Leng, Tens, pspan, pushr, pstren, ll, timing, phase)
End If

End Sub

Function Cycle_Physics() As Boolean

'Lots of Variables--------------------------------------------------
Dim xer, yer, newx, newy As Single
Dim Leng As Single
Dim Leng2Go_x As Single
Dim Leng2Go_y As Single
Dim LengthTotal As Single
Dim TempTime As Single
Dim Fric
'-------------------------------------------------------------------


'Advance the Muscle Cycle Clock if its not paused-------------------
If ClockPause = False Then CycleTime = CycleTime + ClockSpeed
If CycleTime > CycleSize Then CycleTime = CycleTime - CycleSize
If CycleTime < 0 Then CycleTime = CycleTime + CycleSize
'-------------------------------------------------------------------


'Calculate Link Movement -------------------------------------------
For i = 1 To MaxLinks
  With Link(i)
  If .used = True Then 'only bother with used links
  
  
     .Push = 0
     If CycleTime > .pushtiming - .pushspan And CycleTime < .pushtiming + .pushspan Then
        .Push = (.pushstrength * (1 - (Abs(.pushtiming - CycleTime) / (.pushspan))))
        .Push = (.Push / 30) * .linklength
     End If
     If .pushtiming + .pushspan > CycleSize And CycleTime < .pushtiming + .pushspan - CycleSize Then
        TempTime = .pushtiming - CycleSize
        .Push = (.pushstrength * (1 - ((Abs(TempTime - CycleTime) / (.pushspan)))))
        .Push = (.Push / 30) * .linklength
     End If
     If .pushtiming - .pushspan < 0 And CycleTime > .pushtiming - .pushspan + CycleSize Then
        TempTime = .pushtiming + CycleSize
        .Push = (.pushstrength * (1 - ((Abs(TempTime - CycleTime) / (.pushspan)))))
        .Push = (.Push / 30) * .linklength
     End If
     'This stuff calculates how far the link should increase or decrease
     'its length, in order to simulate 'pushing' or 'pulling'.
     'A positive value for .push indicates that the link will push