Author: pingu
Difficulty: 1/5
"Click somewhere on the map and your player will automatically walk there. However, blocks are ignored and the player may find themself stuck if they go too far. Double click to run the distance."
:: CLIENT SIDE ::
Find:Code: ' Game fps
Public GameFPS As Long
Under, add:Code: ' Used for automatic movement
Public XToGo As Long
Public YToGo As Long
Public toRun As Boolean
Find:Code: PlayerBuffer = ""
Under, add:Code: xToGo = -1
YToGo = -1
toRun = False
Find:Code: Sub CheckInput
Replace sub with:Code: Sub CheckInput(ByVal KeyState As Byte, ByVal KeyCode As Integer, ByVal Shift As Integer)
If GettingMap = False Then
If KeyState = 1 Then
If KeyCode = vbKeyReturn Then
XToGo = -1
YToGo = -1
Call CheckMapGetItem
End If
If KeyCode = vbKeyControl Then
XToGo = -1
YToGo = -1
ControlDown = True
End If
If KeyCode = vbKeyUp Then
XToGo = -1
YToGo = -1
DirUp = True
DirDown = False
DirLeft = False
DirRight = False
End If
If KeyCode = vbKeyDown Then
XToGo = -1
YToGo = -1
DirUp = False
DirDown = True
DirLeft = False
DirRight = False
End If
If KeyCode = vbKeyLeft Then
XToGo = -1
YToGo = -1
DirUp = False
DirDown = False
DirLeft = True
DirRight = False
End If
If KeyCode = vbKeyRight Then
XToGo = -1
YToGo = -1
DirUp = False
DirDown = False
DirLeft = False
DirRight = True
End If
If KeyCode = vbKeyShift Then
ShiftDown = True
toRun = False
End If
Else
If KeyCode = vbKeyUp Then DirUp = False
If KeyCode = vbKeyDown Then DirDown = False
If KeyCode = vbKeyLeft Then DirLeft = False
If KeyCode = vbKeyRight Then DirRight = False
If KeyCode = vbKeyShift Then ShiftDown = False
If KeyCode = vbKeyControl Then ControlDown = False
End If
End If
End Sub
Find:Code: Sub picScreen_MouseDown
Replace sub with:Code: Private Sub picScreen_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If (Button = 1 Or Button = 2) And InEditor = False Then
If Button = 1 Then
XToGo = x
YToGo = y
Else
Call PlayerSearch(Button, Shift, x, y)
End If
Else
Call EditorMouseDown(Button, Shift, x, y)
End If
End Sub
Private Sub picScreen_Click()
toRun = False
End Sub
Private Sub picScreen_DblClick()
If InEditor = False Then toRun = True
End Sub
Find:Code: ' Check if player is trying to move
Under, add:Code: ' Auto move
If XToGo <> -1 Or YToGo <> -1 Then
Dim xDif As Long
Dim YDif As Long
xDif = Abs(GetPlayerX(MyIndex) - XToGo)
YDif = Abs(GetPlayerY(MyIndex) - YToGo)
If XToGo = GetPlayerX(MyIndex) Or XToGo = -1 Then
XToGo = -1
xDif = 0
Else
xDif = Abs(GetPlayerX(MyIndex) - XToGo)
End If
If YToGo = GetPlayerY(MyIndex) Or YToGo = -1 Then
YToGo = -1
YDif = 0
Else
YDif = Abs(GetPlayerY(MyIndex) - YToGo)
End If
If YToGo = -1 And XToGo = -1 And toRun = True Then
toRun = False
End If
If xDif > YDif Then
If GetPlayerX(MyIndex) - XToGo > 0 Then
DirLeft = True
Else
DirRight = True
End If
End If
If YDif > xDif Then
If GetPlayerY(MyIndex) - YToGo > 0 Then
DirUp = True
Else
DirDown = True
End If
End If
If xDif = YDif And xDif <> 0 And YDif <> 0 Then
If Int(Rnd * 2) = 0 Then
If GetPlayerX(MyIndex) - XToGo > 0 Then
DirLeft = True
Else
DirRight = True
End If
Else
If GetPlayerY(MyIndex) - YToGo > 0 Then
DirUp = True
Else
DirDown = True
End If
End If
End If
End If
Find:Code: ' Check if player has the shift key down for running
If ShiftDown Then
Replace with:Code: ' Check if player has the shift key down for running
If ShiftDown Or toRun Then
|
