Plantes Automáticos-Gana sigue (Se liberan cupos)-2 Rounds

Ir abajo

Plantes Automáticos-Gana sigue (Se liberan cupos)-2 Rounds

Mensaje por Toyz el 16/12/2016, 10:54 am


Unos plantes automáticos, el usuario en llegar a la cantidad de plantes ganados solicitados por un GM gana el evento.
Es siempre 1vs1, con ciertas cantidad de victorias máximas el usuario que gana queda en la arena el que pierde se vuelve a su antigua posición y se libera un cupo para que entre otro combatiente, si ese combatiente gana se va el que estaba antes y empieza todo el ciclo de vuelta.

Módulo:

Código:
Option Explicit

'*****************************
'Author: G Toyz
'Fecha: 16/12
'Hora: 03:42 A.M
'*****************************

Private Type tUsuario
    ID As Integer    'ID del usuario.
    Posicion As WorldPos    'Última posición del usuario.
    Ganadas As Byte    'Ganadas llevadas hasta el momento.
    X As Byte    'X Arena.
    Y As Byte    'Y Arena.
    X_Espera As Byte    'X Espera.
    Y_Espera As Byte    'Y Espera
    Muertes As Byte    'Cantidad de veces que murió (Rounds)
End Type

Private Type tPlante
    Activo As Boolean    '¿Está activo?
    Enviar_Activo As Boolean    '¿Se puede enviar solicitudes de ingreso?
    Usuario(1 To 2) As tUsuario    'Usuarios en evento
    Maxima_Ganadas As Byte    'Cantidad máxima de ganadas para terminar el evento
    Objetos As Boolean    '¿Caen items?
    Mapa_Evento As Byte    'Mapa en donde se hace el evento.
    Mapa_Objetos As Byte    'Mapa en donde caen los objetos.
    CuentaRegresiva As Integer    'Cuenta regresiva.
    Oro As Long    'Oro.
    Inscripcion As Long
    Usuarios As Byte    'Usuarios en Evento.
    Ultimo_Usuario As String    'Último usuario que jugó.
    X_Objetos As Byte    'Posición X donde caen los items.
    Y_Objetos As Byte    'Posición Y donde caen los items
    ID_Cupo_Ocupado As Byte    'Numero de cupo ocupado.
    MSJ As String
    Tiempo_Cancelamiento As Integer
    Tiempo_Objetos As Integer
End Type

Private Plante As tPlante

Public Sub Carga()

'@@ Llamada en el Sub MAIN.

    Dim LoopC As Long

    Dim Leer As clsIniReader
    Set Leer = New clsIniReader

    Call Leer.Initialize(App.Path & "\Dat\Plantes.dat")
    With Plante
        .Mapa_Evento = CByte(Leer.GetValue("EVENTO", "Mapa_Evento"))
        .Mapa_Objetos = CByte(Leer.GetValue("EVENTO", "Mapa_Objetos"))
        .X_Objetos = CByte(Leer.GetValue("EVENTO", "X_Objetos"))
        .Y_Objetos = CByte(Leer.GetValue("EVENTO", "Y_Objetos"))
        For LoopC = 1 To 2
            .Usuario(LoopC).X = CByte(Leer.GetValue("USUARIO" & LoopC, "X"))
            .Usuario(LoopC).Y = CByte(Leer.GetValue("USUARIO" & LoopC, "Y"))
            .Usuario(LoopC).X_Espera = CByte(Leer.GetValue("USUARIO" & LoopC, "Espera_X"))
            .Usuario(LoopC).Y_Espera = CByte(Leer.GetValue("USUARIO" & LoopC, "Espera_Y"))
        Next LoopC
    End With
   
End Sub

Public Sub ArmarPlante(ByVal Maxima_Ganadas As Byte, ByVal Objetos As Boolean, ByVal Oro As Long)

'@@ CONDICIONALES.

    If Maxima_Ganadas < 3 Then Maxima_Ganadas = 3
    If Maxima_Ganadas > 5 Then Maxima_Ganadas = 10
    Maxima_Ganadas = 1

    With Plante
        .Oro = Oro
        .Inscripcion = Oro
        .Enviar_Activo = True
        .Activo = True
        .Maxima_Ganadas = Maxima_Ganadas
        .Objetos = Objetos
        .MSJ = PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> Gana sigue, Max: " & Maxima_Ganadas & ". Al mejor de 3 rondas" & IIf(Objetos = True, ". Caen los objetos ", vbNullString) & ". Para participar escriba /PLANTE después del conteo.", FontTypeNames.FONTTYPE_GUILD)
        Call SendData(SendTarget.ToAll, 0, .MSJ)
        .CuentaRegresiva = 5
    End With
   
End Sub

Private Function Dame_ID() As Byte
    With Plante
        If .ID_Cupo_Ocupado = 0 Then
            Dame_ID = 1
            .ID_Cupo_Ocupado = 1
            Exit Function
        End If
        If .ID_Cupo_Ocupado = 1 Then
            Dame_ID = 2
            Exit Function
        End If
        If .ID_Cupo_Ocupado = 2 Then
            Dame_ID = 1
            Exit Function
        End If
    End With
End Function

Private Function ID_Array(ByVal ID As Integer) As Byte
    ID_Array = UserList(ID).flags.EnPlantes
End Function

Public Sub Entrar_Plante(ByVal ID As Integer)

    Dim ID_Array As Byte
    If Puede_Entrar(ID) = False Then Exit Sub
    ID_Array = Dame_ID()
    With Plante
        .Tiempo_Cancelamiento = -1
        .Usuarios = .Usuarios + 1
        .Usuario(ID_Array).ID = ID
        .Usuario(ID_Array).Posicion = UserList(ID).Pos
        UserList(ID).flags.EnPlantes = ID_Array
        UserList(ID).flags.DuracionEfecto = 1
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD - .Inscripcion
        .Oro = .Oro + .Inscripcion
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> " & UserList(ID).name & " entra al evento.", FontTypeNames.FONTTYPE_EJECUCION))
        Call WarpUserChar(ID, .Mapa_Evento, .Usuario(ID_Array).X_Espera, .Usuario(ID_Array).Y_Espera, False)
        If .Usuarios = 2 Then
            Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> Cupo completado.", FontTypeNames.FONTTYPE_EJECUCION))
            Call Empezar_Evento
            .Enviar_Activo = False
            .Activo = True
        End If
    End With
End Sub

Private Sub Empezar_Evento()
    With Plante
        .CuentaRegresiva = 10    'Cuenta regresiva para que peleen
        Dim LoopC As Long
        For LoopC = 1 To 2
            Call WritePauseToggle(.Usuario(LoopC).ID)
        Next LoopC
        Call Llevar_Posiciones
    End With
End Sub

Public Sub Muere_Plante(ByVal ID As Integer)
    With Plante
        Dim uGanador As Byte
        Dim uPerdedor As Byte
        uPerdedor = ID_Array(ID)
        If uPerdedor = 1 Then uGanador = 2
        If uPerdedor = 2 Then uGanador = 1
        .Usuario(uPerdedor).Muertes = .Usuario(uPerdedor).Muertes + 1
        Call RevivirUsuario(ID)
        With UserList(ID)
            .Stats.MinHp = .Stats.MaxHp
            .Stats.MinMAN = .Stats.MaxMAN
            .Stats.MinSta = .Stats.MaxSta
            Call WriteUpdateUserStats(ID)
        End With
        If .Usuario(uPerdedor).Muertes = 2 Then
            If .Objetos = True Then
                Call WarpUserChar(ID, .Mapa_Evento, .X_Objetos, .Y_Objetos, False)
                Call TirarTodosLosItems(ID)
            End If
            .ID_Cupo_Ocupado = uGanador
            Call Echar_Usuario(ID)
            Call Gana_Ronda_Plante(uGanador)
            Exit Sub
        End If
        Call WriteConsoleMsg(ID, "Has perdido la ronda!", FontTypeNames.FONTTYPE_GUILD)
        Call WriteConsoleMsg(.Usuario(uGanador).ID, "Has ganado la ronda!", FontTypeNames.FONTTYPE_GUILD)
        Call Llevar_Posiciones
        .CuentaRegresiva = 10
        Call WritePauseToggle(.Usuario(1).ID)
        Call WritePauseToggle(.Usuario(2).ID)
    End With
End Sub

Private Sub Terminar_Plante(ByVal ID_Array As Byte)

    With Plante
        Dim ID As Integer
        ID = .Usuario(ID_Array).ID
        UserList(ID).Stats.GLD = UserList(ID).Stats.GLD + .Oro
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> Ganador del evento: " & UserList(ID).name, FontTypeNames.FONTTYPE_GUILD))
        Call WriteUpdateGold(ID)
        Call WriteConsoleMsg(ID, "¡Has ganado el evento! ¡Has sido premiado con " & .Oro & " monedas de oro! Felicidades!", FontTypeNames.FONTTYPE_GUILD)
        .Activo = False
        .Enviar_Activo = False
        .CuentaRegresiva = 0
'    .Objetos = False
        .Oro = 0
        .Inscripcion = 0
        .Ultimo_Usuario = vbNullString
        .Maxima_Ganadas = 0
        '.ID_Cupo_Ocupado = 0
        .Usuarios = 0
        If .Objetos = True Then
            Call WarpUserChar(ID, .Mapa_Objetos, .X_Objetos, .Y_Objetos, False)
            Call WriteConsoleMsg(ID, "Tienes 60 segundos para recojer los objetos. Después de eso serás regresado a tu antigua posición.", FontTypeNames.FONTTYPE_GUILD)
            .Tiempo_Objetos = 60
            Exit Sub
        End If
        .Objetos = False
        Llevar_Posicion_Usuario .Usuario(ID_Array).ID
        'Echar_Usuario ID
        Limpiar_Usuario (UserList(ID_Array).ID)
       
        .ID_Cupo_Ocupado = 0
    End With
   
End Sub

Private Sub Llevar_Posiciones()
    With Plante
        Call WarpUserChar(.Usuario(1).ID, .Mapa_Evento, .Usuario(1).X, .Usuario(1).Y, False)
        Call WarpUserChar(.Usuario(2).ID, .Mapa_Evento, .Usuario(2).X, .Usuario(2).Y, False)
    End With
End Sub

Private Sub Llevar_Posicion_Usuario(ByVal ID As Integer)
    Dim Array_ID As Byte
    Array_ID = ID_Array(ID)
    With Plante
        Call WarpUserChar(ID, .Usuario(Array_ID).Posicion.Map, .Usuario(Array_ID).Posicion.X, .Usuario(Array_ID).Posicion.Y, False)
    End With
End Sub

Private Sub Limpiar_Usuario(ByVal ID As Integer)
    Plante.Usuario(UserList(ID).flags.EnPlantes).Ganadas = 0
    Plante.Usuario(UserList(ID).flags.EnPlantes).ID = 0
    Plante.Usuario(UserList(ID).flags.EnPlantes).Muertes = 0
    UserList(ID).flags.EnPlantes = 0
End Sub

Private Sub Echar_Usuario(ByVal ID As Integer)
    Plante.Usuarios = Plante.Usuarios - 1
    Plante.Ultimo_Usuario = UCase$(UserList(ID).name)
    Call Llevar_Posicion_Usuario(ID)
    Call Limpiar_Usuario(ID)
End Sub

Public Sub Contar()
   
    Dim Ganador As Byte
   
    With Plante
        If .CuentaRegresiva = 0 Then
            .CuentaRegresiva = -1
            If .Activo = True And .Enviar_Activo = False Then
                Call WriteConsoleMsg(.Usuario(1).ID, "Conteo> Ya!", FontTypeNames.FONTTYPE_GUILD)
                Call WriteConsoleMsg(.Usuario(2).ID, "Conteo> Ya!", FontTypeNames.FONTTYPE_GUILD)
                Call WritePauseToggle(.Usuario(1).ID)
                Call WritePauseToggle(.Usuario(2).ID)
            End If
            If .Activo = True And .Enviar_Activo = True Then
                Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> Ya!", FontTypeNames.FONTTYPE_EJECUCION))
                .Activo = False
            End If

        End If
        If .CuentaRegresiva > 0 Then
            If .Activo = True And .Enviar_Activo = False Then
                Call WriteConsoleMsg(.Usuario(1).ID, "Conteo> " & .CuentaRegresiva, FontTypeNames.FONTTYPE_GUILD)
                Call WriteConsoleMsg(.Usuario(2).ID, "Conteo> " & .CuentaRegresiva, FontTypeNames.FONTTYPE_GUILD)
            End If
            If .Activo = True And .Enviar_Activo = True Then _
              Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> " & .CuentaRegresiva, FontTypeNames.FONTTYPE_GUILD))
            .CuentaRegresiva = .CuentaRegresiva - 1
        End If
       
        If .Tiempo_Cancelamiento = 0 Then
            .Tiempo_Cancelamiento = -1
            If .Activo = False And .Enviar_Activo = True Then
                Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> Debido a que nadie se animó a plantar contra " & UserList(.ID_Cupo_Ocupado).name & " durante 3 minutos, hemos decidido que él es el triunfador del evento. ¡Felicidades!", FontTypeNames.FONTTYPE_GUILD))
                Call Terminar_Plante(.ID_Cupo_Ocupado)
            End If
        End If
       
        If .Tiempo_Cancelamiento > 0 Then
            .Tiempo_Cancelamiento = .Tiempo_Cancelamiento - 1
        End If

        If .Tiempo_Objetos = 0 Then
            .Tiempo_Objetos = -1
            If .Activo = False And .Enviar_Activo = False And .ID_Cupo_Ocupado > 0 Then
                Call Llevar_Posicion_Usuario(.Usuario(.ID_Cupo_Ocupado).ID)
                Call Limpiar_Usuario(.Usuario(.ID_Cupo_Ocupado).ID)
                .ID_Cupo_Ocupado = 0
                .Objetos = False
            End If
        End If

        If .Tiempo_Objetos > 0 Then
            .Tiempo_Objetos = .Tiempo_Objetos - 1
        End If
    End With
End Sub

Public Sub Desconexion_Usuario_Plante(ByVal ID As Integer)
    Dim uGanador As Byte
    Dim IDArray As Byte
    If UserList(ID).flags.EnPlantes = 0 Then Exit Sub
    If Plante.Objetos = True Then
        Call WarpUserChar(ID, Plante.Mapa_Objetos, Plante.X_Objetos, Plante.Y_Objetos, False)
        Call TirarTodosLosItems(ID)
    End If
    IDArray = UserList(ID).flags.EnPlantes
    UserList(ID).Stats.GLD = UserList(ID).Stats.GLD - 500000    '@@ Penalización
    Plante.Oro = Plante.Oro + 500000
    Call WriteUpdateGold(ID)
    Call Echar_Usuario(ID)
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> " & UserList(ID).name & " ha abandonado el evento, ha sido penalizado con un quite de 500.000 monedas de oro (se agrega al premio) y 11 minutos en cárcel. ", FontTypeNames.FONTTYPE_GUILD))
    If IDArray = 1 Then uGanador = 2
    If IDArray = 2 Then uGanador = 1
    If Plante.Usuario(uGanador).ID > 0 Then
        If Plante.CuentaRegresiva > 0 Then
            Call WritePauseToggle(Plante.Usuario(uGanador).ID)
            Plante.CuentaRegresiva = -1
        End If
        Call Gana_Ronda_Plante(uGanador)
    End If
End Sub

Private Sub Gana_Ronda_Plante(ByVal uGanador As Byte)
    With Plante
        .Usuario(uGanador).Ganadas = .Usuario(uGanador).Ganadas + 1
        Call WarpUserChar(.Usuario(uGanador).ID, .Mapa_Evento, .Usuario(uGanador).X_Espera, .Usuario(uGanador).Y_Espera, False)
        Call WriteConsoleMsg(.Usuario(uGanador).ID, "¡Has ganado el combate!, nuevamente estás en la sala de espera.", FontTypeNames.FONTTYPE_GUILD)
        If .Usuario(uGanador).Ganadas = .Maxima_Ganadas Then
          Call Terminar_Plante(uGanador)
          Exit Sub
        End If
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Plantes Automáticos [1vs1]> " & UserList(.Usuario(uGanador).ID).name & " acumula su " & .Usuario(uGanador).Ganadas & " Victoria. Mandar luego del conteo.", FontTypeNames.FONTTYPE_FIGHT))
        Call SendData(SendTarget.ToAll, 0, .MSJ)
        .Enviar_Activo = True
        .CuentaRegresiva = 5
        .Tiempo_Cancelamiento = 185
    End With
End Sub

Private Function Puede_Entrar(ByVal UserIndex As Integer) As Boolean
    Puede_Entrar = False

    With UserList(UserIndex)

        If Plante.Enviar_Activo = False And Plante.Activo = False Then
            WriteConsoleMsg UserIndex, "El evento no está en disputa.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If Plante.Enviar_Activo = False Then
            WriteConsoleMsg UserIndex, "No hay cupos disponibles.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If Plante.Activo = True And Plante.Enviar_Activo = True Then
            WriteConsoleMsg UserIndex, "¡No hay cupos disponibles.!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If Not .Pos.Map = 1 Then
            WriteConsoleMsg UserIndex, "Tienes que estar en Ullathorpe para poder ingresar al evento.", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If .flags.Muerto <> 0 Then
            WriteConsoleMsg UserIndex, "Estás muerto", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If .Stats.GLD < Plante.Inscripcion Then
            WriteConsoleMsg UserIndex, "No tenés suficiente oro", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If UCase$(UserList(UserIndex).name) = Plante.Ultimo_Usuario Then
            WriteConsoleMsg UserIndex, "Debes esperar una ronda más para poder jugar nuevamente.", FontTypeNames.FONTTYPE_INFO
            'Exit Function
        End If

        If .Counters.Pena > 0 Then
            WriteConsoleMsg UserIndex, "¡Estás en la cárcel!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If

        If UserList(UserIndex).flags.EnDeathmatch Then
            WriteConsoleMsg UserIndex, "¡Estás en Deathmatch!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
       
        If UserList(UserIndex).flags.EnJDH Then
            WriteConsoleMsg UserIndex, "¡Estás en los Juegos del Hambre!", FontTypeNames.FONTTYPE_INFO
            Exit Function
        End If
    End With

    Puede_Entrar = True
End Function


_______________

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


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