Juegos del Hambre.

Ir abajo

Juegos del Hambre.

Mensaje por Toyz el 14/12/2016, 10:08 am

Les dejo este evento automático Juegos del Hambre Razz

Me tomó unas 2 horas hacerlo, espero que le den uso.

VIDEO:



Código:
Option Explicit

 '***************
 'AUTOR: Toyz - Luciano
 'FECHA: 14/12/16 - 07:30
 '***************
Private Const Tiempo_Cancelamiento As Integer = 180
Private Const Cofre_Abierto As Integer = 10 'Número de cofre abierto.
Private Const Cofre_Cerrado As Integer = 11 'Número de cofre cerrado.

Private Type tUsuario
    ID As Integer
    Posicion As WorldPos
    X As Byte
    Y As Byte
End Type

Private Type tCofres
    Objetos(1 To 6) As Obj
    X As Byte
    Y As Byte
    Abierto As Boolean
End Type

Private Type tJDH
    Activo As Boolean
    Usuarios(1 To 3) As tUsuario
    Cofres(1 To 9) As tCofres
    Conteo As Integer
    Cupos As Byte
    mapa As Integer
    Premio As Long
    Inscripcion As Long
    Total As Byte
    Restantes As Byte
End Type

Private JDH As tJDH

Public Sub Carga_JDH()
    Dim LoopC As Long
    Dim loopX As Long
    Dim LoopZ As Long
    Dim DataCofre As Obj
    
    DataCofre.Amount = 1
    DataCofre.ObjIndex = Cofre_Cerrado
    
    Dim Leer As clsIniReader
    Set Leer = New clsIniReader
    Call Leer.Initialize(App.Path & "\Dat\JuegosDelHambre.dat")
    
    With JDH
        .Cupos = UBound(.Usuarios())
        .mapa = CInt(Leer.GetValue("EVENTO", "Mapa"))
        For LoopC = 1 To .Cupos
            .Usuarios(LoopC).X = CByte(Leer.GetValue("USUARIO#" & LoopC, "X"))
            .Usuarios(LoopC).Y = CByte(Leer.GetValue("USUARIO#" & LoopC, "Y"))
        Next LoopC
        For loopX = 1 To UBound(.Cofres())
            .Cofres(loopX).X = CByte(Leer.GetValue("COFRE#" & loopX, "X"))
            .Cofres(loopX).Y = CByte(Leer.GetValue("COFRE#" & loopX, "Y"))
            MakeObj DataCofre, .mapa, .Cofres(loopX).X, .Cofres(loopX).Y
            MapData(.mapa, .Cofres(loopX).X, .Cofres(loopX).Y).Blocked = 1
            MapData(.mapa, .Cofres(loopX).X, .Cofres(loopX).Y).Cofre = loopX
            Bloquear True, .mapa, .Cofres(loopX).X, .Cofres(loopX).Y, 1
            For LoopZ = 1 To UBound(.Cofres(loopX).Objetos())
                .Cofres(loopX).Objetos(LoopZ).ObjIndex = CByte(ReadField(1, (Leer.GetValue("COFRE#" & loopX, "OBJETO#" & LoopZ)), 45))
                .Cofres(loopX).Objetos(LoopZ).Amount = CByte(ReadField(2, (Leer.GetValue("COFRE#" & loopX, "OBJETO#" & LoopZ)), 45))
            Next LoopZ
        Next loopX
    End With
End Sub

Public Sub Armar_JDH(ByVal ID As Integer, ByVal Premio As Long, ByVal Inscripcion As Long)
    With JDH
        If .Activo = True Then
            Call WriteConsoleMsg(ID, "Juegos del Hambre> El evento ya está en curso.", FontTypeNames.FONTTYPE_GUILD)
            Exit Sub
        End If
        .Inscripcion = Inscripcion
        .Premio = Premio
        .Total = .Cupos
        .Restantes = .Total
        .Activo = True
        .Conteo = Tiempo_Cancelamiento
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> " & .Cupos & " Cupos, Incripción" & IIf(.Inscripcion > 0, " de: " & .Inscripcion & " Monedas de oro, ", " Gratis, ") & IIf(.Premio > 0, "Premio de: " & .Premio & " Monedas de oro.", " No hay premio.") & " Manden /JDH si desean participar, deben tener el inventario completamente vacío.", FontTypeNames.FONTTYPE_GUILD))
    End With
End Sub

Public Sub Entrar_JDH(ByVal ID As Integer)
    Dim ID_JDH As Byte
    With JDH
        If Puede_Entrar(ID) = False Then Exit Sub
        Call WriteConsoleMsg(ID, "Has ingresado al evento" & IIf(.Inscripcion > 0, ", se te han descontado " & .Inscripcion & " monedas de oro.", vbNullString) & ". Espera a que el cupo se complete. ¡Suerte en el campo de batalla!", FontTypeNames.FONTTYPE_GUILD)
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD - .Inscripcion
        .Cupos = .Cupos - 1
        ID_JDH = JDH_ID
        UserList(ID).flags.EnJDH = ID_JDH
        .Usuarios(ID_JDH).ID = ID
        .Usuarios(ID_JDH).Posicion = UserList(ID).Pos
        WarpUserChar ID, .mapa, .Usuarios(ID_JDH).X, .Usuarios(ID_JDH).Y, False
        WritePauseToggle ID
        WriteUpdateGold ID
        If .Cupos = 0 Then
             Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> El cupo ha sido completado!", FontTypeNames.FONTTYPE_GUILD))
            .Conteo = 10
        End If
    End With
End Sub

Private Function JDH_ID() As Byte
    Dim LoopC As Long
    With JDH
        For LoopC = 1 To .Total
            If .Usuarios(LoopC).ID = 0 Then
                JDH_ID = LoopC
                Exit Function
            End If
        Next LoopC
    End With
End Function

Private Function Puede_Entrar(ByVal ID As Integer) As Boolean
    Puede_Entrar = False
    If UserList(ID).flags.Muerto > 0 Then
        Call WriteConsoleMsg(ID, "Estás muerto.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).flags.EnDeathmatch > 0 Then
        Call WriteConsoleMsg(ID, "Ya estás en Deathmatch.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).flags.EnJDH > 0 Then
        Call WriteConsoleMsg(ID, "Ya estás en los Juegos del Hambre.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If JDH.Activo = False Then
        Call WriteConsoleMsg(ID, "El evento no está en curso.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If JDH.Cupos = 0 Then
        Call WriteConsoleMsg(ID, "El evento ya no tiene cupos disponibles.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If UserList(ID).Stats.GLD < JDH.Inscripcion Then
        Call WriteConsoleMsg(ID, "No tienes el oro suficiente.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If Not UserList(ID).Pos.Map = 1 Then
        Call WriteConsoleMsg(ID, "Tienes que estar en Ullathorpe para poder ingresar al evento", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    If Tiene_Objeto(ID) = False Then
        Call WriteConsoleMsg(ID, "Debes tener el inventario vacío para poder entrar.", FontTypeNames.FONTTYPE_GUILD)
        Exit Function
    End If
    Puede_Entrar = True
End Function

Public Sub Contar_JDH()
    Dim LoopC As Long
    Dim loopX As Long
    With JDH
        If .Conteo = 0 Then
            .Conteo = -1
            If .Activo = True Then
                For LoopC = 1 To .Total
                        WritePauseToggle .Usuarios(LoopC).ID
                Next LoopC
                If .Cupos = 0 Then
                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> Ya!", FontTypeNames.FONTTYPE_FIGHT)
                Else
                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> Evento cancelado por falta de participantes, se ha devuelto el oro por la inscripción.", FontTypeNames.FONTTYPE_GUILD)
                    Cancelar_JDH
                End If
            End If
        End If
        
        If .Conteo > 0 Then
            If .Cupos = 0 Then _
                SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> " & .Conteo, FontTypeNames.FONTTYPE_GUILD)
            .Conteo = .Conteo - 1
        End If
    End With
End Sub

Private Function ID_Usuario() As Byte
    Dim LoopC As Long
    For LoopC = 1 To JDH.Total
            If JDH.Usuarios(LoopC).ID > 0 Then
                ID_Usuario = LoopC
                Exit For
            End If
    Next LoopC
End Function

Public Sub Muere_JDH(ByVal ID As Integer)
    Dim ID_JDH As Byte
    ID_JDH = UserList(ID).flags.EnJDH
    If ID_JDH = 0 Then Exit Sub
    UserList(ID).flags.EnJDH = 0
    With JDH
        .Restantes = .Restantes - 1
        If .Restantes > 1 Then SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> Quedan " & .Restantes & " luchadores.", FontTypeNames.FONTTYPE_GUILD)
        Call WriteConsoleMsg(ID, "Juegos del Hambre> ¡Has perdido, has sido descalificado. ¡Suerte para la próxima!", FontTypeNames.FONTTYPE_GUILD)
        WarpUserChar ID, .Usuarios(ID_JDH).Posicion.Map, .Usuarios(ID_JDH).Posicion.X, .Usuarios(ID_JDH).Posicion.Y, False
        .Usuarios(ID_JDH).ID = 0
        If .Restantes = 1 Then Finalizar
    End With
End Sub

Private Sub Finalizar()
    Dim LoopC As Long
    Dim Dame_ID As Byte
    Dim ID As Integer
    With JDH
        Dame_ID = ID_Usuario
        ID = .Usuarios(Dame_ID).ID
        SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> Ganador del evento: " & UserList(ID).name & " se lleva una cantidad de " & .Premio & " monedas de oro, felicitaciones!", FontTypeNames.FONTTYPE_GUILD)
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD + .Premio
        WriteUpdateGold ID
        UserList(ID).flags.EnJDH = 0
        .Premio = 0
        WarpUserChar ID, .Usuarios(Dame_ID).Posicion.Map, .Usuarios(Dame_ID).Posicion.X, .Usuarios(Dame_ID).Posicion.Y, False
        Limpiar
    End With
End Sub

Public Sub Cancelar_JDH()
    Dim LoopC As Long
    With JDH
        If .Activo = False Then Exit Sub
        For LoopC = 1 To .Total
            If .Usuarios(LoopC).ID > 0 Then
                WarpUserChar .Usuarios(LoopC).ID, .Usuarios(LoopC).Posicion.Map, .Usuarios(LoopC).Posicion.X, .Usuarios(LoopC).Posicion.Y, False
                UserList(.Usuarios(LoopC).ID).flags.EnJDH = 0
                UserList(.Usuarios(LoopC).ID).Stats.GLD = UserList(.Usuarios(LoopC).ID).Stats.GLD + .Inscripcion
                WriteConsoleMsg .Usuarios(LoopC).ID, "El evento ha sido cancelado, se te ha devuelto el costo de la inscripción.", FontTypeNames.FONTTYPE_GUILD
                WriteUpdateGold .Usuarios(LoopC).ID
            End If
        Next LoopC
    End With
    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Juegos del Hambre> Evento cancelado por un Game Master.", FontTypeNames.FONTTYPE_GUILD)
    Limpiar
End Sub

Public Sub Desconexion_JDH(ByVal ID As Integer)
    If UserList(ID).flags.EnJDH = 0 Then Exit Sub
    With JDH
        TirarTodosLosItems ID
        WarpUserChar ID, .Usuarios(UserList(ID).flags.EnJDH).Posicion.Map, .Usuarios(UserList(ID).flags.EnJDH).Posicion.X, .Usuarios(UserList(ID).flags.EnJDH).Posicion.Y, True
        .Usuarios(UserList(ID).flags.EnJDH).ID = 0
        UserList(ID).flags.EnJDH = 0
        .Cupos = .Cupos + 1
        WritePauseToggle ID
    End With
End Sub

Private Sub Limpiar()
    Dim LoopC As Long
    With JDH
        .Activo = False
        .Conteo = -1
        .Cupos = UBound(.Usuarios())
        .Inscripcion = 0
        .Premio = 0
        .Restantes = 0
        .Total = 0
        For LoopC = 1 To .Total
            .Usuarios(LoopC).ID = 0
        Next LoopC
        ReCargar_Cofres
    End With
End Sub

Private Function Tiene_Objeto(ByVal ID As Integer) As Boolean
    Dim LoopC As Long
    Tiene_Objeto = False
    With UserList(ID)
        For LoopC = 1 To .CurrentInventorySlots
            If .Invent.Object(LoopC).ObjIndex > 0 Then Exit Function
        Next LoopC
        Tiene_Objeto = True
    End With
End Function

Public Sub Clickea_Cofre(ByRef Pos As WorldPos)
    Dim ID As Byte
    Dim DataCofre As Obj
    Dim LoopC As Long
    Dim n_Pos As WorldPos
    
    DataCofre.Amount = 1
    DataCofre.ObjIndex = Cofre_Abierto
    ID = MapData(Pos.Map, Pos.X, Pos.Y).Cofre
    
    With JDH
        If ID = 0 Then Exit Sub
        If .Cupos > 0 Then Exit Sub
        If .Activo = False Then Exit Sub
        If .Cofres(ID).Abierto = True Then Exit Sub
        If .Conteo <> -1 Then Exit Sub
        
        .Cofres(ID).Abierto = True
        
        EraseObj MapData(Pos.Map, Pos.X, Pos.Y).ObjInfo.Amount, Pos.Map, Pos.X, Pos.Y
        MakeObj DataCofre, .mapa, .Cofres(ID).X, .Cofres(ID).Y
        
        For LoopC = 1 To UBound(.Cofres(ID).Objetos())
            Tilelibre Pos, n_Pos, .Cofres(ID).Objetos(LoopC), False, True
            MakeObj .Cofres(ID).Objetos(LoopC), .mapa, n_Pos.X, n_Pos.Y
        Next LoopC
    End With
End Sub

Private Sub ReCargar_Cofres()
    Dim DataCofre As Obj
    Dim LoopC As Long

    DataCofre.Amount = 1
    DataCofre.ObjIndex = Cofre_Cerrado
    
    With JDH
        For LoopC = 1 To UBound(.Cofres())
            .Cofres(LoopC).Abierto = False
            EraseObj DataCofre.Amount, .mapa, .Cofres(LoopC).X, .Cofres(LoopC).Y
            MakeObj DataCofre, .mapa, .Cofres(LoopC).X, .Cofres(LoopC).Y
        Next LoopC
    End With
    Call m_Limpieza.CleanWorld_Clear
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

Re: Juegos del Hambre.

Mensaje por zerocx el 14/12/2016, 8:29 pm

Buen evento, le faltan putas, pero buen evento.
avatar
zerocx
Nivel 2
Nivel 2

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 43
Edad : 28
Localización : Buenos Aires
Fecha de inscripción : 23/10/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Juegos del Hambre.

Mensaje por Toyz el 14/12/2016, 8:31 pm

JAJJA, vos sabés cómo. Friend friend, dll.

Me olvidé de aclarar algo:

Para poder implementar este código deberán tener conocimiento básico sobre:
Protocolo binario.
Crear variables.
Hacer llamadas.
Crear métodos.
Leer todo el módulo.


_______________

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

Re: Juegos del Hambre.

Mensaje por Metrosersuah el 14/12/2016, 10:02 pm

Está todo bien :O
Voy a utilizarlo en Darklands, voy a modificarlo totalmente, gracias por el aporte.
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 237
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Re: Juegos del Hambre.

Mensaje por Toyz el 14/12/2016, 10:02 pm

Buenísimo, es bueno ver que gente le da uso Razz


_______________

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

Re: Juegos del Hambre.

Mensaje por ignacio2018 el 18/2/2018, 5:17 pm

Deja el Formulario por lo menos

ignacio2018
Nivel 1
Nivel 1

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 1
Localización : EN MI CASA
Fecha de inscripción : 30/11/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: Juegos del Hambre.

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

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