Luciano_fuentes

Daga Rusa

Mar 15th, 2017
615
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2. '***************
  3. 'AUTOR: Toyz - Luciano
  4. 'FECHA: 19/12/16
  5. '***************
  6.  
  7. Private Const Tiempo_Cancelamiento As Integer = 180
  8.  
  9. Public Const NPC_DAGA_RUSA As Integer = 1050
  10. Public INDEX_NPC_DAGA_RUSA_ONLINE As Integer
  11.  
  12. Private Type tUsuario
  13.     ID As Integer
  14.     Posicion As WorldPos
  15. End Type
  16.  
  17. Private Type tDagaRusa
  18.     Activo As Boolean
  19.     Usuarios() As tUsuario
  20.     Conteo As Integer
  21.     Cupos As Byte
  22.     CoordenadasEspera As WorldPos
  23.     CoordenadasArena As WorldPos
  24.     CoordenadasNPC As WorldPos
  25.     Premio As Long
  26.     Inscripcion As Long
  27.     Total As Byte
  28.     Restantes As Byte
  29.     AtacoUser As Integer
  30.     Atacar As Integer
  31.     PuedeAtacar As Boolean
  32.     ActivarEvento As Boolean
  33.     Volver As Boolean
  34. End Type
  35.  
  36. Private DagaRusa As tDagaRusa
  37.  
  38. Public Sub Carga_DagaRusa()
  39.  
  40.     Dim Leer As clsIniReader
  41.     Set Leer = New clsIniReader
  42.     Call Leer.Initialize(App.Path & "\Dat\DagaRusa.dat")
  43.  
  44.     With DagaRusa.CoordenadasArena
  45.         .Map = CInt(Leer.GetValue("EVENTO", "Mapa_Espera"))
  46.         .X = CByte(Leer.GetValue("EVENTO", "X_Espera"))
  47.         .Y = CByte(Leer.GetValue("EVENTO", "Y_Espera"))
  48.     End With
  49.  
  50.     With DagaRusa.CoordenadasEspera
  51.         .Map = CInt(Leer.GetValue("EVENTO", "Mapa_Arena"))
  52.         .X = CByte(Leer.GetValue("EVENTO", "X_Arena"))
  53.         .Y = CByte(Leer.GetValue("EVENTO", "Y_Arena"))
  54.     End With
  55.  
  56. End Sub
  57.  
  58. Public Sub Armar_DagaRusa(ByVal ID As Integer, ByVal Cupos As Byte, ByVal Premio As Long, ByVal Inscripcion As Long)
  59.  
  60.     With DagaRusa
  61.         If .Activo = True Then
  62.             Call WriteConsoleMsg(ID, "Daga Rusa> El evento ya está en curso.", FontTypeNames.FONTTYPE_GUILD)
  63.             Exit Sub
  64.         End If
  65.  
  66.         If Cupos > 16 Then Cupos = 16
  67.         If Cupos < 2 Then Cupos = 2
  68.         If Premio <= 0 Then Premio = 1
  69.        
  70.         .Cupos = Cupos
  71.         .Inscripcion = Inscripcion
  72.         .Premio = Premio
  73.         .Total = .Cupos
  74.         .Restantes = .Total
  75.         .Activo = True
  76.         .Conteo = Tiempo_Cancelamiento
  77.         ReDim .Usuarios(1 To .Cupos) As tUsuario
  78.        
  79.         Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> " & .Cupos & " Cupos, Incripción" & IIf(.Inscripcion > 0, " de: " & .Inscripcion & " Monedas de oro, ", " Gratis, ") & IIf(.Premio > 0, "Premio de: " & .Premio & " Monedas de oro.", " No hay premio.") & " Manden /DAGARUSA si desean participar.", FontTypeNames.FONTTYPE_GUILD))
  80.     End With
  81.  
  82. End Sub
  83.  
  84. Public Sub Entrar_DagaRusa(ByVal ID As Integer)
  85.  
  86.     Dim ID_DagaRusa As Byte
  87.     Dim LoopC As Long
  88.  
  89.     With DagaRusa
  90.         If Puede_Entrar(ID) = False Then _
  91.            Exit Sub
  92.  
  93.         Call WriteConsoleMsg(ID, "Has ingresado al evento" & IIf(.Inscripcion > 0, ", se te han descontado " & .Inscripcion & " monedas de oro.", vbNullString) & ". Espera a que el cupo se complete. ¡Suerte en el campo de batalla!", FontTypeNames.FONTTYPE_GUILD)
  94.  
  95.         UserList(ID).Stats.GLD = UserList(ID).Stats.GLD - .Inscripcion
  96.         ID_DagaRusa = DagaRusa_ID
  97.         UserList(ID).flags.EnDagaRusa = ID_DagaRusa
  98.  
  99.         .Cupos = .Cupos - 1
  100.         .Usuarios(ID_DagaRusa).ID = ID
  101.         .Usuarios(ID_DagaRusa).Posicion = UserList(ID).pos
  102.  
  103.         With DagaRusa.CoordenadasEspera
  104.             WarpUserChar ID, .Map, .X, .Y, False
  105.         End With
  106.  
  107.         WritePauseToggle ID
  108.         WriteUpdateGold ID
  109.  
  110.         If .Cupos = 0 Then
  111.             For LoopC = 1 To .Total
  112.                 WarpUserChar .Usuarios(LoopC).ID, .CoordenadasArena.Map, .CoordenadasArena.X + LoopC, .CoordenadasArena.Y, True
  113.             Next LoopC
  114.             Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> El cupo ha sido completado!", FontTypeNames.FONTTYPE_GUILD))
  115.             .ActivarEvento = True
  116.             .Conteo = 10
  117.             .CoordenadasNPC = UserList(.Usuarios(1).ID).pos
  118.             .CoordenadasNPC.Y = .CoordenadasNPC.Y - 1
  119.             SpawnNpc NPC_DAGA_RUSA, .CoordenadasNPC, False, False
  120.         End If
  121.     End With
  122.  
  123. End Sub
  124.  
  125. Private Function DagaRusa_ID() As Byte
  126.  
  127.     Dim LoopC As Long
  128.  
  129.     With DagaRusa
  130.         For LoopC = 1 To .Total
  131.             If .Usuarios(LoopC).ID = 0 Then
  132.                 DagaRusa_ID = LoopC
  133.                 Exit Function
  134.             End If
  135.         Next LoopC
  136.     End With
  137.  
  138. End Function
  139.  
  140. Private Function Puede_Entrar(ByVal ID As Integer) As Boolean
  141.  
  142.     Puede_Entrar = False
  143.  
  144.     If UserList(ID).flags.Muerto > 0 Then
  145.         Call WriteConsoleMsg(ID, "Estás muerto.", FontTypeNames.FONTTYPE_GUILD)
  146.         Exit Function
  147.     End If
  148.  
  149.     'If UserList(ID).flags.EnJDH > 0 Then
  150.    '    Call WriteConsoleMsg(ID, "Estás en los Juegos del Hambre.", FontTypeNames.FONTTYPE_GUILD)
  151.     '    Exit Function
  152.    'End If
  153.  
  154.     'If UserList(ID).flags.EnPlantes > 0 Then
  155.    '    Call WriteConsoleMsg(ID, "Ya estás en Plantes Automáticos.", FontTypeNames.FONTTYPE_GUILD)
  156.     '    Exit Function
  157.    'End If
  158.  
  159.     If UserList(ID).flags.EnDagaRusa > 0 Then
  160.         Call WriteConsoleMsg(ID, "Ya estás en el en Daga Rusa.", FontTypeNames.FONTTYPE_GUILD)
  161.         Exit Function
  162.     End If
  163.  
  164.     If DagaRusa.Activo = False Then
  165.         Call WriteConsoleMsg(ID, "El evento no está en curso.", FontTypeNames.FONTTYPE_GUILD)
  166.         Exit Function
  167.     End If
  168.  
  169.     If DagaRusa.Cupos = 0 Then
  170.         Call WriteConsoleMsg(ID, "El evento ya no tiene cupos disponibles.", FontTypeNames.FONTTYPE_GUILD)
  171.         Exit Function
  172.     End If
  173.  
  174.     If UserList(ID).Stats.GLD < DagaRusa.Inscripcion Then
  175.         Call WriteConsoleMsg(ID, "No tienes el oro suficiente.", FontTypeNames.FONTTYPE_GUILD)
  176.         Exit Function
  177.     End If
  178.  
  179.     If Not UserList(ID).pos.Map = 1 Then
  180.         Call WriteConsoleMsg(ID, "Tienes que estar en Ullathorpe para poder ingresar al evento", FontTypeNames.FONTTYPE_GUILD)
  181.         Exit Function
  182.     End If
  183.    
  184.     If Tiene_Objeto(ID) = False Then
  185.         Call WriteConsoleMsg(ID, "No tienes que tener ningún objeto en tu inventario para ingresar al evento.", FontTypeNames.FONTTYPE_GUILD)
  186.         'Exit Function
  187.    End If
  188.  
  189.    Puede_Entrar = True
  190.  
  191. End Function
  192.  
  193. Public Sub Contar_DagaRusa()
  194.  
  195.    Dim LoopC As Long
  196.    Dim LoopX As Long
  197.    Dim ID_DagaRusa As Byte
  198.  
  199.    With DagaRusa
  200.        If .Conteo = 0 Then
  201.            .Conteo = -1
  202.            If .Activo = True Then
  203.                If .ActivarEvento = True Then
  204.                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> Ya!", FontTypeNames.FONTTYPE_FIGHT)
  205.                    .PuedeAtacar = True
  206.                Else
  207.                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> Evento cancelado por falta de participantes, se ha devuelto el oro por la inscripción.", FontTypeNames.FONTTYPE_GUILD)
  208.                    Cancelar_DagaRusa
  209.                End If
  210.            End If
  211.        End If
  212.    '        .Conteo = 3
  213.         If .Conteo > 0 Then
  214.             If .ActivarEvento = True Then _
  215.                SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> " & .Conteo, FontTypeNames.FONTTYPE_GUILD)
  216.             .Conteo = .Conteo - 1
  217.         End If
  218.     End With
  219. End Sub
  220.  
  221. Public Sub IA_NPC_DAGARUSA(ByVal NpcIndex As Integer)
  222.  
  223.     Dim Y As Long
  224.     Dim X As Long
  225.     Dim UI As Integer
  226.     Dim tHeading As Byte
  227.  
  228.     With Npclist(NpcIndex)
  229.         If DagaRusa.PuedeAtacar = True Then
  230.             If DagaRusa.Atacar > 0 Then
  231.                 NpcAtacaUser NpcIndex, DagaRusa.Atacar
  232.                 DagaRusa.AtacoUser = DagaRusa.Atacar
  233.                 DagaRusa.Atacar = 0
  234.             End If
  235.  
  236.             For Y = .pos.Y To .pos.Y + RANGO_VISION_Y
  237.                 For X = .pos.X To .pos.X + RANGO_VISION_Y
  238.                     If X >= MinXBorder And X <= MaxXBorder And Y >= MinYBorder And Y <= MaxYBorder Then
  239.                         UI = MapData(.pos.Map, X, Y).UserIndex
  240.                         If UI > 0 Then
  241.                             If UI <> DagaRusa.AtacoUser Then
  242.                                 If DagaRusa.Volver = False Then
  243.                                     If Distancia(.pos, UserList(UI).pos) <= 1 Then
  244.                                         If DagaRusa.Atacar = 0 Then
  245.                                             DagaRusa.Atacar = UI
  246.                                             .Char.Heading = SOUTH
  247.                                             ChangeNPCChar NpcIndex, .Char.Body, .Char.Head, .Char.Heading
  248.                                             Exit Sub
  249.                                         End If
  250.                                     End If
  251.                                     If UserList(UI).flags.EnDagaRusa = Total Then DagaRusa.Volver = True
  252.                                     tHeading = FindDirection(Npclist(NpcIndex).pos, UserList(UI).pos)
  253.                                 Else
  254.                                     tHeading = FindDirection(Npclist(NpcIndex).pos, DagaRusa.CoordenadasNPC)
  255.                                 End If
  256.                                 MoveNPCChar NpcIndex, tHeading
  257.                                 Exit Sub
  258.                             End If
  259.                         End If
  260.                     End If
  261.                 Next X
  262.             Next Y
  263.         End If
  264.     End With
  265. End Sub
  266.  
  267. Private Function ID_Usuario() As Byte
  268.  
  269.     Dim LoopC As Long
  270.  
  271.     For LoopC = 1 To DagaRusa.Total
  272.         If DagaRusa.Usuarios(LoopC).ID > 0 Then
  273.             ID_Usuario = LoopC
  274.             Exit For
  275.         End If
  276.     Next LoopC
  277.  
  278. End Function
  279.  
  280. Public Sub Apuñalado_DagaRusa(ByVal ID As Integer)
  281.  
  282.     Dim ID_DagaRusa As Byte
  283.  
  284.     ID_DagaRusa = UserList(ID).flags.EnDagaRusa
  285.     UserList(ID).flags.EnDagaRusa = 0
  286.  
  287.     With DagaRusa
  288.         .Restantes = .Restantes - 1
  289.         If .Restantes > 1 Then SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> Quedan " & .Restantes & " participantes.", FontTypeNames.FONTTYPE_GUILD)
  290.         Call WriteConsoleMsg(ID, "Daga Rusa> ¡Has perdido, has sido descalificado. ¡Suerte para la próxima!", FontTypeNames.FONTTYPE_GUILD)
  291.         WarpUserChar ID, .Usuarios(ID_DagaRusa).Posicion.Map, .Usuarios(ID_DagaRusa).Posicion.X, .Usuarios(ID_DagaRusa).Posicion.Y, False
  292.         .Usuarios(ID_DagaRusa).ID = 0
  293.         If .Restantes = 1 Then
  294.             Call QuitarNPC(INDEX_NPC_DAGA_RUSA_ONLINE)
  295.             Call Finalizar
  296.         End If
  297.     End With
  298.  
  299. End Sub
  300.  
  301. Private Sub Finalizar()
  302.  
  303.     Dim LoopC As Long
  304.     Dim Dame_ID As Byte
  305.     Dim ID As Integer
  306.  
  307.     With DagaRusa
  308.         Dame_ID = ID_Usuario
  309.         ID = .Usuarios(Dame_ID).ID
  310.         SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> Ganador del evento: " & UserList(ID).name & " se lleva una cantidad de " & .Premio & " monedas de oro, felicitaciones!", FontTypeNames.FONTTYPE_GUILD)
  311.         UserList(ID).Stats.GLD = UserList(ID).Stats.GLD + .Premio
  312.  
  313.         WriteUpdateGold ID
  314.         UserList(ID).flags.EnDagaRusa = 0
  315.         .Premio = 0
  316.         WarpUserChar ID, .Usuarios(Dame_ID).Posicion.Map, .Usuarios(Dame_ID).Posicion.X, .Usuarios(Dame_ID).Posicion.Y, False
  317.         Call Limpiar
  318.     End With
  319. End Sub
  320.  
  321. Public Sub Cancelar_DagaRusa()
  322.  
  323.     Dim LoopC As Long
  324.  
  325.     With DagaRusa
  326.  
  327.         If .Activo = False Then Exit Sub
  328.  
  329.         For LoopC = 1 To .Total
  330.             If .Usuarios(LoopC).ID > 0 Then
  331.                 WarpUserChar .Usuarios(LoopC).ID, .Usuarios(LoopC).Posicion.Map, .Usuarios(LoopC).Posicion.X, .Usuarios(LoopC).Posicion.Y, False
  332.                 UserList(.Usuarios(LoopC).ID).flags.EnDagaRusa = 0
  333.                 UserList(.Usuarios(LoopC).ID).Stats.GLD = UserList(.Usuarios(LoopC).ID).Stats.GLD + .Inscripcion
  334.  
  335.                 WriteConsoleMsg .Usuarios(LoopC).ID, "El evento ha sido cancelado, se te ha devuelto el costo de la inscripción.", FontTypeNames.FONTTYPE_GUILD
  336.                 WriteUpdateGold .Usuarios(LoopC).ID
  337.             End If
  338.         Next LoopC
  339.     End With
  340.  
  341.     SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Daga Rusa> Evento fue cancelado por un Game Master.", FontTypeNames.FONTTYPE_GUILD)
  342.     Limpiar
  343.  
  344. End Sub
  345.  
  346. Public Sub Desconexion_DagaRusa(ByVal ID As Integer)
  347.  
  348.     If UserList(ID).flags.EnDagaRusa = 0 Then Exit Sub
  349.  
  350.     With DagaRusa
  351.         WarpUserChar ID, .Usuarios(UserList(ID).flags.EnDagaRusa).Posicion.Map, .Usuarios(UserList(ID).flags.EnDagaRusa).Posicion.X, .Usuarios(UserList(ID).flags.EnDagaRusa).Posicion.Y, True
  352.         .Usuarios(UserList(ID).flags.EnDagaRusa).ID = 0
  353.         UserList(ID).flags.EnDagaRusa = 0
  354.         .Cupos = .Cupos + 1
  355.         WritePauseToggle ID
  356.     End With
  357.  
  358. End Sub
  359.  
  360. Private Sub Limpiar()
  361.  
  362.     With DagaRusa
  363.         .Activo = False
  364.         .Conteo = -1
  365.         .Cupos = 0
  366.         .Inscripcion = 0
  367.         .Premio = 0
  368.         .Restantes = 0
  369.         .Total = 0
  370.         .AtacoUser = 0
  371.         .Atacar = 0
  372.         .PuedeAtacar = False
  373.         .ActivarEvento = False
  374.         Erase .Usuarios()
  375.     End With
  376.     INDEX_NPC_DAGA_RUSA_ONLINE = 0
  377. End Sub
  378.  
  379. Private Function Tiene_Objeto(ByVal ID As Integer) As Boolean
  380.     Dim LoopC As Long
  381.     Tiene_Objeto = False
  382.     With UserList(ID)
  383.         For LoopC = 1 To .CurrentInventorySlots
  384.             If .Invent.Object(LoopC).ObjIndex > 0 Then Exit Function
  385.         Next LoopC
  386.         Tiene_Objeto = True
  387.     End With
  388. End Function
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×