My Senior Project

[Sastraxi]

Here's a fixed MoveCharacter routine. Before, the character would move about 5-6 spaces until he stopped. This will make him only move one:

Private Sub MoveCharacter()
If SpeedCount Mod 3 = 0 Then
'move the character
If Key(vbKeyUp) = True Then
'move the character up on plain grass
Key(vbKeyUp) = False
If MapArray(uCharacter.x, uCharacter.y - 1) = "G" Then
    uCharacter.y = uCharacter.y - 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
    Exit Sub
End If
'move the character up and fight monster
If MapArray(uCharacter.x, uCharacter.y - 1) = "M" Then
    uCharacter.y = uCharacter.y - 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
End If
End If
If Key(vbKeyDown) = True Then
'move the character down on plain grass
Key(vbKeyDown) = False
If MapArray(uCharacter.x, uCharacter.y + 1) = "G" Then
    uCharacter.y = uCharacter.y + 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
    Exit Sub
End If
'move the character down and fight monster
If MapArray(uCharacter.x, uCharacter.y + 1) = "M" Then
    uCharacter.y = uCharacter.y + 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
    Key(vbKeyDown) = False
    picFight.ZOrder 0
    picFight.Visible = True
    picFight.SetFocus
    FightInit
End If
End If
If Key(vbKeyLeft) = True Then
'move the character left on plain grass
Key(vbKeyLeft) = False
If MapArray(uCharacter.x - 1, uCharacter.y) = "G" Then
    uCharacter.x = uCharacter.x - 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
    Exit Sub
End If
'move the character left and fight monster
If MapArray(uCharacter.x - 1, uCharacter.y) = "M" Then
    uCharacter.x = uCharacter.x - 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
End If
End If
If Key(vbKeyRight) = True Then
Key(vbKeyRight) = False
'move character right on plain grass
If MapArray(uCharacter.x + 1, uCharacter.y) = "G" Then
    uCharacter.x = uCharacter.x + 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
    Exit Sub
End If
'move the character right and fight monster
If MapArray(uCharacter.x + 1, uCharacter.y) = "M" Then
    uCharacter.x = uCharacter.x + 1
    BitBlt picGameArea.hDC, uCharacter.x * 32, uCharacter.y * 32, 32, 32, picCharacter.hDC, 0, 0, vbSrcCopy
    picGameArea.Refresh
End If
End If
 
'show information sign
If Key(13) = True And MapArray(uCharacter.x, uCharacter.y - 1) = "S" Then
    DoSign uCharacter.x, uCharacter.y - 1
    picSign.ZOrder 0
    picSign.Visible = True
    picSign.SetFocus
    Key(13) = False
End If
End If
 
End Sub

I made them false once they had been validated so they wouldn't be again.