deD33

EventoDS

Apr 19th, 2021
597
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.  
  3. Public Const MAX_EVENT_SIMULTANEO As Byte = 5
  4. Public Const MAX_USERS_EVENT As Byte = 64
  5. Public Const MAX_MAP_FIGHT As Byte = 4
  6. Public Const MAP_TILE_VS As Byte = 17
  7.  
  8. Public Const MAP_TOP_PLAYERS As Byte = 207
  9.  
  10. Public Enum eModalityEvent
  11.     CastleMode = 1
  12.     DagaRusa = 2
  13.     DeathMatch = 3
  14.     Aracnus = 4
  15.     HombreLobo = 5
  16.     Minotauro = 6
  17.     Busqueda = 7
  18.     Unstoppable = 8
  19.     Invasion = 9
  20.     Enfrentamientos = 10
  21. End Enum
  22.  
  23. Private Type tUserEvent
  24.     Id As Integer
  25.     Team As Byte
  26.     Value As Integer
  27.     Selected As Byte
  28.     MapFight As Byte
  29. End Type
  30.  
  31. Public Enum eFaction
  32.     fCrim = 0
  33.     fCiu = 1
  34.     fLegion = 2
  35.     fArmada = 3
  36. End Enum
  37.  
  38. Private Type tEvents
  39.     Enabled As Boolean
  40.     Run As Boolean
  41.     Modality As eModalityEvent
  42.     TeamCant As Byte
  43.    
  44.     Quotas As Byte
  45.     Inscribed As Byte
  46.    
  47.     LvlMax As Byte
  48.     LvlMin As Byte
  49.    
  50.     GldInscription As Long
  51.     DspInscription As Long
  52.    
  53.     AllowedClasses() As Byte
  54.     AllowedFaction() As eFaction
  55.    
  56.     PrizeAccumulated As Boolean
  57.     PrizeDsp As Integer
  58.     PrizeGld As Long
  59.     PrizeObj As Obj
  60.    
  61.     LimitRed As Integer
  62.    
  63.     ValidItem As Boolean
  64.     WinFollow As Boolean
  65.                      
  66.     TimeInit As Long
  67.     TimeCancel As Long
  68.     TimeCount As Long
  69.     TimeFinish As Long
  70.    
  71.     Users() As tUserEvent
  72.    
  73.     ' Por si alguno es con NPC
  74.    NpcIndex As Integer
  75.    
  76.     ' Por si cambia el body del personaje y saca todo lo otro.
  77.    CharBody As Integer
  78.     CharHp As Integer
  79.    
  80.     npcUserIndex As Integer
  81. End Type
  82.  
  83. Public Events(1 To MAX_EVENT_SIMULTANEO) As tEvents
  84.  
  85. Private Type tMap
  86.     Run As Boolean
  87.     map As Integer
  88.     X As Byte
  89.     Y As Byte
  90. End Type
  91.  
  92. Private Type tMapEvent
  93.     Fight(1 To MAX_MAP_FIGHT) As tMap
  94. End Type
  95.  
  96. Private MapEvent As tMapEvent
  97.  
  98.  
  99.  
  100. Public Sub LoadMapEvent()
  101. 10        With MapEvent
  102. 20            .Fight(1).Run = False
  103. 30            .Fight(1).map = 217
  104. 40            .Fight(1).X = 16 '+17
  105. 50            .Fight(1).Y = 12 '+17
  106.              
  107. 60            .Fight(2).Run = False
  108. 70            .Fight(2).map = 217
  109. 80            .Fight(2).X = 16 '+17
  110. 90            .Fight(2).Y = 41 '+17
  111. 100           .Fight(3).Run = False
  112. 110           .Fight(3).map = 217
  113. 120           .Fight(3).X = 16 '+17
  114. 130           .Fight(3).Y = 68 '+17
  115.              
  116. 140           .Fight(4).Run = False
  117. 150           .Fight(4).map = 217
  118. 160           .Fight(4).X = 46 '+17
  119. 170           .Fight(4).Y = 12 '+17
  120.          
  121.          
  122.          
  123. 180       End With
  124. End Sub
  125.  
  126. '// Funcion para enviar un wav a los 5 segundos restantes de cualquier evento. '//
  127. Private Function SendWavs(ByVal Segs As Integer) As Byte
  128.  
  129.     Dim i As Integer
  130.    
  131.     For i = 1 To LastUser
  132.         With UserList(i)
  133.             Select Case Segs
  134.                 Case 5
  135.                     SendData SendTarget.ToAll, i, PrepareMessagePlayWave(EVENTO_5, .Pos.X, .Pos.Y)
  136.                 Case 4
  137.                     SendData SendTarget.ToAll, i, PrepareMessagePlayWave(EVENTO_4, .Pos.X, .Pos.Y)
  138.                 Case 3
  139.                     SendData SendTarget.ToAll, i, PrepareMessagePlayWave(EVENTO_3, .Pos.X, .Pos.Y)
  140.                 Case 2
  141.                     SendData SendTarget.ToAll, i, PrepareMessagePlayWave(EVENTO_2, .Pos.X, .Pos.Y)
  142.                 Case 1
  143.                     SendData SendTarget.ToAll, i, PrepareMessagePlayWave(EVENTO_1, .Pos.X, .Pos.Y)
  144.             End Select
  145.         End With
  146.     Next i
  147.    
  148. End Function
  149. '/MANEJO DE LOS TIEMPOS '/
  150. Public Sub LoopEvent()
  151. 10    On Error GoTo error
  152.           Dim Loopc As Long
  153.           Dim LoopY As Integer
  154.           Dim uIndex As Integer
  155.          
  156. 20        For Loopc = 1 To MAX_EVENT_SIMULTANEO
  157. 30            With Events(Loopc)
  158.                
  159. 40                If .Enabled Then
  160. 50                    If .TimeInit > 0 Then
  161. 60                        .TimeInit = .TimeInit - 1
  162.                        
  163.                         'With UserList(UserIndex)
  164.                              
  165. 70                        Select Case .TimeInit
  166.                               Case 0
  167.                               '
  168.                            
  169.                               Case 1
  170.                                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(Loopc, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit) & " segundo.", FontTypeNames.FONTTYPE_GUILD)
  171.                                 Call SendWavs(1)
  172.                               Case 2
  173.                                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(Loopc, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit) & " segundos.", FontTypeNames.FONTTYPE_GUILD)
  174.                                 Call SendWavs(2)
  175.                               Case 3
  176.                                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(Loopc, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit) & " segundos.", FontTypeNames.FONTTYPE_GUILD)
  177.                                 Call SendWavs(3)
  178.                               Case 4
  179.                                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(Loopc, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit) & " segundos.", FontTypeNames.FONTTYPE_GUILD)
  180.                                 Call SendWavs(4)
  181.                               Case 5
  182.                                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(Loopc, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit) & " segundos.", FontTypeNames.FONTTYPE_GUILD)
  183.                                 Call SendWavs(5)
  184.                                
  185.                            
  186.                               Case 30
  187.                                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(Loopc, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit) & " segundos.", FontTypeNames.FONTTYPE_GUILD)
  188.  
  189. 80                            Case 60
  190. 90                                SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(29, FontTypeNames.FONTTYPE_GUILD, Int(.TimeInit / 60), , , , strModality(Loopc, .Modality))
  191.                                   'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(LoopC, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit / 60) & " minuto.", FontTypeNames.FONTTYPE_GUILD)
  192. 100                           Case 120
  193. 110                               SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(28, FontTypeNames.FONTTYPE_GUILD, Int(.TimeInit / 60), , , , strModality(Loopc, .Modality))
  194.                                   'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(LoopC, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit / 60) & " minutos.", FontTypeNames.FONTTYPE_GUILD)
  195. 120                           Case 180
  196. 130                               SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(28, FontTypeNames.FONTTYPE_GUILD, Int(.TimeInit / 60), , , , strModality(Loopc, .Modality))
  197.                                   'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(LoopC, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit / 60) & " minutos.", FontTypeNames.FONTTYPE_GUILD)
  198. 140                           Case 240
  199. 150                               SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(28, FontTypeNames.FONTTYPE_GUILD, Int(.TimeInit / 60), , , , strModality(Loopc, .Modality))
  200.                                   'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(LoopC, .Modality) & "» Las inscripciones abren en " & Int(.TimeInit / 60) & " minutos.", FontTypeNames.FONTTYPE_GUILD)
  201. 160                       End Select
  202.                         'End With
  203. 170                       If .TimeInit <= 0 Then
  204. 180                           SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(30, FontTypeNames.FONTTYPE_GUILD, , , , , strModality(Loopc, .Modality))
  205.                               'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(LoopC, .Modality) & "» Inscripciones abiertas. /INGRESAR " & strModality(LoopC, .Modality) & " para ingresar al evento. /INFOEVENTO para que entiendas en que consiste el evento.", FontTypeNames.FONTTYPE_GUILD)
  206. 190                           .TimeCancel = 0
  207. 200                       End If
  208.                          
  209.                      
  210. 210                   End If
  211.                      
  212. 220                   If .TimeCancel > 0 And .TimeInit > 0 Then
  213. 230                       .TimeCancel = .TimeCancel - 1
  214.                          
  215. 240                       If .TimeCancel <= 0 Then
  216.                               'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(.Modality) & "» Ha sido cancelado ya que no se completaron los cupos.", FontTypeNames.FONTTYPE_WARNING)
  217. 250                           EventosDS.CloseEvent Loopc, "Evento " & strModality(Loopc, .Modality) & " cancelado.", True
  218. 260                       End If
  219. 270                   End If
  220.                      
  221. 280                   If .TimeCount > 0 Then
  222. 290                       .TimeCount = .TimeCount - 1
  223.                          
  224. 300                       For LoopY = LBound(.Users()) To UBound(.Users())
  225. 310                           If .Users(LoopY).Id > 0 Then
  226. 320                               If .TimeCount = 0 Then
  227.                                       'WriteConsoleMsg .Users(LoopY).Id, "Cuenta» ¡Comienza!", FontTypeNames.FONTTYPE_FIGHT
  228. 330                                   WriteShortMsj .Users(LoopY).Id, 31, FontTypeNames.FONTTYPE_FIGHT
  229. 340                               Else
  230.                                       'WriteConsoleMsg .Users(LoopY).Id, "Cuenta» " & .TimeCount, FontTypeNames.FONTTYPE_GUILD
  231. 350                                   WriteShortMsj .Users(LoopY).Id, 32, FontTypeNames.FONTTYPE_GUILD, .TimeCount
  232. 360                               End If
  233. 370                           End If
  234. 380                       Next LoopY
  235. 390                   End If
  236.                      
  237. 400                   If .NpcIndex > 0 Then
  238. 410                      If Events(Npclist(.NpcIndex).flags.SlotEvent).TimeCount > 0 Then Exit Sub
  239. 420                      Call DagaRusa_MoveNpc(.NpcIndex)
  240. 430                   End If
  241.                      
  242. 440                   If .TimeFinish > 0 Then
  243. 450                       .TimeFinish = .TimeFinish - 1
  244.                          
  245. 460                       If .TimeFinish = 0 Then
  246. 470                           Call FinishEvent(Loopc)
  247. 480                       End If
  248. 490                   End If
  249. 500               End If
  250.          
  251.                
  252. 510           End With
  253.            
  254. 520       Next Loopc
  255.        
  256. 530   Exit Sub
  257.  
  258. error:
  259. 540       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : LoopEvent()"
  260. End Sub
  261.  
  262. '/ FIN MANEJO DE LOS TIEMPOS
  263. Public Function SetInfoEvento() As String
  264.           Dim strTemp As String
  265.           Dim Loopc As Integer
  266.          
  267. 10        For Loopc = 1 To EventosDS.MAX_EVENT_SIMULTANEO
  268. 20            With Events(Loopc)
  269. 30                If .Enabled Then
  270. 40                    strTemp = strModality(Loopc, .Modality)
  271. 50                    SetInfoEvento = SetInfoEvento & strTemp & "» " & strDescEvent(Loopc, .Modality) & ". Se ingresa mediante: /INGRESAR " & strTemp
  272.                      
  273. 60                    If .Run Then
  274. 70                        SetInfoEvento = SetInfoEvento & " Inscripciones cerradas."
  275. 80                    Else
  276. 90                        If .TimeInit > 0 Then
  277. 100                           SetInfoEvento = SetInfoEvento & " Inscripciones abren en " & Int(.TimeInit / 60) & " minuto/s"
  278. 110                       Else
  279. 120                           SetInfoEvento = SetInfoEvento & " Inscripciones abiertas."
  280. 130                       End If
  281. 140                   End If
  282.                      
  283.                      
  284. 150                   SetInfoEvento = SetInfoEvento & vbCrLf
  285. 160               End If
  286. 170           End With
  287. 180       Next Loopc
  288.  
  289. End Function
  290.  
  291. '// Funciones generales '//
  292. Private Function FreeSlotEvent() As Byte
  293.           Dim Loopc As Integer
  294.          
  295. 10        For Loopc = 1 To MAX_EVENT_SIMULTANEO
  296. 20            If Not Events(Loopc).Enabled Then
  297. 30                FreeSlotEvent = Loopc
  298. 40                Exit For
  299. 50            End If
  300. 60        Next Loopc
  301. End Function
  302.  
  303. Private Function FreeSlotUser(ByVal SlotEvent As Byte) As Byte
  304.           Dim Loopc As Integer
  305.          
  306. 10        With Events(SlotEvent)
  307. 20            For Loopc = 1 To MAX_USERS_EVENT
  308. 30                If .Users(Loopc).Id = 0 Then
  309. 40                    FreeSlotUser = Loopc
  310. 50                    Exit For
  311. 60                End If
  312. 70            Next Loopc
  313. 80        End With
  314.          
  315. End Function
  316.  
  317. Private Function FreeSlotArena() As Byte
  318.           Dim Loopc As Integer
  319.          
  320. 10        FreeSlotArena = 0
  321.          
  322. 20        For Loopc = 1 To MAX_MAP_FIGHT
  323. 30            If MapEvent.Fight(Loopc).Run = False Then
  324. 40                FreeSlotArena = Loopc
  325. 50                Exit For
  326. 60            End If
  327. 70        Next Loopc
  328. End Function
  329. Public Function strUsersEvent(ByVal SlotEvent As Byte) As String
  330.  
  331.           ' Texto que marca los personajes que están en el evento.
  332.          Dim Loopc As Integer
  333.          
  334. 10        With Events(SlotEvent)
  335. 20            For Loopc = LBound(.Users()) To UBound(.Users())
  336. 30                If .Users(Loopc).Id > 0 Then
  337. 40                    strUsersEvent = strUsersEvent & UserList(.Users(Loopc).Id).Name & "-"
  338. 50                End If
  339. 60            Next Loopc
  340. 70        End With
  341. End Function
  342. Private Function CheckAllowedClasses(ByRef AllowedClasses() As Byte) As String
  343.           Dim Loopc As Integer
  344.          
  345. 10        For Loopc = 1 To NUMCLASES
  346. 20            If AllowedClasses(Loopc) = 1 Then
  347. 30                If CheckAllowedClasses = vbNullString Then
  348. 40                    CheckAllowedClasses = ListaClases(Loopc)
  349. 50                Else
  350. 60                    CheckAllowedClasses = CheckAllowedClasses & ", " & ListaClases(Loopc)
  351. 70                End If
  352. 80            End If
  353. 90        Next Loopc
  354.          
  355. End Function
  356. ' // último usuario en el evento = ganador. //
  357. Private Function SearchLastUserEvent(ByVal SlotEvent As Byte) As Integer
  358.  
  359.           ' Busca el último usuario que está en el torneo. En todos los eventos será el ganador.
  360.          
  361.           Dim Loopc As Integer
  362.          
  363. 10        With Events(SlotEvent)
  364. 20            For Loopc = LBound(.Users()) To UBound(.Users())
  365. 30                If .Users(Loopc).Id > 0 Then
  366. 40                    SearchLastUserEvent = .Users(Loopc).Id
  367. 50                    Exit For
  368. 60                End If
  369. 70            Next Loopc
  370. 80        End With
  371. End Function
  372.  
  373.  
  374.  
  375. Private Function SearchSlotEvent(ByVal Modality As String) As Byte
  376.           Dim Loopc As Integer
  377.          
  378. 10        SearchSlotEvent = 0
  379.          
  380. 20        For Loopc = 1 To MAX_EVENT_SIMULTANEO
  381. 30            With Events(Loopc)
  382. 40                If StrComp(UCase$(strModality(Loopc, .Modality)), UCase$(Modality)) = 0 Then
  383. 50                    SearchSlotEvent = Loopc
  384. 60                    Exit For
  385. 70                End If
  386. 80            End With
  387. 90        Next Loopc
  388.  
  389. End Function
  390.  
  391. Private Sub EventWarpUser(ByVal UserIndex As Integer, ByVal map As Integer, ByVal X As Byte, ByVal Y As Byte)
  392. 10    On Error GoTo error
  393.  
  394.           ' Teletransportamos a cualquier usuario que cumpla con la regla de estar en un evento.
  395.          
  396.           Dim Pos As WorldPos
  397.          
  398. 20        With UserList(UserIndex)
  399. 30            Pos.map = map
  400. 40            Pos.X = X
  401. 50            Pos.Y = Y
  402.              
  403. 60            ClosestStablePos Pos, Pos
  404. 70            WarpUserChar UserIndex, Pos.map, Pos.X, Pos.Y, False
  405.          
  406. 80        End With
  407.          
  408. 90    Exit Sub
  409.  
  410. error:
  411. 100       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : EventWarpUser()"
  412. End Sub
  413. Private Sub ResetEvent(ByVal Slot As Byte)
  414. 10    On Error GoTo error
  415.  
  416.           Dim Loopc As Integer
  417.          
  418. 20        With Events(Slot)
  419. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  420. 40                If .Users(Loopc).Id > 0 Then
  421. 50                    AbandonateEvent .Users(Loopc).Id, False
  422. 60                End If
  423. 70            Next Loopc
  424.              
  425. 80            If .NpcIndex > 0 Then Call QuitarNPC(.NpcIndex)
  426.              
  427. 90            .Enabled = False
  428. 100           .Run = False
  429. 110           .npcUserIndex = 0
  430. 120           .TimeFinish = 0
  431. 130           .TeamCant = 0
  432. 140           .Quotas = 0
  433. 150           .Inscribed = 0
  434. 160           .DspInscription = 0
  435. 170           .GldInscription = 0
  436. 180           .LvlMax = 0
  437. 190           .LvlMin = 0
  438. 200           .TimeCancel = 0
  439. 210           .NpcIndex = 0
  440. 220           .TimeInit = 0
  441. 230           .TimeCount = 0
  442. 240           .CharBody = 0
  443. 250           .CharHp = 0
  444. 260           .Modality = 0
  445.              
  446. 270           For Loopc = LBound(.AllowedClasses()) To UBound(.AllowedClasses())
  447. 280               .AllowedClasses(Loopc) = 0
  448. 290           Next Loopc
  449.              
  450. 300       End With
  451. 310   Exit Sub
  452.  
  453. error:
  454. 320       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : ResetEvent()"
  455. End Sub
  456.  
  457. Private Function CheckUserEvent(ByVal UserIndex As Integer, ByVal SlotEvent As Byte, ByRef ErrorMsg As Integer) As Boolean
  458. 10    On Error GoTo error
  459.  
  460. 20        CheckUserEvent = False
  461.              
  462. 30        With UserList(UserIndex)
  463. 40            If .flags.Muerto Then
  464. 50                ErrorMsg = 33
  465. 60                Exit Function
  466. 70            End If
  467. 80            If .flags.Mimetizado Then
  468. 90                ErrorMsg = 34
  469. 100               Exit Function
  470. 110           End If
  471.              
  472. 120           If .flags.Montando Then
  473. 130               ErrorMsg = 35
  474. 140               Exit Function
  475. 150           End If
  476.              
  477. 160           If .flags.invisible Then
  478. 170               ErrorMsg = 36
  479. 180               Exit Function
  480. 190           End If
  481.              
  482. 200           If .flags.SlotEvent > 0 Then
  483. 210               ErrorMsg = 37
  484. 220               Exit Function
  485. 230           End If
  486.              
  487. 240           If .flags.SlotReto > 0 Then
  488. 250               ErrorMsg = 37
  489. 260               Exit Function
  490. 270           End If
  491.              
  492. 280           If .flags.InCVC Then
  493. 290               ErrorMsg = 37
  494. 300               Exit Function
  495. 310           End If
  496.              
  497. 320           If .Counters.Pena > 0 Then
  498. 330               ErrorMsg = 38
  499. 340               Exit Function
  500. 350           End If
  501.              
  502. 360           If MapInfo(.Pos.map).Pk Then
  503. 370               ErrorMsg = 39
  504. 380               Exit Function
  505. 390           End If
  506.              
  507. 400           If .flags.Comerciando Then
  508. 410               ErrorMsg = 40
  509. 420               Exit Function
  510. 430           End If
  511.              
  512. 440           If Not Events(SlotEvent).Enabled Or Events(SlotEvent).TimeInit > 0 Then
  513. 450               ErrorMsg = 41
  514. 460               Exit Function
  515. 470           End If
  516.              
  517. 480           If Events(SlotEvent).Run Then
  518. 490               ErrorMsg = 42
  519. 500               Exit Function
  520. 510           End If
  521.              
  522.              
  523. 520           If Events(SlotEvent).LvlMin <> 0 Then
  524. 530               If Events(SlotEvent).LvlMin > .Stats.ELV Then
  525. 540                   ErrorMsg = 43
  526. 550                   Exit Function
  527. 560               End If
  528. 570           End If
  529.              
  530. 580           If Events(SlotEvent).LvlMin <> 0 Then
  531. 590               If Events(SlotEvent).LvlMax < .Stats.ELV Then
  532. 600                   ErrorMsg = 43
  533. 610                   Exit Function
  534. 620               End If
  535. 630           End If
  536.              
  537. 640           If Events(SlotEvent).AllowedClasses(.Clase) = 0 Then
  538. 650               ErrorMsg = 44
  539. 660               Exit Function
  540. 670           End If
  541.              
  542.              
  543. 680           If Events(SlotEvent).GldInscription > .Stats.Gld Then
  544. 690               ErrorMsg = 45
  545. 700               Exit Function
  546. 710           End If
  547.              
  548. 720           If Events(SlotEvent).DspInscription > 0 Then
  549. 730               If Not TieneObjetos(880, Events(SlotEvent).DspInscription, UserIndex) Then
  550. 740                   ErrorMsg = 46
  551. 750                   Exit Function
  552. 760               End If
  553. 770           End If
  554.  
  555.                 ' Limite de Reds.
  556.                 If Events(SlotEvent).LimitRed > 0 Then
  557.                     If TieneObjetos(38, Events(SlotEvent).LimitRed + 1, UserIndex) Then
  558.                         Call WriteConsoleMsg(UserIndex, "Tienes demasiadas pociones para participar, chequea tu inventario.", FontTypeNames.FONTTYPE_INFO)
  559.                         Exit Function
  560.                     End If
  561.                 End If
  562.              
  563. 780           If Events(SlotEvent).Inscribed = Events(SlotEvent).Quotas Then
  564. 790               ErrorMsg = 47
  565. 800               Exit Function
  566. 810           End If
  567.              
  568. 820       End With
  569. 830       CheckUserEvent = True
  570.          
  571. 840   Exit Function
  572.  
  573. error:
  574. 850       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CheckUserEvent()"
  575. End Function
  576.  
  577. ' EDICIÓN GENERAL
  578. Public Function strModality(ByVal SlotEvent As Byte, ByVal Modality As eModalityEvent) As String
  579.  
  580.           ' Modalidad de cada evento
  581.          
  582. 10        Select Case Modality
  583.               Case eModalityEvent.CastleMode
  584. 20                strModality = "CastleMode"
  585.                  
  586. 30            Case eModalityEvent.DagaRusa
  587. 40                strModality = "DagaRusa"
  588.                  
  589. 50            Case eModalityEvent.DeathMatch
  590. 60                strModality = "DeathMatch"
  591.                  
  592. 70            Case eModalityEvent.Aracnus
  593. 80                strModality = "Aracnus"
  594.                  
  595. 90            Case eModalityEvent.HombreLobo
  596. 100               strModality = "HombreLobo"
  597.                  
  598. 110           Case eModalityEvent.Minotauro
  599. 120               strModality = "Minotauro"
  600.              
  601. 130           Case eModalityEvent.Busqueda
  602. 140               strModality = "Busqueda"
  603.              
  604. 150           Case eModalityEvent.Unstoppable
  605. 160               strModality = "Unstoppable"
  606.              
  607. 170           Case eModalityEvent.Invasion
  608. 180               strModality = "Invasion"
  609.                  
  610. 190           Case eModalityEvent.Enfrentamientos
  611. 200               strModality = Events(SlotEvent).TeamCant & "vs" & Events(SlotEvent).TeamCant
  612. 210       End Select
  613. End Function
  614. Private Function strDescEvent(ByVal SlotEvent As Byte, ByVal Modality As eModalityEvent) As String
  615.  
  616.           ' Descripción del evento en curso.
  617. 10        Select Case Modality
  618.               Case eModalityEvent.CastleMode
  619. 20                strDescEvent = "» Los usuarios entrarán de forma aleatorea para formar dos equipos. Ambos equipos deberán defender a su rey y a su vez atacar al del equipo contrario."
  620. 30            Case eModalityEvent.DagaRusa
  621. 40                strDescEvent = "» Los usuarios se teletransportarán a una posición donde estará un asesino dispuesto a apuñalarlos y acabar con su vida. El último que quede en pie es el ganador del evento."
  622. 50            Case eModalityEvent.DeathMatch
  623. 60                strDescEvent = "» Los usuarios ingresan y luchan en una arena donde se toparan con todos los demás concursantes. El que logre quedar en pie, será el ganador."
  624. 70            Case eModalityEvent.Aracnus
  625. 80                strDescEvent = "» Un personaje es escogido al azar, para convertirse en una araña gigante la cual podrá envenenar a los demas concursantes acabando con su vida en el evento."
  626. 90            Case eModalityEvent.Busqueda
  627. 100               strDescEvent = "» Los personajes son teletransportados en un mapa donde su función principal será la recolección de objetos en el piso, para que así luego de tres minutos, el que recolecte más, ganará el evento."
  628. 110           Case eModalityEvent.Unstoppable
  629. 120               strDescEvent = "» Los personajes lucharan en un TODOS vs TODOS, donde los muertos no irán a su mapa de origen, si no que volverán a revivir para tener chances de ganar el evento. El que logre matar más personajes, ganará el evento."
  630. 130           Case eModalityEvent.Invasion
  631. 140               strDescEvent = "» Los personajes son llevados a un mapa donde aparecerán criaturas únicas de PorvooAO, cada criatura dará una recompensa única y los usuarios tendrán chances de entrenar sus personajes."
  632. 150           Case eModalityEvent.Enfrentamientos
  633. 160               If Events(SlotEvent).TeamCant = 1 Then
  634. 170                   strDescEvent = "» Los usuarios combatirán en duelos 1vs1"
  635. 180               Else
  636. 190                   strDescEvent = "» Los usuarios combatirán en duelos " & Events(SlotEvent).TeamCant & "vs" & Events(SlotEvent).TeamCant & " donde se escogerán las parejas al azar."
  637. 200               End If
  638. 210       End Select
  639. End Function
  640. Private Sub InitEvent(ByVal SlotEvent As Byte)
  641.          
  642. 10        Select Case Events(SlotEvent).Modality
  643.               Case eModalityEvent.CastleMode
  644. 20                Call InitCastleMode(SlotEvent)
  645.                  
  646. 30            Case eModalityEvent.DagaRusa
  647. 40                Call InitDagaRusa(SlotEvent)
  648.                  
  649. 50            Case eModalityEvent.DeathMatch
  650. 60                Call InitDeathMatch(SlotEvent)
  651.                  
  652. 70            Case eModalityEvent.Aracnus
  653. 80                Call InitEventTransformation(SlotEvent, 254, 6500, 211, 70, 36)
  654.                  
  655. 90            Case eModalityEvent.HombreLobo
  656. 100               Call InitEventTransformation(SlotEvent, 255, 3500, 211, 70, 36)
  657.                  
  658. 110           Case eModalityEvent.Minotauro
  659. 120               Call InitEventTransformation(SlotEvent, 253, 2500, 211, 70, 36)
  660.              
  661. 130           Case eModalityEvent.Busqueda
  662. 140               Call InitBusqueda(SlotEvent)
  663.                  
  664. 150           Case eModalityEvent.Unstoppable
  665. 160               InitUnstoppable SlotEvent
  666.                  
  667. 170           Case eModalityEvent.Invasion
  668.              
  669. 180           Case eModalityEvent.Enfrentamientos
  670. 190               Call InitFights(SlotEvent)
  671.              
  672. 200           Case Else
  673. 210               Exit Sub
  674.              
  675. 220       End Select
  676. 230   Exit Sub
  677.  
  678. error:
  679. 240       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitEvent() EN EL EVENTO " & Events(SlotEvent).Modality & "."
  680. End Sub
  681. Public Function CanAttackUserEvent(ByVal UserIndex As Integer, ByVal Victima As Integer) As Boolean
  682.          
  683.           ' Si el personaje es del mismo team, no se puede atacar al usuario.
  684.          Dim VictimaSlotUserEvent As Byte
  685.          
  686. 10      VictimaSlotUserEvent = UserList(Victima).flags.SlotUserEvent
  687.          
  688.         If UserList(UserIndex).flags.SlotEvent > 0 And UserList(Victima).flags.SlotEvent > 0 Then
  689.             With UserList(UserIndex)
  690. 40                If Events(.flags.SlotEvent).Users(VictimaSlotUserEvent).Team = Events(.flags.SlotEvent).Users(.flags.SlotUserEvent).Team Then
  691. 50                    CanAttackUserEvent = False
  692. 60                    Exit Function
  693. 70                End If
  694.             End With
  695.         End If
  696.    
  697.    
  698.            CanAttackUserEvent = True
  699.          
  700. 110   Exit Function
  701.  
  702. error:
  703. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CanAttackUserEvent()"
  704. End Function
  705.  
  706.  
  707. Private Sub PrizeUser(ByVal UserIndex As Integer, Optional ByVal MsjConsole As Boolean = True)
  708. 10        On Error GoTo error
  709.          
  710.           ' Premios de los eventos
  711.          
  712.           Dim SlotEvent As Byte
  713.           Dim SlotUserEvent As Byte
  714.           Dim Obj As Obj
  715.           Dim strReWard As String
  716.          
  717. 20        SlotEvent = UserList(UserIndex).flags.SlotEvent
  718. 30        SlotUserEvent = UserList(UserIndex).flags.SlotUserEvent
  719.          
  720. 40        With Events(SlotEvent)
  721. 50            If .GldInscription > 0 Then
  722. 60                With UserList(UserIndex)
  723. 70                    .Stats.Gld = .Stats.Gld + (Events(SlotEvent).GldInscription * Events(SlotEvent).Quotas)
  724. 80                    WriteUpdateGold UserIndex
  725. 90                    strReWard = (Events(SlotEvent).GldInscription * Events(SlotEvent).Quotas) & " Monedas de oro. "
  726. 100               End With
  727. 110           End If
  728.              
  729. 120           If .DspInscription > 0 Then
  730. 130               Obj.ObjIndex = 880
  731. 140               Obj.Amount = .DspInscription * .Quotas
  732.                  
  733. 150               With UserList(UserIndex)
  734.  
  735. 160                   If Not MeterItemEnInventario(UserIndex, Obj) Then
  736.                           'Call TirarItemAlPiso(.Pos, Obj)
  737.                          
  738. 170                       SendData SendTarget.ToAdmins, 0, PrepareMessageShortMsj(49, FontTypeNames.FONTTYPE_ADMIN, , , , , .Name)
  739. 180                       WriteShortMsj UserIndex, 50, FontTypeNames.FONTTYPE_WARNING
  740. 190                   End If
  741.                      
  742. 200                   strReWard = strReWard & (Events(SlotEvent).DspInscription * Events(SlotEvent).Quotas) & " Monedas DSP."
  743.                      
  744. 210               End With
  745. 220           End If
  746.              
  747. 230           With UserList(UserIndex)
  748.                   .Stats.Points = .Stats.Points + 15
  749. 240               .Stats.TorneosGanados = .Stats.TorneosGanados + 1
  750.  
  751.                   WriteUpdatePoints UserIndex
  752. 250           End With
  753.              
  754.              
  755. 260           If MsjConsole Then Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(SlotEvent, .Modality) & "» Premio recibido: " & strReWard, FontTypeNames.FONTTYPE_GUILD))
  756. 270       End With
  757.          
  758. 280   Exit Sub
  759.  
  760. error:
  761. 290       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : PrizeUser()"
  762. End Sub
  763. Private Sub ChangeBodyEvent(ByVal SlotEvent As Byte, ByVal UserIndex As Integer, ByVal ChangeHead As Boolean)
  764. 10    On Error GoTo error
  765.  
  766.           ' En caso de que el evento cambie el body, de lo cambiamos.
  767. 20        With UserList(UserIndex)
  768. 30            .CharMimetizado.body = .Char.body
  769. 40            .CharMimetizado.Head = .Char.Head
  770. 50            .CharMimetizado.CascoAnim = .Char.CascoAnim
  771. 60            .CharMimetizado.ShieldAnim = .Char.ShieldAnim
  772. 70            .CharMimetizado.WeaponAnim = .Char.WeaponAnim
  773.  
  774. 80            .Char.body = Events(SlotEvent).CharBody
  775. 90            .Char.Head = IIf(ChangeHead = False, .Char.Head, 0)
  776. 100           .Char.CascoAnim = 0
  777. 110           .Char.ShieldAnim = 0
  778. 120           .Char.WeaponAnim = 0
  779.                      
  780. 130           ChangeUserChar UserIndex, .Char.body, .Char.Head, .Char.Heading, .Char.WeaponAnim, .Char.ShieldAnim, .Char.CascoAnim, True
  781. 140           RefreshCharStatus UserIndex
  782.          
  783. 150       End With
  784.          
  785. 160   Exit Sub
  786.  
  787. error:
  788. 170       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : ChangeBodyEvent()"
  789. End Sub
  790.  
  791. Private Function ResetBodyEvent(ByVal SlotEvent As Byte, ByVal UserIndex As Integer)
  792.  
  793. 10    On Error GoTo error
  794.  
  795.           ' En caso de que el evento cambie el body del personaje, se lo restauramos.
  796.          
  797. 20        With UserList(UserIndex)
  798. 30            If .flags.Muerto Then Exit Function
  799.               'If Events(SlotEvent).Users(.flags.SlotUserEvent).Selected = 0 Then Exit Function
  800.              
  801. 40            If .CharMimetizado.body > 0 Then
  802. 50                .Char.body = .CharMimetizado.body
  803. 60                .Char.Head = .CharMimetizado.Head
  804. 70                .Char.CascoAnim = .CharMimetizado.CascoAnim
  805. 80                .Char.ShieldAnim = .CharMimetizado.ShieldAnim
  806. 90                .Char.WeaponAnim = .CharMimetizado.WeaponAnim
  807.                  
  808.                  
  809. 100               .CharMimetizado.body = 0
  810. 110               .CharMimetizado.Head = 0
  811. 120               .CharMimetizado.CascoAnim = 0
  812. 130               .CharMimetizado.ShieldAnim = 0
  813. 140               .CharMimetizado.WeaponAnim = 0
  814.                  
  815. 150               .showName = True
  816.                  
  817. 160               ChangeUserChar UserIndex, .Char.body, .Char.Head, .Char.Heading, .Char.WeaponAnim, .Char.ShieldAnim, .Char.CascoAnim, True
  818. 170               RefreshCharStatus UserIndex
  819. 180           End If
  820.          
  821. 190       End With
  822.          
  823. 200   Exit Function
  824.  
  825. error:
  826. 210       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : ResetBodyEvent()"
  827. End Function
  828.  
  829. Private Sub ChangeHpEvent(ByVal UserIndex As Integer)
  830.  
  831. 10    On Error GoTo error
  832.           ' En caso de que el evento edite la vida del personaje, se la editamos.
  833.          
  834.           Dim SlotEvent As Byte
  835.          
  836. 20        With UserList(UserIndex)
  837. 30            SlotEvent = .flags.SlotEvent
  838.              
  839. 40            .Stats.OldHp = .Stats.MaxHp
  840.              
  841. 50            .Stats.MaxHp = Events(SlotEvent).CharHp
  842. 60            .Stats.MinHp = .Stats.MaxHp
  843.              
  844. 70            WriteUpdateUserStats UserIndex
  845.          
  846. 80        End With
  847. 90    Exit Sub
  848.  
  849. error:
  850. 100       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : ChangeHpEvent()"
  851. End Sub
  852.  
  853. Private Sub ResetHpEvent(ByVal UserIndex As Integer)
  854.  
  855. 10    On Error GoTo error
  856.           ' En caso de que el evento haya editado la vida de un personaje, se la volvemos a restaurar.
  857.          
  858. 20        With UserList(UserIndex)
  859. 30            If .Stats.OldHp = 0 Then Exit Sub
  860. 40            .Stats.MaxHp = .Stats.OldHp
  861.               '.Stats.MinHp = .Stats.MaxHp
  862. 50            .Stats.OldHp = 0
  863. 60            WriteUpdateHP UserIndex
  864.              
  865. 70        End With
  866.          
  867. 80    Exit Sub
  868.  
  869. error:
  870. 90        LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : ResetHpEvent()"
  871. End Sub
  872.  
  873.  
  874.  
  875.  
  876. '// Fin Funciones generales '//
  877.  
  878. Public Sub NewEvent(ByVal UserIndex As Integer, _
  879.                     ByVal Modality As eModalityEvent, _
  880.                     ByVal Quotas As Byte, _
  881.                     ByVal LvlMin As Byte, _
  882.                     ByVal LvlMax As Byte, _
  883.                     ByVal GldInscription As Long, _
  884.                     ByVal DspInscription As Long, _
  885.                     ByVal TimeInit As Long, _
  886.                     ByVal TimeCancel As Long, _
  887.                     ByVal TeamCant As Byte, _
  888.                     ByVal PrizeAccumulated As Boolean, _
  889.                     ByVal LimitRed As Integer, _
  890.                     ByVal PrizeDsp As Integer, _
  891.                     ByVal PrizeGld As Integer, _
  892.                     ByVal ObjIndex As Integer, _
  893.                     ByVal ObjAmount As Integer, _
  894.                     ByVal WinFollow As Boolean, _
  895.                     ByVal ValidItem As Boolean, _
  896.                     ByRef AllowedFaction() As eFaction, _
  897.                     ByRef AllowedClasses() As Byte)
  898.                          
  899. 10        On Error GoTo error
  900.                          
  901.           Dim Slot As Integer
  902.           Dim strTemp As String
  903.  
  904. 20        Slot = FreeSlotEvent()
  905.          
  906. 30        If Slot = 0 Then
  907.               'WriteConsoleMsg Userindex, "No hay más lugar disponible para crear un evento simultaneo. Espera a que termine alguno o bien cancela alguno.", FontTypeNames.FONTTYPE_INFO
  908. 40            WriteShortMsj UserIndex, 48, FontTypeNames.FONTTYPE_INFO
  909. 50            Exit Sub
  910. 60        Else
  911. 70            With Events(Slot)
  912. 80                .Enabled = True
  913. 90                .Modality = Modality
  914. 100               .TeamCant = TeamCant
  915. 110               .Quotas = Quotas
  916. 120               .LvlMin = LvlMin
  917. 130               .LvlMax = LvlMax
  918. 140               .GldInscription = GldInscription
  919. 150               .DspInscription = DspInscription
  920. 160               .AllowedClasses = AllowedClasses
  921.                   .AllowedFaction = AllowedFaction
  922. 170               .TimeInit = TimeInit
  923. 180               .TimeCancel = TimeCancel
  924.                
  925.                   .ValidItem = ValidItem
  926.                   .PrizeAccumulated = PrizeAccumulated
  927.                   .LimitRed = LimitRed
  928.                   .PrizeDsp = PrizeDsp
  929.                   .PrizeGld = PrizeGld
  930.                   .PrizeObj.ObjIndex = ObjIndex
  931.                   .PrizeObj.Amount = ObjAmount
  932.                   .WinFollow = WinFollow
  933.                  
  934. 190               ReDim .Users(1 To .Quotas) As tUserEvent
  935.                  
  936.                   ' strModality devuelve: "Evento '1vs1' : Descripción"
  937.                  If .LimitRed > 0 Then
  938.                     strTemp = strModality(Slot, .Modality) & strDescEvent(Slot, .Modality) & vbCrLf & "Cupos: " & .Quotas & ". Nivel permitido: " & .LvlMin & "-" & .LvlMax & "." & vbCrLf & "Limite Rojas: " & .LimitRed & "." & vbCrLf
  939.                   Else
  940. 200                 strTemp = strModality(Slot, .Modality) & strDescEvent(Slot, .Modality) & vbCrLf & "Cupos: " & .Quotas & ". Nivel permitido: " & .LvlMin & "-" & .LvlMax & "." & vbCrLf
  941.                   End If
  942.                  
  943. 210               If .GldInscription > 0 And .DspInscription > 0 Then
  944. 220                   strTemp = strTemp & "Inscripción requerida: " & .GldInscription & " monedas de oro y " & .DspInscription & " monedas DSP."
  945. 230               ElseIf .GldInscription > 0 Then
  946. 240                   strTemp = strTemp & "Inscripción requerida: " & .GldInscription & " monedas de oro."
  947. 250               ElseIf .DspInscription > 0 Then
  948. 260                   strTemp = strTemp & "Inscripción requerida: " & .DspInscription & " monedas DSP."
  949. 270               Else
  950. 280                   strTemp = strTemp & "Inscripción: GRATIS. "
  951. 290               End If
  952.                  
  953. 300               strTemp = strTemp & vbCrLf & "Clases permitidas: " & CheckAllowedClasses(AllowedClasses) & ". Comando para ingresar /INGRESAR " & strModality(Slot, .Modality) & vbCrLf
  954.                  
  955. 310               If .TimeInit = 60 Then
  956. 320                   strTemp = strTemp & "Las inscripciones abren en " & Int(.TimeInit / 60) & " minuto."
  957. 330               Else
  958. 340                   strTemp = strTemp & "Las inscripciones abren en " & Int(.TimeInit / 60) & " minutos."
  959. 350               End If
  960. 360               LoadMapEvent
  961. 370           End With
  962.              
  963. 380           SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("«EVENTOS»", FontTypeNames.FONTTYPE_ADMIN)
  964.                 SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strTemp, FontTypeNames.FONTTYPE_GUILD)
  965. 390       End If
  966.          
  967. 400   Exit Sub
  968.  
  969. error:
  970. 410       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : NewEvent()"
  971. End Sub
  972. Private Sub GiveBack_Inscription(ByVal SlotEvent As Byte)
  973. 10    On Error GoTo error
  974.  
  975.           Dim Loopc As Integer
  976.           Dim Obj As Obj
  977.          
  978. 20        With Events(SlotEvent)
  979.          
  980. 30            Obj.ObjIndex = 880
  981. 40            Obj.Amount = .DspInscription
  982.              
  983. 50            For Loopc = LBound(.Users()) To UBound(.Users())
  984. 60                If .Users(Loopc).Id > 0 Then
  985. 70                    If .DspInscription > 0 Then
  986. 80                        If Not MeterItemEnInventario(.Users(Loopc).Id, Obj) Then
  987.                               'Call TirarItemAlPiso(UserList(.Users(LoopC).Id).Pos, Obj)
  988.                              
  989.                               'SendData SendTarget.ToAdmins, 0, PrepareMessageConsoleMsg("¡¡ATENCIÓN GM!! Al personaje " & UserList(.Users(LoopC).Id).Name & " no se le entrego el dsp porque no tenia espacio en el inventario.", FontTypeNames.FONTTYPE_ADMIN)
  990.                              'WriteConsoleMsg .Users(LoopC).Id, "¡¡HEMOS NOTADO que no tienes espacio en el inventario para recibir los DSP ganadores. Un gm se contactará contigo a la brevedad.", FontTypeNames.FONTTYPE_WARNING
  991. 90                            SendData SendTarget.ToAdmins, 0, PrepareMessageShortMsj(49, FontTypeNames.FONTTYPE_ADMIN, , , , , UserList(.Users(Loopc).Id).Name)
  992. 100                           WriteShortMsj .Users(Loopc).Id, 50, FontTypeNames.FONTTYPE_WARNING
  993.                          
  994. 110                       End If
  995. 120                   End If
  996.                      
  997. 130                   If .GldInscription > 0 Then
  998. 140                       UserList(.Users(Loopc).Id).Stats.Gld = UserList(.Users(Loopc).Id).Stats.Gld + .GldInscription
  999. 150                       WriteUpdateGold (.Users(Loopc).Id)
  1000. 160                   End If
  1001. 170               End If
  1002. 180           Next Loopc
  1003. 190       End With
  1004.          
  1005. 200   Exit Sub
  1006.  
  1007. error:
  1008. 210       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : GiveBack_Inscription()"
  1009. End Sub
  1010. Public Sub CloseEvent(ByVal Slot As Byte, Optional ByVal MsgConsole As String = vbNullString, Optional ByVal Cancel As Boolean = False)
  1011. 10    On Error GoTo error
  1012.          
  1013. 20        With Events(Slot)
  1014.               ' Devolvemos la inscripción
  1015. 30            If Cancel Then
  1016. 40                Call GiveBack_Inscription(Slot)
  1017. 50            End If
  1018.              
  1019. 60            If MsgConsole <> vbNullString Then SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(MsgConsole, FontTypeNames.FONTTYPE_ORO)
  1020.              
  1021.  
  1022.              
  1023. 70            Call ResetEvent(Slot)
  1024. 80        End With
  1025.          
  1026. 90    Exit Sub
  1027.  
  1028. error:
  1029. 100       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CloseEvent()"
  1030. End Sub
  1031.  
  1032.  
  1033.  
  1034.  
  1035. Public Sub ParticipeEvent(ByVal UserIndex As Integer, ByVal Modality As String)
  1036. 10    On Error GoTo error
  1037.  
  1038.           Dim ErrorMsg As Integer
  1039.           Dim SlotUser As Byte
  1040.           Dim Pos As WorldPos
  1041.           Dim SlotEvent As Integer
  1042.          
  1043. 20        SlotEvent = SearchSlotEvent(Modality)
  1044.          
  1045. 30        If SlotEvent = 0 Then
  1046.               'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Error Fatal TESTEO", FontTypeNames.FONTTYPE_ADMIN)
  1047. 40            Exit Sub
  1048. 50        End If
  1049.          
  1050. 60        With UserList(UserIndex)
  1051. 70            If CheckUserEvent(UserIndex, SlotEvent, ErrorMsg) Then
  1052. 80                SlotUser = FreeSlotUser(SlotEvent)
  1053.                  
  1054. 90                .flags.SlotEvent = SlotEvent
  1055. 100               .flags.SlotUserEvent = SlotUser
  1056.                  
  1057. 110               .PosAnt.map = .Pos.map
  1058. 120               .PosAnt.X = .Pos.X
  1059. 130               .PosAnt.Y = .Pos.Y
  1060.                  
  1061. 140               .Stats.Gld = .Stats.Gld - Events(SlotEvent).GldInscription
  1062. 150               Call WriteUpdateGold(UserIndex)
  1063.                  
  1064. 160               Call QuitarObjetos(880, Events(SlotEvent).DspInscription, UserIndex)
  1065.                  
  1066. 170               With Events(SlotEvent)
  1067. 180                   Pos.map = 211
  1068. 190                   Pos.X = 30
  1069. 200                   Pos.Y = 21
  1070.                      
  1071. 210                   Call FindLegalPos(UserIndex, Pos.map, Pos.X, Pos.Y)
  1072. 220                   Call WarpUserChar(UserIndex, Pos.map, Pos.X, Pos.Y, False)
  1073.                  
  1074. 230                   .Users(SlotUser).Id = UserIndex
  1075. 240                   .Inscribed = .Inscribed + 1
  1076.                      
  1077.                      
  1078.                       'WriteConsoleMsg Userindex, "Has ingresado al evento " & strModality(SlotEvent, .Modality) & ". Espera a que se completen los cupos para que comience.", FontTypeNames.FONTTYPE_INFO
  1079. 250                   WriteShortMsj UserIndex, 51, FontTypeNames.FONTTYPE_INFO, , , , , strModality(SlotEvent, .Modality)
  1080.                       LogEventos "El personaje " & UserList(UserIndex).Name & " ingresó el evento de modalidad " & strModality(SlotEvent, .Modality)
  1081.                      
  1082. 260                   If .Inscribed = .Quotas Then
  1083.                           'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(SlotEvent, .Modality) & "» Los cupos han sido alcanzados. Les deseamos mucha suerte a cada uno de los participantes y que gane el mejor!", FontTypeNames.FONTTYPE_GUILD)
  1084. 270                       SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(52, FontTypeNames.FONTTYPE_GUILD, , , , , strModality(SlotEvent, .Modality))
  1085.                          
  1086. 280                       .Run = True
  1087. 290                       InitEvent SlotEvent
  1088. 300                       Exit Sub
  1089. 310                   End If
  1090. 320               End With
  1091.              
  1092. 330           Else
  1093. 340               WriteShortMsj UserIndex, ErrorMsg, FontTypeNames.FONTTYPE_WARNING
  1094.              
  1095. 350           End If
  1096. 360       End With
  1097. 370   Exit Sub
  1098.  
  1099. error:
  1100. 380       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : ParticipeEvent()"
  1101. End Sub
  1102.  
  1103.  
  1104.  
  1105. Public Sub AbandonateEvent(ByVal UserIndex As Integer, _
  1106.                             Optional ByVal MsgAbandonate As Boolean = False, _
  1107.                             Optional ByVal Forzado As Boolean = False)
  1108.          
  1109. 10    On Error GoTo error
  1110.  
  1111.           Dim Pos As WorldPos
  1112.           Dim SlotEvent As Byte
  1113.           Dim SlotUserEvent As Byte
  1114.           Dim UserTeam As Byte
  1115.           Dim UserMapFight As Byte
  1116.          
  1117. 20        With UserList(UserIndex)
  1118. 30            SlotEvent = .flags.SlotEvent
  1119. 40            SlotUserEvent = .flags.SlotUserEvent
  1120.              
  1121. 50            If SlotEvent > 0 And SlotUserEvent > 0 Then
  1122. 60                With Events(SlotEvent)
  1123.                       LogEventos "El personaje " & UserList(UserIndex).Name & " abandonó el evento de modalidad " & strModality(SlotEvent, .Modality)
  1124. 70
  1125.                         If .Inscribed > 0 Then .Inscribed = .Inscribed - 1
  1126.  
  1127. 80                        UserTeam = .Users(SlotUserEvent).Team
  1128. 90                        UserMapFight = .Users(SlotUserEvent).MapFight
  1129.                          
  1130. 100                       .Users(SlotUserEvent).Id = 0
  1131. 110                       .Users(SlotUserEvent).Team = 0
  1132.                           .Users(SlotUserEvent).Value = 0
  1133. 130                       .Users(SlotUserEvent).Selected = 0
  1134. 140                       .Users(SlotUserEvent).MapFight = 0
  1135.                          
  1136. 150                       UserList(UserIndex).flags.SlotEvent = 0
  1137. 160                       UserList(UserIndex).flags.SlotUserEvent = 0
  1138. 170                       UserList(UserIndex).flags.FightTeam = 0
  1139.                          
  1140. 180                       Select Case .Modality
  1141.                               Case eModalityEvent.Aracnus, eModalityEvent.HombreLobo, eModalityEvent.Minotauro
  1142. 190                               If Forzado And .Inscribed > 1 Then
  1143. 200                                   If .Users(SlotUserEvent).Selected = 1 Then
  1144. 210                                       Transformation_SelectionUser SlotEvent
  1145. 220                                   End If
  1146. 230                               End If
  1147.                                  
  1148. 240                           Case eModalityEvent.DagaRusa
  1149. 250                               If Forzado And .Run Then
  1150. 260                                   Call WriteUserInEvent(UserIndex)
  1151.                                      
  1152. 270                                   If .Users(SlotUserEvent).Value = 0 Then
  1153. 280                                       Npclist(.NpcIndex).flags.InscribedPrevio = Npclist(.NpcIndex).flags.InscribedPrevio - 1
  1154. 290                                   End If
  1155. 300                               End If
  1156.                                  
  1157. 310                           Case eModalityEvent.Enfrentamientos
  1158. 320                               If Forzado Then
  1159. 330                                   If UserMapFight > 0 Then
  1160. 340                                       If Not Fight_CheckContinue(UserIndex, SlotEvent, UserTeam) Then
  1161. 350                                           Fight_WinForzado UserIndex, SlotEvent, UserMapFight
  1162. 360                                       End If
  1163. 370                                   End If
  1164. 380                               End If
  1165.                                  
  1166. 390                               If UserList(UserIndex).Counters.TimeFight > 0 Then
  1167. 400                                   UserList(UserIndex).Counters.TimeFight = 0
  1168. 410                                   Call WriteUserInEvent(UserIndex)
  1169. 420                               End If
  1170.                                  
  1171. 430                       End Select
  1172.                                  
  1173. 440                       Pos.map = UserList(UserIndex).PosAnt.map
  1174. 450                       Pos.X = UserList(UserIndex).PosAnt.X
  1175. 460                       Pos.Y = UserList(UserIndex).PosAnt.Y
  1176.                          
  1177. 470                       Call FindLegalPos(UserIndex, Pos.map, Pos.X, Pos.Y)
  1178. 480                       Call WarpUserChar(UserIndex, Pos.map, Pos.X, Pos.Y, False)
  1179.                          
  1180. 490                       If Events(SlotEvent).CharBody <> 0 Then
  1181. 500                           Call ResetBodyEvent(SlotEvent, UserIndex)
  1182. 510                       End If
  1183.                  
  1184. 520                       If UserList(UserIndex).Stats.OldHp <> 0 Then
  1185. 530                           ResetHpEvent UserIndex
  1186. 540                       End If
  1187.                  
  1188. 550                       UserList(UserIndex).showName = True
  1189. 560                       RefreshCharStatus UserIndex
  1190.                          
  1191.                           'If MsgAbandonate Then WriteConsoleMsg Userindex, "Has abandonado el evento. Podrás recibir una pena por hacer esto.", FontTypeNames.FONTTYPE_WARNING
  1192. 570                       If MsgAbandonate Then WriteShortMsj UserIndex, 53, FontTypeNames.FONTTYPE_WARNING
  1193.                          
  1194.                          
  1195.                           ' Abandono general del evento
  1196. 580                       If .Inscribed = 1 And Forzado Then
  1197. 590                           Call FinishEvent(SlotEvent)
  1198.                          
  1199. 600                           CloseEvent SlotEvent
  1200. 610                           Exit Sub
  1201. 620                       End If
  1202.                          
  1203.                          
  1204. 630               End With
  1205. 640           End If
  1206.              
  1207.              
  1208. 650       End With
  1209.          
  1210. 660   Exit Sub
  1211.  
  1212. error:
  1213. 670       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : AbandonateEvent()"
  1214. End Sub
  1215.  
  1216. Private Sub FinishEvent(ByVal SlotEvent As Byte)
  1217.  
  1218. 10    On Error GoTo error
  1219.           Dim UserIndex As Integer
  1220.           Dim IsSelected As Boolean
  1221.          
  1222. 20        With Events(SlotEvent)
  1223. 30            Select Case .Modality
  1224.                   Case eModalityEvent.CastleMode
  1225. 40                    UserIndex = SearchLastUserEvent(SlotEvent)
  1226. 50                    CastleMode_Premio UserIndex, False
  1227.                      
  1228. 60                Case eModalityEvent.DagaRusa
  1229. 70                    DagaRusa_CheckWin SlotEvent
  1230.                      
  1231. 80                Case eModalityEvent.DeathMatch
  1232. 90                    UserIndex = SearchLastUserEvent(SlotEvent)
  1233. 100                   DeathMatch_Premio UserIndex
  1234.                      
  1235. 110               Case eModalityEvent.Aracnus, eModalityEvent.HombreLobo, eModalityEvent.Minotauro
  1236. 120                   UserIndex = SearchLastUserEvent(SlotEvent)
  1237.                      
  1238. 130                   If .Users(UserList(UserIndex).flags.SlotUserEvent).Selected = 1 Then IsSelected = True
  1239.                      
  1240. 140                   Transformation_Premio UserIndex, IsSelected, 250000
  1241.                      
  1242. 150               Case eModalityEvent.Busqueda
  1243. 160                   Busqueda_SearchWin SlotEvent
  1244.                      
  1245. 170               Case eModalityEvent.Unstoppable
  1246. 180                   Unstoppable_UserWin SlotEvent
  1247.                      
  1248. 190           End Select
  1249. 200       End With
  1250.          
  1251.          
  1252. 210   Exit Sub
  1253.  
  1254. error:
  1255. 220       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : FinishEvent()"
  1256. End Sub
  1257.  
  1258.  
  1259. '#################EVENTO CASTLE MODE##########################
  1260. Public Function CanAttackReyCastle(ByVal UserIndex As Integer, ByVal NpcIndex As Integer) As Boolean
  1261. 10        With UserList(UserIndex)
  1262. 20            If .flags.SlotEvent > 0 Then
  1263. 30                If Npclist(NpcIndex).flags.TeamEvent = Events(.flags.SlotEvent).Users(.flags.SlotUserEvent).Team Then
  1264. 40                    CanAttackReyCastle = False
  1265. 50                    Exit Function
  1266. 60                End If
  1267. 70            End If
  1268.          
  1269.          
  1270. 80            CanAttackReyCastle = True
  1271. 90        End With
  1272. End Function
  1273. Private Sub CastleMode_InitRey()
  1274. 10        On Error GoTo error
  1275.          
  1276.           Dim NpcIndex As Integer
  1277.           Const NumRey As Integer = 697
  1278.           Dim Pos As WorldPos
  1279.           Dim LoopX As Integer, LoopY As Integer
  1280.           Const Rango As Byte = 5
  1281.          
  1282. 20        For LoopX = YMinMapSize To YMaxMapSize
  1283. 30            For LoopY = XMinMapSize To XMaxMapSize
  1284. 40                If InMapBounds(212, LoopX, LoopY) Then
  1285. 50                    If MapData(212, LoopX, LoopY).NpcIndex > 0 Then
  1286. 60                        Call QuitarNPC(MapData(212, LoopX, LoopY).NpcIndex)
  1287. 70                    End If
  1288. 80                End If
  1289. 90            Next LoopY
  1290. 100       Next LoopX
  1291.          
  1292. 110       Pos.map = 212
  1293.              
  1294. 120       Pos.X = 74
  1295. 130       Pos.Y = 24
  1296. 140       NpcIndex = SpawnNpc(NumRey, Pos, False, False)
  1297. 150       Npclist(NpcIndex).flags.TeamEvent = 1
  1298.          
  1299. 160       Pos.X = 19
  1300. 170       Pos.Y = 34
  1301. 180       NpcIndex = SpawnNpc(NumRey, Pos, False, False)
  1302. 190       Npclist(NpcIndex).flags.TeamEvent = 2
  1303.          
  1304. 200   Exit Sub
  1305.  
  1306. error:
  1307. 210       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CastleMode_InitRey()"
  1308. End Sub
  1309.  
  1310. Public Sub InitCastleMode(ByVal SlotEvent As Byte)
  1311. 10    On Error GoTo error
  1312.  
  1313.           Dim Loopc As Integer
  1314.          
  1315.           Const NumRey As Integer = 697
  1316.           Dim NpcIndex As Integer
  1317.           Dim Pos As WorldPos
  1318.          
  1319.           ' Spawn the npc castle mode
  1320. 20        CastleMode_InitRey
  1321.          
  1322. 30        With Events(SlotEvent)
  1323. 40            For Loopc = LBound(.Users()) To UBound(.Users())
  1324. 50                If .Users(Loopc).Id > 0 Then
  1325. 60                    If Loopc > (UBound(.Users()) / 2) Then
  1326. 70                        .Users(Loopc).Team = 2
  1327. 80                        Pos.map = 212
  1328. 90                        Pos.X = 19
  1329. 100                       Pos.Y = 34
  1330.                          
  1331. 110                       Call FindLegalPos(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y)
  1332. 120                       Call WarpUserChar(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y, False)
  1333. 130                   Else
  1334. 140                       .Users(Loopc).Team = 1
  1335. 150                       Pos.map = 212
  1336. 160                       Pos.X = 74
  1337. 170                       Pos.Y = 24
  1338.                          
  1339. 180                       Call FindLegalPos(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y)
  1340. 190                       Call WarpUserChar(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y, False)
  1341.                          
  1342. 200                   End If
  1343. 210               End If
  1344. 220           Next Loopc
  1345. 230       End With
  1346.          
  1347. 240   Exit Sub
  1348.  
  1349. error:
  1350. 250       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitCastleMode()"
  1351. End Sub
  1352. Public Sub CastleMode_UserRevive(ByVal UserIndex As Integer)
  1353.  
  1354. 10    On Error GoTo error
  1355.           Dim Loopc As Integer
  1356.           Dim Pos As WorldPos
  1357.          
  1358. 20        With UserList(UserIndex)
  1359. 30            If .flags.SlotEvent > 0 Then
  1360. 40                Call RevivirUsuario(UserIndex)
  1361.                  
  1362.                  
  1363. 50                Pos.map = 212
  1364. 60                Pos.X = RandomNumber(20, 80)
  1365. 70                Pos.Y = RandomNumber(20, 80)
  1366.                  
  1367. 80                Call ClosestLegalPos(Pos, Pos)
  1368.                   'Call FindLegalPos(Userindex, Pos.Map, Pos.X, Pos.Y)
  1369. 90                Call WarpUserChar(UserIndex, Pos.map, Pos.X, Pos.Y, True)
  1370.              
  1371. 100           End If
  1372. 110       End With
  1373.          
  1374. 120   Exit Sub
  1375.  
  1376. error:
  1377. 130       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CastleMode_UserRevive()"
  1378. End Sub
  1379.  
  1380. Public Sub FinishCastleMode(ByVal SlotEvent As Byte, ByVal UserEventSlot As Integer)
  1381. 10    On Error GoTo error
  1382.  
  1383.           Dim Loopc As Integer
  1384.           Dim strTemp As String
  1385.           Dim NpcIndex As Integer
  1386.           Dim MiObj As Obj
  1387.          
  1388. 20        With Events(SlotEvent)
  1389. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  1390. 40                If .Users(Loopc).Id > 0 Then
  1391. 50                    If .Users(Loopc).Team = .Users(UserEventSlot).Team Then
  1392. 60                        If Loopc = UserEventSlot Then
  1393. 70                            CastleMode_Premio .Users(Loopc).Id, True
  1394. 80                        Else
  1395. 90                            CastleMode_Premio .Users(Loopc).Id, False
  1396. 100                       End If
  1397.                          
  1398. 110                       If strTemp = vbNullString Then
  1399. 120                           strTemp = UserList(.Users(Loopc).Id).Name
  1400. 130                       Else
  1401. 140                           strTemp = strTemp & ", " & UserList(.Users(Loopc).Id).Name
  1402. 150                       End If
  1403. 160                   End If
  1404. 170               End If
  1405. 180           Next Loopc
  1406.              
  1407.              
  1408. 190           CloseEvent SlotEvent, "CastleMode» Ha finalizado. Ha ganado el equipo de " & UCase$(strTemp)
  1409. 200       End With
  1410.          
  1411. 210   Exit Sub
  1412.  
  1413. error:
  1414. 220       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : FinishCastleMode()"
  1415. End Sub
  1416.  
  1417. Private Sub CastleMode_Premio(ByVal UserIndex As Integer, ByVal KillRey As Boolean)
  1418. 10    On Error GoTo error
  1419.  
  1420.           ' Entregamos el premio del CastleMode
  1421.          Dim MiObj As Obj
  1422.          
  1423. 20        With UserList(UserIndex)
  1424. 30            .Stats.Gld = .Stats.Gld + 250000
  1425.               'WriteConsoleMsg Userindex, "Felicitaciones, has recibido 250.000 monedas de oro por haber ganado el evento!", FontTypeNames.FONTTYPE_INFO
  1426. 40            WriteShortMsj UserIndex, 54, FontTypeNames.FONTTYPE_INFO, , , , 250000
  1427.              
  1428. 50            If KillRey Then
  1429.                   'WriteConsoleMsg Userindex, "Hemos notado que has aniquilado con la vida del rey oponente. ¡FELICITACIONES! Aquí tienes tu recompensa! 250.000 monedas de oro extra y su equipamiento", FontTypeNames.FONTTYPE_INFO
  1430. 60                WriteShortMsj UserIndex, 55, FontTypeNames.FONTTYPE_INFO, , , , 250000
  1431. 70                .Stats.Gld = .Stats.Gld + 250000
  1432.                  
  1433. 80            End If
  1434.              
  1435. 90            MiObj.ObjIndex = 899
  1436. 100           MiObj.Amount = 1
  1437.                              
  1438. 110           If Not MeterItemEnInventario(UserIndex, MiObj) Then
  1439. 120               Call TirarItemAlPiso(.Pos, MiObj)
  1440. 130           End If
  1441.                              
  1442. 140           MiObj.ObjIndex = 900
  1443. 150           MiObj.Amount = 1
  1444.                              
  1445. 160           If Not MeterItemEnInventario(UserIndex, MiObj) Then
  1446. 170               Call TirarItemAlPiso(.Pos, MiObj)
  1447. 180           End If
  1448.              
  1449. 190           WriteUpdateGold UserIndex
  1450.              
  1451. 200           .Stats.TorneosGanados = .Stats.TorneosGanados + 1
  1452. 210       End With
  1453.          
  1454. 220   Exit Sub
  1455.  
  1456. error:
  1457. 230       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CastleMode_Premio()"
  1458. End Sub
  1459.  
  1460. ' FIN EVENTO CASTLE MODE #####################################
  1461.  
  1462. ' ###################### EVENTO DAGA RUSA ###########################
  1463. Public Sub InitDagaRusa(ByVal SlotEvent As Byte)
  1464. 10    On Error GoTo error
  1465.  
  1466.           Dim Loopc As Integer
  1467.           Dim NpcIndex As Integer
  1468.           Dim Pos As WorldPos
  1469.          
  1470.           Dim Num As Integer
  1471.          
  1472. 20        With Events(SlotEvent)
  1473. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  1474. 40                If .Users(Loopc).Id > 0 Then
  1475. 50                    Call WarpUserChar(.Users(Loopc).Id, 211, 21 + Num, 60, False)
  1476. 60                    Num = Num + 1
  1477. 70                    Call WriteUserInEvent(.Users(Loopc).Id)
  1478. 80                End If
  1479. 90            Next Loopc
  1480.              
  1481. 100           Pos.map = 211
  1482. 110           Pos.X = 21
  1483. 120           Pos.Y = 59
  1484. 130           NpcIndex = SpawnNpc(704, Pos, False, False)
  1485.          
  1486. 140           If NpcIndex <> 0 Then
  1487. 150               Npclist(NpcIndex).Movement = NpcDagaRusa
  1488. 160               Npclist(NpcIndex).flags.SlotEvent = SlotEvent
  1489. 170               Npclist(NpcIndex).flags.InscribedPrevio = .Inscribed
  1490. 180               .NpcIndex = NpcIndex
  1491.                  
  1492. 190               DagaRusa_MoveNpc NpcIndex, True
  1493. 200           End If
  1494.              
  1495.              
  1496. 210           .TimeCount = 10
  1497. 220       End With
  1498.  
  1499. 230   Exit Sub
  1500.  
  1501. error:
  1502. 240       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitDagaRusa()"
  1503. End Sub
  1504. Public Function DagaRusa_NextUser(ByVal SlotEvent As Byte) As Byte
  1505. 10    On Error GoTo error
  1506.  
  1507.           Dim Loopc As Integer
  1508.          
  1509. 20        DagaRusa_NextUser = 0
  1510.          
  1511. 30        With Events(SlotEvent)
  1512. 40            For Loopc = LBound(.Users()) To UBound(.Users())
  1513. 50                If (.Users(Loopc).Id > 0) And (.Users(Loopc).Value = 0) Then
  1514. 60                    DagaRusa_NextUser = .Users(Loopc).Id
  1515.                       '.Users(LoopC).Value = 1
  1516. 70                    Exit For
  1517. 80                End If
  1518. 90            Next Loopc
  1519. 100       End With
  1520.              
  1521. 110   Exit Function
  1522.  
  1523. error:
  1524. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : DagaRusa_NextUser()"
  1525. End Function
  1526. Public Sub DagaRusa_ResetRonda(ByVal SlotEvent As Byte)
  1527.  
  1528.           Dim Loopc As Integer
  1529.          
  1530. 10        With Events(SlotEvent)
  1531. 20            For Loopc = LBound(.Users()) To UBound(.Users())
  1532. 30                .Users(Loopc).Value = 0
  1533. 40            Next Loopc
  1534.          
  1535. 50        End With
  1536. End Sub
  1537. Private Sub DagaRusa_CheckWin(ByVal SlotEvent As Byte)
  1538.  
  1539. 10    On Error GoTo error
  1540.  
  1541.           Dim UserIndex As Integer
  1542.           Dim MiObj As Obj
  1543.          
  1544. 20        With Events(SlotEvent)
  1545. 30            If .Inscribed = 1 Then
  1546. 40                UserIndex = SearchLastUserEvent(SlotEvent)
  1547. 50                DagaRusa_Premio UserIndex
  1548.                  
  1549.  
  1550. 60                Call QuitarNPC(.NpcIndex)
  1551. 70                CloseEvent SlotEvent
  1552.                  
  1553. 80            End If
  1554. 90        End With
  1555.          
  1556. 100   Exit Sub
  1557.  
  1558. error:
  1559. 110       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : DagaRusa_CheckWin()"
  1560. End Sub
  1561.  
  1562. Private Sub DagaRusa_Premio(ByVal UserIndex As Integer)
  1563.  
  1564. 10    On Error GoTo error
  1565.  
  1566.           Dim MiObj As Obj
  1567.          
  1568. 20        With UserList(UserIndex)
  1569. 30             MiObj.Amount = 1
  1570. 40             MiObj.ObjIndex = 1037
  1571.              
  1572.               'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("DagaRusa» El ganador es " & UserList(Userindex).Name & ". Felicitaciones para el personaje, quien se ha ganado una MD! (Espada mata dragones)", FontTypeNames.FONTTYPE_GUILD)
  1573. 50            SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(56, FontTypeNames.FONTTYPE_GUILD, , , , , .Name)
  1574.              
  1575. 60            If Not MeterItemEnInventario(UserIndex, MiObj) Then
  1576. 70                Call TirarItemAlPiso(UserList(UserIndex).Pos, MiObj)
  1577. 80            End If
  1578.              
  1579. 90            .Stats.TorneosGanados = .Stats.TorneosGanados + 1
  1580.              
  1581. 100       End With
  1582.          
  1583. 110   Exit Sub
  1584.  
  1585. error:
  1586. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : DagaRusa_Premio()"
  1587. End Sub
  1588. Public Sub DagaRusa_AttackUser(ByVal UserIndex As Integer, ByVal NpcIndex As Integer)
  1589. 10    On Error GoTo error
  1590.  
  1591.           Dim N As Integer
  1592.           Dim Slot As Byte
  1593.          
  1594. 20        With UserList(UserIndex)
  1595.              
  1596. 30            N = 10
  1597.              
  1598. 40            If RandomNumber(1, 100) <= N Then
  1599.              
  1600.                   ' Sound
  1601. 50                SendData SendTarget.ToPCArea, UserIndex, PrepareMessagePlayWave(SND_IMPACTO, .Pos.X, .Pos.Y)
  1602.                   ' Fx
  1603. 60                SendData SendTarget.ToPCArea, UserIndex, PrepareMessageCreateFX(.Char.CharIndex, FXSANGRE, 0)
  1604.                   ' Cambio de Heading
  1605. 70                ChangeNPCChar NpcIndex, Npclist(NpcIndex).Char.body, Npclist(NpcIndex).Char.Head, SOUTH
  1606.                   'Apuñalada en el piso
  1607. 80                SendData SendTarget.ToPCArea, UserIndex, PrepareMessageCreateDamage(UserList(UserIndex).Pos.X, UserList(UserIndex).Pos.Y, 1000, DAMAGE_PUÑAL)
  1608.                  
  1609. 90                WriteConsoleMsg UserIndex, "¡Has sido apuñalado por 1.000!", FontTypeNames.FONTTYPE_FIGHT
  1610.                  
  1611. 100               Slot = .flags.SlotEvent
  1612.                  
  1613.                  
  1614. 110               Call UserDie(UserIndex)
  1615. 120               EventosDS.AbandonateEvent (UserIndex)
  1616. 130               Call DagaRusa_CheckWin(Slot)
  1617.                  
  1618.                  
  1619. 140           Else
  1620.                   ' Sound
  1621. 150               SendData SendTarget.ToPCArea, UserIndex, PrepareMessagePlayWave(SND_IMPACTO, .Pos.X, .Pos.Y)
  1622.                   ' Fx
  1623. 160               SendData SendTarget.ToPCArea, UserIndex, PrepareMessageCreateFX(.Char.CharIndex, FXSANGRE, 0)
  1624.                   ' Cambio de Heading
  1625. 170               ChangeNPCChar NpcIndex, Npclist(NpcIndex).Char.body, Npclist(NpcIndex).Char.Head, SOUTH
  1626.  
  1627. 180               WriteConsoleMsg UserIndex, "¡Parece que no te he apuñalado, ya verás!", FontTypeNames.FONTTYPE_FIGHT
  1628.                  ' SendData SendTarget.ToPCArea, Userindex, PrepareMessageCreateDamage(UserList(Userindex).Pos.X, UserList(Userindex).Pos.Y, 1000, DAMAGE_PUÑAL)
  1629. 190           End If
  1630.              
  1631.              
  1632.              
  1633. 200       End With
  1634. 210   Exit Sub
  1635.  
  1636. error:
  1637. 220       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : DagaRusa_AttackUser()"
  1638. End Sub
  1639.  
  1640. ' FIN EVENTO DAGA RUSA ###########################################
  1641. Private Function SelectModalityDeathMatch(ByVal SlotEvent As Byte) As Integer
  1642.           Dim Random As Integer
  1643.          
  1644. 10        Randomize
  1645. 20        Random = RandomNumber(1, 8)
  1646.          
  1647. 30        With Events(SlotEvent)
  1648. 40            Select Case Random
  1649.                   Case 1 ' Zombie
  1650. 50                    .CharBody = 11
  1651. 60                Case 2 ' Golem
  1652. 70                    .CharBody = 11
  1653. 80                Case 3 ' Araña
  1654. 90                    .CharBody = 42
  1655. 100               Case 4 ' Asesino
  1656. 110                   .CharBody = 11 '48
  1657. 120               Case 5 'Medusa suprema
  1658. 130                   .CharBody = 151
  1659. 140               Case 6 'Dragón azul
  1660. 150                   .CharBody = 42 '247
  1661. 160               Case 7 'Viuda negra 185
  1662. 170                   .CharBody = 185
  1663. 180               Case 8 'Tigre salvaje
  1664. 190                   .CharBody = 147
  1665. 200           End Select
  1666. 210       End With
  1667. End Function
  1668.  
  1669. ' DEATHMATCH ####################################################
  1670. Private Sub InitDeathMatch(ByVal SlotEvent As Byte)
  1671. 10    On Error GoTo error
  1672.  
  1673.           Dim Loopc As Integer
  1674.           Dim Pos As WorldPos
  1675.          
  1676. 20        Call SelectModalityDeathMatch(SlotEvent)
  1677.          
  1678. 30        With Events(SlotEvent)
  1679. 40            For Loopc = LBound(.Users()) To UBound(.Users())
  1680. 50                If .Users(Loopc).Id > 0 Then
  1681. 60                    .Users(Loopc).Team = Loopc
  1682. 70                    .Users(Loopc).Selected = 1
  1683.                      
  1684. 80                    ChangeBodyEvent SlotEvent, .Users(Loopc).Id, True
  1685. 90                    UserList(.Users(Loopc).Id).showName = False
  1686. 100                   RefreshCharStatus .Users(Loopc).Id
  1687.                      
  1688.                      
  1689. 110                   Pos.map = 211
  1690. 120                   Pos.X = RandomNumber(58, 84)
  1691. 130                   Pos.Y = RandomNumber(28, 44)
  1692.                  
  1693. 140                   Call ClosestLegalPos(Pos, Pos)
  1694. 150                   Call WarpUserChar(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y, True)
  1695. 160               End If
  1696.              
  1697. 170           Next Loopc
  1698.          
  1699. 180           .TimeCount = 20
  1700. 190       End With
  1701.          
  1702. 200   Exit Sub
  1703.  
  1704. error:
  1705. 210       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitDeathMatch()"
  1706. End Sub
  1707.  
  1708. Public Sub DeathMatch_UserDie(ByVal SlotEvent As Byte, ByVal UserIndex As Integer)
  1709.  
  1710. 10    On Error GoTo error
  1711.  
  1712. 20        AbandonateEvent (UserIndex)
  1713.              
  1714. 30        If Events(SlotEvent).Inscribed = 1 Then
  1715. 40            UserIndex = SearchLastUserEvent(SlotEvent)
  1716. 50            DeathMatch_Premio UserIndex
  1717. 60            CloseEvent SlotEvent
  1718. 70        End If
  1719.          
  1720. 80    Exit Sub
  1721.  
  1722. error:
  1723. 90        LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : DeathMatch_UserDie()"
  1724. End Sub
  1725. Private Sub DeathMatch_Premio(ByVal UserIndex As Integer)
  1726. 10    On Error GoTo error
  1727.  
  1728. 20        With UserList(UserIndex)
  1729.               'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("DeathMatch» El ganador es " & .Name & " quien se lleva 1 punto de torneo y 450.000 monedas de oro.", FontTypeNames.FONTTYPE_GUILD)
  1730. 30            SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(57, FontTypeNames.FONTTYPE_GUILD, , , , , .Name)
  1731.                  
  1732. 40            .Stats.Gld = .Stats.Gld + 450000
  1733. 50            WriteUpdateGold UserIndex
  1734.              
  1735. 60            .Stats.TorneosGanados = .Stats.TorneosGanados + 1
  1736. 70        End With
  1737.          
  1738. 80    Exit Sub
  1739.  
  1740. error:
  1741. 90        LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : DeathMatch_Premio()"
  1742. End Sub
  1743.  
  1744. ' FIN DEATHMATCH ################################################
  1745. ' EVENTOS DONDE LOS USUARIOS SE TRANSFORMAN EN CRIATURAS
  1746. Private Sub InitEventTransformation(ByVal SlotEvent As Byte, _
  1747.                                     ByVal NewBody As Integer, _
  1748.                                     ByVal NewHp As Integer, _
  1749.                                     ByVal map As Integer, _
  1750.                                     ByVal X As Byte, _
  1751.                                     ByVal Y As Byte)
  1752.          
  1753. 10        On Error GoTo error
  1754.          
  1755.           Dim Loopc As Integer
  1756.           Dim UserSelected As Integer
  1757.           Dim Pos As WorldPos
  1758.          
  1759.           Const Rango As Byte = 4
  1760.          
  1761. 20        With Events(SlotEvent)
  1762. 30            .CharBody = NewBody
  1763. 40            .CharHp = NewHp
  1764.              
  1765. 50            For Loopc = LBound(.Users()) To UBound(.Users())
  1766. 60                If .Users(Loopc).Id > 0 Then
  1767. 70                    .Users(Loopc).Team = 2
  1768.                      
  1769.                      
  1770. 80                    Pos.map = map
  1771. 90                    Pos.X = RandomNumber(X - Rango, X + Rango)
  1772. 100                   Pos.Y = RandomNumber(Y - Rango, Y + Rango)
  1773.                  
  1774. 110                   Call ClosestLegalPos(Pos, Pos)
  1775. 120                   Call WarpUserChar(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y, True)
  1776.                      
  1777. 130               End If
  1778. 140           Next Loopc
  1779.              
  1780. 150           Transformation_SelectionUser SlotEvent
  1781. 160       End With
  1782.          
  1783. 170   Exit Sub
  1784.  
  1785. error:
  1786. 180       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitEventTransformation()"
  1787. End Sub
  1788.  
  1789. Private Function Transformation_SelectionUser(ByVal SlotEvent As Byte)
  1790. 10    On Error GoTo error
  1791.  
  1792.           Dim Loopc As Integer
  1793. 20        With Events(SlotEvent)
  1794. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  1795. 40                Transformation_SelectionUser = RandomNumber(LBound(.Users()), UBound(.Users()))
  1796.                  
  1797. 50                If .Users(Transformation_SelectionUser).Id > 0 And .Users(Transformation_SelectionUser).Selected = 0 Then
  1798. 60                    Exit For
  1799. 70                End If
  1800. 80            Next Loopc
  1801.              
  1802. 90            .Users(Transformation_SelectionUser).Selected = 1
  1803. 100           .Users(Transformation_SelectionUser).Team = 1
  1804.                          
  1805. 110           Call ChangeHpEvent(.Users(Transformation_SelectionUser).Id)
  1806. 120           Call ChangeBodyEvent(SlotEvent, .Users(Transformation_SelectionUser).Id, IIf(.Modality = Minotauro, False, True))
  1807. 130       End With
  1808. 140   Exit Function
  1809.  
  1810. error:
  1811. 150       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Transformation_SelectionUser()"
  1812. End Function
  1813.  
  1814. Public Sub Transformation_UserDie(ByVal UserIndex As Integer, ByVal AttackerIndex As Integer)
  1815. 10    On Error GoTo error
  1816.  
  1817.           Dim SlotEvent As Byte
  1818.           Dim Exituser As Boolean
  1819.          
  1820. 20        With UserList(UserIndex)
  1821. 30            SlotEvent = .flags.SlotEvent
  1822. 40            AbandonateEvent UserIndex
  1823.              
  1824. 50            Transformation_CheckWin UserIndex, SlotEvent, AttackerIndex
  1825. 60        End With
  1826. 70    Exit Sub
  1827.  
  1828. error:
  1829. 80        LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Transformation_UserDie()"
  1830. End Sub
  1831. Private Function Transformation_SearchUserSelected(ByVal SlotEvent As Byte) As Integer
  1832. 10    On Error GoTo error
  1833.  
  1834.           Dim Loopc As Integer
  1835.          
  1836. 20        With Events(SlotEvent)
  1837. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  1838. 40                If .Users(Loopc).Id > 0 Then
  1839. 50                    If .Users(Loopc).Selected = 1 Then
  1840. 60                        Transformation_SearchUserSelected = Loopc
  1841. 70                    End If
  1842. 80                End If
  1843. 90            Next Loopc
  1844. 100       End With
  1845.          
  1846. 110   Exit Function
  1847.  
  1848. error:
  1849. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Transformation_SearchUserSelected()"
  1850. End Function
  1851. Public Sub Transformation_CheckWin(ByVal UserIndex As Integer, ByVal SlotEvent As Byte, Optional ByVal AttackerIndex As Integer = 0)
  1852. 10        On Error GoTo error
  1853.    
  1854.     ' VER LAUTARO
  1855.    Dim IsSelected As Boolean
  1856.     Dim tUser As Integer
  1857. 20
  1858. 30        With Events(SlotEvent)
  1859. 40          If .Inscribed = 1 Then
  1860. 50              tUser = SearchLastUserEvent(SlotEvent)
  1861. 60
  1862. 70              If .Users(UserList(tUser).flags.SlotUserEvent).Selected = 1 Then IsSelected = True
  1863.                
  1864. 80              Transformation_Premio tUser, IsSelected, 250000
  1865. 90
  1866. 100             CloseEvent SlotEvent
  1867. 110             Exit Sub
  1868. 120         End If
  1869. 130
  1870.        
  1871.         If AttackerIndex <> 0 Then
  1872.             'Significa que hay más de un usuario. Por lo tanto podría haber muerto el bicho transformado
  1873. 140           If UserList(UserIndex).flags.SlotUserEvent = Transformation_SearchUserSelected(SlotEvent) Then
  1874. 150               Transformation_Premio AttackerIndex, False, 250000
  1875. 160
  1876. 170                CloseEvent SlotEvent
  1877. 180         End If
  1878.         End If
  1879. 190       End With
  1880.    
  1881. 200   Exit Sub
  1882.  
  1883. error:
  1884. 210       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Transformation_CheckWin() at line " & Erl
  1885. End Sub
  1886.  
  1887. Private Sub Transformation_Premio(ByVal UserIndex As Integer, _
  1888.                                     ByVal IsSelected As Boolean, _
  1889.                                     ByVal Gld As Long)
  1890.                                    
  1891. 10        On Error GoTo error
  1892. 20
  1893.     Dim UserWin As Integer
  1894.    
  1895. 30    With UserList(UserIndex)
  1896.         Dim SlotEvent As Byte
  1897. 40        SlotEvent = .flags.SlotEvent
  1898.        
  1899. 50        If IsSelected Then
  1900. 60            .Stats.Gld = .Stats.Gld + (Gld * 2)
  1901.             'WriteConsoleMsg Userindex, "Has recibido " & (Gld * 2) & " por haber aniquilado a todos los usuarios.", FontTypeNames.FONTTYPE_INFO
  1902. 70            SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(SlotEvent, Events(SlotEvent).Modality) & "» Ha logrado derrotar a todos los participantes. Felicitaciones para " & .Name & " quien fue escogido como " & strModality(SlotEvent, Events(SlotEvent).Modality), FontTypeNames.FONTTYPE_GUILD)
  1903. 80            WriteShortMsj UserIndex, 58, FontTypeNames.FONTTYPE_INFO, , , , (Gld * 2)
  1904.  
  1905. 90      Else
  1906. 100           .Stats.Gld = .Stats.Gld + Gld
  1907.               'WriteConsoleMsg Userindex, "Has recibido " & Gld & " por haber aniquilado a " & strModality(SlotEvent, Events(SlotEvent).Modality), FontTypeNames.FONTTYPE_INFO
  1908. 110           WriteShortMsj UserIndex, 59, FontTypeNames.FONTTYPE_INFO, , , , Gld, strModality(SlotEvent, Events(SlotEvent).Modality)
  1909. 120           SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strModality(SlotEvent, Events(SlotEvent).Modality) & "» Felicitaciones para " & .Name & " quien derrotó a " & strModality(SlotEvent, Events(SlotEvent).Modality), FontTypeNames.FONTTYPE_GUILD)
  1910.  
  1911. 130     End If
  1912.        
  1913. 140        WriteUpdateGold UserIndex
  1914.        
  1915. 150        .Stats.TorneosGanados = .Stats.TorneosGanados + 1
  1916.    
  1917. 160       End With
  1918.    
  1919. 170   Exit Sub
  1920.  
  1921. error:
  1922. 180       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Transformation_Premio() AT LINE: " & Erl
  1923. End Sub
  1924.  
  1925.  
  1926. ' FIN EVENTOS DONDE LOS USUARIOS SE TRANSFORMAN EN CRIATURAS
  1927.  
  1928. ' ARACNUS #######################################################
  1929.  
  1930. Public Sub Aracnus_Veneno(ByVal AttackerIndex As Integer, ByVal VictimIndex As Integer)
  1931.  
  1932. 10    On Error GoTo error
  1933.           ' El personaje transformado en Aracnus, tiene 10% de probabilidad de envenenar a la víctima y dejarla fuera del torneo.
  1934.  
  1935.           Const N As Byte = 10
  1936.          
  1937. 20        With UserList(AttackerIndex)
  1938. 30            If RandomNumber(1, 100) <= 10 Then
  1939.                   'WriteConsoleMsg Victimindex, "Has sido envenenado por Aracnus, has muerto de inmediato por su veneno letal.", FontTypeNames.FONTTYPE_FIGHT
  1940. 40                WriteShortMsj VictimIndex, 60, FontTypeNames.FONTTYPE_FIGHT
  1941. 50                Call UserDie(VictimIndex)
  1942.                  
  1943. 60                Transformation_CheckWin VictimIndex, .flags.SlotEvent, AttackerIndex
  1944. 70            End If
  1945.          
  1946. 80        End With
  1947.          
  1948. 90    Exit Sub
  1949.  
  1950. error:
  1951. 100       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Aracnus_Veneno()"
  1952. End Sub
  1953.  
  1954. Public Sub Minotauro_Veneno(ByVal AttackerIndex As Integer, ByVal VictimIndex As Integer)
  1955. 10    On Error GoTo error
  1956.  
  1957.           ' El personaje transformado en Minotauro, tiene 10% de posibilidad de dar un golpe mortal
  1958.          Const N As Byte = 10
  1959.          
  1960. 20        With UserList(AttackerIndex)
  1961. 30            If RandomNumber(1, 100) <= 10 Then
  1962.                   'WriteConsoleMsg Victimindex, "¡El minotauro ha logrado paralizar tu cuerpo con su dosis de veneno. Has quedado afuera del evento.", FontTypeNames.FONTTYPE_FIGHT
  1963. 40                WriteShortMsj VictimIndex, 61, FontTypeNames.FONTTYPE_FIGHT
  1964. 50                Call UserDie(VictimIndex)
  1965.                  
  1966. 60                Transformation_CheckWin VictimIndex, .flags.SlotEvent, AttackerIndex
  1967.              
  1968. 70            End If
  1969.          
  1970. 80        End With
  1971.          
  1972. 90    Exit Sub
  1973.  
  1974. error:
  1975. 100       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Minotauro_Veneno()"
  1976. End Sub
  1977.  
  1978. ' FIN ARACNUS ###################################################
  1979.  
  1980. ' EVENTO BUSQUEDA '
  1981. Private Sub InitBusqueda(ByVal SlotEvent As Byte)
  1982. 10    On Error GoTo error
  1983.  
  1984.          
  1985.           Dim Loopc As Integer
  1986.           Dim Pos As WorldPos
  1987.          
  1988. 20        With Events(SlotEvent)
  1989. 30            For Loopc = 1 To 20
  1990. 40                Busqueda_CreateObj 216, RandomNumber(20, 80), RandomNumber(20, 80)
  1991. 50            Next Loopc
  1992.              
  1993. 60            For Loopc = LBound(.Users()) To UBound(.Users())
  1994. 70                If .Users(Loopc).Id > 0 Then
  1995. 80                    Pos.map = 216
  1996. 90                    Pos.X = RandomNumber(50, 60)
  1997. 100                   Pos.Y = RandomNumber(50, 60)
  1998.                      
  1999. 110                   Call ClosestLegalPos(Pos, Pos)
  2000. 120                   Call WarpUserChar(.Users(Loopc).Id, Pos.map, Pos.X, Pos.Y, True)
  2001. 130               End If
  2002. 140           Next Loopc
  2003.              
  2004. 150           .TimeFinish = 60
  2005.          
  2006. 160       End With
  2007.          
  2008. 170   Exit Sub
  2009.  
  2010. error:
  2011. 180       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitBusqueda()"
  2012. End Sub
  2013.  
  2014. Private Sub Busqueda_CreateObj(ByVal map As Integer, ByVal X As Byte, ByVal Y As Byte)
  2015. 10    On Error GoTo error
  2016.  
  2017.           ' Creamos un objeto en el mapa de búsqueda.
  2018.          
  2019.           Dim Pos As WorldPos
  2020.           Dim Obj As Obj
  2021.          
  2022. 20        Pos.map = map
  2023. 30        Pos.X = X
  2024. 40        Pos.Y = Y
  2025. 50        ClosestStablePos Pos, Pos
  2026.          
  2027. 60        Obj.ObjIndex = 1037
  2028. 70        Obj.Amount = 1
  2029. 80        Call MakeObj(Obj, Pos.map, Pos.X, Pos.Y)
  2030. 90        MapData(Pos.map, Pos.X, Pos.Y).ObjEvent = 1
  2031.          
  2032. 100   Exit Sub
  2033.  
  2034. error:
  2035. 110       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Busqueda_CreateObj()"
  2036. End Sub
  2037. Private Sub Busqueda_SearchWin(ByVal SlotEvent As Byte)
  2038. 10    On Error GoTo error
  2039.  
  2040.           Dim UserIndex As Integer
  2041.           Dim CopyUsers() As tUserEvent
  2042.          
  2043. 20        With Events(SlotEvent)
  2044. 30             Event_OrdenateUsersValue SlotEvent, CopyUsers
  2045.              
  2046. 40            UserIndex = CopyUsers(1).Id
  2047.              
  2048. 50            If UserIndex > 0 Then
  2049. 60                UserList(UserIndex).Stats.TorneosGanados = UserList(UserIndex).Stats.TorneosGanados + 1
  2050. 70                UserList(UserIndex).Stats.Gld = UserList(UserIndex).Stats.Gld + 350000
  2051. 80                WriteUpdateGold UserIndex
  2052.                  
  2053.                   ' vercoso este userindex 0
  2054. 90                SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Busqueda de objetos» El ganador de la búsqueda de objetos es " & UserList(UserIndex).Name & ". Felicitaciones! Se lleva como premio 350.000 monedas de oro." & vbCrLf & _
  2055.                       "Tabla final de posiciones: " & Event_GenerateTablaPos(SlotEvent, CopyUsers), FontTypeNames.FONTTYPE_GUILD)
  2056.                    'SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(62, FontTypeNames.FONTTYPE_GUILD, , , , , UserList(Userindex).Name)
  2057. 100           End If
  2058.              
  2059. 110           CloseEvent SlotEvent
  2060.              
  2061. 120       End With
  2062.          
  2063. 130   Exit Sub
  2064.  
  2065. error:
  2066. 140       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Busqueda_SearchWin()"
  2067. End Sub
  2068. Private Function Busqueda_UserRecolectedObj(ByVal SlotEvent As Byte) As Integer
  2069. 10    On Error GoTo error
  2070.  
  2071.           Dim Loopc As Integer
  2072.          
  2073. 20        With Events(SlotEvent)
  2074. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2075.                  
  2076. 40                If .Users(Loopc).Id > 0 Then
  2077. 50                    If Busqueda_UserRecolectedObj = 0 Then Busqueda_UserRecolectedObj = Loopc
  2078. 60                    If .Users(Loopc).Value > .Users(Busqueda_UserRecolectedObj).Value Then
  2079. 70                        Busqueda_UserRecolectedObj = Loopc
  2080. 80                    End If
  2081. 90                End If
  2082.                      
  2083. 100           Next Loopc
  2084.              
  2085. 110           Busqueda_UserRecolectedObj = .Users(Busqueda_UserRecolectedObj).Id
  2086. 120       End With
  2087.          
  2088. 130   Exit Function
  2089.  
  2090. error:
  2091. 140       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Busqueda_UserRecolectedObj()"
  2092. End Function
  2093.  
  2094. Public Sub Busqueda_GetObj(ByVal SlotEvent As Byte, ByVal SlotUserEvent As Byte)
  2095. 10    On Error GoTo error
  2096.  
  2097. 20        With Events(SlotEvent)
  2098. 30            .Users(SlotUserEvent).Value = .Users(SlotUserEvent).Value + 1
  2099.              
  2100.               'WriteConsoleMsg .Users(SlotUserEvent).Id, "Has recolectado un objeto del piso. En total llevas " & .Users(SlotUserEvent).value & " objetos recolectados. Sigue así!", FontTypeNames.FONTTYPE_INFO
  2101. 40            WriteShortMsj .Users(SlotUserEvent).Id, 63, FontTypeNames.FONTTYPE_INFO, .Users(SlotUserEvent).Value
  2102. 50            Busqueda_CreateObj 216, RandomNumber(30, 80), RandomNumber(30, 80)
  2103. 60        End With
  2104. 70    Exit Sub
  2105.  
  2106. error:
  2107. 80        LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Busqueda_GetObj()"
  2108. End Sub
  2109.  
  2110. ' ENFRENTAMIENTOS ###############################################
  2111.  
  2112. Private Sub InitFights(ByVal SlotEvent As Byte)
  2113. 10    On Error GoTo error
  2114.          
  2115. 20        With Events(SlotEvent)
  2116. 30            Fight_SelectedTeam SlotEvent
  2117. 40            Fight_Combate SlotEvent
  2118. 50        End With
  2119. 60    Exit Sub
  2120.  
  2121. error:
  2122. 70        LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitFights()"
  2123. End Sub
  2124. Private Sub Fight_SelectedTeam(ByVal SlotEvent As Byte)
  2125.          
  2126. 10    On Error GoTo error
  2127.  
  2128.           ' En los enfrentamientos utilizamos este procedimiento para seleccionar los grupos o bien el usuario queda solo por 1vs1.
  2129.          Dim LoopX As Integer
  2130.           Dim LoopY As Integer
  2131.           Dim Team As Byte
  2132.          
  2133. 20        Team = 1
  2134.          
  2135. 30        With Events(SlotEvent)
  2136. 40            For LoopX = LBound(.Users()) To UBound(.Users()) Step .TeamCant
  2137. 50                For LoopY = 0 To (.TeamCant - 1)
  2138. 60                    .Users(LoopX + LoopY).Team = Team
  2139. 70                Next LoopY
  2140.                  
  2141. 80                Team = Team + 1
  2142. 90            Next LoopX
  2143.          
  2144. 100       End With
  2145.          
  2146. 110   Exit Sub
  2147.  
  2148. error:
  2149. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_SelectedTeam()"
  2150. End Sub
  2151.  
  2152. Private Sub Fight_WarpTeam(ByVal SlotEvent As Byte, _
  2153.                                         ByVal ArenaSlot As Byte, _
  2154.                                         ByVal TeamEvent As Byte, _
  2155.                                         ByVal IsContrincante As Boolean, _
  2156.                                         ByRef StrTeam As String)
  2157.  
  2158. 10    On Error GoTo error
  2159.  
  2160.           Dim Loopc As Integer
  2161.           Dim strTemp As String, strTemp1 As String, strTemp2 As String
  2162.          
  2163. 20        With Events(SlotEvent)
  2164. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2165. 40                If .Users(Loopc).Id > 0 And .Users(Loopc).Team = TeamEvent Then
  2166. 50                    If IsContrincante Then
  2167. 60                        Call EventWarpUser(.Users(Loopc).Id, MapEvent.Fight(ArenaSlot).map, MapEvent.Fight(ArenaSlot).X + MAP_TILE_VS, MapEvent.Fight(ArenaSlot).Y + MAP_TILE_VS)
  2168.                          
  2169.                           ' / Update color char team
  2170. 70                        UserList(.Users(Loopc).Id).flags.FightTeam = 2
  2171.                          
  2172. 80                        RefreshCharStatus (.Users(Loopc).Id)
  2173. 90                    Else
  2174. 100                       Call EventWarpUser(.Users(Loopc).Id, MapEvent.Fight(ArenaSlot).map, MapEvent.Fight(ArenaSlot).X, MapEvent.Fight(ArenaSlot).Y)
  2175.                          
  2176.                           ' / Update color char team
  2177. 110                       UserList(.Users(Loopc).Id).flags.FightTeam = 1
  2178. 120                       RefreshCharStatus (.Users(Loopc).Id)
  2179. 130                   End If
  2180.                      
  2181. 140                   If StrTeam = vbNullString Then
  2182. 150                       StrTeam = UserList(.Users(Loopc).Id).Name
  2183. 160                   Else
  2184. 170                       StrTeam = StrTeam & "-" & UserList(.Users(Loopc).Id).Name
  2185. 180                   End If
  2186.                      
  2187. 190                   .Users(Loopc).Value = 1
  2188. 200                   .Users(Loopc).MapFight = ArenaSlot
  2189.                      
  2190. 210                   UserList(.Users(Loopc).Id).Counters.TimeFight = 10
  2191. 220                   Call WriteUserInEvent(.Users(Loopc).Id)
  2192. 230               End If
  2193. 240           Next Loopc
  2194. 250       End With
  2195.          
  2196. 260   Exit Sub
  2197.  
  2198. error:
  2199. 270       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_WarpTeam()"
  2200. End Sub
  2201.  
  2202. Private Function Fight_Search_Enfrentamiento(ByVal UserIndex As Integer, ByVal UserTeam As Byte, ByVal SlotEvent As Byte) As Byte
  2203. 10    On Error GoTo error
  2204.  
  2205.           ' Chequeamos que tengamos contrincante para luchar.
  2206.          Dim Loopc As Integer
  2207.          
  2208. 20        Fight_Search_Enfrentamiento = 0
  2209.          
  2210. 30        With Events(SlotEvent)
  2211. 40            For Loopc = LBound(.Users()) To UBound(.Users())
  2212. 50                If .Users(Loopc).Id > 0 And .Users(Loopc).Value = 0 Then
  2213. 60                    If .Users(Loopc).Id <> UserIndex And .Users(Loopc).Team <> UserTeam Then
  2214. 70                        Fight_Search_Enfrentamiento = .Users(Loopc).Team
  2215. 80                        Exit For
  2216. 90                    End If
  2217. 100               End If
  2218. 110           Next Loopc
  2219.          
  2220. 120       End With
  2221.          
  2222. 130   Exit Function
  2223.  
  2224. error:
  2225. 140       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_Search_Enfrentamiento()"
  2226. End Function
  2227.  
  2228. Private Sub NewRound(ByVal SlotEvent As Byte)
  2229.           Dim Loopc As Long
  2230.           Dim Count As Long
  2231.          
  2232. 10        With Events(SlotEvent)
  2233. 20            Count = 0
  2234.              
  2235. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2236. 40                If .Users(Loopc).Id > 0 Then
  2237.                       ' Hay esperando
  2238. 50                    If .Users(Loopc).Value = 0 Then
  2239. 60                        Exit Sub
  2240. 70                    End If
  2241.                      
  2242.                       ' Hay luchando
  2243. 80                    If .Users(Loopc).MapFight > 0 Then
  2244. 90                        Exit Sub
  2245. 100                   End If
  2246. 110               End If
  2247. 120           Next Loopc
  2248.              
  2249. 130           For Loopc = LBound(.Users()) To UBound(.Users())
  2250. 140               .Users(Loopc).Value = 0
  2251. 150           Next Loopc
  2252.  
  2253.             LogEventos "Se reinicio la informacion de los fights()"
  2254.              
  2255. 160       End With
  2256. End Sub
  2257. Private Sub Fight_Combate(ByVal SlotEvent As Byte)
  2258. 10    On Error GoTo error
  2259.  
  2260.           ' Buscamos una arena disponible y mandamos la mayor cantidad de usuarios disponibles.
  2261.          Dim Loopc As Integer
  2262.           Dim FreeArena As Byte
  2263.           Dim OponentTeam As Byte
  2264.           Dim strTemp As String
  2265.           Dim strTeam1 As String
  2266.           Dim strTeam2 As String
  2267.          
  2268. 20        With Events(SlotEvent)
  2269. cheking:
  2270. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2271. 40                If .Users(Loopc).Id > 0 And .Users(Loopc).Value = 0 Then
  2272. 50                    FreeArena = FreeSlotArena()
  2273.                      
  2274. 60                    If FreeArena > 0 Then
  2275. 70                        OponentTeam = Fight_Search_Enfrentamiento(.Users(Loopc).Id, .Users(Loopc).Team, SlotEvent)
  2276.                          
  2277. 80                        If OponentTeam > 0 Then
  2278. 90                            StatsEvent .Users(Loopc).Id
  2279. 100                           Fight_WarpTeam SlotEvent, FreeArena, .Users(Loopc).Team, False, strTeam1
  2280. 110                           Fight_WarpTeam SlotEvent, FreeArena, OponentTeam, True, strTeam2
  2281. 120                           MapEvent.Fight(FreeArena).Run = True
  2282.                              
  2283. 130                           strTemp = "Duelos " & Events(SlotEvent).TeamCant & "vs" & Events(SlotEvent).TeamCant & "» "
  2284. 140                           strTemp = strTemp & strTeam1 & " vs " & strTeam2
  2285. 150                           SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg(strTemp, FontTypeNames.FONTTYPE_GUILD)
  2286.                              
  2287. 160                           strTemp = vbNullString
  2288. 170                           strTeam1 = vbNullString
  2289. 180                           strTeam2 = vbNullString
  2290.                              
  2291. 190                       Else
  2292.                               ' Pasa de ronda automaticamente
  2293. 200                           .Users(Loopc).Value = 1
  2294. 210                           WriteConsoleMsg .Users(Loopc).Id, "Hemos notado que no tienes un adversario. Pasaste a la siguiente ronda.", FontTypeNames.FONTTYPE_INFO
  2295. 220                           NewRound SlotEvent
  2296.                               GoTo cheking:
  2297. 230                       End If
  2298. 240                   End If
  2299. 250               End If
  2300. 260           Next Loopc
  2301.              
  2302. 270       End With
  2303.          
  2304. 280   Exit Sub
  2305.  
  2306. error:
  2307. 290       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_Combate()"
  2308. End Sub
  2309. Private Sub ResetValue(ByVal SlotEvent As Byte)
  2310.           Dim Loopc As Integer
  2311.          
  2312. 10        With Events(SlotEvent)
  2313. 20            For Loopc = LBound(.Users()) To UBound(.Users())
  2314. 30                .Users(Loopc).Value = 0
  2315. 40            Next Loopc
  2316. 50        End With
  2317. End Sub
  2318. Private Function CheckTeam_UserDie(ByVal SlotEvent As Integer, ByVal TeamUser As Byte) As Boolean
  2319.  
  2320. 10    On Error GoTo error
  2321.  
  2322.           Dim Loopc As Integer
  2323.           ' Encontramos a uno del Team vivo, significa que no hay terminación del duelo.
  2324.          
  2325.          
  2326. 20        With Events(SlotEvent)
  2327. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2328. 40                If .Users(Loopc).Id > 0 Then
  2329. 50                    If .Users(Loopc).Team = TeamUser Then
  2330. 60                        If UserList(.Users(Loopc).Id).flags.Muerto = 0 Then
  2331. 70                            CheckTeam_UserDie = False
  2332. 80                            Exit Function
  2333. 90                        End If
  2334. 100                   End If
  2335. 110               End If
  2336. 120           Next Loopc
  2337.              
  2338. 130           CheckTeam_UserDie = True
  2339.          
  2340. 140       End With
  2341.          
  2342. 150   Exit Function
  2343.  
  2344. error:
  2345. 160       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : CheckTeam_UserDie()"
  2346. End Function
  2347. Private Sub Team_UserDie(ByVal SlotEvent As Byte, ByVal TeamSlot As Byte)
  2348. 10    On Error GoTo error
  2349.  
  2350.           Dim Loopc As Integer
  2351. 20        With Events(SlotEvent)
  2352.              
  2353.              
  2354. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2355. 40                If .Users(Loopc).Id > 0 Then
  2356. 50                    If .Users(Loopc).Team = TeamSlot Then
  2357. 60                        AbandonateEvent .Users(Loopc).Id
  2358. 70                    End If
  2359. 80                End If
  2360. 90            Next Loopc
  2361.          
  2362. 100       End With
  2363.          
  2364. 110   Exit Sub
  2365.  
  2366. error:
  2367. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Team_UserDie()"
  2368. End Sub
  2369. Public Function Fight_CheckContinue(ByVal UserIndex As Integer, ByVal SlotEvent As Byte, ByVal TeamSlot As Byte) As Boolean
  2370.           ' Esta función devuelve un TRUE cuando el enfrentamiento puede seguir.
  2371.          
  2372.           Dim Loopc As Integer, cant As Integer
  2373.          
  2374. 10        With Events(SlotEvent)
  2375.              
  2376. 20            Fight_CheckContinue = False
  2377.              
  2378. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2379.                   ' User válido
  2380. 40                If .Users(Loopc).Id > 0 And .Users(Loopc).Id <> UserIndex Then
  2381. 50                    If .Users(Loopc).Team = TeamSlot Then
  2382. 60                        If UserList(.Users(Loopc).Id).flags.Muerto = 0 Then
  2383. 70                            Fight_CheckContinue = True
  2384. 80                            Exit For
  2385. 90                        End If
  2386. 100                   End If
  2387. 110               End If
  2388. 120           Next Loopc
  2389.  
  2390. 130       End With
  2391.          
  2392. 140   Exit Function
  2393.  
  2394. error:
  2395. 150       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Team_CheckContinue()"
  2396. End Function
  2397. Public Sub Fight_WinForzado(ByVal UserIndex As Integer, ByVal SlotEvent As Byte, ByVal MapFight As Byte)
  2398. 10        On Error GoTo error
  2399.          
  2400.           Dim Loopc As Integer
  2401.           Dim strTempWin As String
  2402.           Dim TeamWin As Byte
  2403.           Dim Id As Integer
  2404.  
  2405. 20        With Events(SlotEvent)
  2406.  
  2407.               LogEventos "El personaje " & UserList(UserIndex).Name & " deslogeó en lucha."
  2408.              
  2409. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2410. 40                With .Users(Loopc)
  2411. 50                    If .Id > 0 And UserIndex <> .Id Then
  2412. 60                        If .MapFight = MapFight Then
  2413. 70                            If strTempWin = vbNullString Then
  2414. 80                                strTempWin = UserList(.Id).Name
  2415. 90                            Else
  2416. 100                               strTempWin = strTempWin & "-" & UserList(.Id).Name
  2417. 110                           End If
  2418.                              
  2419.                               '.value = 0
  2420. 130                           .MapFight = 0
  2421.                              
  2422. 140                           EventWarpUser .Id, 211, 30, 21
  2423.                               'WriteConsoleMsg .Id, "Felicitaciones. Has ganado el enfrentamiento", FontTypeNames.FONTTYPE_INFO
  2424.                              LogEventos "El personaje " & UserList(.Id).Name & " ha ganado el enfrentamiento"
  2425.                              
  2426. 150                           WriteShortMsj .Id, 64, FontTypeNames.FONTTYPE_INFO
  2427.  
  2428.                               ' / Update color char team
  2429. 160                           UserList(.Id).flags.FightTeam = 0
  2430. 170                           RefreshCharStatus (.Id)
  2431. 180                           TeamWin = .Team
  2432.  
  2433.                            
  2434. 190                       End If
  2435. 200                   End If
  2436. 210               End With
  2437. 220           Next Loopc
  2438.  
  2439.               MapEvent.Fight(MapFight).Run = False
  2440.              
  2441.              
  2442. 230           If strTempWin <> vbNullString Then SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Duelos " & Events(SlotEvent).TeamCant & "vs" & Events(SlotEvent).TeamCant & "» Duelo ganado por " & strTempWin & ".", FontTypeNames.FONTTYPE_GUILD)
  2443.              
  2444.               ' Nos fijamos si resetea el Value
  2445. 240           Call NewRound(SlotEvent)
  2446.              
  2447.               ' Nos fijamos si eran los últimos o si podemos mandar otro combate..
  2448. 250           If TeamCant(SlotEvent, TeamWin) = .Inscribed Then
  2449. 260               Fight_SearchTeamWin SlotEvent, TeamWin
  2450. 270               CloseEvent SlotEvent
  2451. 280           Else
  2452. 290               Fight_Combate SlotEvent
  2453. 300           End If
  2454.          
  2455. 310       End With
  2456.          
  2457. 320   Exit Sub
  2458.  
  2459. error:
  2460. 330       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_WinForzado()"
  2461. End Sub
  2462. Private Sub StatsEvent(ByVal UserIndex As Integer)
  2463. 10    On Error GoTo error
  2464.  
  2465. 20        With UserList(UserIndex)
  2466. 30            If .flags.Muerto Then
  2467. 40                Call RevivirUsuario(UserIndex)
  2468. 50                Exit Sub
  2469. 60            End If
  2470.              
  2471.               .Stats.MinSta = .Stats.MaxSta
  2472. 70            .Stats.MinHp = .Stats.MaxHp
  2473. 80            .Stats.MinMAN = .Stats.MaxMAN
  2474. 90            .Stats.MinAGU = 100
  2475. 100           .Stats.MinHam = 100
  2476.              
  2477. 110           WriteUpdateUserStats UserIndex
  2478.          
  2479. 120       End With
  2480.          
  2481. 130   Exit Sub
  2482.  
  2483. error:
  2484. 140       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : StatsEvent()"
  2485. End Sub
  2486.  
  2487. Private Function SearchTeamAttacker(ByVal TeamUser As Byte)
  2488.  
  2489. End Function
  2490. Public Sub Fight_UserDie(ByVal SlotEvent As Byte, ByVal SlotUserEvent As Byte, ByVal AttackerIndex As Integer)
  2491. 10    On Error GoTo error
  2492.     Dim TeamSlot As Byte
  2493.     Dim Loopc As Integer
  2494.     Dim strTempWin As String
  2495.     Dim TeamWin As Byte
  2496.     Dim MapFight As Byte
  2497.    
  2498.     ' Aca se hace que el que gané no siga luchando sino que espere.
  2499.    
  2500. 20    With Events(SlotEvent)
  2501. 30        TeamSlot = .Users(SlotUserEvent).Team
  2502. 40        TeamWin = .Users(UserList(AttackerIndex).flags.SlotUserEvent).Team
  2503.        
  2504. 50        If CheckTeam_UserDie(SlotEvent, TeamSlot) = False Then Exit Sub
  2505.        
  2506. 60        For Loopc = LBound(.Users()) To UBound(.Users())
  2507. 70            If .Users(Loopc).Id > 0 Then
  2508. 80                    With .Users(Loopc)
  2509. 90                        If .Team = TeamWin Then
  2510. 100                           StatsEvent .Id
  2511. 110
  2512. 120                            If strTempWin = vbNullString Then
  2513. 130                                strTempWin = UserList(.Id).Name
  2514. 140                            Else
  2515. 150                               strTempWin = strTempWin & "-" & UserList(.Id).Name
  2516. 160                         End If
  2517.                            
  2518.                            
  2519.                             MapFight = .MapFight
  2520. 170
  2521.                            
  2522.                             '.value = 0
  2523. 180                            .MapFight = 0
  2524. 190                            EventWarpUser .Id, 211, 30, 21
  2525.                                'WriteConsoleMsg .Id, "Felicitaciones. Has ganado el enfrentamiento", FontTypeNames.FONTTYPE_INFO
  2526. 200                            WriteShortMsj .Id, 64, FontTypeNames.FONTTYPE_INFO
  2527.                            
  2528.                             ' / Update color char team
  2529. 210                            UserList(.Id).flags.FightTeam = 0
  2530. 220                           RefreshCharStatus (.Id)
  2531. 230                     End If
  2532. 240                 End With
  2533. 250             End If
  2534. 260     Next Loopc
  2535.        
  2536.         MapEvent.Fight(MapFight).Run = False
  2537.        
  2538.         ' Abandono del user/team
  2539. 270     Team_UserDie SlotEvent, TeamSlot
  2540.        
  2541. 280     If strTempWin <> vbNullString Then SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Duelos " & Events(SlotEvent).TeamCant & "vs" & Events(SlotEvent).TeamCant & "» Enfrentamiento ganado por " & strTempWin & ".", FontTypeNames.FONTTYPE_GUILD)
  2542.        
  2543.         ' // Se fija de poder pasar a la siguiente ronda o esperar a los combates que faltan.
  2544. 290     Call NewRound(SlotEvent)
  2545.        
  2546.         ' Si la cantidad es igual al inscripto quedó final.
  2547. 300     If TeamCant(SlotEvent, TeamWin) = .Inscribed Then
  2548. 310            Fight_SearchTeamWin SlotEvent, TeamWin
  2549. 320            CloseEvent SlotEvent
  2550. 330     Else
  2551. 340            Fight_Combate SlotEvent
  2552. 350     End If
  2553.        
  2554. 360       End With
  2555.    
  2556. 370   Exit Sub
  2557.  
  2558. error:
  2559. 380       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_UserDie()" & " AT LINE: " & Erl
  2560. End Sub
  2561. Private Function TeamCant(ByVal SlotEvent As Byte, ByVal TeamSlot As Byte) As Byte
  2562.  
  2563. 10    On Error GoTo error
  2564.           ' Devuelve la cantidad de miembros que tiene un clan
  2565.          Dim Loopc As Integer
  2566.          
  2567. 20        TeamCant = 0
  2568.          
  2569. 30        With Events(SlotEvent)
  2570. 40            For Loopc = LBound(.Users()) To UBound(.Users())
  2571. 50                If .Users(Loopc).Team = TeamSlot Then
  2572. 60                    TeamCant = TeamCant + 1
  2573. 70                End If
  2574. 80            Next Loopc
  2575. 90        End With
  2576.          
  2577. 100   Exit Function
  2578.  
  2579. error:
  2580. 110       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : TeamCant()"
  2581. End Function
  2582. Private Sub Fight_SearchTeamWin(ByVal SlotEvent As Byte, ByVal TeamWin As Byte)
  2583.  
  2584. 10    On Error GoTo error
  2585.  
  2586.           Dim Loopc As Integer
  2587.           Dim strTemp As String
  2588.           Dim strReWard As String
  2589.           Dim mid As Integer
  2590.          
  2591.          
  2592. 20        With Events(SlotEvent)
  2593. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2594. 40                If .Users(Loopc).Id > 0 And .Users(Loopc).Team = TeamWin Then
  2595.                      
  2596.                      
  2597.                      
  2598.                       'riteConsoleMsg .Users(LoopC).Id, "Has ganado el evento. ¡Felicitaciones!", FontTypeNames.FONTTYPE_INFO
  2599. 50                    WriteShortMsj .Users(Loopc).Id, 65, FontTypeNames.FONTTYPE_INFO
  2600.                      
  2601. 60                    PrizeUser .Users(Loopc).Id, False
  2602.                      
  2603. 70                    If strTemp = vbNullString Then
  2604. 80                        strTemp = UserList(.Users(Loopc).Id).Name
  2605. 90                    Else
  2606. 100                       strTemp = strTemp & ", " & UserList(.Users(Loopc).Id).Name
  2607. 110                   End If
  2608. 120               End If
  2609. 130           Next Loopc
  2610.          
  2611.          
  2612. 140       If .TeamCant > 1 Then
  2613. 150           If .GldInscription > 0 Or .DspInscription > 0 Then strReWard = "Los participantes han recibido "
  2614. 160           If .GldInscription > 0 Then strReWard = strReWard & .GldInscription * .Quotas & " Monedas de oro. "
  2615. 170           If .DspInscription > 0 Then strReWard = strReWard & .DspInscription * .Quotas & " Monedas DSP. "
  2616.              
  2617. 180           SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Duelos " & .TeamCant & "vs" & .TeamCant & _
  2618.                   "» Evento terminado. Felicitamos a " & strTemp & " por haber ganado el torneo." & vbCrLf & strReWard, FontTypeNames.FONTTYPE_PREMIUM)
  2619.              
  2620. 190       Else
  2621. 200           If .GldInscription > 0 Or .DspInscription > 0 Then strReWard = "El participante recibió "
  2622. 210           If .GldInscription > 0 Then strReWard = strReWard & .GldInscription * .Quotas & " Monedas de oro"
  2623. 220           If .DspInscription > 0 Then strReWard = strReWard & " y " & .DspInscription * .Quotas & " Monedas DSP."
  2624.              
  2625. 230           SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Duelos " & .TeamCant & "vs" & .TeamCant & "» Evento terminado. Felicitamos a " & strTemp & _
  2626.                   " por haber ganado el evento." & vbCrLf & strReWard, FontTypeNames.FONTTYPE_PREMIUM)
  2627.            
  2628.                 'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("[TABLA-DUELOS]» Ganador: " & strTemp & ". Felicitaciones! " & vbCrLf & _
  2629.                       "Tabla final de posiciones: " & Event_GenerateTablaPos(SlotEvent, CopyUsers), FontTypeNames.FONTTYPE_GUILD)
  2630.            
  2631. 240       End If
  2632.          
  2633. 250       End With
  2634.          
  2635. 260   Exit Sub
  2636.  
  2637. error:
  2638. 270       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Fight_SearchTeamWin()"
  2639. End Sub
  2640.  
  2641.  
  2642. ' ############################## USUARIO UNSTOPPABLE ###########################################
  2643. Public Sub InitUnstoppable(ByVal SlotEvent As Byte)
  2644. 10    On Error GoTo error
  2645.  
  2646.           Dim Loopc As Integer
  2647.          
  2648. 20        With Events(SlotEvent)
  2649. 30            For Loopc = LBound(.Users()) To UBound(.Users())
  2650. 40                If .Users(Loopc).Id > 0 Then
  2651. 50                    EventWarpUser .Users(Loopc).Id, 218, RandomNumber(30, 54), RandomNumber(25, 39)
  2652.                      
  2653. 60                End If
  2654. 70            Next Loopc
  2655.              
  2656. 80            .TimeCount = 10
  2657. 90            .TimeFinish = 60 + .TimeCount
  2658. 100       End With
  2659.          
  2660. 110   Exit Sub
  2661.  
  2662. error:
  2663. 120       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : InitUnstoppable()"
  2664. End Sub
  2665. Public Sub Unstoppable_Userdie(ByVal SlotEvent As Byte, ByVal VictimSlot As Byte, ByVal AttackerSlot As Byte)
  2666. 10    On Error GoTo error
  2667.  
  2668. 20        With Events(SlotEvent)
  2669. 30            With .Users(VictimSlot)
  2670. 40                Call EventWarpUser(.Id, 218, RandomNumber(30, 54), RandomNumber(25, 39))
  2671. 50                Call RevivirUsuario(.Id)
  2672.                   'Call WriteConsoleMsg(.Id, "Has sido aniquilado. Pero no pierdas las esperanzas joven guerrero, reviviste y tu sangre está hambrienta, ve trás el que te asesino y haz justicia!", FontTypeNames.FONTTYPE_FIGHT)
  2673. 60                Call WriteShortMsj(.Id, 66, FontTypeNames.FONTTYPE_FIGHT)
  2674. 70            End With
  2675.              
  2676. 80            With .Users(AttackerSlot)
  2677. 90                .Value = .Value + 1
  2678. 100               WriteShortMsj .Id, 67, FontTypeNames.FONTTYPE_FIGHT, .Value
  2679.                   'WriteConsoleMsg .Id, "Felicitaciones, has sumado una muerte más a tu lista. Actualmente llevas " & .value & " asesinatos. Sigue así y ganarás el evento.", FontTypeNames.FONTTYPE_INFO
  2680. 110           End With
  2681. 120       End With
  2682. 130   Exit Sub
  2683.  
  2684. error:
  2685. 140       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Unstoppable_Userdie()"
  2686. End Sub
  2687.  
  2688. Private Function Event_GenerateTablaPos(ByVal SlotEvent As Byte, ByRef CopyUsers() As tUserEvent) As String
  2689.           Dim Loopc As Integer
  2690.          
  2691. 10        With Events(SlotEvent)
  2692. 20            For Loopc = LBound(.Users()) To UBound(.Users())
  2693. 30                If CopyUsers(Loopc).Id > 0 Then
  2694. 40                    Event_GenerateTablaPos = Event_GenerateTablaPos & _
  2695.                           Loopc & "° »» " & UserList(CopyUsers(Loopc).Id).Name & " (" & CopyUsers(Loopc).Value & ")" & vbCrLf
  2696. 50                End If
  2697. 60            Next Loopc
  2698. 70        End With
  2699.          
  2700. End Function
  2701. Private Sub Unstoppable_UserWin(ByVal SlotEvent As Byte)
  2702.  
  2703. 10    On Error GoTo error
  2704.  
  2705.           Dim UserIndex As Integer
  2706.           Dim strTemp As String
  2707.           Dim CopyUsers() As tUserEvent
  2708.          
  2709. 20        Event_OrdenateUsersValue SlotEvent, CopyUsers
  2710.          
  2711. 30        UserIndex = CopyUsers(1).Id
  2712.          
  2713. 40        With UserList(UserIndex)
  2714. 50            WriteShortMsj UserIndex, 68, FontTypeNames.FONTTYPE_GUILD, Events(.flags.SlotEvent).Users(.flags.SlotUserEvent).Value
  2715.               'WriteConsoleMsg Userindex, "Felicitaciones. Tus " & Events(.flags.SlotEvent).Users(.flags.SlotUserEvent).value & " asesinatos han hecho que ganes el evento. Aquí tienes 500.000 monedas de oro como recompensa.", FontTypeNames.FONTTYPE_INFO
  2716. 60            .Stats.Gld = .Stats.Gld + 350000
  2717. 70            .Stats.TorneosGanados = .Stats.TorneosGanados + 1
  2718. 80            WriteUpdateGold UserIndex
  2719.  
  2720. 90            SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Usuario Unstoppable» El ganador del evento es " & .Name & " con " & _
  2721.                   Events(.flags.SlotEvent).Users(.flags.SlotUserEvent).Value & " asesinatos." & vbCrLf & _
  2722.                   "Tabla de posiciones: " & Event_GenerateTablaPos(SlotEvent, CopyUsers), FontTypeNames.FONTTYPE_GUILD)
  2723.                  
  2724.               'SendData SendTarget.ToAll, 0, PrepareMessageShortMsj(69, FontTypeNames.FONTTYPE_GUILD, Events(.flags.SlotEvent).Users(.flags.SlotUserEvent).value, , , , Event_GenerateTablaPos)
  2725. 100           CloseEvent SlotEvent
  2726. 110       End With
  2727.          
  2728. 120   Exit Sub
  2729.  
  2730. error:
  2731. 130       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Unstoppable_UserWin()"
  2732. End Sub
  2733. Private Sub Event_OrdenateUsersValue(ByVal SlotEvent As Byte, ByRef CopyUsers() As tUserEvent)
  2734.  
  2735. 10    On Error GoTo error
  2736.  
  2737.     ' Utilizados para buscar ganador según VALUE
  2738.    Dim LoopX As Integer
  2739.     Dim LoopY As Integer
  2740.     Dim aux As tUserEvent
  2741.    ' Dim CopyUsers() As tUserEvent
  2742.    
  2743. 20        With Events(SlotEvent)
  2744.         ' Utilizamos la copia para no dañar archivos originales
  2745. 30        ReDim CopyUsers(LBound(.Users()) To UBound(.Users())) As tUserEvent
  2746.        
  2747. 40        For LoopY = LBound(.Users()) To UBound(.Users())
  2748. 50            CopyUsers(LoopY) = .Users(LoopY)
  2749. 60        Next LoopY
  2750.        
  2751. 70        For LoopX = LBound(.Users()) To UBound(.Users())
  2752. 80            For LoopY = LBound(.Users()) To UBound(.Users()) - 1
  2753. 90                If .Users(LoopY).Id > 0 Then
  2754. 100                   If Not LoopX = UBound(.Users()) Then
  2755. 110                       If CopyUsers(LoopY).Value < CopyUsers(LoopY + 1).Value Then
  2756.                            
  2757. 120                           aux = CopyUsers(LoopY)
  2758.                            
  2759. 130                           CopyUsers(LoopY) = CopyUsers(LoopY + 1)
  2760. 140                           CopyUsers(LoopY + 1) = aux
  2761. 150                     End If
  2762. 160                 End If
  2763. 170             End If
  2764. 180         Next LoopY
  2765. 190     Next LoopX
  2766.        
  2767. 200       End With
  2768.    
  2769. 210   Exit Sub
  2770.  
  2771. error:
  2772. 220       LogEventos "[" & Err.Number & "] " & Err.Description & ") PROCEDIMIENTO : Event_OrdenateUsersValue()"
  2773. End Sub
  2774.  
  2775.  
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.

×