[Aporte] Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro, pociones]

G

G Toyz

Invitado
Les dejo un sistema de retos 3vs3, es igual al de Tierras del Sur (O sea, cumple lo mismo).

Un video de cuando lo estaba testeando ^^


Módulo:

Código:
Option Explicit

'*********************************
'                                *
'@@ Retos 3vs3.                  *
'@@ Autor: G Toyz - Luciano      *
'@@ Fecha: 06/10                 *
'@@ Creación: 23:17              *
'                                *
'*********************************

Private Const MAX_ARENAS        As Byte = 3
Private Const INDEX_POTION_RED  As Integer = 1
Private Const MAX_GOLD          As Long = 20000000
Private Const MIN_GOLD          As Integer = 20000
Private Const MIN_LEVEL         As Byte = 40
Private Const MAP_ITEMS_RETO    As Integer = 1
Private Const INDEX_BANKER      As Byte = 24

Private Type uRetos 'Usuarios
    ID              As Integer
    Pos             As WorldPos
End Type

Private Type tRetos 'Teams
    Rounds          As Byte
    Users(1 To 3)   As uRetos
    Deaths          As Byte
    X               As Byte
    Y               As Byte
    DeathX          As Byte
    DeathY          As Byte
End Type

Private Type Retos  'Retos
    Teams(1 To 2)   As tRetos
    MAP_Arena       As Byte
    Count           As Integer
    Occupied        As Boolean
    Gold            As Long
    Items           As Boolean
    X_Items         As Byte
    Y_Items         As Byte
    Time            As Integer
End Type

Private Retos(1 To MAX_ARENAS) As Retos
'_

Private Sub Start_Arenas(ByVal N_Arena As Integer, _
                         ByVal MAP_Arena As Byte, _
                         ByVal Team1_X As Byte, _
                         ByVal Team1_Y As Byte, _
                         ByVal Team2_X As Byte, _
                         ByVal Team2_Y As Byte, _
                         ByVal Team1_Death_X As Byte, _
                         ByVal Team1_Death_Y As Byte, _
                         ByVal Team2_Death_X As Byte, _
                         ByVal Team2_Death_Y As Byte)

    '@@ Cargar las X y Y de cada usuario en cada arena
    '@@ El cálculo es para posicionar uno abajo del otro o viceversa.
    '@@ Death es para guardar la posición en la que va quedar si es _
        que muere dentro del reto. Más que nada es para que no quede _
        ahí en el medio del agite.
   
    With Retos(N_Arena)
        .Teams(1).X = Team2_X
        .Teams(1).Y = Team2_Y
        .Teams(1).DeathX = Team2_Death_X
        .Teams(1).DeathY = Team2_Death_Y
        .Teams(2).X = Team2_X
        .Teams(2).Y = Team2_Y
        .Teams(2).DeathX = Team2_Death_X
        .Teams(2).DeathY = Team2_Death_Y
       
        .MAP_Arena = MAP_Arena
       
        '@@ Cálculos para sacar el medio de la arena.
        .X_Items = Team1_Death_X + 5
        .Y_Items = Team1_Death_Y - 5
    End With
   
End Sub
'
''
Public Sub Load_Arenas()

    '@@ Pongan sus mapas y coordenadas.
    '@@ Llamadas: Main.
   
    Call Start_Arenas(1, 1, 50, 50, 60, 60, 52, 52, 62, 62)
    Call Start_Arenas(2, 1, 50, 50, 60, 60, 52, 52, 62, 62)
    Call Start_Arenas(3, 1, 50, 50, 60, 60, 52, 52, 62, 50)
   
    '@@ Agregan las que quieran.
    '@@ Si agregan más, cambien la constante.
   
End Sub


Public Sub Send_Reto(ByRef Players() As Integer, _
                ByVal Gold As Long, _
                ByVal Items As Boolean, _
                ByVal Potions_Red As Integer)
   
    '@@ Método para enviar retos.
   
    Dim LoopC As Long
   
    If Not Can_Reto(Players(), Gold, Potions_Red, True) Then Exit Sub
   
    With UserList(Players(1)).Retos
        .Gold = Gold
        .Items = Items
        .Players(1) = Players(1)
        .Accepts = 1
        .ID_Send = 1
        .ID_User_Send = Players(1)
       
    End With

    For LoopC = 2 To UBound(Players())
   
        Call WriteConsoleMsg(Players(LoopC), UserList(Players(1)).name & _
 _
                                            " te ha invitado a participar en un reto 3vs3. [" _
                                            & UserList(Players(1)).name _
                                            & ", " & UserList(Players(2)).name _
                                            & ", " & UserList(Players(3)).name _
                                            & "] vs [" & UserList(Players(4)).name _
                                            & ", " & UserList(Players(5)).name _
                                            & ", " & UserList(Players(6)).name _
                                            & "] por " & Gold & " monedas de oro " _
                                            & IIf(Items = True, " y los items del inventario.", ".") _
                                            & "MÁXIMO POCIONES ROJAS: " & Potions_Red _
                                            & ". Para aceptar el reto escriba /ACEPTAR " _
                                            & UserList(Players(1)).name, _
                                            FontTypeNames.FONTTYPE_INFOBOLD)
                                           
        UserList(Players(1)).Retos.Players(LoopC) = Players(LoopC)
        UserList(Players(LoopC)).Retos.ID_Send = LoopC
        UserList(Players(LoopC)).Retos.ID_User_Send = Players(1)
       
    Next LoopC
   
        Call WriteConsoleMsg(Players(1), "Solicitud enviada correctamente", FontTypeNames.FONTTYPE_INFOBOLD)
   
End Sub

Public Sub Accept_Reto(ByVal Player_ID As Integer, ByVal Send_ID As Integer)
   
   '@@ Método para aceptar retos.
   
    Dim Arena As Byte
    Dim LoopC As Long
    Dim loopX As Long
   
    If Send_ID > 0 Then
         If UserList(Send_ID).Retos.Players(UserList(Player_ID).Retos.ID_Send) <> Player_ID Then
             Call WriteConsoleMsg(Player_ID, "El usuario " & UserList(Send_ID).name & " no te ha invitado a ningún reto.", FontTypeNames.FONTTYPE_INFOBOLD)
             Exit Sub
         End If
    Else
        Call WriteConsoleMsg(Player_ID, "El usuario no se encuentra online.", FontTypeNames.FONTTYPE_INFOBOLD)
        Exit Sub
    End If
   
    If UserList(Player_ID).Retos.accept = True Then
        Call WriteConsoleMsg(Player_ID, "Ya aceptaste el reto.", FontTypeNames.FONTTYPE_INFOBOLD)
        Exit Sub
    End If
   
    With UserList(Send_ID).Retos
       
        If Can_Reto(.Players(), .Gold, .Potions, False, Player_ID) = False Then Exit Sub
       
        .Accepts = .Accepts + 1
        .Time = .Time + 5
        UserList(Player_ID).Retos.accept = True
       
        Call WriteConsoleMsg(Player_ID, "Aceptaste el reto correctamente, esperá a que los demás también lo hagan.", FontTypeNames.FONTTYPE_INFOBOLD)
        Call WriteConsoleMsg(Send_ID, UserList(Player_ID).name & " aceptó el reto.", FontTypeNames.FONTTYPE_INFOBOLD)
       
        If .Accepts = 6 Then
           
            Arena = There_Arena()
           
            If Arena = 0 Then
                Call WriteConsoleMsg(Send_ID, "No hay arenas", FontTypeNames.FONTTYPE_INFOBOLD)
                Call Cancel_Send(Send_ID, , True)
                Exit Sub
            End If
           
            If Can_Reto(.Players(), .Gold, .Potions) = False Then
                Call Cancel_Send(.Players(1), False)
                Exit Sub
            End If
           
            .accept = False
            .ID_Send = 0
           
            With Retos(Arena)
           
                .Count = 10
                .Gold = UserList(Send_ID).Retos.Gold
                .Items = UserList(Send_ID).Retos.Items
                .Occupied = True
               
                .Teams(1).Users(1).ID = UserList(Send_ID).Retos.Players(1)
                .Teams(1).Users(2).ID = UserList(Send_ID).Retos.Players(2)
                .Teams(1).Users(3).ID = UserList(Send_ID).Retos.Players(3)
               
                .Teams(2).Users(1).ID = UserList(Send_ID).Retos.Players(4)
                .Teams(2).Users(2).ID = UserList(Send_ID).Retos.Players(5)
                .Teams(2).Users(3).ID = UserList(Send_ID).Retos.Players(6)
               
                For LoopC = 1 To 2
                    For loopX = 1 To 3
                        .Teams(LoopC).Users(loopX).Pos = UserList(.Teams(LoopC).Users(loopX).ID).Pos
                        WarpUserChar .Teams(LoopC).Users(loopX).ID, .MAP_Arena, .Teams(LoopC).X, .Teams(LoopC).Y, False
                        WritePauseToggle .Teams(LoopC).Users(loopX).ID
                        UserList(.Teams(LoopC).Users(loopX).ID).Stats.GLD = UserList(.Teams(LoopC).Users(loopX).ID).Stats.GLD - .Gold
                        WriteUpdateGold (.Teams(LoopC).Users(loopX).ID)
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_Send = 0
                        Assign_Remove_Flags (.Teams(LoopC).Users(loopX).ID)
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_Team = LoopC
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_User = loopX
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.Arena = Arena
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.accept = False
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_User_Send = 0
                    Next loopX
                Next LoopC
               
            End With
                         
            Call Reset_Sender(Send_ID)
           
        End If
       
    End With
   
End Sub
Private Sub Assign_Remove_Flags(ByVal ID As Integer)

    '@@ Método para actualizar la vida, mana, sacarle el paralizado, revivir al usuario, etc.

    Call RevivirUsuario(ID)

    With UserList(ID).flags
        .Paralizado = 0
        .Envenenado = 0
        .Escondido = 0
        .invisible = 0
        .Inmovilizado = 0
    End With
   
    With UserList(ID).Stats
        .MinMAN = .MaxMAN
        .MinSta = .MaxSta
    End With

    Call WriteUpdateUserStats(ID)
   
End Sub

Public Sub Cancel_Send(ByVal Send_ID As Integer, Optional ByVal Cancel_ID As Integer, Optional ByVal Cancel_Arenas As Boolean)

    '@@ Método para cancelar el envío de reto.

    Dim LoopC As Long

    If Cancel_ID > 0 Then
        If UserList(Send_ID).Retos.Players(UserList(Cancel_ID).Retos.ID_Send) <> Cancel_ID Then
            Call WriteConsoleMsg(Cancel_ID, "El usuario " & UserList(Send_ID).name & " no te ha invitado a ningún reto.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If
    End If
   
    For LoopC = 1 To 6
   
        UserList(UserList(Send_ID).Retos.Players(LoopC)).Retos.ID_Send = 0
        UserList(UserList(Send_ID).Retos.Players(LoopC)).Retos.ID_User_Send = 0
        UserList(UserList(Send_ID).Retos.Players(LoopC)).Retos.accept = False
       
        If Cancel_ID > 0 Then
            WriteConsoleMsg UserList(Send_ID).Retos.Players(LoopC), UserList(Cancel_ID).name & " Rechazó el reto.", FontTypeNames.FONTTYPE_INFOBOLD
            GoTo 1
        End If
       
        If Cancel_Arenas = True Then _
            WriteConsoleMsg UserList(Send_ID).Retos.Players(LoopC), "El reto se autocanceló por falta de arenas.", FontTypeNames.FONTTYPE_INFOBOLD
   
1    Next LoopC
   
    If Cancel_ID > 0 Then _
        WriteConsoleMsg Cancel_ID, "Rechazaste el reto, ya puedes buscar otro.", FontTypeNames.FONTTYPE_INFOBOLD
   
    Reset_Sender Send_ID

End Sub
Private Sub Reset_Sender(ByVal ID As Integer)
   
    '@@ Método para resetear las variables del que envía el reto.
   
    Dim LoopC As Long

    With UserList(ID).Retos
        .Accepts = 0
        .Gold = 0
        .Items = False
       
        For LoopC = 1 To 6
            .Players(LoopC) = 0
        Next LoopC
       
        .Potions = 0
    End With
   
End Sub

Private Function There_Arena() As Byte

    '@@ Función que devuelve una arena libre.

    Dim LoopC As Long
   
    For LoopC = 1 To MAX_ARENAS
        If Retos(LoopC).Occupied = False Then
            There_Arena = LoopC
            Exit Function
        End If
    Next LoopC
   
    There_Arena = 0

End Function

Private Function Can_Reto(ByRef Players() As Integer, ByVal Gold As Long, ByVal Potions_Red As Integer, Optional ByVal Sender As Boolean, Optional ByVal ID As Integer) As Boolean
   
    '@@ Función para comprobar si puede retar.
   
    '@@ Comprobaciones.
   
    '@@ Agregan si es que piensan que falta una o _
        si simplemente quieren agregar otras restricciones.
   
    Dim LoopC As Long
    Dim LoopZ As Long
   
    Can_Reto = False
       
    With UserList(Players(1))
   
        For LoopZ = 2 To 6
            If Players(1) = Players(LoopZ) Then
                Call WriteConsoleMsg(Players(1), "No puedes enviarte una solicitud a vos mismo.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
        Next LoopZ
       
        If .Retos.Players(1) = Players(1) And Sender = True Then
            Call WriteConsoleMsg(Players(1), "Ya has enviado una solicitud.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Retos.ID_Send > 0 And Sender = True Then
            Call WriteConsoleMsg(Players(1), "Estás respondiendo a una solicitud.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Stats.GLD < Gold Then
            Call WriteConsoleMsg(Players(1), "No tienes suficiente oro.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
   
        If Not Potions_Red = 0 Then
            If Potion_Red(Players(1)) > Potions_Red Then
                Call WriteConsoleMsg(Players(1), "Tienes demasiadas pociones.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
        End If
       
        If Gold < MIN_GOLD Then
            Call WriteConsoleMsg(Players(1), "La cantidad mínima para retar es de " & MIN_GOLD & " monedas de oro.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If Gold > MAX_GOLD Then
            Call WriteConsoleMsg(Players(1), "La cantidad máxima para retar es de " & MAX_GOLD & " monedas de oro.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If Not Is_City(.Pos.Map) Then
            Call WriteConsoleMsg(Players(1), "Para mandar un reto debes estar en una ciudad.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Retos.Arena > 0 Then
            Call WriteConsoleMsg(Players(1), "Ya estás en un reto!", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Stats.ELV < MIN_LEVEL Then
            Call WriteConsoleMsg(Players(1), "No tienes suficiente nivel como para retar.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
    End With
   
    For LoopC = 2 To 6
   
        If ID > 0 Then _
            LoopC = UserList(ID).Retos.ID_Send
       
        If Players(LoopC) = 0 Then
            Call WriteConsoleMsg(Players(1), "Uno de los usuarios no se encuentra online.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
   
        With UserList(Players(LoopC))
           
            If .flags.Muerto = 1 Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " está muerto", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "¡Estás muerto!", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
         
            If Not Potions_Red = 0 Then
                If Potion_Red(Players(LoopC)) > Potions_Red Then
                    Call WriteConsoleMsg(Players(1), "El usuario " & .name & " tiene demasiadas pociones.", FontTypeNames.FONTTYPE_INFOBOLD)
                    If Not Sender Then _
                        Call WriteConsoleMsg(Players(LoopC), "Tienes demasiadas pociones", FontTypeNames.FONTTYPE_INFOBOLD)
                    Exit Function
                End If
            End If
           
            If .Stats.GLD < Gold Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " no tiene suficiente oro para retar.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "No tienes suficiente oro.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
           
            If Not Is_City(.Pos.Map) Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " no esta en una ciudad.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "Debes estar en una ciudad.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
   
            If .Stats.ELV < MIN_LEVEL Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " no tiene un nivel adecuado.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "Tienes que ser nivel mayor a 40 para poder retar.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
           
            If .Retos.Arena > 0 Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " está en un reto.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "Para aceptar un reto no debes estar en uno.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
       
        End With
       
        If ID > 0 Then _
            Exit For
       
    Next LoopC
       
        Can_Reto = True
   
End Function

Private Function Potion_Red(ByVal ID As Integer) As Long

    '@@ Función que devuelve las pociones rojas del usuario.

    Dim LoopC As Long
    Dim Total As Long
   
    With UserList(ID)
   
        For LoopC = 1 To .CurrentInventorySlots
            If .Invent.Object(LoopC).ObjIndex = INDEX_POTION_RED Then
                Total = Total + .Invent.Object(LoopC).Amount
            End If
        Next LoopC
       
        Potion_Red = Total
       
    End With
   
End Function

Private Function Is_City(ByVal Map As Integer) As Boolean
   
    '@@ Función que devuelve si el mapa es una ciudad.
   
    Dim LoopC As Long
   
    For LoopC = 1 To NUMCIUDADES
        If Map = Ciudades(LoopC).Map Then
            Is_City = True
            Exit Function
        End If
    Next LoopC
   
    Is_City = False

End Function
Public Sub Count_Reto()

    '@@ Método para contar los tiempos del envío del reto y de cada arena para que _
        empiece la batalla.

    Dim LoopC As Long
    Dim loopX As Long
    Dim LoopZ As Long
    Dim LoopV As Long

    For LoopC = 1 To MAX_ARENAS
        With Retos(LoopC)
       
            If .Time = -1 Then
                Call Clean_Teams(LoopC)
                For LoopV = 1 To 3
                    Call WarpUserChar(.Teams(1).Users(LoopV).ID, .Teams(1).Users(LoopV).Pos.Map, .Teams(1).Users(LoopV).Pos.X, .Teams(1).Users(LoopV).Pos.Y, True)
                    Call Reset_All(.Teams(1).Users(LoopV).ID)
                    Call Reset_All(.Teams(2).Users(LoopV).ID)
                    Call Assign_Remove_Flags(.Teams(1).Users(LoopV).ID)
                    Call Assign_Remove_Flags(.Teams(2).Users(LoopV).ID)
                Next LoopV
                Call QuitarNPC(INDEX_BANKER)
            End If
           
            If .Time > 0 Then
                .Time = .Time - 1
            End If
       
            If .Count = 0 Then
                .Count = -1
               
                For loopX = 1 To 3
                    If .Teams(1).Users(loopX).ID > 0 Then
                        Call WriteConsoleMsg(.Teams(1).Users(loopX).ID, "Reto> Ya!", FontTypeNames.FONTTYPE_FIGHT)
                        Call WritePauseToggle(.Teams(1).Users(loopX).ID)
                    End If
                   
                    If .Teams(2).Users(loopX).ID > 0 Then
                        Call WriteConsoleMsg(.Teams(2).Users(loopX).ID, "Reto> Ya!", FontTypeNames.FONTTYPE_FIGHT)
                        Call WritePauseToggle(.Teams(2).Users(loopX).ID)
                    End If
                Next loopX

            End If
           
            If .Count >= 1 Then
                For LoopZ = 1 To 3
                    If .Teams(1).Users(LoopZ).ID > 0 Then _
                        Call WriteConsoleMsg(.Teams(1).Users(LoopZ).ID, "Reto> " & .Count, FontTypeNames.FONTTYPE_INFOBOLD)
                    If .Teams(2).Users(LoopZ).ID > 0 Then _
                        Call WriteConsoleMsg(.Teams(2).Users(LoopZ).ID, "Reto> " & .Count, FontTypeNames.FONTTYPE_INFOBOLD)
                Next LoopZ
                .Count = .Count - 1
            End If
           
        End With
    Next LoopC

End Sub

Public Sub Death(ByVal ID As Integer)

    'Método para saber quién muere y si ya murieron todos que gane un round el equipo ganador.

    Dim LoopC As Long
    Dim Team_Win As Byte
   
    If UserList(ID).Retos.Arena = 0 Then Exit Sub
   
    With Retos(UserList(ID).Retos.Arena)
   
        If UserList(ID).Retos.ID_Team = 1 Then
            Team_Win = 2
        Else
            Team_Win = 1
        End If
       
        .Teams(UserList(ID).Retos.ID_Team).Deaths = .Teams(UserList(ID).Retos.ID_Team).Deaths + 1
       
        Call WarpUserChar(ID, .MAP_Arena, .Teams(UserList(ID).Retos.ID_Team).DeathX, .Teams(UserList(ID).Retos.ID_Team).DeathY, False)
   
        If .Teams(UserList(ID).Retos.ID_Team).Deaths = 3 Then _
            Call Round_Reto(Team_Win, UserList(ID).Retos.Arena)
           
    End With

End Sub

Public Sub Round_Reto(ByVal ID_Team As Byte, ByVal Arena As Byte)

    '@@ Método que contabiliza los rounds ganados, los lleva a las _
        esquinas y verifica si ganó o no el reto.

    Dim LoopC As Long
    Dim Team_Loser As Byte
   
    If ID_Team = 1 Then
        Team_Loser = 2
    Else
        Team_Loser = 1
    End If
   
    With Retos(Arena)
       
        .Teams(ID_Team).Rounds = .Teams(ID_Team).Rounds + 1
       
        If .Teams(ID_Team).Rounds = 2 Then
            Call Finish(ID_Team, Team_Loser, Arena)
            Exit Sub
        End If
        .Count = 10
       
        For LoopC = 1 To 3
            Call Assign_Remove_Flags(.Teams(1).Users(LoopC).ID)
            Call Assign_Remove_Flags(.Teams(2).Users(LoopC).ID)
            Call WarpUserChar(.Teams(1).Users(LoopC).ID, .MAP_Arena, .Teams(1).X, .Teams(1).Y, False)
            Call WarpUserChar(.Teams(2).Users(LoopC).ID, .MAP_Arena, .Teams(2).X, .Teams(2).Y, False)
            Call WritePauseToggle(.Teams(1).Users(LoopC).ID)
            Call WritePauseToggle(.Teams(2).Users(LoopC).ID)
            .Teams(1).Deaths = 0
            .Teams(2).Deaths = 0
        Next LoopC

    End With

End Sub

Public Sub Reset_All(ByVal ID As Integer)

    '@@ Método para resetear todos los flags de reto del usuario.

    Dim LoopC As Long

    With UserList(ID).Retos
        .Accepts = 0
        .Arena = 0
        .Gold = 0
        .ID_Send = 0
        .ID_Team = 0
        .ID_User = 0
        .Items = False
       
        For LoopC = 1 To 6
            .Players(LoopC) = 0
        Next LoopC
       
        .Potions = 0
        .Time = 0
    End With

End Sub

Public Sub Finish(ByVal ID_Winner As Byte, ByVal ID_Loser As Byte, ByVal Arena As Byte, Optional Cancel As Boolean)

    '@@ Método para finalizar el reto.

    Dim LoopC As Long
    Dim Pos As WorldPos

    With Retos(Arena)
   
    Pos.Map = .MAP_Arena
    Pos.X = .X_Items - 5
    Pos.Y = .Y_Items - 5
   
        For LoopC = 1 To 3
            UserList(.Teams(ID_Winner).Users(LoopC).ID).Stats.GLD = UserList(.Teams(ID_Winner).Users(LoopC).ID).Stats.GLD + (.Gold * 2)
            Call WriteConsoleMsg(.Teams(ID_Winner).Users(LoopC).ID, "Has ganado el reto, felicidades!", FontTypeNames.FONTTYPE_INFOBOLD)
            Call WriteConsoleMsg(.Teams(ID_Loser).Users(LoopC).ID, "Has perdido el reto, siga practicando!", FontTypeNames.FONTTYPE_INFOBOLD)
            Call Assign_Remove_Flags(.Teams(1).Users(LoopC).ID)
            Call Assign_Remove_Flags(.Teams(2).Users(LoopC).ID)
            Call WriteUpdateGold(.Teams(ID_Winner).Users(LoopC).ID)
            If Cancel = False Then
                Call WritePauseToggle(.Teams(ID_Winner).Users(LoopC).ID)
                Call WritePauseToggle(.Teams(ID_Loser).Users(LoopC).ID)
            End If
            If .Items = False Then
                Call WarpUserChar(.Teams(1).Users(LoopC).ID, .Teams(1).Users(LoopC).Pos.Map, .Teams(1).Users(LoopC).Pos.X, .Teams(1).Users(LoopC).Pos.Y, True)
                Call WarpUserChar(.Teams(2).Users(LoopC).ID, .Teams(2).Users(LoopC).Pos.Map, .Teams(2).Users(LoopC).Pos.X, .Teams(2).Users(LoopC).Pos.Y, True)
                Call Reset_All(.Teams(1).Users(LoopC).ID)
                Call Reset_All(.Teams(2).Users(LoopC).ID)
            Else
                Call WarpUserChar(.Teams(1).Users(LoopC).ID, .MAP_Arena, .X_Items, .Y_Items, False)
                Call WarpUserChar(.Teams(2).Users(LoopC).ID, .MAP_Arena, .X_Items, .Y_Items, False)
                Call WarpUserChar(.Teams(ID_Loser).Users(LoopC).ID, .Teams(ID_Loser).Users(LoopC).Pos.Map, .Teams(ID_Loser).Users(LoopC).Pos.X, .Teams(ID_Loser).Users(LoopC).Pos.Y, True)
                Call TirarTodosLosItems(.Teams(ID_Loser).Users(LoopC).ID)
                Call WriteConsoleMsg(.Teams(ID_Winner).Users(LoopC).ID, "Tienen " & .Time & " segundos para recojer los ítems.", FontTypeNames.FONTTYPE_INFOBOLD)
                Call Assign_Remove_Flags(.Teams(ID_Winner).Users(LoopC).ID)
                Call SpawnNpc(INDEX_BANKER, Pos, False, False)
            End If
        Next LoopC
       
        If .Items = False Then _
            Call Clean_Teams(Arena)
       
    End With

End Sub


Public Sub Clean_Teams(ByVal Arena As Byte)
   
    '@@ Método que limpia las arenas y los teams.
   
    Dim LoopC As Long
   
    With Retos(Arena)
        .Count = 0
        .Gold = 0
        .Items = 0
        .Occupied = False
        For LoopC = 1 To 3
            .Teams(1).Users(LoopC).ID = 0
            .Teams(2).Users(LoopC).ID = 0
        Next LoopC
        .Teams(1).Rounds = 0: .Teams(2).Rounds = 0
        .Teams(1).Deaths = 0: .Teams(2).Deaths = 0
    End With

End Sub

Public Sub Cancel_Reto(ByVal ID As Integer)

    '@@ Método para cuando un usuario se desconecta o abandona el reto.

    Dim Team_Win As Byte
   
    If UserList(ID).Retos.ID_Team = 1 Then Team_Win = 2
    If UserList(ID).Retos.ID_Team = 2 Then Team_Win = 1

    Call Finish(Team_Win, UserList(ID).Retos.ID_Team, UserList(ID).Retos.Arena)
   
End Sub
Handles:

Código:
Private Sub HandleSendReto(ByVal ID As Integer)

On Error GoTo Errhandler

    With UserList(ID)
  
        Dim buffer As New clsByteQueue
        Call buffer.CopyBuffer(.incomingData)
  
        'Remove packet ID
        Call buffer.ReadByte
  
        Dim Players(1 To 6) As Integer
        Dim Gold As Long
        Dim Items As Boolean
        Dim Potions As Integer
  
        Players(1) = ID
        Players(2) = NameIndex(buffer.ReadASCIIString())
        Players(3) = NameIndex(buffer.ReadASCIIString())
        Players(4) = NameIndex(buffer.ReadASCIIString())
        Players(5) = NameIndex(buffer.ReadASCIIString())
        Players(6) = NameIndex(buffer.ReadASCIIString())
        Gold = buffer.ReadLong()
        Items = buffer.ReadBoolean()
        Potions = buffer.ReadInteger()
  
        Call Retos3vs3.Send_Reto(Players(), Gold, Items, Potions)
  
        Call .incomingData.CopyBuffer(buffer)
  
    End With
    Exit Sub

Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0

    'Destroy auxiliar buffer
    Set buffer = Nothing

    If error <> 0 Then _
        Err.Raise error

End Sub

Private Sub HandleAcceptReto(ByVal UserIndex As Integer)

On Error GoTo Errhandler

    With UserList(UserIndex)
  
        Dim buffer As New clsByteQueue
        Call buffer.CopyBuffer(.incomingData)
  
        'Remove packet ID
        Call buffer.ReadByte
  
        Dim Name_Send As String
        Dim ID_Send As Integer
  
        Name_Send = buffer.ReadASCIIString()
        ID_Send = NameIndex(Name_Send)
  
        Call Retos3vs3.Accept_Reto(UserIndex, ID_Send)
  
        Call .incomingData.CopyBuffer(buffer)
  
    End With
    Exit Sub

Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0

    'Destroy auxiliar buffer
    Set buffer = Nothing

    If error <> 0 Then _
        Err.Raise error
End Sub

Private Sub handleRefuseReto(ByVal UserIndex As Integer)

On Error GoTo Errhandler

    With UserList(UserIndex)
  
        Dim buffer As New clsByteQueue
        Call buffer.CopyBuffer(.incomingData)
  
        'Remove packet ID
        Call buffer.ReadByte
  
        Dim Name_Send As String
        Dim ID_Send As Integer
  
        Name_Send = buffer.ReadASCIIString()
        ID_Send = NameIndex(Name_Send)
  
        Call Retos3vs3.Cancel_Send(ID_Send, UserIndex)
  
        Call .incomingData.CopyBuffer(buffer)
  
    End With
    Exit Sub

Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0

    'Destroy auxiliar buffer
    Set buffer = Nothing

    If error <> 0 Then _
        Err.Raise error
End Sub

Writes:

Código:
Public Sub WriteSendReto(ByVal Name2_TeamSend As String, _
                          ByVal Name3_TeamSend As String, _
                          ByVal Name4_Team2 As String, _
                          ByVal Name5_Team2 As String, _
                          ByVal Name6_Team2 As String, _
                          ByVal Gold As Long, _
                          ByVal Items As Boolean, _
                          ByVal Potions As Integer)
                    
    With outgoingData
            Call .WriteByte(ClientPacketID.Send_Reto)
            Call .WriteASCIIString(Name2_TeamSend)
            Call .WriteASCIIString(Name3_TeamSend)
            Call .WriteASCIIString(Name4_Team2)
            Call .WriteASCIIString(Name5_Team2)
            Call .WriteASCIIString(Name6_Team2)
            Call .WriteLong(Gold)
            Call .WriteBoolean(Items)
            Call .WriteInteger(Potions)
    End With

End Sub

Public Sub WriteAcceptReto(ByVal Name_Send As String)

    With outgoingData
            Call .WriteByte(ClientPacketID.Accept_Reto)
            Call .WriteASCIIString(Name_Send)
    End With

End Sub

Public Sub WriteRefuseReto(ByVal Name_Send As String)

    With outgoingData
            Call .WriteByte(ClientPacketID.Refuse_Reto)
            Call .WriteASCIIString(Name_Send)
    End With

End Sub

Una ayuda:

Código:
If UserList(UserIndex).Retos.Arena > 0 Then _
        Call Retos3vs3.Cancel_Reto(UserIndex)

    If UserList(UserIndex).Retos.Players(1) = UserIndex Then _
        Call Retos3vs3.Cancel_Send(UserIndex, UserIndex)

    If UserList(UserIndex).Retos.ID_Send > 0 Then _
        Call Retos3vs3.Cancel_Send(UserList(UserIndex).Retos.ID_User_Send, UserIndex)
Una más:

Código:
Public Type User_Reto
    Items           As Boolean
    Gold            As Long
    Potions         As Integer
    Players(1 To 6) As Integer
    Accepts         As Byte
    Time            As Byte
    ID_Send         As Integer
    ID_Team         As Byte
    ID_User         As Byte
    ID_User_Send    As Integer
    Arena           As Byte
    Accept          As Boolean
End Type
Código:
    Retos As User_Reto
 
Última edición por un moderador:

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
Cambiaria el bool de los items por un byte xD

Creo que si guardas el ID como Strings, sería mejor. Es decir en vez de guardar el UserIndex como ID, que guardes el .name como ID. Porque el name no puede cambiar, pero el UserIndex es variable. Es decir hasta donde estuve viendo, si un user deslogea y entra otro. Y yo chequeo la id que tenia el anterior, y el que logeo pasa a tener ese "UserIndex", creo que habría problemas.

CONCLUSIÓN: El Username no cambia, el UserIndex puede cambiar
 
G

G Toyz

Invitado
Cambiaria el bool de los items por un byte xD

Creo que si guardas el ID como Strings, sería mejor. Es decir en vez de guardar el UserIndex como ID, que guardes el .name como ID. Porque el name no puede cambiar, pero el UserIndex es variable. Es decir hasta donde estuve viendo, si un user deslogea y entra otro. Y yo chequeo la id que tenia el anterior, y el que logeo pasa a tener ese "UserIndex", creo que habría problemas.

CONCLUSIÓN: El Username no cambia, el UserIndex puede cambiar
Entiendo lo que decís, pero jamás llegaría a pasar. Cada vez que un usuario desloguea lo saco del reto y también cancelo la solicitud. También aclaro que cada vez que un usuario desloguea, limpio toda la arena más los flags de los usuarios.

Nuevo módulo.

Código:
Option Explicit

'*********************************
'                                *
'@@ Retos 3vs3.                  *
'@@ Autor: G Toyz - Luciano      *
'@@ Fecha: 06/10                 *
'@@ Creación: 23:17              *
'                                *
'*********************************

Private Const MAX_ARENAS        As Byte = 3
Private Const INDEX_POTION_RED  As Integer = 1
Private Const MAX_GOLD          As Long = 20000000
Private Const MIN_GOLD          As Integer = 20000
Private Const MIN_LEVEL         As Byte = 40
Private Const MAP_ITEMS_RETO    As Integer = 1
Private Const INDEX_BANKER      As Byte = 24

Private Type uRetos 'Usuarios
    ID              As Integer
    Pos             As WorldPos
End Type

Private Type tRetos 'Teams
    Rounds          As Byte
    Users(1 To 3)   As uRetos
    Deaths          As Byte
    X               As Byte
    Y               As Byte
    DeathX          As Byte
    DeathY          As Byte
End Type

Private Type Retos  'Retos
    Teams(1 To 2)   As tRetos
    MAP_Arena       As Byte
    Count           As Integer
    Occupied        As Boolean
    Gold            As Long
    Items           As Boolean
    X_Items         As Byte
    Y_Items         As Byte
    Time            As Integer
End Type

Private Retos(1 To MAX_ARENAS) As Retos
'_

Private Sub Start_Arenas(ByVal N_Arena As Integer, _
                         ByVal MAP_Arena As Byte, _
                         ByVal Team1_X As Byte, _
                         ByVal Team1_Y As Byte, _
                         ByVal Team2_X As Byte, _
                         ByVal Team2_Y As Byte, _
                         ByVal Team1_Death_X As Byte, _
                         ByVal Team1_Death_Y As Byte, _
                         ByVal Team2_Death_X As Byte, _
                         ByVal Team2_Death_Y As Byte)

    '@@ Cargar las X y Y de cada usuario en cada arena
    '@@ El cálculo es para posicionar uno abajo del otro o viceversa.
    '@@ Death es para guardar la posición en la que va quedar si es _
        que muere dentro del reto. Más que nada es para que no quede _
        ahí en el medio del agite.
   
    With Retos(N_Arena)
        .Teams(1).X = Team2_X
        .Teams(1).Y = Team2_Y
        .Teams(1).DeathX = Team2_Death_X
        .Teams(1).DeathY = Team2_Death_Y
        .Teams(2).X = Team2_X
        .Teams(2).Y = Team2_Y
        .Teams(2).DeathX = Team2_Death_X
        .Teams(2).DeathY = Team2_Death_Y
       
        .MAP_Arena = MAP_Arena
       
        '@@ Cálculos para sacar el medio de la arena.
        .X_Items = Team1_Death_X + 5
        .Y_Items = Team1_Death_Y - 5
    End With
   
End Sub
'
''
Public Sub Load_Arenas()

    '@@ Pongan sus mapas y coordenadas.
    '@@ Llamadas: Main.
   
    Call Start_Arenas(1, 1, 50, 50, 60, 60, 52, 52, 62, 62)
    Call Start_Arenas(2, 1, 50, 50, 60, 60, 52, 52, 62, 62)
    Call Start_Arenas(3, 1, 50, 50, 60, 60, 52, 52, 62, 50)
   
    '@@ Agregan las que quieran.
    '@@ Si agregan más, cambien la constante.
   
End Sub


Public Sub Send_Reto(ByRef Players() As Integer, _
                ByVal Gold As Long, _
                ByVal Items As Boolean, _
                ByVal Potions_Red As Integer)
   
    '@@ Método para enviar retos.
   
    Dim LoopC As Long
   
    If Not Can_Reto(Players(), Gold, Potions_Red, True) Then Exit Sub
   
    With UserList(Players(1)).Retos
        .Gold = Gold
        .Items = Items
        .Players(1) = Players(1)
        .Accepts = 1
        .ID_Send = 1
        .ID_User_Send = Players(1)
       
    End With

    For LoopC = 2 To UBound(Players())
   
        Call WriteConsoleMsg(Players(LoopC), UserList(Players(1)).name & _
 _
                                            " te ha invitado a participar en un reto 3vs3. [" _
                                            & UserList(Players(1)).name _
                                            & ", " & UserList(Players(2)).name _
                                            & ", " & UserList(Players(3)).name _
                                            & "] vs [" & UserList(Players(4)).name _
                                            & ", " & UserList(Players(5)).name _
                                            & ", " & UserList(Players(6)).name _
                                            & "] por " & Gold & " monedas de oro " _
                                            & IIf(Items = True, " y los items del inventario.", ".") _
                                            & "MÁXIMO POCIONES ROJAS: " & Potions_Red _
                                            & ". Para aceptar el reto escriba /ACEPTAR " _
                                            & UserList(Players(1)).name, _
                                            FontTypeNames.FONTTYPE_INFOBOLD)
                                           
        UserList(Players(1)).Retos.Players(LoopC) = Players(LoopC)
        UserList(Players(LoopC)).Retos.ID_Send = LoopC
        UserList(Players(LoopC)).Retos.ID_User_Send = Players(1)
       
    Next LoopC
   
        Call WriteConsoleMsg(Players(1), "Solicitud enviada correctamente", FontTypeNames.FONTTYPE_INFOBOLD)
   
End Sub

Public Sub Accept_Reto(ByVal Player_ID As Integer, ByVal Send_ID As Integer)
   
   '@@ Método para aceptar retos.
   
    Dim Arena As Byte
    Dim LoopC As Long
    Dim loopX As Long
   
    If Send_ID > 0 Then
         If UserList(Send_ID).Retos.Players(UserList(Player_ID).Retos.ID_Send) <> Player_ID Then
             Call WriteConsoleMsg(Player_ID, "El usuario " & UserList(Send_ID).name & " no te ha invitado a ningún reto.", FontTypeNames.FONTTYPE_INFOBOLD)
             Exit Sub
         End If
    Else
        Call WriteConsoleMsg(Player_ID, "El usuario no se encuentra online.", FontTypeNames.FONTTYPE_INFOBOLD)
        Exit Sub
    End If
   
    If UserList(Player_ID).Retos.accept = True Then
        Call WriteConsoleMsg(Player_ID, "Ya aceptaste el reto.", FontTypeNames.FONTTYPE_INFOBOLD)
        Exit Sub
    End If
   
    With UserList(Send_ID).Retos
       
        If Can_Reto(.Players(), .Gold, .Potions, False, Player_ID) = False Then Exit Sub
       
        .Accepts = .Accepts + 1
        .Time = .Time + 5
        UserList(Player_ID).Retos.accept = True
       
        Call WriteConsoleMsg(Player_ID, "Aceptaste el reto correctamente, esperá a que los demás también lo hagan.", FontTypeNames.FONTTYPE_INFOBOLD)
        Call WriteConsoleMsg(Send_ID, UserList(Player_ID).name & " aceptó el reto.", FontTypeNames.FONTTYPE_INFOBOLD)
       
        If .Accepts = 6 Then
           
            Arena = There_Arena()
           
            If Arena = 0 Then
                Call WriteConsoleMsg(Send_ID, "No hay arenas", FontTypeNames.FONTTYPE_INFOBOLD)
                Call Cancel_Send(Send_ID, , True)
                Exit Sub
            End If
           
            If Can_Reto(.Players(), .Gold, .Potions) = False Then
                Call Cancel_Send(.Players(1), False)
                Exit Sub
            End If
           
            .accept = False
            .ID_Send = 0
           
            With Retos(Arena)
           
                .Count = 10
                .Gold = UserList(Send_ID).Retos.Gold
                .Items = UserList(Send_ID).Retos.Items
                .Occupied = True
               
                .Teams(1).Users(1).ID = UserList(Send_ID).Retos.Players(1)
                .Teams(1).Users(2).ID = UserList(Send_ID).Retos.Players(2)
                .Teams(1).Users(3).ID = UserList(Send_ID).Retos.Players(3)
               
                .Teams(2).Users(1).ID = UserList(Send_ID).Retos.Players(4)
                .Teams(2).Users(2).ID = UserList(Send_ID).Retos.Players(5)
                .Teams(2).Users(3).ID = UserList(Send_ID).Retos.Players(6)
               
                For LoopC = 1 To 2
                    For loopX = 1 To 3
                        .Teams(LoopC).Users(loopX).Pos = UserList(.Teams(LoopC).Users(loopX).ID).Pos
                        WarpUserChar .Teams(LoopC).Users(loopX).ID, .MAP_Arena, .Teams(LoopC).X, .Teams(LoopC).Y, False
                        WritePauseToggle .Teams(LoopC).Users(loopX).ID
                        UserList(.Teams(LoopC).Users(loopX).ID).Stats.GLD = UserList(.Teams(LoopC).Users(loopX).ID).Stats.GLD - .Gold
                        WriteUpdateGold (.Teams(LoopC).Users(loopX).ID)
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_Send = 0
                        Assign_Remove_Flags (.Teams(LoopC).Users(loopX).ID)
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_Team = LoopC
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_User = loopX
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.Arena = Arena
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.accept = False
                        UserList(.Teams(LoopC).Users(loopX).ID).Retos.ID_User_Send = 0
                    Next loopX
                Next LoopC
               
            End With
                         
            Call Reset_Sender(Send_ID)
           
        End If
       
    End With
   
End Sub
Private Sub Assign_Remove_Flags(ByVal ID As Integer)

    '@@ Método para actualizar la vida, mana, sacarle el paralizado, revivir al usuario, etc.

    Call RevivirUsuario(ID)

    With UserList(ID).flags
        .Paralizado = 0
        .Envenenado = 0
        .Escondido = 0
        .invisible = 0
        .Inmovilizado = 0
    End With
   
    With UserList(ID).Stats
        .MinMAN = .MaxMAN
        .MinSta = .MaxSta
    End With

    Call WriteUpdateUserStats(ID)
   
End Sub

Public Sub Cancel_Send(ByVal Send_ID As Integer, Optional ByVal Cancel_ID As Integer, Optional ByVal Cancel_Arenas As Boolean)

    '@@ Método para cancelar el envío de reto.

    Dim LoopC As Long

    If Cancel_ID > 0 Then
        If UserList(Send_ID).Retos.Players(UserList(Cancel_ID).Retos.ID_Send) <> Cancel_ID Then
            Call WriteConsoleMsg(Cancel_ID, "El usuario " & UserList(Send_ID).name & " no te ha invitado a ningún reto.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Sub
        End If
    End If
   
    For LoopC = 1 To 6
   
        UserList(UserList(Send_ID).Retos.Players(LoopC)).Retos.ID_Send = 0
        UserList(UserList(Send_ID).Retos.Players(LoopC)).Retos.ID_User_Send = 0
        UserList(UserList(Send_ID).Retos.Players(LoopC)).Retos.accept = False
       
        If Cancel_ID > 0 Then
            WriteConsoleMsg UserList(Send_ID).Retos.Players(LoopC), UserList(Cancel_ID).name & " Rechazó el reto.", FontTypeNames.FONTTYPE_INFOBOLD
            GoTo 1
        End If
       
        If Cancel_Arenas = True Then _
            WriteConsoleMsg UserList(Send_ID).Retos.Players(LoopC), "El reto se autocanceló por falta de arenas.", FontTypeNames.FONTTYPE_INFOBOLD
   
1    Next LoopC
   
    If Cancel_ID > 0 Then _
        WriteConsoleMsg Cancel_ID, "Rechazaste el reto, ya puedes buscar otro.", FontTypeNames.FONTTYPE_INFOBOLD
   
    Reset_Sender Send_ID

End Sub
Private Sub Reset_Sender(ByVal ID As Integer)
   
    '@@ Método para resetear las variables del que envía el reto.
   
    Dim LoopC As Long

    With UserList(ID).Retos
        .Accepts = 0
        .Gold = 0
        .Items = False
       
        For LoopC = 1 To 6
            .Players(LoopC) = 0
        Next LoopC
       
        .Potions = 0
    End With
   
End Sub

Private Function There_Arena() As Byte

    '@@ Función que devuelve una arena libre.

    Dim LoopC As Long
   
    For LoopC = 1 To MAX_ARENAS
        If Retos(LoopC).Occupied = False Then
            There_Arena = LoopC
            Exit Function
        End If
    Next LoopC
   
    There_Arena = 0

End Function

Private Function Can_Reto(ByRef Players() As Integer, ByVal Gold As Long, ByVal Potions_Red As Integer, Optional ByVal Sender As Boolean, Optional ByVal ID As Integer) As Boolean
   
    '@@ Función para comprobar si puede retar.
   
    '@@ Comprobaciones.
   
    '@@ Agregan si es que piensan que falta una o _
        si simplemente quieren agregar otras restricciones.
   
    Dim LoopC As Long
    Dim LoopZ As Long
   
    Can_Reto = False
       
    With UserList(Players(1))
   
        For LoopZ = 2 To 6
            If Players(1) = Players(LoopZ) Then
                Call WriteConsoleMsg(Players(1), "No puedes enviarte una solicitud a vos mismo.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
        Next LoopZ
       
        If .Retos.Players(1) = Players(1) And Sender = True Then
            Call WriteConsoleMsg(Players(1), "Ya has enviado una solicitud.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Retos.ID_Send > 0 And Sender = True Then
            Call WriteConsoleMsg(Players(1), "Estás respondiendo a una solicitud.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Stats.GLD < Gold Then
            Call WriteConsoleMsg(Players(1), "No tienes suficiente oro.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
   
        If Not Potions_Red = 0 Then
            If Potion_Red(Players(1)) > Potions_Red Then
                Call WriteConsoleMsg(Players(1), "Tienes demasiadas pociones.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
        End If
       
        If Gold < MIN_GOLD Then
            Call WriteConsoleMsg(Players(1), "La cantidad mínima para retar es de " & MIN_GOLD & " monedas de oro.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If Gold > MAX_GOLD Then
            Call WriteConsoleMsg(Players(1), "La cantidad máxima para retar es de " & MAX_GOLD & " monedas de oro.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If Not Is_City(.Pos.Map) Then
            Call WriteConsoleMsg(Players(1), "Para mandar un reto debes estar en una ciudad.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Retos.Arena > 0 Then
            Call WriteConsoleMsg(Players(1), "Ya estás en un reto!", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
        If .Stats.ELV < MIN_LEVEL Then
            Call WriteConsoleMsg(Players(1), "No tienes suficiente nivel como para retar.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
       
    End With
   
    For LoopC = 2 To 6
   
        If ID > 0 Then _
            LoopC = UserList(ID).Retos.ID_Send
       
        If Players(LoopC) = 0 Then
            Call WriteConsoleMsg(Players(1), "Uno de los usuarios no se encuentra online.", FontTypeNames.FONTTYPE_INFOBOLD)
            Exit Function
        End If
   
        With UserList(Players(LoopC))
           
            If .flags.Muerto = 1 Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " está muerto", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "¡Estás muerto!", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
         
            If Not Potions_Red = 0 Then
                If Potion_Red(Players(LoopC)) > Potions_Red Then
                    Call WriteConsoleMsg(Players(1), "El usuario " & .name & " tiene demasiadas pociones.", FontTypeNames.FONTTYPE_INFOBOLD)
                    If Not Sender Then _
                        Call WriteConsoleMsg(Players(LoopC), "Tienes demasiadas pociones", FontTypeNames.FONTTYPE_INFOBOLD)
                    Exit Function
                End If
            End If
           
            If .Stats.GLD < Gold Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " no tiene suficiente oro para retar.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "No tienes suficiente oro.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
           
            If Not Is_City(.Pos.Map) Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " no esta en una ciudad.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "Debes estar en una ciudad.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
   
            If .Stats.ELV < MIN_LEVEL Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " no tiene un nivel adecuado.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "Tienes que ser nivel mayor a 40 para poder retar.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
           
            If .Retos.Arena > 0 Then
                Call WriteConsoleMsg(Players(1), "El usuario " & .name & " está en un reto.", FontTypeNames.FONTTYPE_INFOBOLD)
                If Not Sender Then _
                    Call WriteConsoleMsg(Players(LoopC), "Para aceptar un reto no debes estar en uno.", FontTypeNames.FONTTYPE_INFOBOLD)
                Exit Function
            End If
       
        End With
       
        If ID > 0 Then _
            Exit For
       
    Next LoopC
       
        Can_Reto = True
   
End Function

Private Function Potion_Red(ByVal ID As Integer) As Long

    '@@ Función que devuelve las pociones rojas del usuario.

    Dim LoopC As Long
    Dim Total As Long
   
    With UserList(ID)
   
        For LoopC = 1 To .CurrentInventorySlots
            If .Invent.Object(LoopC).ObjIndex = INDEX_POTION_RED Then
                Total = Total + .Invent.Object(LoopC).Amount
            End If
        Next LoopC
       
        Potion_Red = Total
       
    End With
   
End Function

Private Function Is_City(ByVal Map As Integer) As Boolean
   
    '@@ Función que devuelve si el mapa es una ciudad.
   
    Dim LoopC As Long
   
    For LoopC = 1 To NUMCIUDADES
        If Map = Ciudades(LoopC).Map Then
            Is_City = True
            Exit Function
        End If
    Next LoopC
   
    Is_City = False

End Function
Public Sub Count_Reto()

    '@@ Método para contar los tiempos del envío del reto y de cada arena para que _
        empiece la batalla.

    Dim LoopC As Long
    Dim loopX As Long
    Dim LoopZ As Long
    Dim LoopV As Long

    For LoopC = 1 To MAX_ARENAS
        With Retos(LoopC)
       
            If .Time = -1 Then
                Call Clean_Teams(LoopC)
                For LoopV = 1 To 3
                    Call WarpUserChar(.Teams(1).Users(LoopV).ID, .Teams(1).Users(LoopV).Pos.Map, .Teams(1).Users(LoopV).Pos.X, .Teams(1).Users(LoopV).Pos.Y, True)
                    Call Reset_All(.Teams(1).Users(LoopV).ID)
                    Call Reset_All(.Teams(2).Users(LoopV).ID)
                    Call Assign_Remove_Flags(.Teams(1).Users(LoopV).ID)
                    Call Assign_Remove_Flags(.Teams(2).Users(LoopV).ID)
                Next LoopV
                Call QuitarNPC(INDEX_BANKER)
            End If
           
            If .Time > 0 Then
                .Time = .Time - 1
            End If
       
            If .Count = 0 Then
                .Count = -1
               
                For loopX = 1 To 3
                    If .Teams(1).Users(loopX).ID > 0 Then
                        Call WriteConsoleMsg(.Teams(1).Users(loopX).ID, "Reto> Ya!", FontTypeNames.FONTTYPE_FIGHT)
                        Call WritePauseToggle(.Teams(1).Users(loopX).ID)
                    End If
                   
                    If .Teams(2).Users(loopX).ID > 0 Then
                        Call WriteConsoleMsg(.Teams(2).Users(loopX).ID, "Reto> Ya!", FontTypeNames.FONTTYPE_FIGHT)
                        Call WritePauseToggle(.Teams(2).Users(loopX).ID)
                    End If
                Next loopX

            End If
           
            If .Count >= 1 Then
                For LoopZ = 1 To 3
                    If .Teams(1).Users(LoopZ).ID > 0 Then _
                        Call WriteConsoleMsg(.Teams(1).Users(LoopZ).ID, "Reto> " & .Count, FontTypeNames.FONTTYPE_INFOBOLD)
                    If .Teams(2).Users(LoopZ).ID > 0 Then _
                        Call WriteConsoleMsg(.Teams(2).Users(LoopZ).ID, "Reto> " & .Count, FontTypeNames.FONTTYPE_INFOBOLD)
                Next LoopZ
                .Count = .Count - 1
            End If
           
        End With
    Next LoopC

End Sub

Public Sub Death(ByVal ID As Integer)

    'Método para saber quién muere y si ya murieron todos que gane un round el equipo ganador.

    Dim LoopC As Long
    Dim Team_Win As Byte
   
    If UserList(ID).Retos.Arena = 0 Then Exit Sub
   
    With Retos(UserList(ID).Retos.Arena)
   
        If UserList(ID).Retos.ID_Team = 1 Then
            Team_Win = 2
        Else
            Team_Win = 1
        End If
       
        .Teams(UserList(ID).Retos.ID_Team).Deaths = .Teams(UserList(ID).Retos.ID_Team).Deaths + 1
       
        Call WarpUserChar(ID, .MAP_Arena, .Teams(UserList(ID).Retos.ID_Team).DeathX, .Teams(UserList(ID).Retos.ID_Team).DeathY, False)
   
        If .Teams(UserList(ID).Retos.ID_Team).Deaths = 3 Then _
            Call Round_Reto(Team_Win, UserList(ID).Retos.Arena)
           
    End With

End Sub

Public Sub Round_Reto(ByVal ID_Team As Byte, ByVal Arena As Byte)

    '@@ Método que contabiliza los rounds ganados, los lleva a las _
        esquinas y verifica si ganó o no el reto.

    Dim LoopC As Long
    Dim Team_Loser As Byte
   
    If ID_Team = 1 Then
        Team_Loser = 2
    Else
        Team_Loser = 1
    End If
   
    With Retos(Arena)
       
        .Teams(ID_Team).Rounds = .Teams(ID_Team).Rounds + 1
       
        If .Teams(ID_Team).Rounds = 2 Then
            Call Finish(ID_Team, Team_Loser, Arena)
            Exit Sub
        End If
        .Count = 10
       
        For LoopC = 1 To 3
            Call Assign_Remove_Flags(.Teams(1).Users(LoopC).ID)
            Call Assign_Remove_Flags(.Teams(2).Users(LoopC).ID)
            Call WarpUserChar(.Teams(1).Users(LoopC).ID, .MAP_Arena, .Teams(1).X, .Teams(1).Y, False)
            Call WarpUserChar(.Teams(2).Users(LoopC).ID, .MAP_Arena, .Teams(2).X, .Teams(2).Y, False)
            Call WritePauseToggle(.Teams(1).Users(LoopC).ID)
            Call WritePauseToggle(.Teams(2).Users(LoopC).ID)
            .Teams(1).Deaths = 0
            .Teams(2).Deaths = 0
        Next LoopC

    End With

End Sub

Public Sub Reset_All(ByVal ID As Integer)

    '@@ Método para resetear todos los flags de reto del usuario.

    Dim LoopC As Long

    With UserList(ID).Retos
        .Accepts = 0
        .Arena = 0
        .Gold = 0
        .ID_Send = 0
        .ID_Team = 0
        .ID_User = 0
        .Items = False
       
        For LoopC = 1 To 6
            .Players(LoopC) = 0
        Next LoopC
       
        .Potions = 0
        .Time = 0
    End With

End Sub

Public Sub Finish(ByVal ID_Winner As Byte, ByVal ID_Loser As Byte, ByVal Arena As Byte, Optional Cancel As Boolean)

    '@@ Método para finalizar el reto.

    Dim LoopC As Long
    Dim Pos As WorldPos

    With Retos(Arena)
   
    Pos.Map = .MAP_Arena
    Pos.X = .X_Items - 5
    Pos.Y = .Y_Items - 5
   
        For LoopC = 1 To 3
            UserList(.Teams(ID_Winner).Users(LoopC).ID).Stats.GLD = UserList(.Teams(ID_Winner).Users(LoopC).ID).Stats.GLD + (.Gold * 2)
            Call WriteConsoleMsg(.Teams(ID_Winner).Users(LoopC).ID, "Has ganado el reto, felicidades!", FontTypeNames.FONTTYPE_INFOBOLD)
            Call WriteConsoleMsg(.Teams(ID_Loser).Users(LoopC).ID, "Has perdido el reto, siga practicando!", FontTypeNames.FONTTYPE_INFOBOLD)
            Call Assign_Remove_Flags(.Teams(1).Users(LoopC).ID)
            Call Assign_Remove_Flags(.Teams(2).Users(LoopC).ID)
            Call WriteUpdateGold(.Teams(ID_Winner).Users(LoopC).ID)
            If Cancel = False Then
                Call WritePauseToggle(.Teams(ID_Winner).Users(LoopC).ID)
                Call WritePauseToggle(.Teams(ID_Loser).Users(LoopC).ID)
            End If
            If .Items = False Then
                Call WarpUserChar(.Teams(1).Users(LoopC).ID, .Teams(1).Users(LoopC).Pos.Map, .Teams(1).Users(LoopC).Pos.X, .Teams(1).Users(LoopC).Pos.Y, True)
                Call WarpUserChar(.Teams(2).Users(LoopC).ID, .Teams(2).Users(LoopC).Pos.Map, .Teams(2).Users(LoopC).Pos.X, .Teams(2).Users(LoopC).Pos.Y, True)
                Call Reset_All(.Teams(1).Users(LoopC).ID)
                Call Reset_All(.Teams(2).Users(LoopC).ID)
            Else
                Call WarpUserChar(.Teams(1).Users(LoopC).ID, .MAP_Arena, .X_Items, .Y_Items, False)
                Call WarpUserChar(.Teams(2).Users(LoopC).ID, .MAP_Arena, .X_Items, .Y_Items, False)
                Call WarpUserChar(.Teams(ID_Loser).Users(LoopC).ID, .Teams(ID_Loser).Users(LoopC).Pos.Map, .Teams(ID_Loser).Users(LoopC).Pos.X, .Teams(ID_Loser).Users(LoopC).Pos.Y, True)
                Call TirarTodosLosItems(.Teams(ID_Loser).Users(LoopC).ID)
                Call WriteConsoleMsg(.Teams(ID_Winner).Users(LoopC).ID, "Tienen " & .Time & " segundos para recojer los ítems.", FontTypeNames.FONTTYPE_INFOBOLD)
                Call Assign_Remove_Flags(.Teams(ID_Winner).Users(LoopC).ID)
                Call SpawnNpc(INDEX_BANKER, Pos, False, False)
            End If
        Next LoopC
       
        If .Items = False Then _
            Call Clean_Teams(Arena)
       
    End With

End Sub


Public Sub Clean_Teams(ByVal Arena As Byte)
   
    '@@ Método que limpia las arenas y los teams.
   
    Dim LoopC As Long
   
    With Retos(Arena)
        .Count = 0
        .Gold = 0
        .Items = 0
        .Occupied = False
        For LoopC = 1 To 3
            .Teams(1).Users(LoopC).ID = 0
            .Teams(2).Users(LoopC).ID = 0
        Next LoopC
        .Teams(1).Rounds = 0: .Teams(2).Rounds = 0
        .Teams(1).Deaths = 0: .Teams(2).Deaths = 0
    End With

End Sub

Public Sub Cancel_Reto(ByVal ID As Integer)

    '@@ Método para cuando un usuario se desconecta o abandona el reto.

    Dim Team_Win As Byte
   
    If UserList(ID).Retos.ID_Team = 1 Then Team_Win = 2
    If UserList(ID).Retos.ID_Team = 2 Then Team_Win = 1

    Call Finish(Team_Win, UserList(ID).Retos.ID_Team, UserList(ID).Retos.Arena)
   
End Sub
 
Última edición por un moderador:

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
  1. Código:
            UserList(Players(1)).Retos.Players(LoopC) = Players(LoopC)
            UserList(Players(LoopC)).Retos.ID_Send = LoopC
            UserList(Players(LoopC)).Retos.ID_User_Send = Players(1)
Creo que si vos lo haces de esta manera, cuando te envia fulanito, te guarda a fulanito, pero si despues te manda menganito, se te va todo al carajo , por eso uno que se aviva te hace boleta el sistema y no dejas que acepten X reto xD no se si me entendiste

Tampoco lei todo el codigo entero, pero me llamo la atencion eso
 
G

G Toyz

Invitado
Que raro que no haya hecho la condiciona. Me pareció haber hecho que si un usuario está respondiendo una solicitud no se le envíe.
Ahora lo agrego. Gracias por avisar.
 

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
Que raro que no haya hecho la condiciona. Me pareció haber hecho que si un usuario está respondiendo una solicitud no se le envíe.
Ahora lo agrego. Gracias por avisar.
Si pero aun asi, es ilegible eso! La idea como te dije en el chat, es que un usuario reciba las solicitudes que se le plazca y acepte la que quiere! Además, un cargoso te envia reto seguidos como un bot, y tenes que cancelar, y cuando cancelas ya te envió otra mas.

Por eso te conviene hacer que el index se guarde en el que envia reto. Es decir yo fulanito, se me guardan los ultimos chars a los que le mande! Y asi tendria un mejor funcionamiento
 
G

G Toyz

Invitado
Si pero aun asi, es ilegible eso! La idea como te dije en el chat, es que un usuario reciba las solicitudes que se le plazca y acepte la que quiere! Además, un cargoso te envia reto seguidos como un bot, y tenes que cancelar, y cuando cancelas ya te envió otra mas.

Por eso te conviene hacer que el index se guarde en el que envia reto. Es decir yo fulanito, se me guardan los ultimos chars a los que le mande! Y asi tendria un mejor funcionamiento
A mí en el momento se me ocurrió un "Esperá, no ves que estoy respondiendo otra solicitud?". Pero sé, ahora veo de hacerlo como me decís. En un rato lo dejo.
 

Shak

Evolution
Miembro del equipo
Developer
Especialista de Argentum
Pregunta , donde pongo esos codes en Server o Cliente o en los dos?.
En este caso no vas apoder poner el sistema copiando y pegando en respectivos lados y tenerlo andando. Hay que ir más alla, si bien dejo la ayuda, faltan algunas cositas...

Por empezar, los handles en este caso van del lado del servidor, los writes del lado del cliente. Pero al preguntar esto, tengo que alertarte que no estás prestando atención o que no sabes el manejo/envio de paquetes del client-sv y viceversa. Es necesario que aprendas esto para tus proximos sistemas, y así llegues a crear tus propios sistemas. Y creeme que va a ser satisfactorio
 
Arriba