Sistema de retos 1vs1 multiples arenas + oro e items o

Ir abajo

Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por xcs el 8/9/2016, 5:09 pm

Les traigo este código acá. Vamos a empezar con el servidor.

Sub PasaSegundo()

en la ultima parte

Código:
            '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

buscar

Código:
'<< Actualizamos clientes >>
arriba de eso
Código:
        'Evento 1vs1
        If .Reto1vs1.RetoIndex <> 0 Then Retos1vs1.Muere UserIndex


Modúlo declaraciones.

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

buscar

Código:
   Ping                    '/PING

abajo ponemos

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

ahora buscar

Código:
       Case ClientPacketID.GuildLeave              '/SALIRCLAN
            Call HandleGuildLeave(UserIndex)

abajo

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

abajo del protocol

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

modulo

reto:

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 7.
            If Not Usuario <> 1 Then
                DameX = 74
            Else
                DameX = 88
            End If
            
        Case 9 '<Arena 7.
            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 6.
            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 6.*****************************
            If Not Usuario <> 1 Then
                DameY = 18
            Else
                DameY = 28
            End If
        
         Case 8   '<Arena 6.
            If Not Usuario <> 1 Then
                DameY = 46
            Else
                DameY = 58
            End If
            
         Case 9   '<Arena 6.
            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
    
     If .reto2Data.reto_Index <> 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
  
            UserList(EnviadorIndex).flags.Inmovilizado = 0
            UserList(UserIndex).flags.Paralizado = 0
     '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
         UserList(EnviadorIndex).flags.Inmovilizado = 0
        UserList(UserIndex).flags.Paralizado = 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
         UserList(EnviadorIndex).flags.Inmovilizado = 0
        UserList(UserIndex).flags.Paralizado = 0
         'Cuenta regresiva.
         WriteConsoleMsg .Usuarios(loopx), UserList(.Usuarios(1)).name & " vs " & UserList(.Usuarios(2)).name & ".", FontTypeNames.FONTTYPE_GUILD
 UserList(.Usuarios(loopx)).flags.Round = 0
         UserList(EnviadorIndex).flags.Inmovilizado = 0
        UserList(UserIndex).flags.Paralizado = 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.Inmovilizado = 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
            UserList(winnerIndex).flags.Inmovilizado = 0
            UserList(winnerIndex).flags.Paralizado = 0
            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).flags.Paralizado = 0
        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
            UserList(winnerIndex).flags.Inmovilizado = 0
            UserList(winnerIndex).flags.Paralizado = 0
        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
            .flags.Inmovilizado = 0
            .flags.Paralizado = 0
            UserList(winnerIndex).flags.Inmovilizado = 0
            UserList(winnerIndex).flags.Paralizado = 0
            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).flags.Paralizado = 0
            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
            UserList(winnerIndex).flags.Inmovilizado = 0
            UserList(winnerIndex).flags.Paralizado = 0
            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).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

            UserList(winnerIndex).flags.Inmovilizado = 0
            UserList(winnerIndex).flags.Paralizado = 0
            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).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 >= 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.
UserList(winnerIndex).Stats.RetosGanados = UserList(winnerIndex).Stats.RetosGanados + 1

'setea reto perdi2.
UserList(muertoIndex).Stats.RetosPerdidos = UserList(muertoIndex).Stats.RetosPerdidos + 1
                    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_PREMIUM)
                    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
'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
                .flags.Inmovilizado = 0
                .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
            UserList(muertoIndex).flags.Inmovilizado = 0
            UserList(muertoIndex).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 >= 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_PREMIUM)
                        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




en el sub pasarsegundo

Código:
   'Retos 1vs1
    Retos1vs1.PasaSegundo

buscar
Sub CloseSocket(ByVal UserIndex As Integer)

debajo de

Código:
   If UserIndex = LastUser Then
        Do Until UserList(LastUser).flags.UserLogged
            LastUser = LastUser - 1
            If LastUser < 1 Then Exit Do
        Loop
    End If

Código:
'1vs1
  With UserList(UserIndex)
    If .Reto1vs1.RetoIndex <> 0 Then Retos1vs1.Muere UserIndex, True
     End With

listo sv. pasamos al cliente.

buscar

Código:
   Ping                    '/PING

abajo

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

en el modulo protocol (abajo de todo)

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

formlario:
No lo voy a crear yo.Les dejo el códe.
Código:
Private Sub CmdSend_Click()

 
Dim sText As String
Dim i     As Long
  
For i = 0 To 2
 
    sText = sText & bName(i).Text & IIf(i <> 2, "*", vbNullString)
 
Next i
  
Call Protocol.WriteSendReto(sText, Val(bGold.Text), (cDrop.value <> 0))
Unload Me
End Sub

Private Sub Form_Load()
'System invisible desde entrada asi queda chevere
'System 2vs2 Invisible
bName(0).Visible = False
bName(1).Visible = False
bName(2).Visible = False
bGold.Visible = False
cDrop.Visible = False
'Label5.Visible = False
CmdSend.Visible = False
End Sub

Private Sub Image1_Click()
Unload Me
End Sub

Private Sub Label1_Click()
Unload Me
End Sub

Private Sub Label5_Click()
'//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
End Sub

Private Sub Option1_Click()
'1vs1
Text4.Visible = True
Text3.Visible = True
Text1.Visible = True
Text2(0).Visible = True
Check3.Visible = True
Label5.Visible = True
Image1.Visible = True
Option1.Visible = True
'2vs2
bName(0).Visible = False
bName(1).Visible = False
bName(2).Visible = False
bGold.Visible = False
cDrop.Visible = False
CmdSend.Visible = False
End Sub

Private Sub Option2_Click()
Text4.Visible = False
Text3.Visible = False
Text1.Visible = False
Text2(0).Visible = False
Check3.Visible = False
Label5.Visible = False
Image1.Visible = False
'2vs2
bName(0).Visible = True
bName(1).Visible = True
bName(2).Visible = True
bGold.Visible = True
cDrop.Visible = True
CmdSend.Visible = True
End Sub

Private Sub Text3_Change()
Text3.Enabled = False
End Sub

Private Sub Text4_Change()
Text4.Enabled = False
End Sub

creó que ya debería estar funcionando.
no lo testee.
avatar
xcs
Nivel 2
Nivel 2

¿BANEADO? : Si, BAN PERMANENTE.
Premios : Ninguno.
Cantidad de envíos : 38
Localización : .
Fecha de inscripción : 08/09/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por Toyz el 8/9/2016, 7:10 pm

¿Fuente? ¿Lo desarrollaste vos?

Gracias por aportar, aclarame estos puntos y te recompenso.


_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por xcs el 8/9/2016, 7:27 pm


Está extraído de Tierras Nórdicas.

El Perro Justiciero escribió:¿Fuente? ¿Lo desarrollaste vos?

Gracias por aportar, aclarame estos puntos y te recompenso.
avatar
xcs
Nivel 2
Nivel 2

¿BANEADO? : Si, BAN PERMANENTE.
Premios : Ninguno.
Cantidad de envíos : 38
Localización : .
Fecha de inscripción : 08/09/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por ShadowAO el 15/11/2016, 7:46 am

Buenas, les dejo lo qué faltaba.
Buscamos

Código:
'flags

y ponemos.

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

buscar
Código:
'Tipo de los Usuarios
Public Type User
y abajo poner
   Reto1vs1 As TRetin
Y aclaro que el "Sub PasaSegundo()" está en el modúlo de los retos,

ShadowAO
Nivel 2
Nivel 2

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 22
Localización : Global
Fecha de inscripción : 27/09/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por Toyz el 15/11/2016, 10:58 am

Reemplazar DameX y DameY y cargarlas con un array. 

Está bueno, pero eso de "desconexión" como parámetro opcional en el usuario Muere es horrible. Debería ser un método totalmente aparte y hacer otro método que limpie, entonces cuando el usuario muere hacés:


Código:
Sub Death (B ID As I)
Clean ID
End Sub

Sub Disconnect (B ID As I)
Clean ID
End Sub


_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por Facugaming el 19/2/2017, 8:28 pm

Te faltaron muchisimas cosas de ese sistema :V

Facugaming
Nivel 1
Nivel 1

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 1
Localización : Argentina
Fecha de inscripción : 18/02/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: Sistema de retos 1vs1 multiples arenas + oro e items o

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


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