Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- 'Autor: G Toyz.
- Public Const MAX_PARTICIPANTES_PARTY As Byte = 10 ' No exceder este límite 10 (diez).
- Private Const MAX_PARTIES As Byte = 50
- Private Type tUsuarios
- UsuarioIndex As Integer
- Porcentaje As Byte
- Experiencia As Long
- End Type
- Private Type tGeneral
- Participantes(1 To MAX_PARTICIPANTES_PARTY) As tUsuarios
- Solicitudes(1 To MAX_PARTICIPANTES_PARTY) As Integer
- CantidadParticipantes As Byte
- Activa As Boolean
- Lider As Byte
- End Type
- Public Parties(1 To MAX_PARTIES) As tGeneral
- Public Sub AñadirParty(ByVal UsuarioIndex As Integer)
- Dim PartyIndex As Byte
- With UserList(UsuarioIndex)
- If .Party.PartyIndex > 0 Then
- Call WriteConsoleMsg(UsuarioIndex, "Primero debes " & IIf(.Party.Lider, "disolver", "abandonar") & " la party para poder fundar una.", FontTypeNames.FONTTYPE_CONSEJO)
- Exit Sub
- End If
- .Party.PartyIndex = PartyIndex
- .Party.ParticipanteIndex = 1
- End With
- PartyIndex = DamePartyIndex()
- With Parties(PartyIndex)
- .CantidadParticipantes = 1
- .Activa = True
- .Lider = 1 ' «« El que la crea es el lider.
- .Participantes(.Lider).UsuarioIndex = UsuarioIndex
- End With
- Call WriteConsoleMsg(UsuarioIndex, "Has fundado una party.", FontTypeNames.FONTTYPE_CONSEJO)
- End Sub
- Public Sub EnviarSolicitudIngreso(ByVal UsuarioIndex As Integer, ByVal LiderIndex As Integer)
- Dim SolicitudIndex As Byte
- If LiderIndex = 0 Then
- Call WriteConsoleMsg(UsuarioIndex, "Clickea al lider de la party.", FontTypeNames.FONTTYPE_CONSEJO)
- Exit Sub
- End If
- If Not UserList(LiderIndex).Party.Lider Then
- Call WriteConsoleMsg(UsuarioIndex, "El usuario no es lider de ninguna party.", FontTypeNames.FONTTYPE_CONSEJO)
- Exit Sub
- End If
- SolicitudIndex = DameSolicitudIndex(UserList(LiderIndex).Party.PartyIndex)
- If SolicitudIndex = 0 Then
- Call WriteConsoleMsg(UsuarioIndex, "La party ya tiene muchas solicitudes de ingreso, intente más tarde", FontTypeNames.FONTTYPE_CONSEJO)
- Exit Sub
- End If
- Parties(UserList(LiderIndex).Party.PartyIndex).Solicitudes(SolicitudIndex) = UsuarioIndex
- Call WriteActualizarDatosParty(LiderIndex)
- End Sub
- Public Sub AñadirParticipante(ByVal SolicitudIndex As Byte, ByVal PartyIndex As Byte)
- Dim ParticipanteIndex As Byte
- Dim UsuarioIndex As Integer
- UsuarioIndex = Parties(PartyIndex).Solicitudes(SolicitudIndex)
- ParticipanteIndex = DameParticipanteIndex(PartyIndex)
- With UserList(UsuarioIndex)
- If .Party.PartyIndex > 0 Then
- Call WriteConsoleMsg(UsuarioIndex, "Primero debes " & IIf(.Party.Lider, "disolver", "abandonar") & " la party para poder entrar a una.", FontTypeNames.FONTTYPE_CONSEJO)
- Exit Sub
- End If
- .Party.PartyIndex = PartyIndex
- .Party.ParticipanteIndex = ParticipanteIndex
- Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg(.Name & " ha ingresado a la party.", FontTypeNames.FONTTYPE_CONSEJO))
- End With
- Parties(PartyIndex).CantidadParticipantes = Parties(PartyIndex).CantidadParticipantes + 1
- With Parties(PartyIndex).Participantes(PartyIndex)
- .Experiencia = 0
- .UsuarioIndex = UsuarioIndex
- ResetearPorcentajes PartyIndex
- End With
- Parties(PartyIndex).Solicitudes(SolicitudIndex) = 0
- Call WriteActualizarDatosParty(UsuarioIndex)
- End Sub
- Public Sub QuitarParticipante(ByVal UsuarioIndex As Integer)
- Call SendData(SendTarget.ToPartyArea, UserList(UsuarioIndex).Party.PartyIndex, PrepareMessageConsoleMsg(UserList(UsuarioIndex).Name & " abandona la party.", FontTypeNames.FONTTYPE_CONSEJO))
- Call WriteConsoleMsg(UsuarioIndex, "Abandonas la party.", FontTypeNames.FONTTYPE_CONSEJO)
- With Parties(UserList(UsuarioIndex).Party.PartyIndex)
- DarExperiencia UsuarioIndex, .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).Experiencia
- .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).Experiencia = 0
- .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).Porcentaje = 0
- .Participantes(UserList(UsuarioIndex).Party.ParticipanteIndex).UsuarioIndex = 0
- .CantidadParticipantes = .CantidadParticipantes - 1
- ResetearPorcentajes UserList(UsuarioIndex).Party.PartyIndex
- End With
- End Sub
- Public Sub RepartirExperiencia(ByVal PartyIndex As Byte, ByVal Experiencia As Long)
- Dim LoopC As Long
- With Parties(PartyIndex)
- For LoopC = 1 To MAX_PARTICIPANTES_PARTY
- If .Participantes(LoopC).UsuarioIndex > 0 Then
- Experiencia = CLng(Round(Experiencia * .Participantes(LoopC).Porcentaje / 100))
- .Participantes(LoopC).Experiencia = Experiencia
- End If
- 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, "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 ' « Porcentaje para cada usuario
- Dim LoopC As Long
- With Parties(PartyIndex)
- Porcentaje = CByte(Round(100 / .CantidadParticipantes))
- For LoopC = 1 To .CantidadParticipantes
- .Participantes(LoopC).Porcentaje = Porcentaje
- Next LoopC
- Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg("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 MAX_PARTICIPANTES_PARTY
- With Parties(sndIndex)
- If .Participantes(LoopC).UsuarioIndex > 0 Then
- Call EnviarDatosASlot(.Participantes(LoopC).UsuarioIndex, dataTosend)
- End If
- End With
- Next LoopC
- End Sub
- Public Sub SetearPorcentajes(ByVal PartyIndex As Byte, ByVal ParticipanteIndex As Byte, ByVal Porcentaje As Byte)
- Parties(PartyIndex).Participantes(ParticipanteIndex).Porcentaje = Porcentaje
- Call SendData(SendTarget.ToPartyArea, PartyIndex, PrepareMessageConsoleMsg("El porcentaje de " & UserList(Parties(PartyIndex).Participantes(ParticipanteIndex).UsuarioIndex).Name & " ahora es de " & Porcentaje, FontTypeNames.FONTTYPE_CONSEJO))
- End Sub
- Public Sub DisolverParty(ByVal UsuarioIndex As Byte)
- Dim LoopC As Long
- With Parties(UserList(UsuarioIndex).Party.PartyIndex)
- If Not .Lider = UserList(UsuarioIndex).Party.ParticipanteIndex Then Exit Sub
- For LoopC = 1 To MAX_PARTICIPANTES_PARTY
- If .Participantes(LoopC).UsuarioIndex > 0 Then
- Call QuitarParticipante(.Participantes(LoopC).UsuarioIndex)
- End If
- Next LoopC
- .Activa = False
- .Lider = 0
- .CantidadParticipantes = 0
- Erase .Participantes()
- Erase .Solicitudes()
- End With
- End Sub
- Private Function DameSolicitudIndex(ByVal PartyIndex As Byte) As Byte
- Dim LoopC As Long
- With Parties(PartyIndex)
- For LoopC = 1 To MAX_PARTICIPANTES_PARTY
- If .Solicitudes(LoopC) = 0 Then
- DameSolicitudIndex = LoopC
- Exit Function
- End If
- Next LoopC
- End With
- End Function
- Private Function DameParticipanteIndex(ByVal PartyIndex As Byte) As Byte
- Dim LoopC As Long
- With Parties(PartyIndex)
- For LoopC = 1 To MAX_PARTICIPANTES_PARTY
- If .Participantes(LoopC).UsuarioIndex = 0 Then
- DameParticipanteIndex = LoopC
- Exit Function
- End If
- Next LoopC
- End With
- End Function
- Private Function DamePartyIndex() As Byte
- Dim LoopC As Long
- For LoopC = 1 To MAX_PARTIES
- If Parties(LoopC).Activa = False Then
- DamePartyIndex = LoopC
- Exit Function
- End If
- Next LoopC
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement