ÍndiceCalendarioIndiceFAQBuscarMiembrosGrupos de UsuariosRegistrarseConectarseReglamento
¿Quién está en línea?
En total hay 1 usuario en línea: 0 Registrados, 0 Ocultos y 1 Invitado

Ninguno

La mayor cantidad de usuarios en línea fue 16 el Miér Ago 07, 2013 8:12 pm.
Mejores posteadores
Rango
 
Habauc
 
Trogclodita
 
WhoTeR
 
Tomm-
 
ZankuR
 
GM-PekeMixz
 
LuciMoyo
 
MwM
 
Diclut s2 Lalaa♥
 
Estadísticas
Tenemos 97 miembros registrados.
El último usuario registrado es PekeMixzGamer1

Nuestros miembros han publicado un total de 1289 mensajes en 264 argumentos.

Comparte | 
 

 Eventos Automaticos x.13

Ir abajo 
AutorMensaje
ZankuR
Director
Director
avatar

Cantidad de envíos : 107
Fecha de inscripción : 19/07/2013

MensajeTema: Eventos Automaticos x.13   Dom Ago 11, 2013 5:15 pm

Evento - Rey vs Rey, base.

bueno para los qe jugaron bender ao capas que ya saben como es , igual lo explico cortito.

Son 2 equipos , en los cuales, cuando el evento se inicia, se elige (al azar) un rey para cada equipo, y cada jugador de cada equipo es transportado a su base, bueno y quien mata al rey primero seria el ganador, cuando morís a los 3 segundos sos revivido y transportado a tu base, acá les dejo el módulo.


Código:
Option Explicit
 
Type tEquiposRey
     UserIndex()      As Integer
     Rey              As Integer
     CContados        As Byte
End Type
 
Public Type Rey
     Equipo1        As tEquiposRey
     Equipo2        As tEquiposRey
     Cupos          As Byte
     CuentaCupos    As Byte
     Hay            As Boolean
     Cerrado        As Boolean
End Type
 
Public Type uREY
     iRey            As Byte
     EsperaRevivir   As Byte
     iEvento         As Boolean
End Type
 
Public sRey As Rey
 
'CONSTANTES
 
Public Const MAPA_REY As Integer = 190
 
Public Const TEAM1_X  As Byte = 50
Public Const TEAM1_Y  As Byte = 50
Public Const TEAM2_X  As Byte = 50
Public Const TEAM2_Y  As Byte = 50
 
 
Public Sub REY_START(ByVal Cupos As Byte)
 
' \ Author   :  maTih.-
' \ Note     :  Iniciamos el evento
 
Dim sCupos  As Byte
 
sCupos = (Cupos / 2)
 
With sRey
.Cupos = Cupos
.CuentaCupos = 0
.Equipo1.CContados = 0
.Equipo2.CContados = 0
.Equipo1.Rey = 0
.Equipo2.Rey = 0
 
ReDim .Equipo1.UserIndex(1 To sCupos) As Integer
ReDim .Equipo2.UserIndex(1 To sCupos) As Integer
 
End With
 
End Sub
 
Public Sub REY_GO()
 
' \ Author   :  maTih.-
' \ Note     :  Mandamos a peliar
 
Dim LoopC     As Long
 
With sRey
 
'RANDOMIZE REYS
 
.Equipo1.Rey = REY_DameRey(1)
.Equipo2.Rey = REY_DameRey(2)
 
'MENSAJE DE CONSOLA
 
SendData SendTarget.toMap, MAPA_REY, PrepareMessageConsoleMsg("El REY Del equipo 1 es : " & UserList(.Equipo1.Rey).name & " y el del equipo 2 es : " & UserList(.Equipo2.Rey).name & " que empieze la masacre!", FontTypeNames.FONTTYPE_GUILD)
 
'CERRAMOS PARA QUE NO ENTRE MÁS GENTE
 
.Cerrado = True
 
'vamos desde LBOUND to UBOUND
 
For LoopC = LBound(.Equipo1.UserIndex()) To UBound(.Equipo2.UserIndex())
 
    'ID VALIDA?
    If UserList(.Equipo1.UserIndex(LoopC)).ConnID <> -1 Then
  
    'WARP A LA BASE
  
    WarpUserChar .Equipo1.UserIndex(LoopC), MAPA_REY, TEAM1_X + LoopC, TEAM1_Y + LoopC, True
  
    'FLAGS
  
    UserList(.Equipo1.UserIndex(LoopC)).reyUser.iRey = 1
    UserList(.Equipo2.UserIndex(LoopC)).reyUser.iEvento = True
  
    End If
  
    'ID VALIDA?
    If UserList(.Equipo2.UserIndex(LoopC)).ConnID <> -1 Then
  
    'WARP A LA BASE
  
    WarpUserChar .Equipo2.UserIndex(LoopC), MAPA_REY, TEAM2_X + LoopC, TEAM2_Y + LoopC, True
  
    'FLAGS
  
    UserList(.Equipo2.UserIndex(LoopC)).reyUser.iRey = 2
    UserList(.Equipo2.UserIndex(LoopC)).reyUser.iEvento = True
  
    End If
  
Next LoopC
 
End With
 
End Sub
 
Public Sub REY_MensajeTeams(ByVal TeamRey As Byte, ByVal MENSAJE As String)
 
' \ Author   :  maTih.-
' \ Note     :  Envia un mensaje al teamRey
 
Dim LoopC  As Long
 
'MANEJAMOS TEAM1 O TEAM2
 
If TeamRey = 1 Then
 
'1 TO UBOUND USERINDEXS
 
For LoopC = 1 To UBound(sRey.Equipo1.UserIndex())
    If UserList(sRey.Equipo1.UserIndex(LoopC)).ConnID <> -1 Then
  
    WriteConsoleMsg sRey.Equipo1.UserIndex(LoopC), MENSAJE, FontTypeNames.FONTTYPE_CITIZEN
  
    End If
Next LoopC
 
Else
 
For LoopC = 1 To UBound(sRey.Equipo2.UserIndex())
    If UserList(sRey.Equipo2.UserIndex(LoopC)).ConnID <> -1 Then
  
    WriteConsoleMsg sRey.Equipo2.UserIndex(LoopC), MENSAJE, FontTypeNames.FONTTYPE_CITIZEN
  
    End If
Next LoopC
 
End If
 
End Sub
 
Public Sub REY_MuereIndex(ByVal UserMuerto As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  Controla las muertes de los usuarios
 
With UserList(UserMuerto)
 
If REY_UserEsRey(UserMuerto, .reyUser.iRey) Then
 
REY_Finish TeamWinner
 
Exit Sub
 
End If
 
.reyUser.EsperaRevivir = 3
 
End With
 
End Sub
 
Public Sub REY_SegundoRevivirUsuario(ByVal UserIndex As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  Segundos (3) para revivir el usuario cuando muere.
 
With UserList(UserIndex).reyUser
 
Dim XPos As Byte
Dim YPos As Byte
 
XPos = IIf(.iRey = 1, TEAM1_X, TEAM1_Y)
YPos = IIf(.iRey = 1, TEAM2_X, TEAM2_Y)
 
.EsperaRevivir = .EsperaRevivir - 1
 
If .EsperaRevivir <= 0 Then
 
.EsperaRevivir = 0
 
RevivirUsuario UserIndex
 
WarpUserChar UserIndex, MAPA_REY, XPos, YPos, True
 
End If
 
End With
 
End Sub
 
Public Sub REY_DisconnectUser(ByVal UserDis As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  Controla las muertes de los usuarios
 
With UserList(UserDis)
 
WarpUserChar UserDis, 1, 58, 45, True
 
REY_MensajeTeams .reyUser.iRey, .name & " Se ha desconectado."
 
End With
 
End Sub
 
Public Sub REY_Finish(ByVal TeamWinner As Byte)
 
' \ Author   :  maTih.-
' \ Note     :  Termina el evento y lleva a todos a su casa
 
Dim LoopC     As Long
 
With sRey.Equipo1
 
For LoopC = LBound(.UserIndex()) To UBound(.UserIndex())
  
    'ID VALIDA?
  
    If UserList(.UserIndex(LoopC)).ConnID <> -1 Then
  
    WarpUserChar .UserIndex(LoopC), 1, 68 + LoopC, 45 + LoopC, True
  
    WriteConsoleMsg .UserIndex(LoopC), "El evento ha finalizado, ah ganado el equipo " & TeamWinner, FontTypeNames.FONTTYPE_GUILD
      
    End If
  
Next LoopC
 
End With
 
With sRey.Equipo2
  
For LoopC = LBound(.UserIndex()) To UBound(.UserIndex())
 
    'ID VALIDA?
    
    If UserList(.UserIndex(LoopC)).ConnID <> -1 Then
  
    WarpUserChar .UserIndex(LoopC), 1, 58 + LoopC, 45 + LoopC, True
  
    WriteConsoleMsg .UserIndex(LoopC), "El evento ha finalizado, ah ganado el equipo " & TeamWinner, FontTypeNames.FONTTYPE_GUILD
      
    End If
    
Next LoopC
  
End With
 
End Sub
 
Public Function REY_DameRey(ByVal TeamRey As Byte) As Integer
 
' \ Author   :  maTih.-
' \ Note     :  Devuelve un usuario random como rey
 
Dim rRey   As Integer
 
If TeamRey = 1 Then
 
rRey = RandomNumber(LBound(sRey.Equipo1.UserIndex()), UBound(sRey.Equipo1.UserIndex()))
 
rRey = sRey.Equipo1.UserIndex(rRey)
 
Else
 
rRey = RandomNumber(LBound(sRey.Equipo2.UserIndex()), UBound(sRey.Equipo2.UserIndex()))
 
rRey = sRey.Equipo2.UserIndex(rRey)
 
End If
 
REY_DameRey = rRey
 
End Function
 
Public Function REY_UserEsRey(ByVal UserIndex As Integer, ByVal TeamRey As Byte) As Boolean
 
' \ Author   :  maTih.-
' \ Note     :  Devuelve si UserIndex es el Rey del TeamRey
 
If TeamRey = 1 Then
 
REY_UserEsRey = (sRey.Equipo1.Rey = UserIndex)
 
Else
 
REY_UserEsRey = (sRey.Equipo2.Rey = UserIndex)
 
End If
 
End Function
 
Public Function REY_UserDameTag(ByVal UserIndex As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  Devuelve el Tag de userIndex by su team
 
With UserList(UserIndex).reyUser
 
REY_UserDameTag = UserList(UserIndex).name & " <Equipo " & .iRey & ">"
 
End With
 
End Function
Código:
desp es facil lo van leyendo y van poniendo en el sub userdie , closesocket , refreshcharstatus, etc etc.
Evento : Muerte súbita.

Muerte Súbita
La muerte súbita consiste en una pelea entre los 2 bandos. Gana el que llega al límite de kill requerido.

En otras palabras, son dos equipos, cada uno tiene un máximo de jugadores muertos (en este caso 20) cada ves que un usuario muere, se suma uno y a los tres (3) segundos ese usuario revive y cae en su base, cuando uno de los dos equipos llega a el máximo de muertes (20) pierde y gana el otro.

[la idea no fue mia]

módulo llamado ModKits


Código:
Option Explicit
 
'Oro por equipo ganador (se divide por la cantidad de jugadores)
Const KITS_GOLD_TO_WINNER    As Long = 5000000
'Ejemplo = 5kk dividido 5 jugadores = 1kk por player
 
'Constante para enviar a todos los usuarios del evento un mensaje
Const KITS_ALL_MSG           As Byte = 0
 
'Mapa donde se realiza el evento.
Const KITS_MAP               As Integer = 50
 
'Sala espera.
Const KITS_WAITING_ROOM      As Integer = 10
Const KITS_WAITING_X         As Byte = 50
Const KITS_WAITING_Y         As Byte = 30
 
'Posicionex X-Y para el equipo uno.
Const KITS_X1                As Byte = 60
Const KITS_Y1                As Byte = 30
 
'Posicionex X-Y para el equipo dos.
Const KITS_X2                As Byte = 53
Const KITS_Y2                As Byte = 77
 
'Jugadores por equipo.
Const KITS_USER              As Byte = 5
 
'Segundos para revivir usuarios.
Const KITS_RESPAWN           As Byte = 3
 
'Maximas muertes por equipo (en lo que consta este evento)
Const KITS_MAX_KILLS         As Byte = 20
 
Type Kits
     Users(1 To KITS_USER)   As Integer      'Usuarios.
     Kills                   As Byte         'Cuantas muertes tiene.
     Counters                As Byte         'Para los cupos.
End Type
 
Type kitsEvent
     KitsNum(1 To 2)         As Kits         'Index para los equipos.
     QuotaMax                As Byte         'Maximos cupos (no vamos contando con esto)
     KillsMax                As Byte         'Cuantas muertes por equipo.
     EventEnabled            As Boolean      'Si hay evento.
     EventStarted            As Boolean      'Si ya empezó.
End Type
 
Public kitsEvent             As kitsEvent
 
Sub KitsClear()
 
' \ author : maTih.-
' \ Note   : Limpia todo tipo de variables y uso de este sistema.
 
Dim loopC   As Long
 
With kitsEvent
  
    .EventStarted = False
    .EventEnabled = False
    .KillsMax = 0
    .QuotaMax = 0
  
    'Limpiamos los equipos.
  
    'Equipo #1
    With .KitsNum(1)
         .Counters = 0
         .Kills = 0
        
         For loopC = LBound(.Users()) To UBound(.Users())
         .Users(loopC) = 0
         Next loopC
        
    End With
  
    'Limpio el equipo #2
    With .KitsNum(2)
         .Counters = 0
         .Kills = 0
        
         For loopC = LBound(.Users()) To UBound(.Users())
         .Users(loopC) = 0
         Next loopC
        
    End With
 
End With
 
'Limpiar mapa.
 
modKits.KitsClearMap
End Sub
 
Sub KitsClearMap()
 
' \ author : maTih.-
' \ Note   : Limpia objetos del mapa.
 
Dim LoopX   As Long
Dim LoopY   As Long
 
For LoopX = 1 To 100
    For LoopY = 1 To 100
        'Hay un objeto?
        If MapData(KITS_MAP, LoopX, LoopY).ObjInfo.ObjIndex > 0 Then
            'Borramos.
            EraseObj MapData(KITS_MAP, LoopX, LoopY).ObjInfo.Amount, KITS_MAP, LoopX, LoopY
        End If
    Next LoopY
Next LoopX
 
End Sub
 
Sub KitsStart()
 
' \ author : maTih.-
' \ Note   : Empieza el evento é inicializa variables.
 
modKits.KitsClear
 
With kitsEvent
     .EventEnabled = True
    
     .KillsMax = KITS_MAX_KILLS
     .QuotaMax = KITS_USER
    
End With
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Evento automático : Pelea de bandos dió inicio, para participar tipea /PARTICIPAR" & vbNewLine & " El cupo es de " & kitsEvent.QuotaMax & " jugadores.", FontTypeNames.FONTTYPE_CITIZEN)
 
End Sub
 
Sub KitsGoTo()
 
' \ author : maTih.-
' \ Note   : Empieza el evento.
 
Dim loopC       As Long
Dim iUserIndex  As Integer
 
With kitsEvent
  
    .EventStarted = True
  
    'Llevamos a los usuarios del equipo uno a su base.
    With .KitsNum(1)
        For loopC = 1 To KITS_USER
            iUserIndex = .Users(loopC)
          
            If modKits.KitsUserValid(iUserIndex) Then
                WarpUserChar iUserIndex, KITS_MAP, KITS_X1 + loopC, KITS_Y1, True, False
            End If
          
        Next loopC
    End With
  
    'Llevamos a los usuarios del equipo dos a su base.
    With .KitsNum(2)
        For loopC = 1 To KITS_USER
            iUserIndex = .Users(loopC)
          
            If modKits.KitsUserValid(iUserIndex) Then
                WarpUserChar iUserIndex, KITS_MAP, KITS_X1 + loopC, KITS_Y1, True, False
            End If
          
        Next loopC
    End With
  
    'Avisamos.
    modKits.KitsMessage KITS_ALL_MSG, "Empieza la batalla!! " & vbNewLine & "Muertes máximas por equipo : " & .KillsMax
  
    'Seteamos que el evento ya inicio.
    .EventStarted = True
  
End With
 
End Sub
 
Sub KitsKillUser(ByVal userIndex As Integer)
 
' \ author : maTih.-
' \ Note   : Muere un usuario.
 
Dim userKit As Byte
 
userKit = UserList(userIndex).event.userKit
 
With kitsEvent
    
     'Sumamos el contador.
     .KitsNum(userKit).Kills = .KitsNum(userKit).Kills + 1
    
     'Avisamos cuantas muertes le quedan al equipo.
     modKits.KitsMessage userKit, UserList(userIndex).name & " Ha muerto!! " & vbNewLine & " Al equipo le quedan : " & (KITS_MAX_KILLS - .KitsNum(userKit).Kills) & " Muertes!"
  
     'Limite de muertes?
     If .KitsNum(userKit).Kills >= KITS_MAX_KILLS Then
        'Perdieron
        modKits.KitsManageKits userKit
        Exit Sub
    End If
  
    'Si no perdieron , seteamos los segundos de resu.
  
    UserList(userIndex).event.secondRelive = KITS_RESPAWN
  
    WriteConsoleMsg userIndex, "Has muerto! volverás a la vida en " & KITS_RESPAWN & " segundos.", FontTypeNames.FONTTYPE_CITIZEN
  
End With
 
End Sub
 
Sub KitsManageKits(ByVal kitDead As Byte)
 
' \ author : maTih.-
' \ Note   : Acciones que dan fin al evento , setea ganadores y perdedores.
 
Dim kWinner     As Byte
 
'Obtengo el equipo que ganó.
kWinner = modKits.KitsGiveWinner(kitDead)
 
'Acciones para los ganadores.
modKits.KitsWin kWinner
'Acciones para los perdedores.
modKits.KitsWarpLoosers kitDead
 
'Limpio todo.
modKits.KitsClear
 
End Sub
 
Sub KitsGoSeconds(ByVal userIndex As Integer)
 
' \ author : maTih.-
' \ Note   : Contador para revivir usuarios.
 
Dim MiPos   As WorldPos
 
With UserList(userIndex).event
    
     If UserList(userIndex).flags.Muerto <> 1 Then Exit Sub
    
     'Encontramos a donde hay que llevarlo
     modKits.KitsPos MiPos, .userKit
    
     'Restamos el tiempo
        
     If .secondRelive > 0 Then .secondRelive = .secondRelive - 1
    
     'Llego a 0? respawn!
    
     If .secondRelive <= 0 Then
        RevivirUsuario userIndex
        'Lleno la vida
        UserList(userIndex).Stats.MinHp = UserList(userIndex).Stats.MaxHp
        WriteUpdateHP userIndex
    End If
    
    WriteConsoleMsg userIndex, "Has vuelto a la vida!", FontTypeNames.FONTTYPE_CITIZEN
  
    'Aviso al team
    modKits.KitsMessage .userKit, UserList(userIndex).name & " Volvió a la vida!"
  
    'Telep a la base.
  
    WarpUserChar userIndex, MiPos.Map, MiPos.X, MiPos.Y, True
  
End With
 
End Sub
 
Sub KitsSubmit(ByVal userIndex As Integer)
 
' \ author : maTih.-
' \ Note   : Inscribe a un usuario al evento.
 
Dim toKit   As Byte
 
toKit = modKits.KitsGiveTeam
 
With kitsEvent
  
    'Lleno los datos con el del nuevo usuario
    'Y sieeeempre y cuando "ToKit" sea #2
    'Y El contador llege al maximo,
    'Doy inicio con el evento =)
  
    .KitsNum(toKit).Counters = .KitsNum(toKit).Counters + 1
    .KitsNum(toKit).Users(.KitsNum(toKit).Counters) = userIndex
  
    modKits.KitsMessage toKit, UserList(userIndex).name & " Se inscribio para nuestro lado!"
  
    If toKit = 2 Then
       If .KitsNum(2).Counters >= KITS_USER Then
          modKits.KitsGoTo
        End If
    End If
  
End With
 
With UserList(userIndex).event
     .inEvent = True
     .secondRelive = 0
     .userKit = toKit
End With
 
End Sub
 
Sub KitsWin(ByVal kitWinner As Byte)
 
' \ author : maTih.-
' \ Note   : Gana un equipo y termina el evento.
 
Dim loopC           As Long
Dim GoldToPlayer    As Long
Dim iUserIndex      As Integer
 
With kitsEvent
 
     GoldToPlayer = modKits.KitsGoldToPlayer(kitWinner)
  
    For loopC = 1 To KITS_USER
  
    With .KitsNum(kitWinner)
         iUserIndex = .Users(loopC)
        
         If modKits.KitsUserValid(iUserIndex) Then
            'Doy el oro.
            UserList(iUserIndex).Stats.GLD = UserList(iUserIndex).Stats.GLD + GoldToPlayer
            'Actualizo el cliente del usuario.
            WriteUpdateGold iUserIndex
            'Lo llevo a su hogar.
            WarpUserChar iUserIndex, Ciudades(UserList(iUserIndex).Hogar).Map, Ciudades(UserList(iUserIndex).Hogar).X, Ciudades(UserList(iUserIndex).Hogar).Y, True
        End If
          
    End With
  
    Next loopC
End With
 
'Chaaau nos vemos.
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Evento automático : Guerra de bandos , GANADOR EQUIPO #" & kitWinner, FontTypeNames.FONTTYPE_CITIZEN)
 
End Sub
 
Sub KitsWarpLoosers(ByVal Looser As Byte)
 
' \ author : maTih.-
' \ Note   : Se lleva a los perdedores a su hogar
 
Dim sPos    As WorldPos
Dim loopC   As Long
Dim iUser   As Integer
 
For loopC = 1 To KITS_USER
    iUser = kitsEvent.KitsNum(Looser).Users(loopC)
  
    'Si es un usuario válido, busco su hogar y lo teletransporto al mismo.
    If modKits.KitsUserValid(iUser) Then
       sPos = Ciudades(UserList(iUser).Hogar)
       WarpUserChar iUser, sPos.Map, sPos.X, sPos.Y, True
       'Si está muerto lo revivo.
       If UserList(iUser).flags.Muerto <> 0 Then
          RevivirUsuario iUser
          'Lleno la vida
          UserList(iUser).Stats.MinHp = UserList(iUser).Stats.MaxHp
          WriteUpdateHP iUser
        End If
    End If
  
Next loopC
 
End Sub
 
Function KitsGoldToPlayer(ByVal giveKit As Byte) As Long
 
' \ author : maTih.-
' \ Note   : Encuentra cuantos jugadores hay y divide el oro
 
Dim loopC   As Long
Dim iUser   As Integer
Dim aUsers  As Byte
 
For loopC = 1 To KITS_USER
    iUser = kitsEvent.KitsNum(giveKit).Users(loopC)
  
    'Sumamos el contador.
    If modKits.KitsUserValid(iUser) Then
        aUsers = aUsers + 1
    End If
  
Next loopC
 
KitsGoldToPlayer = (KITS_GOLD_TO_WINNER / aUsers)
 
End Function
 
Sub KitsMessage(ByVal toKit As Byte, ByRef sMessage As String)
 
' \ author : maTih.-
' \ Note   : Envia un mensaje a un equipo o a todos los del evento.
 
Dim loopC       As Long
Dim K_FONT      As FontTypeNames
Dim iUserIndex  As Integer
 
K_FONT = FontTypeNames.FONTTYPE_WARNING
 
Select Case toKit
  
    Case 0              'Todos los del evento.
  
        SendData SendTarget.toMap, KITS_MAP, PrepareMessageConsoleMsg(sMessage, K_FONT)
  
    Case 1 To 2         'Un equipo específico.
  
        For loopC = 1 To KITS_USER
            With kitsEvent.KitsNum(toKit)
            iUserIndex = .Users(loopC)
                    If modKits.KitsUserValid(iUserIndex) Then
                        WriteConsoleMsg iUserIndex, "[MENSAJE AL EQUIPO #" & toKit & "] : " & sMessage, K_FONT
                    End If
            End With
        Next loopC
  
End Select
 
End Sub
 
Sub KitsPos(ByRef MiPos As WorldPos, ByVal kitNum As Byte)
 
' \ author : maTih.-
' \ Note   : Toma el numero de equipo y guarda la posicion de su base en MiPos
 
MiPos.Map = KITS_MAP
 
If kitNum = 1 Then
    MiPos.X = KITS_X1
    MiPos.Y = KITS_Y1
Else
    MiPos.X = KITS_X2
    MiPos.Y = KITS_Y2
End If
 
End Sub
 
Function KitsGiveWinner(ByVal KitLooser As Byte) As Byte
 
' \ author : maTih.-
' \ Note   : Devuelve el equipo ganador según quien pierde.
 
If KitLooser = 1 Then
   KitsGiveWinner = 2
Else
    KitsGiveWinner = 1
End If
 
End Function
 
Function KitsGiveTag(ByVal userKit As Byte) As String
 
' \ author : maTih.-
' \ Note   : Devuelve el tag del usuario segun su equipo.
 
KitsGiveTag = " <Equipo #" & userKit & ">"
 
End Function
 
Function KitsUserIngress(ByVal userIndex As Integer, ByRef refError As String) As Boolean
 
' \ author : maTih.-
' \ Note   : Comprobaciones si puede ingresar al evento
 
KitsUserIngress = False
 
'Importante el orden de los condicionales
 
With UserList(userIndex)
 
     'Si no hay evento.
     If kitsEvent.EventEnabled <> True Then
        refError = "No hay ningún evento actualmente."
        Exit Function
    End If
  
    'Si hay evento pero ya empezó.
    If kitsEvent.EventStarted <> False Then
        refError = "El evento ya ha iniciado."
        Exit Function
    End If
  
    'Si está muerto.
    If .flags.Muerto <> 0 Then
        refError = "Estás muerto!!"
        Exit Function
    End If
  
    'Si está en carcel.
    If .Counters.Pena <> 0 Then
        refError = "Estás en la carcel!!"
        Exit Function
    End If
  
    'Si no está en su hogar.
    'Pueden sacar esto si quieren....
    If .Pos.Map <> Ciudades(.Hogar).Map Then
        refError = "Tienes que estar en tu hogar para participar"
        Exit Function
    End If
  
    KitsUserIngress = True
  
End With
 
End Function
 
Function KitsUserValid(ByVal userIndex As Integer) As Boolean
 
' \ author : maTih.-
' \ Note   : Devuelve si UserIndex , es <> 0 y si es un usuario logeado.
 
KitsUserValid = False
 
'Si no es diferente a 0.
If Not (userIndex <> 0) Then Exit Function
 
'Si no tiene IDValida.
 
If Not (UserList(userIndex).ConnID <> -1) Then Exit Function
 
'Si no es un usuario logeado (muy improbable llegar acá y que esto de false)
 
If Not (UserList(userIndex).flags.UserLogged) Then Exit Function
 
KitsUserValid = True
End Function
 
Function KitsGiveTeam() As Byte
 
' \ author : maTih.-
' \ Note   : Devuelve el equipo con menos jugadores (para inscribir usaurios)
 
With kitsEvent
 
'Si el equipo #1 tiene mas players que el #2 entonces
'Ingresar para el equipo #2.
If .KitsNum(1).Counters > .KitsNum(2).Counters Then
        KitsGiveTeam = 2
    Else        'Si no, entra al #1.
        KitsGiveTeam = 1
End If
 
End With
 
End Function
En modulo declaraciones :

Código:
Type kitsEventUser
     userKit         As Byte     'Para que evento está.
     secondRelive    As Byte     'Segundos para resucitar.
     inEvent         As Boolean  'Si está inscripto.
End Type
en el type user

Código:
Event as kitsEventUser
en el sub pasarSegundo (dentro del bucle de usuarios y debajo del chekeo si está logeado)

Código:
 If UserList(i).event.inEvent Then
                modKits.KitsGoSeconds i
            End If
sub userdie

Código:
If .event.inEvent Then modKits.KitsKillUser userIndex
sub MakeUserChar

arriba de donde envia el paquete WriteCharacterCreate (es una linea larga)


Código:
'Preparo el tag del evento
                If .event.inEvent Then
                   UserName = .name & modKits.KitsGiveTag(.event.userKit)
                End If
en el sub RefreshCharStatus , arriba del Checkeo "if .showName"

Código:
 'Preparo el tag del evento
        If .event.inEvent Then
            ClanTag = .name & modKits.KitsGiveTag(.event.userKit)
        End If
timer con 60.000 de intervalo en el frmmain (mejoren esto x q lo hice aca en el foro)

Código:
Static conteoIniciar    As Byte
 
conteoIniciar = conteoIniciar + 1
 
If conteoIniciar = 60 Then
    modKits.KitsStart
    conteoIniciar = 0
End If
paquete para ingresar al evento

Código:
Private Sub HandleEvent(ByVal userIndex As Integer)
 
' \ author : maTih.-
' \ Note   : Usuario ingresa al evento.
 
UserList(userIndex).incomingData.ReadByte
 
Dim nError  As String
 
If modKits.KitsUserIngress(userIndex, nError) Then
   modKits.KitsSubmit userIndex
Else
   WriteConsoleMsg userIndex, nError, FontTypeNames.FONTTYPE_CITIZEN
End If
 
End Sub
Código:
Case ClientPacketID.EventSubmit             '/PARTICIPAR
            Call HandleEvent(userIndex)
Código:
EventSubmit             '/PARTICIPAR
paquete del cliente

Código:
 EventSubmit             '/PARTICIPAR
Código:
Sub WriteEventSubmit()
Call outgoingData.WriteByte(ClientPacketID.eventsubmit)
End Sub
comando

Código:
Case "/PARTICIPAR"
         writeEventSubmit
La bestia (base)

En este evento, cuando se da inicio, al llenarse los cupos, se transforma a un usuario Random de los que entraron en "LA BESTIA" , tendrá el cuerpo de una animal o lo que fuese, tendrá muchos stats de vida y mana y será practicamente inmortal, pero se verá si podrá matar a todos los demás usuarios sin que muera, cada usuario que "LA BESTIA" mata, se lo recompensa (a el bicho) con 1.000.000 de oro, y cuando la bestia muere, a todos los que participaron también se les dá esa suma.

Acá les dejo el código, es un modulo en el que solo tienen que hacer las llamadas, está todo y funciona.


Código:
Option Explicit
 
' \ Author  :  maTih.-
' \ Note    :  Handle the system of quest.
 
Type userBestia
     isBestia    As Boolean         'Es la bestia?
     enBestia    As Boolean         'Está en el evento?
     LastBody    As Integer         'Cuerpo anterior
     LastHead    As Integer         'Cabeza anterior
     LastMAN     As Integer         'Mana anterior
     LastHP      As Integer         'HP Anterior
End Type
 
Type tBestia
     tmpIndex()     As Integer      'Indices
     BestiaIndex    As Integer      'Indice de la Bestia
     hayEvento      As Boolean      'Hay Evento?
     CuposCont      As Byte         'Cupos contados
     CuposTotal     As Byte         'Cupos total
     Muertos        As Byte         'Cuantos muertos
End Type
 
'DECLARACIÓN DEL TIPO
Public nBestia      As tBestia
'DECLARACIÓN DEL TIPO
 
'CONSTANTES PRIVADAS
 
Private Const MAPA_BESTIA    As Integer = 21
Private Const BESTIA_X       As Integer = 30
Private Const BESTIA_Y       As Integer = 66
Private Const BODY_BESTIA    As Integer = 300
Private Const BESTIABASE_X   As Integer = 50
Private Const BESTIABASE_Y   As Integer = 40
Private Const BESTIA_MANA    As Integer = 4000
Private Const BESTIA_HP      As Integer = 989
Private Const BESTIA_ESPERAX As Integer = 30
Private Const BESTIA_ESPERAY As Integer = 66
Private Const BESTIA_ORO     As Long = 1000000
 
'CONSTANTES PRIVADAS
 
Public Sub Bestia_DarInicio(ByVal Cupos As Byte)
 
' \ Author   :  maTih.-
' \ Note     :  Dar Inicio al Evento según Cupos
 
With nBestia
 
.BestiaIndex = 0
.CuposCont = 0
.CuposTotal = Cupos
.hayEvento = True
 
ReDim .tmpIndex(1 To Cupos) As Integer
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("[EVENTO LA BESTIA] : Inició con un cupo máximo de " & Cupos, FontTypeNames.FONTTYPE_CITIZEN)
 
End With
 
End Sub
 
Public Sub Bestia_Comienza()
 
' \ Author   :  maTih.-
' \ Note     :  Comienza el evento
 
With nBestia
 
.BestiaIndex = Bestia_RandomizeBestia()
.hayEvento = False
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("[EVENTO LA BESTIA] : La bestia es : " & UserList(.BestiaIndex).name, FontTypeNames.FONTTYPE_CITIZEN)
 
Dim LoopX      As Long
Dim iBestia    As Integer
 
For LoopX = 1 To UBound(.tmpIndex())
 
    If UserList(.tmpIndex(LoopX)).ConnID <> -1 Then
  
       If UserList(.tmpIndex(LoopX)).name <> UserList(.BestiaIndex).name Then
        WarpUserChar .tmpIndex(LoopX), MAPA_BESTIA, BESTIABASE_X + LoopX, BESTIABASE_Y + LoopX, True
          UserList(.tmpIndex(LoopX)).Bestia.enBestia = True
          UserList(.tmpIndex(LoopX)).Bestia.isBestia = False
          Else
        .tmpIndex(LoopX) = -1
       End If
      
    End If
  
Next LoopX
 
WarpUserChar .BestiaIndex, MAPA_BESTIA, BESTIA_X, BESTIA_Y, True
 
End With
 
iBestia = nBestia.BestiaIndex
 
With UserList(iBestia)
 
If .ConnID <> -1 Then
 
.Bestia.enBestia = True
.Bestia.isBestia = True
.Bestia.LastBody = .Char.body
.Bestia.LastHead = .Char.Head
.Bestia.LastHP = .Stats.MaxHp
.Bestia.LastMAN = .Stats.MaxMAN
 
.Char.body = BODY_BESTIA
.Char.Head = 0
.Stats.MaxMAN = BESTIA_MANA
.Stats.MaxHp = BESTIA_HP
.Stats.MinMAN = .Stats.MaxMAN
.Stats.MinHp = .Stats.MaxHp
 
WriteUpdateUserStats iBestia
 
ChangeUserChar iBestia, BODY_BESTIA, 0, .Char.heading, 0, 0, 0
 
End If
 
End With
 
End Sub
 
Public Sub Bestia_Muere(ByVal Muerto As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  Muere un usuario en evento.
 
With UserList(Muerto)
 
If Muerto <> nBestia.BestiaIndex Then
 
nBestia.Muertos = nBestia.Muertos + 1
 
If UserList(nBestia.BestiaIndex).ConnID <> -1 Then
 
UserList(nBestia.BestiaIndex).Stats.GLD = UserList(nBestia.BestiaIndex).Stats.GLD + BESTIA_ORO
WriteUpdateGold nBestia.BestiaIndex
 
End If
 
If nBestia.Muertos >= (UBound(nBestia.tmpIndex()) - 1) Then
 
Bestia_Termina
 
End If
 
WarpUserChar Muerto, 1, 58, 45, True
 
UserList(Muerto).Bestia.enBestia = False
 
Else
 
Bestia_MuereBestia
 
End If
 
End With
 
End Sub
 
Public Sub Bestia_EntraUser(ByVal UserIndex As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  UserIndex entra a el evento
 
With nBestia
 
.CuposCont = .CuposCont + 1
 
.tmpIndex(.CuposCont) = UserIndex
 
WarpUserChar UserIndex, MAPA_BESTIA, BESTIA_ESPERAX, BESTIA_ESPERAY, True
 
SendData SendTarget.toMap, MAPA_BESTIA, PrepareMessageConsoleMsg("[EVENTO LA BESTIA] : " & UserList(UserIndex).name & " Se ha inscripto!!", FontTypeNames.FONTTYPE_CITIZEN)
 
If .CuposCont >= .CuposTotal Then
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("[EVENTO LA BESTIA] : Cupos completos!!", FontTypeNames.FONTTYPE_CITIZEN)
Bestia_Comienza
End If
 
End With
 
End Sub
 
Public Sub Bestia_Termina()
 
' \ Author   :  maTih.-
' \ Note     :  Termina el evento y gana la bestia
 
Dim LoopX   As Long
 
With nBestia
 
For LoopX = 1 To UBound(.tmpIndex())
 
If .tmpIndex(LoopX) <> -1 Then
 
If UserList(.tmpIndex(LoopX)).ConnID <> -1 Then
   UserList(.tmpIndex(LoopX)).Bestia.enBestia = False
End If
 
End If
 
Next LoopX
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("[EVENTO LA BESTIA] : Ganó la bestia!!", FontTypeNames.FONTTYPE_CITIZEN)
 
WarpUserChar .BestiaIndex, 1, 57, 45, True
 
End With
 
With UserList(nBestia.BestiaIndex)
 
.Bestia.enBestia = False
.Bestia.isBestia = False
 
.Char.body = .Bestia.LastBody
.Char.Head = .Bestia.LastHead
 
.Bestia.LastBody = 0
.Bestia.LastHead = 0
 
.Stats.MaxMAN = .Bestia.LastMAN
.Stats.MaxHp = .Bestia.LastHP
 
.Stats.MinHp = .Stats.MaxHp
.Stats.MinMAN = .Stats.MaxMAN
 
WriteUpdateUserStats nBestia.BestiaIndex
 
ChangeUserChar nBestia.BestiaIndex, .Char.body, .Char.Head, .Char.heading, .Char.WeaponAnim, .Char.ShieldAnim, .Char.CascoAnim
 
End With
 
Bestia_Clear
 
End Sub
 
Public Sub Bestia_MuereBestia()
 
' \ Author   :  maTih.-
' \ Note     :  Muere la bestia
 
Dim LoopX   As Long
 
With nBestia
 
For LoopX = 1 To UBound(.tmpIndex())
 
    If .tmpIndex(LoopX) <> -1 Then
  
       If UserList(.tmpIndex(LoopX)).ConnID <> -1 Then
          UserList(.tmpIndex(LoopX)).Stats.GLD = UserList(.tmpIndex(LoopX)).Stats.GLD + BESTIA_ORO
          WriteUpdateGold .tmpIndex(LoopX)
       End If
      
    End If
  
Next LoopX
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("[EVENTO LA BESTIA] : La bestia ha muerto!!!", FontTypeNames.FONTTYPE_CITIZEN)
 
End With
 
With UserList(nBestia.BestiaIndex)
 
.Bestia.enBestia = False
.Bestia.isBestia = False
 
.Char.body = .Bestia.LastBody
.Char.Head = .Bestia.LastHead
 
.Bestia.LastBody = 0
.Bestia.LastHead = 0
 
.Stats.MaxMAN = .Bestia.LastMAN
.Stats.MaxHp = .Bestia.LastHP
 
.Stats.MinHp = .Stats.MaxHp
.Stats.MinMAN = .Stats.MaxMAN
 
WriteUpdateUserStats nBestia.BestiaIndex
 
ChangeUserChar nBestia.BestiaIndex, .Char.body, .Char.Head, .Char.heading, .Char.WeaponAnim, .Char.ShieldAnim, .Char.CascoAnim
 
End With
 
Bestia_Clear
 
End Sub
 
Public Function Bestia_RandomizeBestia() As Integer
 
' \ Author   :  maTih.-
' \ Note     :  Devuelve un UserIndex random.
 
Dim RNa      As Byte
 
RNa = RandomNumber(1, UBound(nBestia.tmpIndex()))
 
Bestia_RandomizeBestia = nBestia.tmpIndex(RNa)
 
End Function
Public Sub Bestia_Clear()
 
' \ Author   :  maTih.-
' \ Note     :  Limpiamos el type tBestia
 
With nBestia
 
.BestiaIndex = 0
.CuposCont = 0
.CuposTotal = 0
.hayEvento = False
 
Dim LoopX     As Long
 
For LoopX = 1 To UBound(.tmpIndex())
    .tmpIndex(LoopX) = 0
Next LoopX
 
End With
 
End Sub
Evento Resistencia de equipos

acá les dejo un sistemita qe hice un rato jajaja, es algo así

2 equipos, 1 equipo arranca en un cuadrado que estan encerrados, y el 2do equipo arranca afuera, cuando matan a todos los del equipo 1 , se hace la inversa y el 2do equipo va adentro y el 1 afuera, el equipo que resista más, seria el ganador, se puede hacer automático como con un comando, les dejo el modulo qe solo tienen qe hacer las llamadas.


Código:
Option Explicit
 
Type tResistence
     IndexsA()          As Integer
     IndexsB()          As Integer
     CuposContados      As Byte
     CuposTotal         As Byte
     Contadores(1)      As Byte
     TimeStart(1)       As Long
     TimeFinish(1)      As Long
     Caspers(1)         As Byte
End Type
 
Public Type userResistencia
       Team        As Byte
       EnEvento    As Boolean
       pIndex      As Byte
End Type
 
'MAPA Y CORDENADAS CUANDO EMPIEZA
 
Public Const MAPA_RESISTENCIA    As Integer = 35
Public Const ENCIERRE_X          As Byte = 35
Public Const ENCIERRE_Y          As Byte = 50
Public Const AFUERA_X            As Byte = 66
Public Const AFUERA_Y            As Byte = 55
 
'MAPA Y CORDENADAS CUANDO EMPIEZA
 
'ORO PREMIO
 
Public Const ORO_PREMIO  As Long = 1000000000
 
Public ResistenciaType As tResistence
 
Public Function CheckCuposPar(ByVal Cupos As Byte) As Boolean
 
' \ Author   :  maTih.-
' \ Note     :  Returns if the quotas are few
 
CheckCuposPar = (Not Cupos Mod 2)
 
End Function
 
Public Sub R_INICIAR(ByVal Cupos As Byte)
 
' \ Author   :  maTih.-
' \ Note     :  We begin at the event here
 
If Not CheckCuposPar(Cupos) Then Exit Sub
 
Dim LoopC   As Long
Dim dCupos  As Byte
 
dCupos = (Cupos / 2)
 
With ResistenciaType
 
.CuposTotal = Cupos
.CuposContados = 0
 
For LoopC = 0 To 1
.Caspers(LoopC) = 0
.TimeFinish(LoopC) = 0
.TimeStart(LoopC) = 0
.Contadores(LoopC) = 0
Next LoopC
 
If UBound(.IndexsA()) > 0 Then
 
For LoopC = LBound(.IndexsA()) To UBound(.IndexsA())
 .IndexsA(LoopC) = 0
Next LoopC
 
End If
 
If UBound(.IndexsB()) > 0 Then
 
For LoopC = LBound(.IndexsB()) To UBound(.IndexsB())
 .IndexsB(LoopC) = 0
Next LoopC
 
End If
 
ReDim .IndexsA(1 To dCupos) As Integer
ReDim .IndexsB(1 To dCupos) As Integer
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Evento> Resistencia " & Cupos & " cupos, /RESISTENCIA Para ingresar.", FontTypeNames.FONTTYPE_GUILD)
 
End With
 
End Sub
 
Public Sub R_ADDUSER(ByVal UserIndex As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  Add User To list array of teams
 
'si los 2 eqipos tan iguales, sumamos al primero
 
Dim tSelected   As Byte
 
ResistenciaType.CuposContados = ResistenciaType.CuposContados + 1
 
If ResistenciaType.Contadores(0) = ResistenciaType.Contadores(1) Then
   ResistenciaType.Contadores(0) = ResistenciaType.Contadores(0) + 1
   tSelected = 0
Else
   ResistenciaType.Contadores(1) = ResistenciaType.Contadores(1) + 1
   tSelected = 1
End If
 
If tSelected = 0 Then
 
ReDim Preserve ResistenciaType.IndexsA(1 To ResistenciaType.Contadores(0))
 
ResistenciaType.IndexsA(ResistenciaType.Contadores(0)) = UserIndex
UserList(UserIndex).userResistencia.pIndex = ResistenciaType.Contadores(0)
 
Else
 
ReDim Preserve ResistenciaType.IndexsB(1 To ResistenciaType.Contadores(1))
 
ResistenciaType.IndexsB(ResistenciaType.Contadores(1)) = UserIndex
UserList(UserIndex).userResistencia.pIndex = ResistenciaType.Contadores(1)
 
End If
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(UserList(UserIndex).name & " Entró a el evento, quedan " & ResistenciaType.CuposTotal - ResistenciaType.CuposContados & " cupos disponibles.", FONTTYPE_CITIZEN)
 
WriteConsoleMsg UserIndex, "Has ingresado al evento, espera a que se llenen los cupos y serás teletransportado.", FontTypeNames.FONTTYPE_CITIZEN
 
UserList(UserIndex).userResistencia.EnEvento = True
UserList(UserIndex).userResistencia.Team = tSelected
UserList(UserIndex).userResistencia.pIndex = ResistenciaType.Contadores(1)
 
If UBound(ResistenciaType.IndexsB()) * 2 = ResistenciaType.CuposTotal Then
 R_ARRANCAR
End If
 
End Sub
 
Public Sub R_ARRANCAR()
 
' \ Author   :  maTih.-
' \ Note     :  THIS EVENT STARTS THE ROUTINE
 
Dim LoopC   As Long
 
With ResistenciaType
 
'encerramos a los usuarios del team 1 y los team 2 afuera
 
    For LoopC = 1 To UBound(.IndexsA())
       If .IndexsA(LoopC) > 0 Then
       WarpUserChar .IndexsA(LoopC), MAPA_RESISTENCIA, ENCIERRE_X + LoopC, ENCIERRE_Y + LoopC, True
       WriteConsoleMsg .IndexsA(LoopC), "Defiendanse lo más que puedan!!!", FontTypeNames.FONTTYPE_CITIZEN
       RefreshCharStatus .IndexsA(LoopC)
       End If
    Next LoopC
  
   For LoopC = 1 To UBound(.IndexsB())
       If .IndexsB(LoopC) > 0 Then
        WarpUserChar .IndexsB(LoopC), MAPA_RESISTENCIA, AFUERA_X + LoopC, AFUERA_Y + LoopC, True
        WriteConsoleMsg .IndexsB(LoopC), "Atacais a los del bando contrario!!!", FontTypeNames.FONTTYPE_CITIZEN
        RefreshCharStatus .IndexsB(LoopC)
       End If
   Next LoopC
  
   'tiempos de inicio
  
   .TimeStart(0) = GetTickCount
  
End With
 
End Sub
 
Public Sub R_MUEREINDEX(ByVal UserMuerto As Integer)
 
' \ Author   :  maTih.-
' \ Note     :  COMPARE RESULTS
 
Dim tSelected   As Byte
 
tSelected = UserList(UserMuerto).userResistencia.Team
 
ResistenciaType.Caspers(tSelected) = ResistenciaType.Caspers(tSelected) + 1
 
If tSelected = 0 Then
 
If ResistenciaType.Caspers(tSelected) >= UBound(ResistenciaType.IndexsA()) Then
 
R_PASAOTROEQUIPO
 
End If
 
Else
 
If ResistenciaType.Caspers(tSelected) >= UBound(ResistenciaType.IndexsB()) Then
 
R_COMPRARRESULTADOS
 
End If
 
End If
 
 
End Sub
 
Public Sub R_PASAOTROEQUIPO()
 
' \ Author   :  maTih.-
' \ Note     :  SEND OUT THE TEAM TWO AND ONE IN
 
Dim LoopC   As Long
 
With ResistenciaType
 
'antes de hacer otra cosa, guardamos el timeFinish
 
.TimeFinish(0) = (GetTickCount - .TimeStart(0))
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Evento> Resistencia : Team 1 todos muertos!! resistieron : " & (.TimeFinish(0) / 60000), FontTypeNames.FONTTYPE_CITIZEN)
 
    For LoopC = 1 To UBound(.IndexsA())
    
      'revivir usuarios
    
      If .IndexsA(LoopC) > 0 Then
    
      RevivirUsuario LoopC
            
      'warp afuera
    
      WarpUserChar .IndexsA(LoopC), MAPA_RESISTENCIA, AFUERA_X + LoopC, AFUERA_Y + LoopC, True
    
      WriteConsoleMsg .IndexsA(LoopC), "Atacais a los del bando contrario!!!", FontTypeNames.FONTTYPE_CITIZEN
    
      End If
    
    Next LoopC
  
    For LoopC = 1 To UBound(.IndexsB())
        'warp afuera y resu por si estan muertos
      
        If .IndexsB(LoopC) > 0 Then
      
        If UserList(.IndexsB(LoopC)).flags.Muerto = 1 Then
      
        RevivirUsuario .IndexsB(LoopC)
      
        End If
      
        WarpUserChar .IndexsB(LoopC), MAPA_RESISTENCIA, ENCIERRE_X + LoopC, ENCIERRE_Y + LoopC, True
        WriteConsoleMsg .IndexsB(LoopC), "Defiendanse lo más que puedan!!!", FontTypeNames.FONTTYPE_CITIZEN
      
        End If
      
    Next LoopC
  
    'START CONTADOR DEL TEAM 2
  
    .TimeStart(1) = GetTickCount
  
End With
End Sub
 
Public Sub R_DARGANADOR(ByRef TeamGanador As Byte)
 
With ResistenciaType
 
If .TimeFinish(0) < .TimeFinish(1) Then
 
TeamGanador = 0
 
Else
 
TeamGanador = 1
 
End If
 
End With
 
End Sub
 
Public Sub R_COMPRARRESULTADOS()
 
' \ Author   :  maTih.-
' \ Note     :  Compares the results and returns a winner
 
Dim LoopC     As Long
Dim TWINNER   As Byte
 
With ResistenciaType
 
.TimeFinish(1) = (GetTickCount - .TimeStart(1))
 
SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Evento> Resistencia : Team 2 todos muertos!! resistieron : " & (.TimeFinish(1) / 60000) & " MINUTOS.", FontTypeNames.FONTTYPE_CITIZEN)
 
Call R_DARGANADOR(TWINNER)
 
For LoopC = 1 To UBound(.IndexsA())
 
    If .IndexsA(LoopC) > 0 Then
      WarpUserChar .IndexsA(LoopC), 1, 58, 45 + LoopC, True
      WriteConsoleMsg .IndexsA(LoopC), "El evento ah finalizado!! el equipo ganador es el equipo : " & TWINNER + 1, FontTypeNames.FONTTYPE_GUILD
    End If
  
Next LoopC
 
For LoopC = 1 To UBound(.IndexsB())
 
     If .IndexsB(LoopC) > 0 Then
      WarpUserChar .IndexsB(LoopC), 1, 58, 45 + LoopC, True
      WriteConsoleMsg .IndexsB(LoopC), "El evento ah finalizado!! el equipo ganador es el equipo : " & TWINNER + 1, FontTypeNames.FONTTYPE_GUILD
    End If
  
Next LoopC
 
Call R_PREMIER(TWINNER)
 
Call R_RESETALLTYPES
 
End With
 
End Sub
 
Public Sub R_PREMIER(ByVal TWIN As Byte)
 
' \ Author   :  maTih.-
' \ Note     :  Premier all userIndexs of team winner
 
Dim LoopC    As Long
 
With ResistenciaType
 
If TWIN = 1 Then
 
For LoopC = 1 To UBound(.IndexsA())
 
    If .IndexsA(LoopC) > 0 Then
  
    UserList(.IndexsA(LoopC)).Stats.GLD = UserList(.IndexsA(LoopC)).Stats.GLD + ORO_PREMIO
  
    WriteUpdateGold .IndexsA(LoopC)
    R_ResetUser .IndexsA(LoopC)
    End If
  
Next LoopC
 
Else
 
For LoopC = 1 To UBound(.IndexsB())
 
    If .IndexsB(LoopC) > 0 Then
  
    UserList(.IndexsB(LoopC)).Stats.GLD = UserList(.IndexsB(LoopC)).Stats.GLD + ORO_PREMIO
  
    WriteUpdateGold .IndexsB(LoopC)
    R_ResetUser .IndexsB(LoopC)
    End If
  
Next LoopC
 
End If
 
End With
 
End Sub
 
Sub R_RESETALLTYPES()
 
' \ Author   :  maTih.-
' \ Note     :  Reset all stats of the event
 
Dim LoopC    As Long
 
With ResistenciaType
 
For LoopC = 0 To 1
.TimeFinish(LoopC) = 0
.Caspers(LoopC) = 0
.Contadores(LoopC) = 0
.CuposContados = 0
.CuposTotal = 0
Next LoopC
 
For LoopC = 1 To UBound(.IndexsA())
.IndexsA(LoopC) = 0
.IndexsB(LoopC) = 0
Next LoopC
 
End With
 
End Sub
 
Sub R_ResetUser(ByVal UserIndex As Integer)
 
With UserList(UserIndex).userResistencia
 
.EnEvento = False
.Team = 0
.pIndex = 0
 
End With
 
End Sub
Código:
Private Sub HandleCrearResistencia(ByVal UserIndex As Integer)
 
Call UserList(UserIndex).incomingData.ReadByte
 
If UserList(UserIndex).flags.Privilegios >= PlayerType.SemiDios Then
 
R_INICIAR UserList(UserIndex).incomingData.ReadByte()
 
End If
 
End Sub
 
Private Sub HandleEntrarResistencia(ByVal UserIndex As Integer)
 
Call UserList(UserIndex).incomingData.ReadByte
 
If UserList(UserIndex).flags.Muerto = 0 Then
 
R_ADDUSER UserIndex
 
Else
 
WriteConsoleMsg UserIndex, "Estás muerto!!", FontTypeNames.FONTTYPE_GUILD
 
End If
 
End Sub
write del cliente

Código:
Public Sub WriteCrearResistencia(byval Cupos as byte)
call OutGoinGdAtA.WrITeByTE(CLIenTpAKCietID.CrearResistencia)
call OutgOingDaTa.writebYTe(CuPos)
end sub
 
Public Sub WriteResistencia()
call OuTgOInGDATa.writebyte(CLienTpAcKETId.EntrarResistencia)
end sub
si quieren qe abajo diga <TEAM 1> O Team 2 ponen

en el sub refreshcharstatus, buscan


Código:
If .showName Then
            Call SendData(SendTarget.ToPCArea, UserIndex, PrepareMessageUpdateTagAndStatus(UserIndex, NickColor, .name & ClanTag))
        Else
            Call SendData(SendTarget.ToPCArea, UserIndex, PrepareMessageUpdateTagAndStatus(UserIndex, NickColor, vbNullString))
        End If
arriba ponen

Código:
If .userResistencia.EnEvento Then
           ClanTag = "Equipo " & .userResistencia.Team + 1
        End If
buscan en el sub MakeUserChar

Código:
  Call WriteCharacterCreate(sndIndex, .Char.body, .Char.Head, .Char.heading, _
                            .Char.CharIndex, X, Y, _
                            .Char.WeaponAnim, .Char.ShieldAnim, .Char.FX, 999, .Char.CascoAnim, _
                            UserName, NickColor, Privileges)
arriba ponen

Código:
If .userResistencia.EnEvento Then
                 UserName = .name & " <TEAM " & .userResistencia.Team + 1
                End If
desp en el sub userdie ponen

Código:
if .userresistencia.enevento then
  r_muereindex userindex
end if
Sistema de Evento Estilo TPAO

Un GM activa el evento con el Comando /EVENTO MAPA@POSICIÓNX@POSICIÓNY y en ese mapa va a aparecer la criatura feroz el que la mate resivira 15000 monedas de oro ustedes pueden hacerlo como mas gusten con puntos de torneo, etc.


Empecemos:

SERVDOR:

Buscan:


Código:
Private Enum ClientPacketID
Debajo ponen:

Código:
Evento          '/EVENTO
Buscan:

Código:
Sub MuereNpc(ByVal NpcIndex As Integer, ByVal userindex As Integer)
'********************************************************
'Author: Unknown
'Llamado cuando la vida de un NPC llega a cero.
'Last Modify Date: 24/01/2007
'22/06/06: (Nacho) Chequeamos si es pretoriano
'24/01/2007: Pablo (ToxicWaste): Agrego para actualización de tag si cambia de status.
'********************************************************
On Error GoTo Errhandler
    Dim MiNPC As npc
    MiNPC = Npclist(NpcIndex)
    Dim EraCriminal As Boolean
Y debajo ponen:

Código:
If ucase$(MiNPC.numero) = 501 Then 'Cambien 501 por el numero de su npc.
    Call SendData(SendTarget.ToAll, userindex, PrepareMessageConsoleMsg("Servidor> " & UserList(userindex).name & " ha detruido a la feroz criatura! Nuestro mundo se mantiene en paz... Pero los dioses prometen regresarla.", FontTypeNames.fonttype_consejo))
    WriteConsolemsg userindex, "¡Recibes 15000 monedas de oro por haber destruido a la criatura feroz que atacaba a nuestro mundo!", fonttypenames.FONTTYPE_CONSEJO
    Userlist(Userindex).flags.GLD = Userlist(Userindex).flags.GLD + 15000
  End If
Al final del protocol.bas, poner:

Código:
Public sub HandleEvento(Byval userindex as integer)
Dim MapadelNPC as Worldpos
With userlist(userindex)
Call .incomingData.readByte
If not .flags.privilegios > 0 then exit sub
MapadelNPC.Map = .incomingdata.readbyte()
Mapadelnpc.x = .incomingdata.readbyte()
MapadelNPC.Y = .incomingdata.readbyte()
Call SpawnNpc(X, Mapadelnpcjefe, True, False) 'Cambia la X por el numero de la criatura segun NPCs.dat
 
Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Servidor> ¡Los dioses se han despertado de muy malhumor y por eso han despertado a la criatura mas feroz de estas tierras, que aparecio en el Mapa " & MapadelNPC.Map & " X: " & Mapadelnpc.x & " Y: " & Mapadelnpc.x"! ¿Te atravez a destruirla?", FontTypeNames.FONTTYPE_SERVER))
End with
End sub
Buscar:

Código:
Select Case packetID
Debajo poner:

Código:
Case ClientPacketID.Evento
            Call HandleEvento(userindex)
CLIENTE:

Buscamos:

Código:
Public Enum ClientPacketID
debajo ponemos:

Código:
Evento          '/EVENTO
Al final del protocol.bas, ponemos

Código:
Public sub WriteEvento(byval Mapa as byte, Byval PosX as byte, Byval PosY as byte)
with outgoingdata
    Call .writebyte(ClientPacketID.Evento)
    Call .WriteByte(Mapa)
    Call .WriteByte(PosX)
    Call .WriteByte(PosY)
End with
End sub
Buscamos:

Código:
Case "/ONLINE"
Código:
Case "/EVENTO"
                If notNullArguments Then
                    tmpArr = Split(ArgumentosRaw, "@")
                    If UBound(tmpArr) = 2 Then
                        If ValidNumber(tmpArr(0), eNumber_Types.ent_Byte) And ValidNumber(tmpArr(1), eNumber_Types.ent_Byte) and ValidNumber(tmpArr(2), eNumber_Types.ent_Byte)Then
                            Call WriteEvento(tmpArr(0), tmpArr(1), tmpArr(2))
                        Else
                            'No es numerico
                            Call ShowConsoleMsg("Parametros incorrecto. Utilice /EVENTO MAPA@POSX@POSY.")
                        End If
                Else
                    'Avisar que falta el parametro
                    Call ShowConsoleMsg("Faltan parámetros. Utilice /EVENTO MAPA@POSX@POSY.")
                End If
        end if
FUENTE 100% GS-ZONE Saludos. Very Happy 
Volver arriba Ir abajo
Ver perfil de usuario
 
Eventos Automaticos x.13
Volver arriba 
Página 1 de 1.
 Temas similares
-
» JUEVES 23 DE JUNIO DE 2011 POR FAVOR DEJEN SUS MJES. DIARIOS AQUÍ. GRACIAS!!
» SABADO 7 DE ENERO DE 2012. POR FAVOR DEJEN SUS MJES. DIARIOS AQUÍ .GRACIAS

Permisos de este foro:No puedes responder a temas en este foro.
 :: Argentum Online :: Talleres Taller Argentum :: Programación-
Cambiar a: