Deathmatch para Enzo.

Option Explicit
'***************
'AUTOR: Toyz - Luciano
'FECHA: 11/12/16 - 23:00
'***************
Private Const Tiempo_Cancelamiento As Integer = 180
Private Const Banquero As Byte = 24
Private Const MaxCupos As Byte = 40
Private Const MinCupos As Byte = 2

Private Type tUsuario
    ID As Integer
    Posicion As WorldPos
End Type

Private Type tDeathmatch
    Activo As Boolean
    Usuarios() As tUsuario
    Objetos As Boolean
    Conteo As Integer
    Cupos As Byte
    Coordenadas As WorldPos
    Premio As Long
    Inscripcion As Long
    Total As Byte
    Restantes As Byte
    Pos_Banquero As WorldPos
    EsperaPelear As Boolean
    TorneoFinalizado As Boolean
    EsperandoParticipantes As Boolean
End Type

Private Deathmatch As tDeathmatch

Public Sub Carga_Death()
    Dim Leer As clsIniManager
    Set Leer = New clsIniManager
    Call Leer.Initialize(App.Path & "\Dat\DeathMatch.dat")
    With Deathmatch.Coordenadas
        .Map = CInt(Leer.GetValue("EVENTO", "Mapa"))
        .X = CByte(Leer.GetValue("EVENTO", "X"))
        .Y = CByte(Leer.GetValue("EVENTO", "Y"))
    End With
End Sub

Public Sub Armar_Death(ByVal ID As Integer, ByVal Cupos As Byte, ByVal Objetos As Boolean, ByVal Premio As Long, ByVal Inscripcion As Long)
    With Deathmatch
        If .Activo = True Then
            Call WriteConsoleMsg(ID, "Deathmatch> El evento ya está en curso.", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
        If Cupos > MaxCupos Then Cupos = MaxCupos
        If Cupos < MinCupos Then Cupos = MinCupos
        .Cupos = Cupos
        .Inscripcion = Inscripcion
        .Objetos = Objetos
        .Premio = Premio
        .Total = .Cupos
        .Restantes = .Total
        .Activo = True
        .Conteo = Tiempo_Cancelamiento
        .EsperandoParticipantes = True
        ReDim .Usuarios(1 To .Cupos) As tUsuario
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> " & .Cupos & " Cupos, Incripción" & IIf(.Inscripcion > 0, " de: " & .Inscripcion & " Monedas de oro, ", " Gratis, ") & IIf(Objetos = True, "Caen items, ", "No caen items, ") & IIf(.Premio > 0, "Premio de: " & .Premio & " Monedas de oro.", " No hay premio.") & " Manden/DEATHMATCH si desean participar.", FontTypeNames.FONTTYPE_GUILD))
    End With
End Sub

Public Sub Entrar_Death(ByVal ID As Integer)
    Dim ID_Death As Byte
    Dim nuevaPos As WorldPos
    With Deathmatch
        If Puede_Entrar(ID) = False Then Exit Sub
        Call WriteConsoleMsg(ID, "Has ingresado al evento" & IIf(.Inscripcion > 0, ", se te han descontado " & .Inscripcion & " monedas de oro.", vbNullString) & ". Espera a que el cupo se complete. ¡Suerte en el campo de batalla!", FontTypeNames.FONTTYPE_GUILD)
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD - .Inscripcion
        .Cupos = .Cupos - 1
        ID_Death = Death_ID
        UserList(ID).flags.EnDeathMatch = ID_Death
        .Usuarios(ID_Death).ID = ID
        .Usuarios(ID_Death).Posicion = UserList(ID).Pos
        Call ClosestLegalPos(Deathmatch.Coordenadas, nuevaPos, False, True, True)
        WarpUserChar ID, nuevaPos.Map, nuevaPos.X, nuevaPos.Y, False
    'WritePauseToggle ID '<--- No  pausamos, hacemos que se muevan.
    WriteUpdateGold ID
    If .Cupos = 0 Then
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> El cupo ha sido completado!", FontTypeNames.FONTTYPE_GUILD))
        .Conteo = 10
        AsignarFlagEspera
        .EsperaPelear = True
        .EsperandoParticipantes = False
    End If
End With
End Sub

Private Function Death_ID() As Byte
    Dim LoopC As Long
    With Deathmatch
        For LoopC = 1 To .Total
            If .Usuarios(LoopC).ID = 0 Then
                Death_ID = LoopC
                Exit Function
            End If
        Next LoopC
    End With
End Function

Private Function Puede_Entrar(ByVal ID As Integer) As Boolean
    Puede_Entrar = False
    If EsGm(ID) = True Then
        Call WriteConsoleMsg(ID, "No puedes entrar a un evento si eres miembro del staff", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).flags.Muerto > 0 Then
        Call WriteConsoleMsg(ID, "Estás muerto.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).flags.EnJDH > 0 Then
        Call WriteConsoleMsg(ID, "Estás en los Juegos del Hambre.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).flags.EnDeathMatch > 0 Then
        Call WriteConsoleMsg(ID, "Ya estás en el Deathmatch.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If Deathmatch.Activo = False Then
        Call WriteConsoleMsg(ID, "El evento no está en curso.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If Deathmatch.Cupos = 0 Then
        Call WriteConsoleMsg(ID, "El evento ya no tiene cupos disponibles.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).Stats.GLD < Deathmatch.Inscripcion Then
        Call WriteConsoleMsg(ID, "No tienes el oro suficiente.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If Not UserList(ID).Pos.Map = 1 Then
        Call WriteConsoleMsg(ID, "Tienes que estar en Ullathorpe para poder ingresar al evento", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    Puede_Entrar = True
End Function

Public Sub Contar_Death()
    Dim LoopC As Long
    Dim LoopX As Long
    Dim ID_Death As Byte
    With Deathmatch
        If .Conteo = 0 Then
            .Conteo = -1
            If .Activo = True Then
                If .EsperaPelear = True Then
                    Call AsignarFlagEspera
                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> Ya!", FontTypeNames.FONTTYPE_FIGHT)
                    .EsperaPelear = False
                ElseIf .EsperandoParticipantes = True Then
                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> Evento cancelado por falta de participantes, se ha devuelto el oro por la inscripción.", FontTypeNames.FONTTYPE_GUILD)
                    Cancelar_Death
                End If
                If .TorneoFinalizado = True Then
                    ID_Death = ID_Usuario
                    WarpUserChar .Usuarios(ID_Death).ID, .Usuarios(ID_Death).Posicion.Map, .Usuarios(ID_Death).Posicion.X, .Usuarios(ID_Death).Posicion.Y, False
                    QuitarNPC (MapData(.Pos_Banquero.Map, .Pos_Banquero.X, .Pos_Banquero.Y).NpcIndex)
                    Limpiar
                    m_Limpieza.CleanWorld_Clear
                End If
            End If
        End If
        If .Conteo > 0 Then
            If .EsperaPelear = True Then _
               SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> " & .Conteo, FontTypeNames.FONTTYPE_GUILD)
            .Conteo = .Conteo - 1
        End If
    End With
End Sub

Private Function ID_Usuario() As Byte
    Dim LoopC As Long
    For LoopC = 1 To Deathmatch.Total
        If Deathmatch.Usuarios(LoopC).ID > 0 Then
            ID_Usuario = LoopC
            Exit For
        End If
    Next LoopC
End Function

Public Sub Muere_Death(ByVal ID As Integer)
    Dim ID_Death As Byte
    ID_Death = UserList(ID).flags.EnDeathMatch
    If ID_Death = 0 Then Exit Sub
    RestarUsuario ID
    UserList(ID).flags.EnDeathMatch = 0
    UserList(ID).flags.EnEspera = False
End Sub

Public Sub RestarUsuario(ByVal ID As Integer)
    Dim ID_Death As Byte
    ID_Death = UserList(ID).flags.EnDeathMatch
    With Deathmatch
        .Restantes = .Restantes - 1
         If .Restantes > 1 Then SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> Quedan " & .Restantes & " luchadores.", FontTypeNames.FONTTYPE_GUILD)
        Call WriteConsoleMsg(ID, "Deathmatch> ¡Has perdido, has sido descalificado. ¡Suerte para la próxima!", FontTypeNames.FONTTYPE_GUILD)
        WarpUserChar ID, .Usuarios(ID_Death).Posicion.Map, .Usuarios(ID_Death).Posicion.X, .Usuarios(ID_Death).Posicion.Y, False
        .Usuarios(ID_Death).ID = 0
        If .Restantes = 1 Then Finalizar
    End With
End Sub

Private Sub Finalizar()
    Dim LoopC As Long
    Dim Dame_ID As Byte
    Dim ID As Integer
    With Deathmatch
        Dame_ID = ID_Usuario
        ID = .Usuarios(Dame_ID).ID
        .Pos_Banquero = UserList(ID).Pos
        '.Pos_Banquero.Y = .Pos_Banquero.Y
        SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> Ganador del evento: " & UserList(ID).Name & " se lleva una cantidad de " & .Premio & " monedas de oro" & IIf(.Objetos = True, " y los items recaudados.", vbNullString) & ", felicitaciones!", FontTypeNames.FONTTYPE_GUILD)
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD + .Premio

        WriteUpdateGold ID
        UserList(ID).flags.EnDeathMatch = 0
        UserList(ID).flags.EnEspera = 0
        .Premio = 0
        If .Objetos = True Then
            .Conteo = 60
            .TorneoFinalizado = True
    'Call WriteConsoleMsg(ID, "Tienes 60 segundos para recoger los items del piso.", FontTypeNames.FONTTYPE_GUILD)
            WarpUserChar ID, .Pos_Banquero.Map, .Pos_Banquero.X, .Pos_Banquero.Y + 1, False
            Call SpawnNpc(Banquero, .Pos_Banquero, True, False)
            Call SendData(SendTarget.ToPCArea, ID, PrepareMessageChatOverHead("Tienes 60 segundos para recoger los items del piso.", MapData(.Pos_Banquero.Map, .Pos_Banquero.X, .Pos_Banquero.Y).NpcIndex, vbWhite))
        Else
            WarpUserChar ID, .Usuarios(Dame_ID).Posicion.Map, .Usuarios(Dame_ID).Posicion.X, .Usuarios(Dame_ID).Posicion.Y, False
            Limpiar
        End If
    End With
End Sub

Public Sub Cancelar_Death()
    Dim LoopC As Long
    With Deathmatch
        If .Activo = False Then Exit Sub
        For LoopC = 1 To .Total
            If .Usuarios(LoopC).ID > 0 Then
                WarpUserChar .Usuarios(LoopC).ID, .Usuarios(LoopC).Posicion.Map, .Usuarios(LoopC).Posicion.X, .Usuarios(LoopC).Posicion.Y, False
                UserList(.Usuarios(LoopC).ID).flags.EnDeathMatch = 0
                UserList(.Usuarios(LoopC).ID).flags.EnEspera = False
                UserList(.Usuarios(LoopC).ID).Stats.GLD = UserList(.Usuarios(LoopC).ID).Stats.GLD + .Inscripcion

                WriteConsoleMsg .Usuarios(LoopC).ID, "El evento ha sido cancelado, se te ha devuelto el costo de la inscripción.", FontTypeNames.FONTTYPE_GUILD
                WriteUpdateGold .Usuarios(LoopC).ID
            End If
        Next LoopC
    End With
    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Deathmatch> Evento fue cancelado por un Game Master.", FontTypeNames.FONTTYPE_GUILD)
    Limpiar
End Sub

Public Sub Desconexion_Death(ByVal ID As Integer)
    If UserList(ID).flags.EnDeathMatch = 0 Then Exit Sub
    With Deathmatch
        If UserList(ID).flags.EnEspera = True Then
            WarpUserChar ID, .Usuarios(UserList(ID).flags.EnDeathMatch).Posicion.Map, .Usuarios(UserList(ID).flags.EnDeathMatch).Posicion.X, .Usuarios(UserList(ID).flags.EnDeathMatch).Posicion.Y, True
            '.Usuarios(UserList(ID).flags.EnDeathMatch).ID = 0
            'UserList(ID).flags.EnDeathMatch = 0
            UserList(ID).flags.EnEspera = False
            .Cupos = .Cupos + 1
           ' WritePauseToggle ID
        Else
            RestarUsuario ID
        End If
       ' UserList(ID).flags.EnEspera = False
        UserList(ID).flags.EnDeathMatch = 0
    End With
End Sub

Private Sub Limpiar()
    With Deathmatch
        .Activo = False
        .Conteo = -1
        .Cupos = 0
        .Inscripcion = 0
        .Objetos = False
        .Premio = 0
        .Restantes = 0
        .Total = 0
        Erase .Usuarios()
    End With
End Sub

Private Sub AsignarFlagEspera()

    With Deathmatch
        Dim LoopC As Long
        For LoopC = 1 To .Total
            UserList(.Usuarios(LoopC).ID).flags.EnEspera = Not UserList(.Usuarios(LoopC).ID).flags.EnEspera
        Next LoopC
    End With
End Sub