Sistema de Parties v0.2

Option Explicit

'**************************************************
''      FENIX XIII.
''      AUTOR; G Toyz.
''      FECHA; 04/17 - 05/17
''      SISTEMA; Party v0.2
''      ACLARACIÓN; Party. Party. MAB, cof cof se la come cof cof, no es grupo (?
'**************************************************

Public Parties As Collection

Public Sub AñadirParty(ByVal UsuarioIndex As Integer)

    If .Party.PartyIndex > 0 Then
        Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» Primero debes " & IIf(UserList(UsuarioIndex).Party.estatus = Lider, "disolver", "abandonar") & " la party para poder crear una.", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    Dim nuevaParty As New clsParty

    Parties.Add nuevaParty
    UserList(UsuarioIndex).Party.estatus = Lider
    EnviarSolicitudIngreso UsuarioIndex, UsuarioIndex
    AñadirMiembro 1, Parties.Count 'TODO: Default, xD. Después lo cambio, igual no genera error pero rico hardcode.

    Set nuevaParty = Nothing

    Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» Has creado una party.", FontTypeNames.FONTTYPE_CONSEJO)
    Call WriteActualizarDatosParty(UsuarioIndex)
End Sub

Public Sub EnviarSolicitudIngreso(ByVal UsuarioIndex As Integer, ByVal LiderIndex As Integer)

    If LiderIndex = 0 Then
        Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» Clickea al líder de la party.", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    If UserList(LiderIndex).Party.PartyIndex > 0 Then
        Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» Primero debes " & IIf(UserList(LiderIndex).Party.estatus = Lider, "disolver", "abandonar") & " la party para poder entrar a una.", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    If Not UserList(LiderIndex).Party.estatus = Lider Then
        Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» El usuario no es líder de ninguna party.", FontTypeNames.FONTTYPE_CONSEJO)
        Exit Sub
    End If

    Parties.Item(UserList(UsuarioIndex).Party.PartyIndex).Miembros.Add UsuarioIndex

    Call WriteConsoleMsg(LiderIndex, "[PARTY]»» Nueva solicitud de ingreso", FontTypeNames.FONTTYPE_CONSEJO)
    Call WriteActualizarDatosParty(LiderIndex)

End Sub

Public Sub AñadirMiembro(ByVal SolicitudIndex As Integer, ByVal PartyIndex As Integer)

    Dim UsuarioIndex As Integer
    Dim nuevoMiembro As New clsMiembrosParty

    UsuarioIndex = Parties.Item(PartyIndex).Solicitudes.Item(SolicitudIndex)

    With UserList(UsuarioIndex)
        If Not .Party.estatus = Lider Then Exit Sub

        If .Party.PartyIndex > 0 Then
            Call WriteConsoleMsg(UsuarioIndex, "[PARTY] »» Primero debes " & IIf(.Party.estatus = Lider, "disolver", "abandonar") & " la party para poder entrar a una.", FontTypeNames.FONTTYPE_CONSEJO)
            Exit Sub
        End If

        Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg("[PARTY]»» " & .Name & " ha ingresado a la party.", FontTypeNames.FONTTYPE_CONSEJO))
    End With

    With nuevoMiembro
        .Experiencia = 0
        .UsuarioIndex = UsuarioIndex
        Call ResetearPorcentajes(UsuarioIndex)
    End With

    Parties.Item(PartyIndex).Miembros.Add nuevoMiembro
    Parties.Item(PartyIndex).Solicitudes.Remove SolicitudIndex

    With UserList(UsuarioIndex).Party
        .MiembroIndex = Parties.Item(PartyIndex).Miembros.Count
        .PartyIndex = PartyIndex
    End With

    Set nuevoMiembro = Nothing

    Call WriteActualizarDatosParty(UsuarioIndex)
End Sub

Public Sub QuitarMiembro(ByVal PartyIndex As Integer, ByVal MiembroIndex As Integer)

    Dim UsuarioIndex As Integer
    UsuarioIndex = Parties.Item(PartyIndex).Miembros.Item(MiembroIndex).UsuarioIndex

    With UserList(UsuarioIndex)
        Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg _
                ("[PARTY]»» " & .Name & " abandona la party.", FontTypeNames.FONTTYPE_CONSEJO))

        With .Party
            .estatus = SinParty
            .MiembroIndex = 0
            .PartyIndex = 0
        End With
    End With

    Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» Abandonas la party.", FontTypeNames.FONTTYPE_CONSEJO)

    With Parties.Item(PartyIndex)
        DarExperiencia UsuarioIndex, .Miembros.Item(MiembroIndex).Experiencia
        .Miembros.Remove MiembroIndex
        ResetearPorcentajes PartyIndex
    End With

End Sub

Public Sub RepartirExperiencia(ByVal PartyIndex As Byte, ByVal ExperienciaTotal As Long)

    Dim LoopC As Long
    Dim Experiencia As Long
    Dim cantidadMiembros As Byte

    With Parties.Item(PartyIndex)
        cantidadMiembros = .Miembros.Count
        For LoopC = 1 To cantidadMiembros
            With .Miembros.Item(LoopC)
                Experiencia = CLng(Round(ExperienciaTotal * .Porcentaje / 100))
                .Experiencia = .Experiencia + Experiencia
                Call WriteActualizarDatosParty(.UsuarioIndex)
            End With
        Next LoopC
    End With
End Sub

Private Sub DarExperiencia(ByVal UsuarioIndex As Integer, ByVal Experiencia As Long)

    With UserList(UsuarioIndex)
        .Stats.Exp = .Stats.Exp + Experiencia
        If .Stats.Exp > MAXEXP Then _
            .Stats.Exp = MAXEXP
        Call WriteConsoleMsg(UsuarioIndex, "[PARTY]»» Has ganado " & Experiencia & " puntos de experiencia durante la party.", FontTypeNames.FONTTYPE_CONSEJO)
        Call CheckUserLevel(UsuarioIndex)
    End With
End Sub

Private Sub ResetearPorcentajes(ByVal PartyIndex As Byte)

    Dim Porcentaje As Byte
    Dim cantidadMiembros As Byte
    Dim LoopC As Long

    With Parties.items(PartyIndex)
        cantidadMiembros = .Miembros.Count
        Porcentaje = CByte(Round(100 / cantidadMiembros))

        For LoopC = 1 To cantidadMiembros
            .Miembros.Item(LoopC).Porcentaje = Porcentaje
        Next LoopC
        Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg _
                ("[PARTY]»» Los porcentajes han sido reseteados.", FontTypeNames.FONTTYPE_CONSEJO))
    End With

End Sub

Public Sub EnviarToParty(ByRef dataTosend As String, ByVal sndIndex As Byte)

    Dim LoopC  As Long

    For LoopC = 1 To Parties.Item(sndIndex).Miembros.Count
        Call EnviarDatosASlot(Parties.Item(sndIndex).Miembros.Item(LoopC).UsuarioIndex, dataTosend)
    Next LoopC

End Sub

Public Sub DisolverParty(ByVal UsuarioIndex As Byte)

    Dim LoopC As Long
    Dim PartyIndex As Byte

    If Not UserList(UsuarioIndex).Party.estatus = Lider Then Exit Sub

    PartyIndex = UserList(UsuarioIndex).Party.PartyIndex

    With Parties.Item(PartyIndex)
        Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg _
            ("[PARTY]»» El líder a disuelto la party", FontTypeNames.FONTTYPE_CONSEJO))

        For LoopC = 1 To .Miembros.Count
            Call QuitarMiembro(PartyIndex, LoopC)
        Next LoopC
    End With
End Sub

Public Sub SetearPorcentajes(ByVal PartyIndex As Byte, ByRef Miembros() As Byte, ByRef Porcentajes() As Byte)

    Dim LoopC As Long
    Dim PorcentajeTotal As Byte

    With Parties.Item(PartyIndex)

        For LoopC = 1 To .Miembros.Count
            PorcentajeTotal = PorcentajeTotal + Porcentajes(LoopC)
        Next LoopC

        If PorcentajeTotal <> 100 Then Exit Sub

        For LoopC = 1 To .Miembros.Count
            .Miembros.Item(Miembros(LoopC)).Porcentaje = Porcentajes(LoopC)
        Next LoopC
    End With
End Sub