Ranking.

Ir abajo

Ranking.

Mensaje por Toyz el 16/12/2016, 9:08 pm

Esto es de GS-Zone, me tomé el tiempo de implementarlo y ver si era funcional y toda la cosa. En fin, es funcional sólo tenía algún que otro error como no guardar los nombres en mayúscula para poder hacer la comparación, pero nada más.

Aporte:
http://www.gs-zone.org/temas/ranking-top10-frags-oro-retos-torneos-clanes.95820/

Módulo nuevo:
Código:
Option Explicit
 
Public Const MAX_TOP As Byte = 10
Public Const MAX_RANKINGS As Byte = 6
 
Public Type tRanking
    Value(1 To MAX_TOP) As Long
    Nombre(1 To MAX_TOP) As String
End Type
 
Public Ranking(1 To MAX_RANKINGS) As tRanking
 
Public Enum eRanking
    TopFrags = 1
    TopLevel = 2
    TopOro = 3
    TopRetos = 4
End Enum
 
 
 
Public Function RenameRanking(ByVal Ranking As eRanking) As String
 
    '@ Devolvemos el nombre del TAG [] del archivo .DAT
    Select Case Ranking
        Case eRanking.TopFrags
            RenameRanking = "FRAGS"
        Case eRanking.TopLevel
            RenameRanking = "NIVEL"
        Case eRanking.TopOro
            RenameRanking = "ORO"
        Case eRanking.TopRetos
            RenameRanking = "RETOS"
        Case Else
            RenameRanking = vbNullString
    End Select
End Function
Public Function RenameValue(ByVal UserIndex As Integer, ByVal Ranking As eRanking) As Long

    ' @ Devolvemos a que hace referencia el ranking
    With UserList(UserIndex)
        Select Case Ranking
            Case eRanking.TopFrags
                RenameValue = .Stats.UsuariosMatados
            Case eRanking.TopLevel
                RenameValue = .Stats.ELV
            Case eRanking.TopOro
                RenameValue = .Stats.GLD
            Case eRanking.TopRetos
                RenameValue = 0
        End Select
    End With
End Function
 
Public Sub LoadRanking()
    ' @ Cargamos los rankings
 
    Dim LoopI As Integer
    Dim loopX As Integer
    Dim ln As String
 
    For loopX = 1 To MAX_RANKINGS
        For LoopI = 1 To MAX_TOP
            ln = GetVar(App.Path & "\Dat\" & "Ranking.dat", RenameRanking(loopX), "Top" & LoopI)
            Ranking(loopX).Nombre(LoopI) = ReadField(1, ln, 45)
            Ranking(loopX).Value(LoopI) = val(ReadField(2, ln, 45))
        Next LoopI
    Next loopX
 
End Sub
 
Public Sub SaveRanking(ByVal Rank As eRanking)
' @ Guardamos el ranking
    Dim LoopI As Integer
 
        For LoopI = 1 To MAX_TOP
            Call WriteVar(DatPath & "Ranking.dat", RenameRanking(Rank), _
                "Top" & LoopI, Ranking(Rank).Nombre(LoopI) & "-" & Ranking(Rank).Value(LoopI))
        Next LoopI
End Sub
 
Public Sub CheckRankingUser(ByVal UserIndex As Integer, ByVal Rank As eRanking)

    Dim loopX As Integer
    Dim LoopY As Integer
    Dim loopZ As Integer
    Dim i As Integer
    Dim Value As Long
    Dim Actualizacion As Byte
    Dim Auxiliar As String
    Dim PosRanking As Byte
    Dim NameUser As String

    With UserList(UserIndex)
        NameUser = UCase$(.name)
        ' @ Not gms
        If EsGM(UserIndex) Then Exit Sub
     
        Value = RenameValue(UserIndex, Rank)
     
        ' @ Buscamos al personaje en el ranking
        For i = 1 To MAX_TOP
            If Ranking(Rank).Nombre(i) = NameUser Then
                PosRanking = i
                Exit For
            End If
        Next i
     
        ' @ Si el personaje esta en el ranking actualizamos los valores.
        If PosRanking <> 0 Then
            ' ¿Si está actualizado pa que?
            If Value <> Ranking(Rank).Value(PosRanking) Then
                Call ActualizarPosRanking(PosRanking, Rank, NameUser, Value)
                 
                ' @ Chequeamos los datos para actualizar el ranking
                For LoopY = 1 To MAX_TOP
                    For loopZ = 1 To MAX_TOP - LoopY
                         
                        If Ranking(Rank).Value(loopZ) < Ranking(Rank).Value(loopZ + 1) Then
                            Auxiliar = Ranking(Rank).Value(loopZ)
                            Ranking(Rank).Value(loopZ) = Ranking(Rank).Value(loopZ + 1)
                            Ranking(Rank).Value(loopZ + 1) = Auxiliar
                            Actualizacion = 1
                        End If
                    Next loopZ
                Next LoopY
                 
              If Actualizacion <> 0 Then
                    Call SaveRanking(Rank)
                End If
            End If
         
            Exit Sub
        End If
     
        ' @ Nos fijamos si podemos ingresar al ranking
        For loopX = 1 To MAX_TOP
            If Value > Ranking(Rank).Value(loopX) Then
                Call ActualizarRanking(loopX, Rank, NameUser, Value)
                Exit For
            End If
        Next loopX
     
    End With
End Sub
 
Public Sub ActualizarPosRanking(ByVal Top As Byte, ByVal Rank As eRanking, ByVal UserName As String, ByVal Value As Long)
    ' @ Actualizamos la pos indicada en caso de que el personaje esté en el ranking
    Dim loopX As Integer
 
    With Ranking(Rank)
        .Value(Top) = Value
        .Nombre(Top) = UserName
    End With
End Sub
Public Sub ActualizarRanking(ByVal Top As Byte, ByVal Rank As eRanking, ByVal UserName As String, ByVal Value As Long)
 
    '@ Actualizamos la lista de ranking
 
    Dim LoopC As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Valor(1 To MAX_TOP) As Long
    Dim Nombre(1 To MAX_TOP) As String
 
    ' @ Copia necesaria para evitar que se dupliquen repetidamente
    For LoopC = 1 To MAX_TOP
        Valor(LoopC) = Ranking(Rank).Value(LoopC)
        Nombre(LoopC) = Ranking(Rank).Nombre(LoopC)
    Next LoopC
 
    ' @ Corremos las pos, desde el "Top" que es la primera
    For LoopC = Top To MAX_TOP - 1
        Ranking(Rank).Value(LoopC + 1) = Valor(LoopC)
        Ranking(Rank).Nombre(LoopC + 1) = Nombre(LoopC)
    Next LoopC
 
    Ranking(Rank).Nombre(Top) = UserName
    Ranking(Rank).Value(Top) = Value
    Call SaveRanking(Rank)
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Ranking de " & RenameRanking(Rank) & "»" & UserName & " ha subido al TOP " & Top & ".", FontTypeNames.FONTTYPE_GUILD))
End Sub



_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

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

Ver perfil de usuario

Volver arriba Ir abajo

Volver arriba

- Temas similares

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