Sistema de retos 1 vs 1 Múltiples Arenas [%100 Funcional]

Ir abajo

Sistema de retos 1 vs 1 Múltiples Arenas [%100 Funcional]

Mensaje por Metrosersuah el 20/4/2017, 3:36 pm

Server

Modúlo:


Código:
Option Explicit
Const RETOS_ARENAS      As Byte = 9     'NUM DE ARENAS.
Const RETOS_VOLVER      As Byte = 10    'TIEMPO PARA VOLVER DESP DE GANAR.
Const RETOS_CUENTA      As Byte = 10     'SEGUNDOS DE CUENTA
Const RETOS_MAPA        As Integer = 176  'NUMERO DE MAPA.
Type Datos
     Usuarios(1 To 2)   As Integer      'UI DE LOS USUARIOS.
     Cuenta             As Byte         'CUENTA REGRESIVA.
     PorInventario      As Boolean      'SI ES POR ITEMS.
     ApuestaOro         As Long         'CANTIDAD DE ORO.
     SalaOcupada        As Boolean      'PARA BUSCAR RINGS VACIOS.
     Ganador            As Integer      'UI DEL GANADOR DEL RETO.
End Type
Public Retos(1 To RETOS_ARENAS) As Datos
Public ElSlot As Byte
Function PuedeEnviar(ByVal UserIndex As Integer, ByVal otherUser As String, ByVal Oro As Long, ByRef error As String) As Boolean
' @ Checks si puede enviar reto
PuedeEnviar = False
Dim OtherUI As Integer
With UserList(UserIndex)
  ' If Not UserList(.Reto1vs1.RetoIndex).flags.Peleando = 1 Then
   '  error = "MO PODE REGTAR VIGOGT3TETETEETTETETETE."
   ' Exit Function
    'End If
If Not .Pos.Map = 1 Then
    'Call WriteConsoleMsg(UserIndex, "¡¡No puedes ingresar si no estas en Ullathorpe!!.", FontTypeNames.FONTTYPE_INFO)
    error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.."
    Exit Function
    End If
    'Muerto.
    If .flags.Muerto <> 0 Then
        error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
        Exit Function
    End If
    'Preso.
    If .Counters.Pena <> 0 Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
  
    'No tiene el oro.
    If .Stats.Gld < Oro Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
    'Ya en reto.
    If .Reto1vs1.RetoIndex <> 0 Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
  
End With
OtherUI = NameIndex(otherUser)
  
    'No online.
    If Not OtherUI <> 0 Then
        error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
        Exit Function
    End If
With UserList(OtherUI)
    'Muerto.
    If .flags.Muerto <> 0 Then
        error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
        Exit Function
    End If
    'Preso.
    If .Counters.Pena <> 0 Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
  
    'amb hack
  
     If UserList(UserIndex).name = UserList(OtherUI).name Then
           error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
            Exit Function
            End If
  
  
     If Oro < 5000 Then
                WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
             Exit Function
    End If
  
    'No tiene el oro.
    If .Stats.Gld < Oro Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
  
    'Ya en reto.
    If .Reto1vs1.RetoIndex <> 0 Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
  
End With
    'No hay salas.
    If Not SalaLibre <> 0 Then
       error = "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos."
       Exit Function
    End If
  
   ' If Not UserList(UserIndex).flags.EnEvento = 0 Then
'error = "GORDO."
' Exit Function
' End If
PuedeEnviar = True
End Function
Function DameX(ByVal Usuario As Byte, ByVal RetoIndex As Byte)
' @ Devuelve una posición X para un usuario y un reto.
Select Case RetoIndex
       Case 1   '<Arena 1.
            If Not Usuario <> 1 Then
                DameX = 13
            Else
                DameX = 27
            End If
          
       Case 2   '<Arena 2.
            If Not Usuario <> 1 Then
                DameX = 13
            Else
                DameX = 27
            End If
          
       Case 3   '<Arena 3.
            If Not Usuario <> 1 Then
                DameX = 13
            Else
                DameX = 27
            End If
          
       Case 4   '<Arena 4.
            If Not Usuario <> 1 Then
                DameX = 44
            Else
                DameX = 58
            End If
          
       Case 5   '<Arena 6.
            If Not Usuario <> 1 Then
                DameX = 44
            Else
                DameX = 50
            End If
          
       Case 6   '<Arena 6.
            If Not Usuario <> 1 Then
                DameX = 44
            Else
                DameX = 58
            End If
          
        Case 7 '<Arena 7.
            If Not Usuario <> 1 Then
                DameX = 74
            Else
                DameX = 88
            End If
          
        Case 8 '<Arena 8.
            If Not Usuario <> 1 Then
                DameX = 74
            Else
                DameX = 88
            End If
          
        Case 9 '<Arena 9.
            If Not Usuario <> 1 Then
                DameX = 74
            Else
                DameX = 88
            End If
End Select
End Function
Function DameY(ByVal Usuario As Byte, ByVal RetoIndex As Byte)
' @ Devuelve una posición Y para un usuario y un reto.
Select Case RetoIndex
       Case 1   '<Arena 1.
            If Not Usuario <> 1 Then
                DameY = 18
            Else
                DameY = 28
            End If
          
       Case 2   '<Arena 2.
            If Not Usuario <> 1 Then
                DameY = 46
            Else
                DameY = 56
            End If
          
       Case 3   '<Arena 3.
            If Not Usuario <> 1 Then
                DameY = 74
            Else
                DameY = 84
            End If
          
       Case 4   '<Arena 4.**************
            If Not Usuario <> 1 Then
                DameY = 18
            Else
                DameY = 28
            End If
          
       Case 5   '<Arena 5.
            If Not Usuario <> 1 Then
                DameY = 46
            Else
                DameY = 56
            End If
          
       Case 6   '<Arena 6.
            If Not Usuario <> 1 Then
                DameY = 74
            Else
                DameY = 84
            End If
      
         Case 7   '<Arena 7.*****************************
            If Not Usuario <> 1 Then
                DameY = 18
            Else
                DameY = 28
            End If
      
         Case 8   '<Arena 8.
            If Not Usuario <> 1 Then
                DameY = 46
            Else
                DameY = 58
            End If
          
         Case 9   '<Arena 9.
            If Not Usuario <> 1 Then
                DameY = 74
            Else
                DameY = 84
            End If
End Select
End Function
Function SalaLibre() As Byte
' @ Busca una arena que no esté usada.
Dim loopX   As Long
For loopX = 1 To RETOS_ARENAS
    If Not Retos(loopX).SalaOcupada Then
       SalaLibre = CByte(loopX)
       Exit Function
    End If
Next loopX
SalaLibre = 0
End Function
Sub PasaSegundo()
' @ Pasa un segundo.
Dim loopX   As Long
For loopX = 1 To RETOS_ARENAS
    With Retos(loopX)
         'Hay reto?
         If .SalaOcupada Then
            'Cuenta?
            If .Cuenta <> 0 Then
               'Envia.
               WriteConsoleMsg .Usuarios(1), "Reto> " & .Cuenta, FontTypeNames.FONTTYPE_INFO
               WriteConsoleMsg .Usuarios(2), "Reto>" & .Cuenta, FontTypeNames.FONTTYPE_INFO
               'Resta.
               .Cuenta = .Cuenta - 1
               'Llega a 0?
               If Not .Cuenta <> 0 Then
                  'Despausea.
                  WritePauseToggle .Usuarios(1)
                  WritePauseToggle .Usuarios(2)
 
                  'Avisa
                  WriteConsoleMsg .Usuarios(1), "YA!", FontTypeNames.FONTTYPE_FIGHT
                  WriteConsoleMsg .Usuarios(2), "YA!", FontTypeNames.FONTTYPE_FIGHT
               End If
            End If
          
            'Hay ganador?
            If .Ganador <> 0 Then
               'Está logeado?
               If UserList(.Ganador).ConnID <> -1 Then
                  'Pasa tiempo.
                  UserList(.Ganador).Reto1vs1.VolverSeg = UserList(.Ganador).Reto1vs1.VolverSeg - 1
                  'Se acabó el tiempo.
                  If Not UserList(.Ganador).Reto1vs1.VolverSeg <> 0 Then
                     'Devuelve a la posición.
                     Call WarpUserChar(.Ganador, UserList(.Ganador).flags.BeforeMap, UserList(.Ganador).flags.BeforeX, UserList(.Ganador).flags.BeforeY, False)
                     'Reset usuario y slot.
                     Call Retos1vs1.Limpiar(.Ganador)
                     Call Retos1vs1.LimpiarIndex(loopX)
                  End If
               End If
            End If
         End If
      
    End With
Next loopX
End Sub
Sub Enviar(ByVal UserIndex As Integer, ByVal otherIndex As Integer, ByVal Apuesta As Long, ByVal Inventario As Boolean)
' @ Envia reto.
Dim nextStr As String
With UserList(UserIndex)
  
    'buffer para los datos.
    With .Reto1vs1
         '.ApuestaInv = Inventario
         .ApuestaOro = Apuesta
    End With
  
    'Prepara el mensaje
    If Apuesta <> 0 Then
       nextStr = "Apuesta " & Format$(Apuesta) & " monedas de oro"
    End If
  
  
  
  
    'If Inventario Then
       'nextStr = "" & Format$(Apuesta) & " y los item del inventario"
    'End If
  
    'Avisa al usuario.
  
    WriteConsoleMsg otherIndex, .name & "(" & UserList(otherIndex).Stats.ELV & ") te ha retado por la " & nextStr & ". si aceptas escribe /ACEPTAR " & .name & ".", FontTypeNames.FONTTYPE_GUILD
End With
'Datos del otro usuario.
With UserList(otherIndex).Reto1vs1
     .MeEnvio = UserIndex
End With
'Avisa
Call WriteConsoleMsg(UserIndex, "Le enviaste reto a " & UserList(otherIndex).name & " (" & UserList(otherIndex).Stats.ELV & "). por la cantidad " & nextStr & "", FontTypeNames.FONTTYPE_GUILD)
End Sub
Sub Aceptar(ByVal UserIndex As Integer)
' @ Usuario acepta reto.
Dim LibreSlot   As Byte
With UserList(UserIndex)
     'Nadie lo reta.
     If Not .Reto1vs1.MeEnvio <> 0 Then Exit Sub
        
     'Busca slot.
     LibreSlot = SalaLibre
  
  
     If Not .Pos.Map = 1 Then
    'Call WriteConsoleMsg(UserIndex, "¡¡No puedes ingresar si no estas en Ullathorpe!!.", FontTypeNames.FONTTYPE_INFO)
    WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
    Exit Sub
     End If
  
     'No hay sala.
     If Not LibreSlot <> 0 Then
        WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
        Exit Sub
     End If
  
     'No está online.
     If Not UserList(.Reto1vs1.MeEnvio).ConnID <> -1 Then
        WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
        Exit Sub
     End If
  
     If .Reto1vs1.RetoIndex <> 0 Then
     WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
     Exit Sub
     End If
  
     If .flags.Peleando <> 0 Then
     WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
     Exit Sub
     End If
  
     If .flags.EnEvento <> 0 Then
     WriteConsoleMsg UserIndex, "Requisito para retar invalido. Verifica tu oro y el de tu oponente y la condición de ambos.", FontTypeNames.FONTTYPE_INFO
     Exit Sub
     End If
  

  
     'Que empieze el reto!
     Empezar UserIndex, .Reto1vs1.MeEnvio, LibreSlot
     ElSlot = LibreSlot
  
End With
End Sub
Sub Empezar(ByVal UserIndex As Integer, ByVal EnviadorIndex As Integer, ByVal Slot As Byte)
' @ Empieza un nuevo reto.
'Llena los datos.
On Error GoTo Err
Dim loopX   As Long
1 With Retos(Slot)
  
     'Setea los UI.
2     .Usuarios(1) = UserIndex
3     .Usuarios(2) = EnviadorIndex
  
     'Guarda apuestas.
4     .ApuestaOro = UserList(EnviadorIndex).Reto1vs1.ApuestaOro
5     .PorInventario = UserList(EnviadorIndex).Reto1vs1.ApuestaInv
  
     'Setea cuenta regresiva.
6     .Cuenta = RETOS_CUENTA
 
     'Setea sala ocupada y resetea ganador UI
7     .SalaOcupada = True
8     .Ganador = 0
  
For loopX = 1 To 2
         'Setea anteriorPos
10         UserList(.Usuarios(loopX)).Reto1vs1.Anteriorposition = UserList(.Usuarios(loopX)).Pos
         UserList(.Usuarios(loopX)).flags.Round = 0
  
         'Telep a los usuarios.
11         Call Usuarios.WarpUserChar(.Usuarios(loopX), RETOS_MAPA, DameX(loopX, Slot), DameY(loopX, Slot), True)
         'Pause clientes.
12         Call Protocol.WritePauseToggle(.Usuarios(loopX))
          UserList(.Usuarios(loopX)).flags.Round = 0
      
         'Cuenta regresiva.
         WriteConsoleMsg .Usuarios(loopX), UserList(.Usuarios(1)).name & " vs " & UserList(.Usuarios(2)).name & ".", FontTypeNames.FONTTYPE_GUILD
UserList(.Usuarios(loopX)).flags.Round = 0
    
' Setear mapas
        UserList(.Usuarios(loopX)).flags.BeforeMap = UserList(.Usuarios(loopX)).Pos.Map
        UserList(.Usuarios(loopX)).flags.BeforeX = UserList(.Usuarios(loopX)).Pos.X
        UserList(.Usuarios(loopX)).flags.BeforeY = UserList(.Usuarios(loopX)).Pos.Y
         'Setea retoIndex
14         UserList(.Usuarios(loopX)).Reto1vs1.RetoIndex = Slot
         'Setea Round
         UserList(.Usuarios(loopX)).flags.Round = 0
            UserList(EnviadorIndex).flags.Paralizado = 0
            UserList(UserIndex).flags.Paralizado = 0
    
15     Next loopX
     'Avistage to WORLD !!
  
     'SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El reto de " & UserIndex & " vs " & EnviadorIndex & " ha dado inicio!", FontTypeNames.FONTTYPE_CITIZEN)
      End With
Err:
Debug.Print "Linea " & Erl()
End Sub
Sub Muere(ByVal muertoIndex As Integer, Optional ByVal Desconexion As Boolean = False)
' @ Muere un usuario en reto
    Dim winnerIndex As Integer  'UI DEL GANADOR DEL RETO.
    Dim indexUser   As Byte     'INDEX DE LOS USUARIOS DEL RETO.
    Dim indexReto   As Byte
    indexReto = UserList(muertoIndex).Reto1vs1.RetoIndex
    indexUser = IIf(Retos(indexReto).Usuarios(1) = muertoIndex, 2, 1)
'OBTENGO SU UI.
    winnerIndex = Retos(indexReto).Usuarios(indexUser)
    If Desconexion Then
        If UserList(winnerIndex).ConnID > 0 Then
            UserList(winnerIndex).flags.Round = 3
        ElseIf UserList(muertoIndex).ConnID > 0 Then
            UserList(muertoIndex).flags.Round = 3
        
        End If
    End If
    If UserList(winnerIndex).flags.Round <= 2 And UserList(winnerIndex).flags.Muerto = 0 Then
        UserList(winnerIndex).flags.Round = UserList(winnerIndex).flags.Round + 1
      
        With UserList(muertoIndex)
            With Retos(indexReto)
                WarpUserChar .Usuarios(1), UserList(.Usuarios(1)).flags.BeforeMap, UserList(.Usuarios(1)).flags.BeforeX, UserList(.Usuarios(1)).flags.BeforeY, True
                WarpUserChar .Usuarios(2), UserList(.Usuarios(2)).flags.BeforeMap, UserList(.Usuarios(2)).flags.BeforeX, UserList(.Usuarios(2)).flags.BeforeY, True
            End With
            WriteConsoleMsg muertoIndex, "Retos> Resultado parcial:" & vbNewLine & "Retos> " & .name & " " & .flags.Round & " - " & UserList(winnerIndex).name & " " & UserList(winnerIndex).flags.Round & "", FontTypeNames.FONTTYPE_GUILD
            WriteConsoleMsg winnerIndex, "Retos> Resultado parcial:" & vbNewLine & "Retos> " & .name & " " & .flags.Round & " - " & UserList(winnerIndex).name & " " & UserList(winnerIndex).flags.Round & "", FontTypeNames.FONTTYPE_GUILD
            WritePauseToggle muertoIndex
            WritePauseToggle winnerIndex
      
        
            Dim i As Long
            Dim pt As Integer
            Dim pt1 As Integer
            For i = 1 To RETOS_ARENAS
                If Retos(i).Usuarios(indexUser) > 0 Then
                    pt = Retos(i).Usuarios(1)
                    pt1 = Retos(i).Usuarios(2)
                    If (Retos(i).Cuenta = 0 And Retos(i).SalaOcupada = True) And (UserList(pt).flags.Muerto = 1 Or UserList(pt1).flags.Muerto = 1) Then
                        Retos(i).Cuenta = RETOS_CUENTA
                    End If
                End If
                Next i
                RevivirUsuario muertoIndex
                .Stats.MinHp = .Stats.MaxHp
                .Stats.MinMAN = .Stats.MaxMAN
                .Stats.MinSta = .Stats.MaxSta
                With UserList(winnerIndex)
                    .Stats.MinHp = .Stats.MaxHp
                    .Stats.MinMAN = .Stats.MaxMAN
                    .Stats.MinSta = .Stats.MaxSta
                End With
            End With
        ElseIf UserList(muertoIndex).flags.Round <= 2 And UserList(muertoIndex).flags.Muerto = 0 Then
            UserList(muertoIndex).flags.Round = UserList(muertoIndex).flags.Round + 1
            With UserList(winnerIndex)
                .Stats.MinHp = .Stats.MaxHp
                .Stats.MinMAN = .Stats.MaxMAN
                .Stats.MinSta = .Stats.MaxSta
                WarpUserChar winnerIndex, .flags.BeforeMap, .flags.BeforeX, .flags.BeforeY, True
                WarpUserChar muertoIndex, UserList(muertoIndex).flags.BeforeMap, UserList(muertoIndex).flags.BeforeX, UserList(muertoIndex).flags.BeforeY, True
                WriteConsoleMsg muertoIndex, "Retos> Resultado parcial:" & vbNewLine & "Retos> " & .name & " " & .flags.Round & " - " & UserList(winnerIndex).name & " " & UserList(winnerIndex).flags.Round & "", FontTypeNames.FONTTYPE_GUILD
                WriteConsoleMsg winnerIndex, "Retos> Resultado parcial:" & vbNewLine & "Retos> " & .name & " " & .flags.Round & " - " & UserList(winnerIndex).name & " " & UserList(winnerIndex).flags.Round & "", FontTypeNames.FONTTYPE_GUILD
                WritePauseToggle muertoIndex
                WritePauseToggle winnerIndex
            .flags.Inmovilizado = 0
            .flags.Paralizado = 0
    
                For i = 1 To RETOS_ARENAS
                    If Retos(i).Usuarios(indexUser) > 0 Then
                        pt = Retos(i).Usuarios(1)
                        pt1 = Retos(i).Usuarios(2)
                        If (Retos(i).Cuenta = 0 And Retos(i).SalaOcupada = True) And (UserList(pt).flags.Muerto = 1 Or UserList(pt1).flags.Muerto = 1) Then
                            Retos(i).Cuenta = RETOS_CUENTA
                        End If
                    End If
                    Next i
                    RevivirUsuario winnerIndex
                    .Stats.MinHp = .Stats.MaxHp
                    .Stats.MinMAN = .Stats.MaxMAN
                    .Stats.MinSta = .Stats.MaxSta
                    With UserList(muertoIndex)
                        .Stats.MinHp = .Stats.MaxHp
                        .Stats.MinMAN = .Stats.MaxMAN
                        .Stats.MinSta = .Stats.MaxSta
                    End With
                End With
            End If
            If UserList(winnerIndex).flags.Round >= 2 Then
                WritePauseToggle muertoIndex
                WritePauseToggle winnerIndex
      
      
                For i = 1 To RETOS_ARENAS
                    If Retos(i).Usuarios(indexUser) > 0 Then
                        pt = Retos(i).Usuarios(1)
                        pt1 = Retos(i).Usuarios(2)
                        If (Retos(i).Cuenta >= 1 And Retos(i).SalaOcupada = True) And (UserList(pt).flags.Muerto = 0 Or UserList(pt1).flags.Muerto = 0) Then
                            Retos(i).Cuenta = RETOS_CUENTA
                        End If
                    End If
                    Next i
'ERA POR ORO
'setea reto ganado.
                    If Retos(indexReto).ApuestaOro <> 0 Then
'Da el oro.
                        UserList(winnerIndex).Stats.Gld = UserList(winnerIndex).Stats.Gld + Retos(indexReto).ApuestaOro
                        UserList(muertoIndex).Stats.Gld = UserList(muertoIndex).Stats.Gld - Retos(indexReto).ApuestaOro
'Update cliente.
                        Call Protocol.WriteUpdateGold(winnerIndex)
                        WriteUpdateGold muertoIndex
'Has ganado blabla
Call Protocol.WriteConsoleMsg(winnerIndex, "Felicitaciones has ganado el monto de " & Format$(Retos(indexReto).ApuestaOro, "") & " monedas de oro.", FontTypeNames.FONTTYPE_INFO)
                    End If
                    UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).flags.Paralizado = 0
'ERA POR OBJETOS?
                    If Retos(indexReto).PorInventario Then
'Lo ejecuto.
                        Call TirarTodosLosItems(muertoIndex)
'Lo devuelvo a su posición..
                        Call WarpUserChar(muertoIndex, UserList(muertoIndex).Reto1vs1.Anteriorposition.Map, UserList(muertoIndex).Reto1vs1.Anteriorposition.X, UserList(muertoIndex).Reto1vs1.Anteriorposition.Y, True)
'Seteo el ganador.
                        Retos(indexReto).Ganador = winnerIndex
                        UserList(winnerIndex).Reto1vs1.VolverSeg = RETOS_VOLVER
                                            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).flags.Paralizado = 0
'Avisa.
With UserList(winnerIndex)
                        SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Retos> " & UserList(winnerIndex).name & " vs " & UserList(muertoIndex).name & ". Ganador " & UserList(winnerIndex).name & ". Apuesta por " & Retos(ElSlot).ApuestaOro & " monedas de oro y los items.", FontTypeNames.FONTTYPE_INFO)
                        WriteConsoleMsg winnerIndex, "Retos> Bienvenido en " & (RETOS_VOLVER) & " segundos podras agarrar todos los item ganados en este Reto, luego deslogea y seras enviado a tu posición anterior.", FontTypeNames.FONTTYPE_GUILD
WritePauseToggle muertoIndex
                WritePauseToggle winnerIndex
                                    UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).flags.Paralizado = 0
            
             End With
      
'Limpia al usuario
                        Limpiar muertoIndex
                        Retos1vs1.Limpiar muertoIndex
                        Retos1vs1.Limpiar winnerIndex
                        If UserList(winnerIndex).Reto1vs1.VolverSeg >= RETOS_VOLVER Then
                            Call WarpUserChar(winnerIndex, UserList(winnerIndex).Reto1vs1.Anteriorposition.Map, UserList(winnerIndex).Reto1vs1.Anteriorposition.X, UserList(winnerIndex).Reto1vs1.Anteriorposition.Y, True)
                        End If
'Cierra.
                        Exit Sub
                    End If
'Los devuelvo a su posición..
                    Call WarpUserChar(muertoIndex, UserList(muertoIndex).Reto1vs1.Anteriorposition.Map, UserList(muertoIndex).Reto1vs1.Anteriorposition.X, UserList(muertoIndex).Reto1vs1.Anteriorposition.Y, True)
                    Call WarpUserChar(winnerIndex, UserList(winnerIndex).Reto1vs1.Anteriorposition.Map, UserList(winnerIndex).Reto1vs1.Anteriorposition.X, UserList(winnerIndex).Reto1vs1.Anteriorposition.Y, True)
      
'Avisa al mundo.
                  
                    SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Retos> " & UserList(winnerIndex).name & " vs " & UserList(muertoIndex).name & ". Ganador " & UserList(winnerIndex).name & ". Apuesta por " & Retos(ElSlot).ApuestaOro & " monedas de oro.", FontTypeNames.FONTTYPE_INFO) 'Limpia el index del reto
                    LimpiarIndex indexReto
                  
'Limpia los usuarios
                    Retos1vs1.Limpiar muertoIndex
                    Retos1vs1.Limpiar winnerIndex
                ElseIf UserList(muertoIndex).flags.Round >= 2 Then
                    WritePauseToggle muertoIndex
                    WritePauseToggle winnerIndex
          
                    For i = 1 To RETOS_ARENAS
                        If Retos(i).Usuarios(indexUser) > 0 Then
                            pt = Retos(i).Usuarios(1)
                            pt1 = Retos(i).Usuarios(2)
                            If (Retos(i).Cuenta >= 1 And Retos(i).SalaOcupada = True) And (UserList(pt).flags.Muerto = 1 Or UserList(pt1).flags.Muerto = 1) Then
                                Retos(i).Cuenta = RETOS_CUENTA
                            End If
                        End If
                        Next i
                        If Retos(indexReto).ApuestaOro <> 0 Then
'Da el oro.
                            UserList(winnerIndex).Stats.Gld = UserList(winnerIndex).Stats.Gld - Retos(indexReto).ApuestaOro
                            UserList(muertoIndex).Stats.Gld = UserList(muertoIndex).Stats.Gld + Retos(indexReto).ApuestaOro
'Update cliente.
                            Call Protocol.WriteUpdateGold(winnerIndex)
                            WriteUpdateGold muertoIndex
'Has ganado blabla
Call Protocol.WriteConsoleMsg(winnerIndex, "Felicitaciones has ganado el monto de " & Format$(Retos(indexReto).ApuestaOro, "") & " monedas de oro.", FontTypeNames.FONTTYPE_INFO)
                        End If
            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).flags.Paralizado = 0
                
'ERA POR OBJETOS?
                        If Retos(indexReto).PorInventario Then
'Lo ejecuto.
                            Call TirarTodosLosItems(winnerIndex)
'Lo devuelvo a su posición..
                            Call WarpUserChar(winnerIndex, UserList(muertoIndex).Reto1vs1.Anteriorposition.Map, UserList(muertoIndex).Reto1vs1.Anteriorposition.X, UserList(muertoIndex).Reto1vs1.Anteriorposition.Y, True)
'Seteo el ganador.
                            Retos(indexReto).Ganador = muertoIndex
                            UserList(muertoIndex).Reto1vs1.VolverSeg = RETOS_VOLVER
'Avisa.
                            SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Retos> " & UserList(muertoIndex).name & " vs " & UserList(muertoIndex).name & ". Ganador " & UserList(winnerIndex).name & ". Apuesta por " & Retos(ElSlot).ApuestaOro & " monedas de oro y los items.", FontTypeNames.FONTTYPE_INFO)
                            WriteConsoleMsg muertoIndex, "Retos> Bienvenido a la sala de retos. Tienes " & (RETOS_VOLVER) & " segundos para agarrar los objetos antes de ser teletransportado a tu anterior posición.", FontTypeNames.FONTTYPE_GUILD
'Limpia al usuario
                            Limpiar winnerIndex
                            Retos1vs1.Limpiar muertoIndex
                            Retos1vs1.Limpiar winnerIndex
                            If UserList(muertoIndex).Reto1vs1.VolverSeg >= RETOS_VOLVER Then
                                Call WarpUserChar(muertoIndex, UserList(muertoIndex).Reto1vs1.Anteriorposition.Map, UserList(muertoIndex).Reto1vs1.Anteriorposition.X, UserList(muertoIndex).Reto1vs1.Anteriorposition.Y, True)
                            End If
'Cierra.
                            Exit Sub
                        End If
'Los devuelvo a su posición..
                        Call WarpUserChar(muertoIndex, UserList(muertoIndex).Reto1vs1.Anteriorposition.Map, UserList(muertoIndex).Reto1vs1.Anteriorposition.X, UserList(muertoIndex).Reto1vs1.Anteriorposition.Y, True)
                        Call WarpUserChar(winnerIndex, UserList(winnerIndex).Reto1vs1.Anteriorposition.Map, UserList(winnerIndex).Reto1vs1.Anteriorposition.X, UserList(winnerIndex).Reto1vs1.Anteriorposition.Y, True)
'Avisa al mundo.
                        SendData SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Retos> " & UserList(winnerIndex).name & " vs " & UserList(muertoIndex).name & ". Ganador " & UserList(muertoIndex).name & ". Apuesta por " & Retos(ElSlot).ApuestaOro & " monedas de oro.", FontTypeNames.FONTTYPE_INFO) 'Limpia el index del reto
                        LimpiarIndex indexReto
'Limpia los usuarios
                        Retos1vs1.Limpiar muertoIndex
                        Retos1vs1.Limpiar winnerIndex
                    End If
                End Sub
Sub Limpiar(ByVal cleanIndex As Integer)
' @ Limpia el tipo de un usuario.
Dim NoPos   As WorldPos
With UserList(cleanIndex).Reto1vs1
     .MeEnvio = 0
     .Anteriorposition = NoPos
     '.ApuestaInv = False
     .ApuestaOro = 0
     .VolverSeg = 0
     .RetoIndex = 0
End With
End Sub
Sub LimpiarIndex(ByVal RetoIndex As Byte)
' @ Limpia un slot de un reto.
With Retos(RetoIndex)
     .ApuestaOro = 0
     '.PorInventario = False
     .Cuenta = 0
     .Ganador = 0
     .SalaOcupada = False
     .Usuarios(1) = 0
     .Usuarios(2) = 0
End With
End Sub


Declarar


Código:
Public PuedeAbandonar As Boolean
   Public Type Retos
    Retador As Integer
    Oponente As Integer
    End Type
    Public Retoz As Retos
    Public LReto As Byte
Public RetoxItems As Integer


En el Sub PasarSegundo()
arriba de For i = 1 To LastUser            'Retos 1vs1
   Retos1vs1.PasaSegundo



en el sub userdie arriba de

Código:
'<< Actualizamos clientes >>


Código:
     'Evento 1vs1
        If .Reto1vs1.RetoIndex <> 0 Then Retos1vs1.Muere UserIndex


En el Sub CloseSocket(ByVal UserIndex As Integer)

arriba de
'Call SecurityIp.IpRestarConexion(GetLongIp(UserList(UserIndex).ip))


Código:
   If .Reto1vs1.RetoIndex <> 0 Then Retos1vs1.Muere UserIndex, True
     End With
    End If



buscar


Código:
Consultation


Ponemos


Código:
   Retos                   '/RETAR
    Areto                   '/ARETO



abajo de


Código:
       Case ClientPacketID.Consultation
            Call HandleConsultation(UserIndex)


Ponemos esto


Código:
       Case ClientPacketID.Retos
            Call HandleRetos(UserIndex)
          
        Case ClientPacketID.Areto
            Call HandleAreto(UserIndex)



Al final del modúlo protocol ponemos


Código:
Public Sub HandleRetos(ByVal UserIndex As Integer)
With UserList(UserIndex)
 
Dim destroyB As New clsByteQueue
 
Call destroyB.CopyBuffer(.incomingData)
 
Call destroyB.ReadByte
 
Dim tUserName As String
Dim tOro As Long
Dim tItems As Boolean
Dim tError As String
tUserName = Replace(destroyB.ReadASCIIString, "+", " ")
tOro = destroyB.ReadLong
tItems = destroyB.ReadBoolean
 
If Retos1vs1.PuedeEnviar(UserIndex, tUserName, tOro, tError) Then
Retos1vs1.Enviar UserIndex, NameIndex(tUserName), tOro, tItems
Else
WriteConsoleMsg UserIndex, tError, FontTypeNames.FONTTYPE_INFO
End If
 
Call .incomingData.CopyBuffer(destroyB)
 
End With
End Sub

Private Sub HandleAreto(ByVal UserIndex As Integer)

'
' @ fran

Dim buffer As New clsByteQueue
Dim tmpName As String

Set buffer = New clsByteQueue

Call buffer.CopyBuffer(UserList(UserIndex).incomingData)

Call buffer.ReadByte

tmpName = buffer.ReadASCIIString()

 Retos1vs1.Aceptar UserIndex

Call UserList(UserIndex).incomingData.CopyBuffer(buffer)

Set buffer = Nothing

End Sub


Buscar

Código:
'Tipo de los Usuarios
Public Type User


Abajo de eso ponemos


Código:
Reto1vs1 As TRetin


Arriba del type user


Código:
Public Type TRetin
RetoIndex As Byte
VolverSeg As Byte
Anteriorposition As WorldPos
MeEnvio As Byte
ApuestaOro As Long
ApuestaInv As Boolean
End Type


Ahora abajo de esto


Código:
'Flags
Public Type UserFlags


Ponemos

Código:
   Round As Byte
    EnEvento As Byte
    Peleando As Byte
    BeforeMap As Integer 'Antes mapa
    BeforeX As Integer 'AntesX
    BeforeY As Integer 'AntesY


Ahora para darle un buen toque buscamos y remplazamos


Código:
'
' Handles the "SummonChar" message.
'
' @param    userIndex The index of the user sending the message.

Private Sub HandleSummonChar(ByVal UserIndex As Integer)
'***************************************************
'Author: Nicolas Matias Gonzalez (NIGO)
'Last Modification: 26/03/2009
'26/03/2009: ZaMa - Chequeo que no se teletransporte donde haya un char o npc
'***************************************************
    If UserList(UserIndex).incomingData.length < 3 Then
        Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
  
On Error GoTo Errhandler
    With UserList(UserIndex)
        'This packet contains strings, make a copy of the data to prevent losses if it's not complete yet...
        Dim buffer As New clsByteQueue
        Call buffer.CopyBuffer(.incomingData)
      
        'Remove packet ID
        Call buffer.ReadByte
      
        Dim UserName As String
        Dim tUser As Integer
        Dim X As Integer
        Dim Y As Integer
      
        UserName = buffer.ReadASCIIString()
      
        If (.flags.Privilegios And (PlayerType.Admin Or PlayerType.Dios Or PlayerType.SemiDios)) Then
            tUser = NameIndex(UserName)
          
            If tUser <= 0 Then
                Call WriteConsoleMsg(UserIndex, "El jugador no está online.", FontTypeNames.FONTTYPE_INFO)
              
            Else
                If (.flags.Privilegios And (PlayerType.Dios Or PlayerType.Admin)) <> 0 Or _
                  (UserList(tUser).flags.Privilegios And (PlayerType.Consejero Or PlayerType.User)) <> 0 Then
                If Not UserList(tUser).Pos.Map = 176 Then
                If Not UserList(tUser).Counters.Pena >= 1 Then
                    Call WriteConsoleMsg(tUser, .name & " te ha trasportado.", FontTypeNames.FONTTYPE_INFO)
                    X = .Pos.X
                    Y = .Pos.Y + 1
                    Call FindLegalPos(tUser, .Pos.Map, X, Y)
                    Call WarpUserChar(tUser, .Pos.Map, X, Y, True, True)
                    Call LogGM(.name, "/SUM " & UserName & " Map:" & .Pos.Map & " X:" & .Pos.X & " Y:" & .Pos.Y)
                Else
                    Call WriteConsoleMsg(UserIndex, "No puedes invocar a usuarios que estan en retos o estan en cárcel.", FontTypeNames.FONTTYPE_INFO)
                End If
            End If
        End If
        End If
        End If
      
        'If we got here then packet is complete, copy data back to original queue
        Call .incomingData.CopyBuffer(buffer)
    End With
 
Errhandler:
    Dim error As Long
    error = Err.Number
On Error GoTo 0
  
    'Destroy auxiliar buffer
    Set buffer = Nothing
  
    If error <> 0 Then _
        Err.Raise error
End Sub

Listo el servidor, pasamos al Cliente

Buscar

Código:
Consulta


Abajo ponemos


Código:
   Retos                   '/RETAR
    Areto                   '/ARETO


Abajo del modulo protocol

Código:
Public Sub WriteRetos(ByVal UserName As String, ByVal Oro As Long, ByVal Items As Boolean)
    With outgoingData
        Call .WriteByte(ClientPacketID.Retos)
        Call .WriteASCIIString(UserName)
        Call .WriteLong(Oro)
        .WriteBoolean Items
    End With
End Sub
 
Public Sub WriteAreto(ByVal UserName As String)
    With outgoingData
        Call .WriteByte(ClientPacketID.Areto)
        Call .WriteASCIIString(UserName)
    End With
End Sub



Buscar


Código:
Case "/COMPARTIRNPC"


Abajo de eso ponemos


Código:
                             Case "/ACEPTAR"
                    If notNullArguments Then
                        Call WriteAreto(ArgumentosRaw)
                    Else
                        'Avisar que falta el parametro
                        Call ShowConsoleMsg("Faltan parámetros. Utilice /RETAR NICKNAME.")
                    End If



Listo con eso ya estaría completo y funcional, lo unico qué tendrían que hacer es crear el Formulario
Dentro del formulario: Crear un label llamado "bName", otro label llamado "bGold"
Una imagen o un command button con esto

Código:
'//Reto 1vs1
If Check3.value = 1 And Option1.value = True Then
WriteRetos Replace(Text2(0), " ", "+"), Text1.Text, True
ElseIf Check3.value = 0 And Option1.value = True Then
WriteRetos Replace(Text2(0), " ", "+"), Text1.Text, False
End If
Unload Me
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 237
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.