ZankuR Director
Cantidad de envíos : 107 Fecha de inscripción : 19/07/2013
| Tema: 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 equiposacá 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 TPAOUn 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. | |
|