API tools faq
paste
Advertisement
Luciano_fuentes

asd

Luciano_fuentes
Sep 12th, 2016
200
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 16.87 KB | None | 0 0
raw download clone embed print report
  1. Option Explicit
  2.  
  3. '@@@ AUTOR: LUCIANO
  4. '@@@ EVENTO: DELEGADO
  5.  
  6. Private Type tTeams
  7.  
  8.     Delegate            As Integer
  9.     UsersInTeam()       As Integer
  10.     WinPoints           As Byte
  11.     DeathTeam           As Byte
  12.     WinRounds           As Byte
  13.     Delegate_X          As Byte
  14.     Delegate_Y          As Byte
  15.     X                   As Byte
  16.     Y                   As Byte
  17.    
  18. End Type
  19.  
  20. Private Type tUserEvent
  21.  
  22.     ID                  As Integer
  23.     LastPosition        As WorldPos
  24.  
  25. End Type
  26.  
  27. Private Type tEventDelegate
  28.  
  29.     Teams(1 To 2)       As tTeams
  30.     UsersEvent          As Byte
  31.     UserIndex()         As tUserEvent
  32.     EventDelegate       As Boolean
  33.     Points              As Byte
  34.     Rounds              As Byte
  35.     Requirement         As Long
  36.     Prize               As Long
  37.     Quotas              As Byte
  38.     Level               As Byte
  39.     Countdown           As Byte
  40.     LoadTeams           As Byte
  41.    
  42. End Type
  43.  
  44. Private Const MAP_EVENT As Integer = 1
  45.  
  46. Private Const POS_DEATH_X As Byte = 60
  47. Private Const POS_DEATH_Y As Byte = 60
  48.  
  49. Private EventDelegate As tEventDelegate
  50. '_
  51.  
  52. ''
  53. '
  54. Public Sub Load_Coordinates()
  55.  
  56.     '@@ Cargamos las coordenas de los equipos y la del delegado.
  57.    '@@ Cargado desde el sub main()
  58.    
  59.     With EventDelegate
  60.    
  61.         '@@ EQUIPOS:
  62.        .Teams(1).X = 57
  63.         .Teams(1).Y = 46
  64.        
  65.         .Teams(2).X = 59
  66.         .Teams(2).Y = 46
  67.        
  68.         '@@ DELEGADOS:
  69.        .Teams(1).Delegate_X = 61
  70.         .Teams(1).Delegate_Y = 46
  71.        
  72.         .Teams(2).Delegate_X = 55
  73.         .Teams(2).Delegate_Y = 46
  74.        
  75.     End With
  76. End Sub
  77. ''
  78. '
  79. Public Sub Start_Event(ByVal UserIndex As Integer, _
  80.                        ByVal Quotas As Byte, _
  81.                        ByVal Prize As Long, _
  82.                        ByVal Requirement_Gold As Long, _
  83.                        ByVal Rounds As Byte, _
  84.                        ByVal Points As Byte, _
  85.                        ByVal Level As Byte)
  86.                        
  87.     '@@ Inicio el evento.
  88.    '@@ Paso requerimientos
  89.    '@@ Compruebo si se puede armar torneo.
  90.    '@@ Aviso por consola
  91.  
  92.     With EventDelegate
  93.        
  94.         If Can_Event(UserIndex) = False Then Exit Sub
  95.        
  96.         If Quotas < 3 Then Quotas = 3
  97.        
  98.         ReDim .Teams(1).UsersInTeam(1 To Quotas) As Integer
  99.         ReDim .Teams(2).UsersInTeam(1 To Quotas) As Integer
  100.        
  101.         If Rounds = 3 Then Rounds = 2
  102.         If Rounds = 5 Then Rounds = 3
  103.        
  104.         .Quotas = Quotas * 2
  105.         .Prize = Prize
  106.         .Points = Points
  107.        
  108.         .Requirement = Requirement_Gold
  109.         .Rounds = Rounds
  110.         .EventDelegate = True
  111.        
  112.         .Level = Level
  113.         .UsersEvent = 0
  114.        
  115.         ReDim .UserIndex(1 To .Quotas) As tUserEvent
  116.        
  117.         Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Evento Delegado> Iniciado", FontTypeNames.FONTTYPE_GUILD))
  118.  
  119.     End With
  120.  
  121. End Sub
  122. ''
  123. '
  124. Public Sub Enter_Event(ByVal UserIndex As Integer)
  125.  
  126.     '@@ Participan al evento
  127.    '@@ Los llevo a la sala de espera
  128.    '@@ Sumo la cantidad de usuarios en evento.
  129.    '@@ Guardo la ID del usuario.
  130.    '@@ Guardo la posición del usuario.
  131.    '@@ Le saco el oro.
  132.  
  133.     If Can_EnterEvent(UserIndex) = False Then Exit Sub
  134.  
  135.     With EventDelegate
  136.        
  137.         .UsersEvent = .UsersEvent + 1
  138.        
  139.         .Quotas = .Quotas - 1
  140.    
  141.         .UserIndex(.UsersEvent).ID = UserIndex
  142.        
  143.         .UserIndex(.UsersEvent).LastPosition = UserList(UserIndex).Pos
  144.    
  145.         UserList(UserIndex).Stats.GLD = UserList(UserIndex).Stats.GLD - .Requirement
  146.    
  147.         Call Enter_Wait(UserIndex)
  148.         Call WriteUpdateGold(UserIndex)
  149.        
  150.         If .Quotas = 0 Then _
  151.             Call Enter_Fight
  152.    
  153.     End With
  154.  
  155. End Sub
  156. ''
  157. '
  158. Private Sub Enter_Fight()
  159.  
  160.     '@@ Aviso que se completa el cupo.
  161.    '@@ Inicio la cuenta regresiva.
  162.    
  163.     With EventDelegate
  164.    
  165.         Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El cupo ha sido completado.", FontTypeNames.FONTTYPE_INFOBOLD))
  166.        
  167.         '@@ Defino los equipos.
  168.        '@@ También se define el delegado.
  169.        Call DefineTeam(1)
  170.         Call DefineTeam(2)
  171.        
  172.         '@@ Los llevo a la arena.
  173.        '@@ También llevo al lugar correspondiente al delegado.
  174.        Call WarpTeam(1, True, False)
  175.         Call WarpTeam(2, True, False)
  176.        
  177.         '@@ Para iniciar la cuenta regresiva.
  178.        .Countdown = 15
  179.        
  180.        
  181.         '@@ Ya no hay más cupos.
  182.        .Quotas = 0
  183.        
  184.     End With
  185.  
  186. End Sub
  187. ''
  188. '
  189. Private Sub Enter_Wait(ByVal ID As Integer)
  190.  
  191.     '@@ Los mando a la sala de espera.
  192.    '@@ Les marco que están en evento.
  193.    '@@ Les pongo el flag de evento.
  194.    
  195.     Call WarpUserChar(ID, 1, 50, 50, True)
  196.    
  197.     UserList(ID).flags.EventDelegate = 1
  198.    
  199.     Call WriteConsoleMsg(ID, "Has ingresado al evento, eres el participante Nº" & EventDelegate.UsersEvent, FontTypeNames.FONTTYPE_INFOBOLD)
  200.  
  201. End Sub
  202. ''
  203. '
  204. Private Function Can_Event(ByVal ID As Integer) As Boolean
  205.  
  206.     '@@ Compruebo si se puede armar evento.
  207.  
  208.     Can_Event = False
  209.  
  210.     If Not EsGM(ID) Then
  211.         Call WriteConsoleMsg(ID, "Tienes que ser GM para realizar el evento.", FontTypeNames.FONTTYPE_INFOBOLD)
  212.         Exit Function
  213.     End If
  214.    
  215.     With EventDelegate
  216.    
  217.         If .EventDelegate = True Then
  218.             Call WriteConsoleMsg(ID, "Ya hay un evento en curso. Espera a que el mismo termine.", FontTypeNames.FONTTYPE_INFOBOLD)
  219.             Exit Function
  220.         End If
  221.        
  222.        ' If .Quotas < 3 * 2 Then Exit Function
  223.    
  224.     End With
  225.    
  226.     Can_Event = True
  227.    
  228. End Function
  229. ''
  230. '
  231. Private Function Can_EnterEvent(ByVal ID As Integer) As Boolean
  232.  
  233.     '@@ Compruebo si puede entrar al evento
  234.    '@@ Comprueba el nivel del usuario.
  235.    '@@ Si está en el evento.
  236.    '@@ Si hay evento.
  237.    '@@ Si tiene oro
  238.    '@@ Si hay cupos.
  239.    '@@ Si está muerto
  240.    
  241.     Can_EnterEvent = False
  242.  
  243.     With UserList(ID)
  244.  
  245.         If .Stats.ELV < EventDelegate.Level Then
  246.        
  247.             Call WriteConsoleMsg(ID, "No tienes suficiente nivel para entrar al evento.", FontTypeNames.FONTTYPE_INFOBOLD)
  248.             Exit Function
  249.            
  250.         End If
  251.        
  252.         If EventDelegate.EventDelegate = False Then
  253.        
  254.             Call WriteConsoleMsg(ID, "No hay evento en curso.", FontTypeNames.FONTTYPE_INFOBOLD)
  255.             Exit Function
  256.            
  257.         End If
  258.        
  259.         If .flags.Delegate = 1 Then
  260.        
  261.             Call WriteConsoleMsg(ID, "Ya estás dentro del evento!", FontTypeNames.FONTTYPE_INFOBOLD)
  262.             Exit Function
  263.            
  264.         End If
  265.        
  266.         If .Stats.GLD < EventDelegate.Requirement Then
  267.        
  268.             Call WriteConsoleMsg(ID, "No tienes suficiente oro :(", FontTypeNames.FONTTYPE_INFOBOLD)
  269.             Exit Function
  270.            
  271.         End If
  272.        
  273.         If EventDelegate.Quotas = 0 Then
  274.        
  275.             Call WriteConsoleMsg(ID, "Cupos completados.", FontTypeNames.FONTTYPE_INFOBOLD)
  276.             Exit Function
  277.            
  278.         End If
  279.        
  280.         If .flags.Muerto = 1 Then
  281.            
  282.             Call WriteConsoleMsg(ID, "¡¡Estás muerto!!", FontTypeNames.FONTTYPE_INFOBOLD)
  283.             Exit Function
  284.            
  285.         End If
  286.        
  287.     End With
  288.    
  289.      Can_EnterEvent = True
  290.  
  291. End Function
  292. ''
  293. '
  294. Public Sub Countdown_Event()
  295.  
  296.     '@@ Cuenta regresiva.
  297.    '@@ Manejada desde el pasarsegundo()
  298.  
  299.     With EventDelegate
  300.  
  301.         If .Countdown > 0 Then
  302.    
  303.             .Countdown = .Countdown - 1
  304.    
  305.             Select Case .Countdown
  306.        
  307.                 Case 15
  308.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  309.        
  310.                 Case 10
  311.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  312.                
  313.                 Case 5
  314.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  315.                
  316.                 Case 4
  317.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  318.                
  319.                 Case 3
  320.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  321.                
  322.                 Case 2
  323.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  324.                
  325.                 Case 1
  326.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» CONTEO» " & .Countdown, FontTypeNames.FONTTYPE_INFOBOLD))
  327.                
  328.                 Case 0
  329.                     Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» PELEEN!", FontTypeNames.FONTTYPE_FIGHT))
  330.        
  331.             End Select
  332.            
  333.         End If
  334.        
  335.     End With
  336.    
  337. End Sub
  338. ''
  339. '
  340. Public Function All_Death(ByVal Team As Byte) As Boolean
  341.  
  342.     '@@ Chequeo si todos murieron.
  343.  
  344.     All_Death = False
  345.    
  346.     If EventDelegate.Teams(Team).DeathTeam >= UBound(EventDelegate.Teams(Team).UsersInTeam()) Then Exit Function
  347.    
  348.     All_Death = True
  349.  
  350. End Function
  351. ''
  352. '
  353. Public Function Return_Team(ByVal UserID As Integer) As Byte
  354.  
  355.     '@@ Retorna en que equipo está el usuario pasado por parametro.
  356.  
  357.     Dim LoopC As Long
  358.     Dim loopX As Long
  359.    
  360.     For LoopC = 1 To 2
  361.    
  362.         For loopX = 1 To EventDelegate.UsersEvent * 0.5
  363.        
  364.             If EventDelegate.Teams(LoopC).UsersInTeam(loopX) = UserID Then
  365.            
  366.                 Return_Team = LoopC
  367.                 Exit Function
  368.                
  369.             End If
  370.        
  371.         Next loopX
  372.        
  373.     Next LoopC
  374.  
  375. End Function
  376. ''
  377. '
  378. Public Sub Death_User(ByVal ID As Integer)
  379.  
  380.     '@@ Si muere un usuario lo mando hacia arriba de la arena para que no estorbe.
  381.    '@@ Veo en que equipo está y chequeo si ya murieron todos.
  382.    '@@ Si mueren todos veo quien ganó el round y se los sumo.
  383.  
  384.     Dim Team As Byte
  385.     Dim TeamW As Byte
  386.  
  387.     Call WarpUserChar(ID, MAP_EVENT, POS_DEATH_X, POS_DEATH_Y, True)
  388.  
  389.     Team = Return_Team(ID)
  390.    
  391.     If All_Death(Team) = True Then
  392.    
  393.         TeamW = Return_Team_Life()
  394.         Call WinRound(TeamW)
  395.        
  396.     End If
  397.  
  398. End Sub
  399. ''
  400. '
  401. Private Sub WinRound(ByVal Team As Byte)
  402.  
  403.     '@@ Les subo un round ganado al team ganador.
  404.    '@@ Si ganaron lo suficiente le sumo un punto.
  405.  
  406.     With EventDelegate
  407.  
  408.         .Teams(Team).WinRounds = .Teams(Team).WinRounds + 1
  409.        
  410.         If .Teams(Team).WinRounds = .Rounds Then _
  411.             Call WinPoint(Team)
  412.    
  413.     End With
  414.    
  415. End Sub
  416. ''
  417. '
  418. Private Sub WinPoint(ByVal Team As Byte)
  419.  
  420.     '@@ Les subo un punto.
  421.    '@@ Llevo al equipo que perdió el combate a su antigua posición.
  422.    '@@ Si ganaron lo suficiente ganan el evento :D
  423.  
  424.         Dim TeamL As Byte
  425.  
  426.     With EventDelegate
  427.  
  428.         TeamL = Return_Team_Death
  429.        
  430.         Call Remove_Team(TeamL)
  431.        
  432.         .Teams(Team).WinPoints = .Teams(Team).WinPoints + 1
  433.        
  434.         If .Teams(Team).WinPoints = .Points Then _
  435.             Call WinEvent(Team)
  436.    
  437.     End With
  438.    
  439. End Sub
  440. ''
  441. '
  442. Private Sub WinEvent(ByVal Team As Byte)
  443.  
  444.     '@@ Si ganaron el evento reparto el premio.
  445.    '@@ Los llevo a ullathorpe.
  446.    '@@ Aviso quién ganó el evento.
  447.  
  448.     Dim LoopC As Long
  449.  
  450.     With EventDelegate
  451.    
  452.         For LoopC = 1 To .UsersEvent * 0.5
  453.    
  454.             UserList(.Teams(Team).UsersInTeam(LoopC)).Stats.GLD = UserList(.Teams(Team).UsersInTeam(LoopC)).Stats.GLD + .Prize
  455.    
  456.             Call WriteUpdateGold(.Teams(Team).UsersInTeam(LoopC))
  457.        
  458.         Next LoopC
  459.  
  460.         Call WarpTeam(Team, False, False)
  461.        
  462.         Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Delegado» Ganador del evento el equipo del delegado " & UserList(.Teams(Team).Delegate).name, FontTypeNames.FONTTYPE_FIGHT))
  463.        
  464.     End With
  465.  
  466. End Sub
  467. ''
  468. '
  469. Private Sub DefineTeam(ByVal Team As Byte)
  470.    
  471.     '@@ Defino el equipo azul.
  472.    '@@ Defino al delegado con azar.
  473.    '@@ Le asigno el flag al delegado.
  474.    '@@ Le aviso que se convirtió en delegado.
  475.    '@@ Les informo a que equipo pertenecen.
  476.    
  477.     Dim LoopC As Long
  478.     Dim TeamColor As String
  479.    
  480.     If Team = 1 Then
  481.    
  482.         TeamColor = "Azul!"
  483.        
  484.     Else
  485.    
  486.         TeamColor = "Rojo!"
  487.        
  488.     End If
  489.  
  490.  
  491.     With EventDelegate
  492.  
  493.         For LoopC = 1 To .UsersEvent * 0.5
  494.            
  495.             .LoadTeams = .LoadTeams + 1
  496.            
  497.             .Teams(Team).UsersInTeam(LoopC) = .UserIndex(.LoadTeams).ID
  498.             Call WriteConsoleMsg(.Teams(Team).UsersInTeam(LoopC), "Ahora perteneces al equipo " & TeamColor, FontTypeNames.FONTTYPE_INFOBOLD)
  499.            
  500.         Next LoopC
  501.    
  502.         .Teams(Team).Delegate = .Teams(Team).UsersInTeam(RandomNumber(1, UBound(.Teams(Team).UsersInTeam)))
  503.         UserList(.Teams(Team).Delegate).flags.EventDelegate = 1
  504.         Call WriteConsoleMsg(.Teams(Team).Delegate, "Eres delegado del equipo " & TeamColor, FontTypeNames.FONTTYPE_INFOBOLD)
  505.            
  506.         If .LoadTeams = .UsersEvent Then _
  507.             .LoadTeams = 0
  508.            
  509.     End With
  510.    
  511. End Sub
  512.  
  513. ''
  514. '
  515. Private Sub WarpTeam(ByVal Team As Byte, ByVal toEvent As Boolean, ByVal Wait As Boolean)
  516.  
  517.     ' Si es al evento mando el team a las arenas.
  518.    ' Si no es al evento los mando a su antigua posición.
  519.    ' Mando al delegado al área correspondiente.
  520.    ' Nos llevamos también a la sala de espera.
  521.  
  522.     Dim LoopC As Long
  523.  
  524.     With EventDelegate
  525.  
  526.         For LoopC = 1 To .UsersEvent * 0.5
  527.  
  528.             If toEvent = False Then
  529.    
  530.                 Call WarpUserChar(.Teams(Team).UsersInTeam(LoopC), .UserIndex(.Teams(Team).UsersInTeam(LoopC)).LastPosition.Map, .UserIndex(.Teams(Team).UsersInTeam(LoopC)).LastPosition.X, .UserIndex(.Teams(Team).UsersInTeam(LoopC)).LastPosition.Y, True)
  531.            
  532.             ElseIf Wait = True And toEvent = True Then
  533.            
  534.                 Call WarpUserChar(.Teams(Team).UsersInTeam(LoopC), MAP_EVENT, 50, 50, True)
  535.                
  536.                 Call WarpUserChar(.Teams(Team).Delegate, MAP_EVENT, 50, 50, True)
  537.            
  538.             ElseIf toEvent = True And Wait = False Then
  539.        
  540.                 Call WarpUserChar(.Teams(Team).UsersInTeam(LoopC), MAP_EVENT, .Teams(Team).X, .Teams(Team).Y, True)
  541.                
  542.                 Call WarpUserChar(.Teams(Team).Delegate, MAP_EVENT, .Teams(Team).Delegate_X, .Teams(Team).Delegate_Y, True)
  543.            
  544.             End If
  545.            
  546.         Next LoopC
  547.  
  548.     End With
  549.  
  550. End Sub
  551.  
  552. ''
  553. '
  554. Private Sub Remove_Team(ByVal Team As Byte)
  555.  
  556.     '@@ Remueve a un equipo del evento.
  557.  
  558.     Dim LoopC As Long
  559.    
  560.     With EventDelegate
  561.  
  562.         For LoopC = 1 To .UsersEvent * 0.5
  563.        
  564.             '@@ Sacamos al delegado.
  565.            UserList(.UserIndex(LoopC).ID).flags.Delegate = 0
  566.             '@@ Sacamos del evento.
  567.            UserList(.UserIndex(LoopC).ID).flags.EventDelegate = 0
  568.             '@@ Sacamos a los usuarios del team.
  569.            .Teams(Team).UsersInTeam(LoopC) = 0
  570.  
  571.         Next LoopC
  572.  
  573.  
  574.         '@@ Lo sacamos del mapa.
  575.        Call WarpTeam(Team, False, False)
  576.  
  577.         '@@ Para cargar nuevos teams.
  578.        If .LoadTeams > 0 Then _
  579.             .LoadTeams = .LoadTeams - .UsersEvent * 0.5
  580.        
  581.         '@@ Nueva cantidad de usuarios en el evento.
  582.        .UsersEvent = .UsersEvent - .UsersEvent * 0.5
  583.        
  584.     End With
  585.    
  586.     With EventDelegate.Teams(Team)
  587.        
  588.         '@@ Le sacamos los flags al team.
  589.        .DeathTeam = 0
  590.         .Delegate = 0
  591.         .WinPoints = 0
  592.         .WinRounds = 0
  593.    
  594.     End With
  595.  
  596. End Sub
  597. ''
  598. '
  599. Public Sub Open_Event(ByVal TeamInEvent As Byte)
  600.  
  601.     '@@ Abre nuevos cupos.
  602.  
  603.     With EventDelegate
  604.  
  605.         If TeamInEvent = 1 Then
  606.        
  607.             .LoadTeams = .UsersEvent
  608.             .Quotas = .UsersEvent
  609.            
  610.            
  611.         End If
  612.    
  613.     End With
  614.  
  615. End Sub
  616. ''
  617. '
  618. Private Function Return_Team_Life() As Byte
  619.  
  620.     '@@ Devuelve cuál equipo está vivo.
  621.  
  622.     If All_Death(1) = True Then
  623.    
  624.         Return_Team_Life = 2
  625.        
  626.     Else
  627.    
  628.         Return_Team_Life = 1
  629.        
  630.     End If
  631.  
  632. End Function
  633. ''
  634. '
  635. Private Function Return_Team_Death() As Byte
  636.    
  637.     '@@ Devuelve cuál equipo está muerto.
  638.    
  639.     If All_Death(1) = True Then
  640.    
  641.         Return_Team_Death = 1
  642.        
  643.     Else
  644.    
  645.         Return_Team_Death = 2
  646.        
  647.     End If
  648.    
  649. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!