1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)

Ir abajo

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)

Mensaje por Toyz el 8/11/2016, 7:56 pm

Explicación:

Es un gana sigue (como los eventos manuales) sólo que no son cupos fijos, o sea, a medida que gana se libera un cupo entra otro. El evento consiste en estar en una arena de 4x4 (en lo posible) y tratar de matar al otro con solo tirar golpes al aire (no se vale ningún hechizo, ni escudos, cascos, arcos, flechas, etc) . Sólo se permiten clérigos, paladines y guerreros. Al llegar a X ganadas (elegido por el game master) gana el evento.
Edit: Es a 3 rounds.

Testeado al 100%, directo a Mundos del Sur


Código:

Option Explicit

'*****************************
'Author: G Toyz
'Fecha: 08/11
'Hora: 00:30 A.M
'Testeado: 100%
'*****************************
Private Type tUser
    ID As Integer          'ID del usuario.
    LastPos As WorldPos    'Última posición del usuario.
    Wins As Byte           'Ganadas llevadas hasta el momento.
    X As Byte              'X Arena.
    Y As Byte              'Y Arena.
    X_Room As Byte         'X Espera.
    Y_Room As Byte         'Y Espera
    Deaths As Byte         'Cantidad de veces que murió (Rounds)
End Type

Private Type tEvent
    Active  As Boolean     '¿Está activo?
    Active_Send As Boolean '¿Se puede enviar solicitudes de ingreso?
    Users(1 To 2) As tUser 'Usuarios en evento
    Max_Win As Byte        'Cantidad máxima de ganadas para terminar el evento
    Drop_Items As Byte     '¿Caen items?
    MAP_Event As Byte      'Mapa en donde se hace el evento.
    Map_Items As Byte      'Mapa en donde caen los objetos.
    Count_Down As Integer  'Cuenta regresiva.
    Gold As Long           'Oro.
    UsersInEvent As Byte   'Usuarios en Evento.
    LastUser As String     'Último usuario que jugó.
    X_Items As Byte        'Posición X donde caen los items.
    Y_Items As Byte        'Posición Y donde caen los items
End Type

Private Evento As tEvent

Public Sub Load_Arenas()
    '// 1 Sola arena.
    With Evento
        .MAP_Event = 1
        .Users(1).X = 50
        .Users(1).Y = 50
        .Users(2).X = 60
        .Users(2).Y = 60
        .Users(1).X_Room = 30
        .Users(1).Y_Room = 30
        .Users(2).X_Room = 33
        .Users(2).Y_Room = 33
        .Map_Items = 1
        .X_Items = 50
        .Y_Items = 50
    End With
End Sub

Public Sub Do_Event(ByVal Max_Win As Byte, ByVal Drop_Items As Boolean)
  
    '@@ CONDICIONALES.
  
    Dim MSG As String

    With Evento
        .Active_Send = True
        .Active = True
        .Max_Win = Max_Win
        .Drop_Items = Drop_Items
        MSG = PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Gana sigue, Max: " & Max_Win & ". Al mejor de 3 Rounds" & IIf(Drop_Items = True, ". Caen los items ", vbNullString) & ". Para participar escriba /ENTRARAIM", FontTypeNames.FONTTYPE_GUILD)
        Call SendData(SendTarget.ToAll, 0, MSG)
        Call Rules
        .Count_Down = 5
    End With
End Sub

Private Function GiveBack_ID() As Byte
    Dim LoopC As Long
    For LoopC = 1 To 2
        If Evento.Users(LoopC).ID = 0 Then
            GiveBack_ID = LoopC
            Exit For
        End If
    Next LoopC
End Function

Private Function ID_Array(ByVal ID As Integer) As Byte
    ID_Array = UserList(ID).EventAim.ID_Array
End Function

Public Sub Enter_Event(ByVal ID As Integer)
  
    '@@ Condicionales
    Dim ID_Array As Byte
    ID_Array = GiveBack_ID()
    If CanAim(ID) = False Then Exit Sub
    With Evento
        .UsersInEvent = .UsersInEvent + 1
        .Users(ID_Array).ID = ID
        .Users(ID_Array).LastPos = UserList(ID).Pos
        UserList(ID).EventAim.ID_Array = ID_Array
        UserList(ID).flags.DuracionEfecto = 1
        Call WarpUserChar(ID, .MAP_Event, .Users(ID_Array).X_Room, .Users(ID_Array).Y_Room, False)
        If .UsersInEvent = 2 Then
            Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Cupo completado!", FontTypeNames.FONTTYPE_FIGHT))
            Call Start_Event
            .Active_Send = False
            .Active = True
        End If
    End With
End Sub

Private Sub Start_Event()
    With Evento
        .Count_Down = 10 'Cuenta regresiva para que peleen
        Dim LoopC As Long
        For LoopC = 1 To 2
            Call WritePauseToggle(.Users(LoopC).ID)
        Next LoopC
        Call GO_Corner
    End With
End Sub

Public Sub Death_Event(ByVal ID As Integer)
    With Evento
        Dim uWin As Byte
        If ID_Array(ID) = 1 Then uWin = 2
        If ID_Array(ID) = 2 Then uWin = 1
        .Users(ID_Array(ID)).Deaths = .Users(ID_Array(ID)).Deaths + 1
        Call RevivirUsuario(ID)
        With UserList(ID)
            .Stats.MinHp = .Stats.MaxHp
            .Stats.MinMAN = .Stats.MaxMAN
            .Stats.MinSta = .Stats.MaxSta
            Call WriteUpdateUserStats(ID)
        End With
        Call WriteConsoleMsg(ID, "Has perdido el round!", FontTypeNames.FONTTYPE_GUILD)
        Call WriteConsoleMsg(.Users(uWin).ID, "Has ganado el round!", FontTypeNames.FONTTYPE_GUILD)
        If .Users(ID_Array(ID)).Deaths = 2 Then
            If .Drop_Items = True Then
                Call WarpUserChar(ID, .Map_Items, .X_Items, .Y_Items, False)
                Call TirarTodosLosItems(ID)
            End If
            Call Bye_User(ID)
            Call Win_Round(uWin)
            Exit Sub
        End If
        Call GO_Corner
        .Count_Down = 10
        Call WritePauseToggle(.Users(1).ID)
        Call WritePauseToggle(.Users(2).ID)
    End With
End Sub

Private Sub End_Event(ByVal ID_Array As Byte)
    With Evento
        Dim ID As Integer
        ID = .Users(ID_Array).ID
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD + .Gold
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Ganador del evento: " & UserList(ID).name, FontTypeNames.FONTTYPE_GUILD))
        Call WriteUpdateGold(ID)
        Call WriteConsoleMsg(ID, "¡Has ganado el evento! ¡Has sido premiado con " & .Gold & " monedas de oro!", FontTypeNames.FONTTYPE_GUILD)
        Call Bye_User(ID)
    End With
End Sub

Private Sub GO_Corner()
    With Evento
        Call WarpUserChar(.Users(1).ID, .MAP_Event, .Users(1).X, .Users(1).Y, False)
        Call WarpUserChar(.Users(2).ID, .MAP_Event, .Users(2).X, .Users(2).Y, False)
    End With
End Sub

Private Sub GO_LastPos(ByVal ID As Integer)
    With Evento
        Call WarpUserChar(ID, .Users(ID_Array(ID)).LastPos.map, .Users(ID_Array(ID)).LastPos.X, .Users(ID_Array(ID)).LastPos.Y, False)
    End With
End Sub

Private Sub Clean_User(ByVal ID As Integer)
    With Evento
        .Users(ID_Array(ID)).Deaths = 0
        .Users(ID_Array(ID)).ID = 0
        .Users(ID_Array(ID)).Wins = 0
    End With
End Sub

Private Sub Bye_User(ByVal ID As Integer)
    With UserList(ID).EventAim
        Evento.UsersInEvent = Evento.UsersInEvent - 1
        Evento.LastUser = UCase$(UserList(ID).name)
        Call GO_LastPos(ID)
        Call Clean_User(ID)
        .ID_Array = 0
    End With
End Sub

Public Sub Count()
    With Evento
        If .Count_Down = 0 Then
            .Count_Down = -1
            If .Active = True And .Active_Send = False Then
                Call WriteConsoleMsg(.Users(1).ID, "Conteo> Ya!", FontTypeNames.FONTTYPE_CONSEJO)
                Call WriteConsoleMsg(.Users(2).ID, "Conteo> Ya!", FontTypeNames.FONTTYPE_CONSEJO)
                Call WritePauseToggle(.Users(1).ID)
                Call WritePauseToggle(.Users(2).ID)
            End If
            If .Active = True And .Active_Send = True Then
                Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Conteo> Ya!", FontTypeNames.FONTTYPE_FIGHT))
                .Active = False
            End If
          
        End If
        If .Count_Down > 0 Then
            If .Active = True And .Active_Send = False Then
                Call WriteConsoleMsg(.Users(1).ID, "Conteo> " & .Count_Down, FontTypeNames.FONTTYPE_CONSEJO)
                Call WriteConsoleMsg(.Users(2).ID, "Conteo> " & .Count_Down, FontTypeNames.FONTTYPE_CONSEJO)
            End If
            If .Active = True And .Active_Send = True Then _
                Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Conteo> " & .Count_Down, FontTypeNames.FONTTYPE_CONSEJO))
          
            .Count_Down = .Count_Down - 1
          
        End If
    End With
End Sub

Public Sub Disconnect_User(ByVal UserIndex As Integer)
    Dim uWin As Byte
    Dim IDArray As Byte
    IDArray = ID_Array(UserIndex)
    UserList(UserIndex).Stats.GLD = UserList(UserIndex).Stats.GLD - 500000     '@@ Penalización
    Call WriteUpdateGold(UserIndex)
    Call Bye_User(UserIndex)
    'Call Encarcelar(UserIndex, 11)
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> " & UserList(UserIndex).name & " ha abandonado el evento, ha sido penalizado con un quite de 500.000 monedas de oro y 11 minutos en cárcel. Cupos restantes: " & Evento.UsersInEvent, FontTypeNames.FONTTYPE_GUILD))
    If Evento.Count_Down > 0 Then Evento.Count_Down = 0
    If IDArray = 1 Then uWin = 2
    If IDArray = 2 Then uWin = 1
    If Evento.Users(uWin).ID > 0 Then
        Call WritePauseToggle(Evento.Users(uWin).ID)
        Call Win_Round(uWin)
    End If
End Sub

Private Sub Win_Round(ByVal uWin As Byte)
    With Evento
    .Users(uWin).Wins = .Users(uWin).Wins + 1
    Call WarpUserChar(.Users(uWin).ID, .MAP_Event, .Users(uWin).X_Room, .Users(uWin).Y_Room, False)
    Call WriteConsoleMsg(.Users(uWin).ID, "¡Has ganado el combate!, nuevamente estás en la sala de espera.", FontTypeNames.FONTTYPE_GUILD)
    If .Users(uWin).Wins = .Max_Win Then _
        Call End_Event(uWin)
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> " & UserList(.Users(uWin).ID).name & " acumula su " & .Users(uWin).Wins & " Victoria. Mandar luego del conteo.", FontTypeNames.FONTTYPE_FIGHT))
    Call Rules
    .Active_Send = True
    .Count_Down = 5
    End With
End Sub

Private Function CanAim(ByVal UserIndex As Integer) As Boolean
    CanAim = False
  
    With UserList(UserIndex)
      
        If Evento.Active_Send = False And Evento.Active = False Then
            WriteConsoleMsg UserIndex, "El evento no está en disputa.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If Evento.Active_Send = False Then
            WriteConsoleMsg UserIndex, "No hay cupos disponibles.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If Evento.Active = True And Evento.Active_Send = True Then
            WriteConsoleMsg UserIndex, "¡No hay cupos disponibles.!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
    
        If .clase = Bandit Or .clase = Bard Or .clase = Druid Or .clase = Hunter Or .clase = Mage Or .clase = Pirat Or .clase = Worker Or .clase = Thief Then
            WriteConsoleMsg UserIndex, "Tu clase no te deja ingresar al evento.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If Not isCity(.Pos.map) Then
            WriteConsoleMsg UserIndex, "Estás en una zona insegura", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If .flags.Muerto <> 0 Then
            WriteConsoleMsg UserIndex, "Estás muerto", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If .Stats.GLD < Evento.Gold Then
            WriteConsoleMsg UserIndex, "No tenés suficiente oro", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
  
        If .UserReto.EnReto = True Then
            WriteConsoleMsg UserIndex, "¡Estás en reto!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If Items_Restricted(UserIndex) = True Then
            WriteConsoleMsg UserIndex, "¡Tienes items no válidos para el evento.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If UCase$(UserList(UserIndex).name) = Evento.LastUser Then
            WriteConsoleMsg UserIndex, "Debes esperar una ronda más para poder jugar nuevamente.", FontTypeNames.FONTTYPE_INFO
          '  Exit Function
        End If
      
        If .UserDeath.EnDeath = True Then
            WriteConsoleMsg UserIndex, "¡Estás en Deathmatch!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
      
        If .Counters.Pena > 0 Then
            WriteConsoleMsg UserIndex, "¡Estás en la cárcel!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
  
    End With

    CanAim = True
End Function

Private Function Items_Restricted(ByVal ID As Integer) As Boolean

    '@@ Función que devuelve si tiene pociones o items prohibidos el usuario
    Dim LoopC As Long
  
    With UserList(ID)
  
        Dim oType As Byte
          
        For LoopC = 1 To .CurrentInventorySlots
            If .Invent.Object(LoopC).ObjIndex = 38 Or .Invent.Object(LoopC).ObjIndex = 37 Or .Invent.Object(LoopC).ObjIndex = 36 Or .Invent.Object(LoopC).ObjIndex = 39 Then
                Items_Restricted = True
                Exit Function
            End If
            If .Invent.Object(LoopC).ObjIndex <> 0 Then
                oType = ObjData(.Invent.Object(LoopC).ObjIndex).OBJType
                If oType = eOBJType.otESCUDO Or _
                    oType = eOBJType.otCASCO Or _
                    oType = eOBJType.otFlechas Then
                    Items_Restricted = True
                    Exit Function
                End If
            End If
        Next LoopC
      
        Items_Restricted = False
      
    End With
End Function

Private Sub Rules()
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Reglas> Venir sin; cascos, escudos, arcos, flechas, pociones. Clases permitidas: Paladín, Guerrero, Clerigo", FontTypeNames.FONTTYPE_FIGHT))
End Sub
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: 1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)

Mensaje por Toyz el 30/11/2016, 10:49 pm

Nuevo módulo:
*Ahora limpia el evento*
*Optimicé para saber qué index del array era el correcto*
*Ahora las coordenadas se leen desde un dat*
*Ahora limpia el array con Erase*

Código:
Option Explicit
 
'*****************************
'Author: G Toyz
'Fecha: 08/11
'Hora: 00:30 A.M
'Testeado: 100%
'*****************************
Private Type tUser
    ID As Integer    'ID del usuario.
    LastPos As WorldPos    'Última posición del usuario.
    Wins As Byte    'Ganadas llevadas hasta el momento.
    X As Byte    'X Arena.
    Y As Byte    'Y Arena.
    X_Room As Byte    'X Espera.
    Y_Room As Byte    'Y Espera
    Deaths As Byte    'Cantidad de veces que murió (Rounds)
End Type
 
Private Type tEvent
    Active As Boolean    '¿Está activo?
    Active_Send As Boolean    '¿Se puede enviar solicitudes de ingreso?
    Users(1 To 2) As tUser    'Usuarios en evento
    Max_Win As Byte    'Cantidad máxima de ganadas para terminar el evento
    Drop_Items As Boolean    '¿Caen items?
    MAP_Event As Byte    'Mapa en donde se hace el evento.
    Map_Items As Byte    'Mapa en donde caen los objetos.
    Count_Down As Integer    'Cuenta regresiva.
    Gold As Long    'Oro.
    UsersInEvent As Byte    'Usuarios en Evento.
    LastUser As String    'Último usuario que jugó.
    X_Items As Byte    'Posición X donde caen los items.
    Y_Items As Byte    'Posición Y donde caen los items
    Slot_Occupied As Byte 'Numero de cupo ocupado.
End Type
 
Private Evento As tEvent
 
Public Sub Load_Arenas()
 
'@@ Llamada en el Sub MAIN.
 
    Dim LoopC As Long
 
    Dim Leer As clsIniReader
    Set Leer = New clsIniReader
 
    Call Leer.Initialize(App.Path & "\Dat\eventAim.dat")
    With Evento
        .MAP_Event = CByte(Leer.GetValue("EVENTO", "Mapa_Evento"))
        .Map_Items = CByte(Leer.GetValue("EVENTO", "Mapa_Objetos"))
        .X_Items = CByte(Leer.GetValue("EVENTO", "X_Objetos"))
        .Y_Items = CByte(Leer.GetValue("EVENTO", "Y_Objetos"))
        For LoopC = 1 To 2
            .Users(LoopC).X = CByte(Leer.GetValue("USUARIO" & LoopC, "X"))
            .Users(LoopC).Y = CByte(Leer.GetValue("USUARIO" & LoopC, "Y"))
            .Users(LoopC).X_Room = CByte(Leer.GetValue("USUARIO" & LoopC, "Espera_X"))
            .Users(LoopC).Y_Room = CByte(Leer.GetValue("USUARIO" & LoopC, "Espera_Y"))
        Next LoopC
    End With
End Sub
 
Public Sub Do_Event(ByVal Max_Win As Byte, ByVal Drop_Items As Boolean)
 
'@@ CONDICIONALES.
 
    Dim MSG As String
 
    With Evento
        .Active_Send = True
        .Active = True
        .Max_Win = Max_Win
        .Drop_Items = Drop_Items
        MSG = PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Gana sigue, Max: " & Max_Win & ". Al mejor de 3 Rounds" & IIf(Drop_Items = True, ". Caen los items ", vbNullString) & ". Para participar escriba /ENTRARAIM", FontTypeNames.FONTTYPE_GUILD)
        Call SendData(SendTarget.ToAll, 0, MSG)
        Call Rules
        .Count_Down = 5
    End With
End Sub
 
Private Function GiveBack_ID() As Byte
    With Evento
        If .Slot_Occupied = 0 Then
            GiveBack_ID = 1
            .Slot_Occupied = 1
            Exit Function
        End If
        If .Slot_Occupied = 1 Then
            GiveBack_ID = 2
            Exit Function
        End If
        If .Slot_Occupied = 2 Then
            GiveBack_ID = 1
            Exit Function
        End If
    End With
End Function
 
Private Function ID_Array(ByVal ID As Integer) As Byte
    ID_Array = UserList(ID).EventAim.ID_Array
End Function
 
Public Sub Enter_Event(ByVal ID As Integer)
 
'@@ Condicionales
    Dim ID_Array As Byte
    If CanAim(ID) = False Then Exit Sub
    ID_Array = GiveBack_ID()
    With Evento
        .UsersInEvent = .UsersInEvent + 1
        .Users(ID_Array).ID = ID
        .Users(ID_Array).LastPos = UserList(ID).Pos
        UserList(ID).EventAim.ID_Array = ID_Array
        UserList(ID).flags.DuracionEfecto = 1
        Call WarpUserChar(ID, .MAP_Event, .Users(ID_Array).X_Room, .Users(ID_Array).Y_Room, False)
        If .UsersInEvent = 2 Then
            Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Cupo completado!", FontTypeNames.FONTTYPE_FIGHT))
            Call Start_Event
            .Active_Send = False
            .Active = True
        End If
    End With
End Sub
 
Private Sub Start_Event()
    With Evento
        .Count_Down = 10    'Cuenta regresiva para que peleen
        Dim LoopC As Long
        For LoopC = 1 To 2
            Call WritePauseToggle(.Users(LoopC).ID)
        Next LoopC
        Call GO_Corner
    End With
End Sub
 
Public Sub Death_Event(ByVal ID As Integer)
    With Evento
        Dim uWin As Byte
        Dim uLoser As Byte
        uLoser = ID_Array(ID)
        If uLoser = 1 Then uWin = 2
        If uLoser = 2 Then uWin = 1
        .Users(uLoser).Deaths = .Users(uLoser).Deaths + 1
        Call RevivirUsuario(ID)
        With UserList(ID)
            .Stats.MinHp = .Stats.MaxHp
            .Stats.MinMAN = .Stats.MaxMAN
            .Stats.MinSta = .Stats.MaxSta
            Call WriteUpdateUserStats(ID)
        End With
        Call WriteConsoleMsg(ID, "Has perdido el round!", FontTypeNames.FONTTYPE_GUILD)
        Call WriteConsoleMsg(.Users(uWin).ID, "Has ganado el round!", FontTypeNames.FONTTYPE_GUILD)
        If .Users(uLoser).Deaths = 2 Then
            If .Drop_Items = True Then
                Call WarpUserChar(ID, .Map_Items, .X_Items, .Y_Items, False)
                Call TirarTodosLosItems(ID)
            End If
            .Slot_Occupied = uWin
            Call Bye_User(ID)
            Call Win_Round(uWin)
            Exit Sub
        End If
        Call GO_Corner
        .Count_Down = 10
        Call WritePauseToggle(.Users(1).ID)
        Call WritePauseToggle(.Users(2).ID)
    End With
End Sub
 
Private Sub End_Event(ByVal ID_Array As Byte)
    With Evento
        Dim ID As Integer
        ID = .Users(ID_Array).ID
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD + .Gold
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Ganador del evento: " & UserList(ID).name, FontTypeNames.FONTTYPE_GUILD))
        Call WriteUpdateGold(ID)
        Call WriteConsoleMsg(ID, "¡Has ganado el evento! ¡Has sido premiado con " & .Gold & " monedas de oro!", FontTypeNames.FONTTYPE_GUILD)
        Call Bye_User(ID)
        .Active = False
        .Active_Send = False
        .Count_Down = 0
        .Drop_Items = False
        .Gold = 0
        .LastUser = vbNullString
        .Max_Win = 0
        .Slot_Occupied = 0
        .UsersInEvent = 0
    End With
End Sub
 
Private Sub GO_Corner()
    With Evento
        Call WarpUserChar(.Users(1).ID, .MAP_Event, .Users(1).X, .Users(1).Y, False)
        Call WarpUserChar(.Users(2).ID, .MAP_Event, .Users(2).X, .Users(2).Y, False)
    End With
End Sub
 
Private Sub GO_LastPos(ByVal ID As Integer)
    With Evento
        Call WarpUserChar(ID, .Users(ID_Array(ID)).LastPos.map, .Users(ID_Array(ID)).LastPos.X, .Users(ID_Array(ID)).LastPos.Y, False)
    End With
End Sub
 
Private Sub Clean_User(ByVal ID As Integer)
    Erase Evento.Users()
End Sub
 
Private Sub Bye_User(ByVal ID As Integer)
    With UserList(ID).EventAim
        Evento.UsersInEvent = Evento.UsersInEvent - 1
        Evento.LastUser = UCase$(UserList(ID).name)
        Call GO_LastPos(ID)
        Call Clean_User(ID)
        .ID_Array = 0
    End With
End Sub
 
Public Sub Count()
    With Evento
        If .Count_Down = 0 Then
            .Count_Down = -1
            If .Active = True And .Active_Send = False Then
                Call WriteConsoleMsg(.Users(1).ID, "Conteo> Ya!", FontTypeNames.FONTTYPE_CONSEJO)
                Call WriteConsoleMsg(.Users(2).ID, "Conteo> Ya!", FontTypeNames.FONTTYPE_CONSEJO)
                Call WritePauseToggle(.Users(1).ID)
                Call WritePauseToggle(.Users(2).ID)
            End If
            If .Active = True And .Active_Send = True Then
                Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Conteo> Ya!", FontTypeNames.FONTTYPE_FIGHT))
                .Active = False
            End If
 
        End If
        If .Count_Down > 0 Then
            If .Active = True And .Active_Send = False Then
                Call WriteConsoleMsg(.Users(1).ID, "Conteo> " & .Count_Down, FontTypeNames.FONTTYPE_CONSEJO)
                Call WriteConsoleMsg(.Users(2).ID, "Conteo> " & .Count_Down, FontTypeNames.FONTTYPE_CONSEJO)
            End If
            If .Active = True And .Active_Send = True Then _
               Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> Conteo> " & .Count_Down, FontTypeNames.FONTTYPE_CONSEJO))
 
            .Count_Down = .Count_Down - 1
 
        End If
    End With
End Sub
 
Public Sub Disconnect_User(ByVal UserIndex As Integer)
    Dim uWin As Byte
    Dim IDArray As Byte
    IDArray = ID_Array(UserIndex)
    UserList(UserIndex).Stats.GLD = UserList(UserIndex).Stats.GLD - 500000    '@@ Penalización
    Call WriteUpdateGold(UserIndex)
    Call Bye_User(UserIndex)
    'Call Encarcelar(UserIndex, 11)
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> " & UserList(UserIndex).name & " ha abandonado el evento, ha sido penalizado con un quite de 500.000 monedas de oro y 11 minutos en cárcel. Cupos restantes: " & Evento.UsersInEvent, FontTypeNames.FONTTYPE_GUILD))
    If Evento.Count_Down > 0 Then Evento.Count_Down = 0
    If IDArray = 1 Then uWin = 2
    If IDArray = 2 Then uWin = 1
    If Evento.Users(uWin).ID > 0 Then
        Call WritePauseToggle(Evento.Users(uWin).ID)
        Call Win_Round(uWin)
    End If
End Sub
 
Private Sub Win_Round(ByVal uWin As Byte)
    With Evento
        .Users(uWin).Wins = .Users(uWin).Wins + 1
        Call WarpUserChar(.Users(uWin).ID, .MAP_Event, .Users(uWin).X_Room, .Users(uWin).Y_Room, False)
        Call WriteConsoleMsg(.Users(uWin).ID, "¡Has ganado el combate!, nuevamente estás en la sala de espera.", FontTypeNames.FONTTYPE_GUILD)
        If .Users(uWin).Wins = .Max_Win Then _
           Call End_Event(uWin)
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("1VS1 - AIM - MELEE> " & UserList(.Users(uWin).ID).name & " acumula su " & .Users(uWin).Wins & " Victoria. Mandar luego del conteo.", FontTypeNames.FONTTYPE_FIGHT))
        Call Rules
        .Active_Send = True
        .Count_Down = 5
    End With
End Sub
 
Private Function CanAim(ByVal UserIndex As Integer) As Boolean
    CanAim = False
 
    With UserList(UserIndex)
 
        If Evento.Active_Send = False And Evento.Active = False Then
            WriteConsoleMsg UserIndex, "El evento no está en disputa.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If Evento.Active_Send = False Then
            WriteConsoleMsg UserIndex, "No hay cupos disponibles.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If Evento.Active = True And Evento.Active_Send = True Then
            WriteConsoleMsg UserIndex, "¡No hay cupos disponibles.!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If .clase = Bandit Or .clase = Bard Or .clase = Druid Or .clase = Hunter Or .clase = Mage Or .clase = Pirat Or .clase = Worker Or .clase = Thief Then
            WriteConsoleMsg UserIndex, "Tu clase no te deja ingresar al evento.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If Not .Pos.map = 1 Then
            WriteConsoleMsg UserIndex, "Tienes que estar en Ullathorpe para poder ingresar al evento.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If .flags.Muerto <> 0 Then
            WriteConsoleMsg UserIndex, "Estás muerto", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If .Stats.GLD < Evento.Gold Then
            WriteConsoleMsg UserIndex, "No tenés suficiente oro", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If Items_Restricted(UserIndex) = True Then
            WriteConsoleMsg UserIndex, "¡Tienes items no válidos para el evento.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If UCase$(UserList(UserIndex).name) = Evento.LastUser Then
            WriteConsoleMsg UserIndex, "Debes esperar una ronda más para poder jugar nuevamente.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
        If .Counters.Pena > 0 Then
            WriteConsoleMsg UserIndex, "¡Estás en la cárcel!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
 
    End With
 
    CanAim = True
End Function
 
Private Function Items_Restricted(ByVal ID As Integer) As Boolean
 
'@@ Función que devuelve si tiene pociones o items prohibidos el usuario
    Dim LoopC As Long
 
    With UserList(ID)
 
        Dim oType As Byte
 
        For LoopC = 1 To .CurrentInventorySlots
            If .Invent.Object(LoopC).objIndex = 38 Or .Invent.Object(LoopC).objIndex = 37 Or .Invent.Object(LoopC).objIndex = 36 Or .Invent.Object(LoopC).objIndex = 39 Then
                Items_Restricted = True
                Exit Function
            End If
 
            If .Invent.Object(LoopC).objIndex <> 0 Then
                oType = ObjData(.Invent.Object(LoopC).objIndex).OBJType
                If oType = eOBJType.otESCUDO Or _
                   oType = eOBJType.otCASCO Or _
                   oType = eOBJType.otFlechas Then
                    Items_Restricted = True
                    Exit Function
                End If
            End If
        Next LoopC
 
        Items_Restricted = False
 
    End With
End Function
 
Private Sub Rules()
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Reglas> Venir sin; cascos, escudos, arcos, flechas, pociones. Clases permitidas: Paladín, Guerrero, Clerigo", FontTypeNames.FONTTYPE_FIGHT))
End Sub
 
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.