Movimento por Mouse

Para quem nao tem a engine em Directx8,aí segue o download da mesma: [Apenas Administradores podem visualizar links]

Bom,este tutorial trata-se de um tutorial exclusivo à comunidade,o autor pede que o mesmo nao seja copiado

Ao fim de " ModGlobal "
Adicine:

Código:

'Pathfinding
Public MovXD As Integer
Public MovYD As Integer
Public MouseMove As Boolean

Em " ModGeneral " na Sub " Sub Main ",
Adicine:

Código:

' Set Default MouseMove Boolean to False
MouseMove = False

Procure por:

Código:

Sub CheckInputKeys

Mude sua Sub inteira por:

Código:

Public Sub CheckInputKeys()
    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler
   
    If GetKeyState(vbKeyShift) < 0 Then
        ShiftDown = True
    Else
        ShiftDown = False
    End If

    If GetKeyState(vbKeyReturn) < 0 Then
        CheckMapGetItem
    End If

    If GetKeyState(vbKeyControl) < 0 Then
        ControlDown = True
    Else
        ControlDown = False
    End If

    'Move Up
    If GetKeyState(vbKeyUp) < 0 Then
        DirUp = True
        DirDown = False
        DirLeft = False
        DirRight = False
        MouseMove = False
        Exit Sub
    Else
        DirUp = False
    End If

    'Move Right
    If GetKeyState(vbKeyRight) < 0 Then
        DirUp = False
        DirDown = False
        DirLeft = False
        DirRight = True
        MouseMove = False
        Exit Sub
    Else
        DirRight = False
    End If

    'Move down
    If GetKeyState(vbKeyDown) < 0 Then
        DirUp = False
        DirDown = True
        DirLeft = False
        DirRight = False
        MouseMove = False
        Exit Sub
    Else
        DirDown = False
    End If

    'Move left
    If GetKeyState(vbKeyLeft) < 0 Then
        DirUp = False
        DirDown = False
        DirLeft = True
        DirRight = False
        MouseMove = False
        Exit Sub
    Else
        DirLeft = False
    End If

    If (GetPlayerX(MyIndex) <> MovXD Or GetPlayerY(MyIndex) <> MovYD) And MouseMove Then
        MoveNextStep
    Else
        MouseMove = False
    End If

    ' Error handler
    Exit Sub
errorhandler:
    HandleError "CheckInputKeys", "modInput", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Ainda neste módulo,no final dele adicione esta sub:

Código:

Public Sub MoveNextStep()

            DirUp = False
            DirDown = False
            DirLeft = False
            DirRight = False
           
            If (Abs(MovXD - GetPlayerX(MyIndex)) > Abs(MovYD - GetPlayerY(MyIndex))) Then
                'Move Right
                If MovXD > GetPlayerX(MyIndex) Then
                    DirRight = True
                'Move Left
                Else
                    DirLeft = True
                End If
            Else
                'Move Down
                If MovYD > GetPlayerY(MyIndex) Then
                    DirDown = True
                'Move Up
                Else
                    DirUp = True
                End If
            End If
End Sub

Na sua " frmmain " na sub " MouseDown " ( Observaçao: Pode ser na Sub " Mousedown " ou na frmmain_Mousedown,mas tanto faz. )

Código:

'Pathfinding
            MouseMove = True
            MovXD = CurX
            MovYD = CurY

Agora procure por:

Código:

Call CheckKeys

e coloque um ' na frente da linha,para deixa-la oculta

Código:

 ' Call CheckKeys

Fim,se bugar podem comentar no tópico que eu arrumo ; )