Sistema de Retos 1vs1

» 07 Sep 2010 07:50

Este es como el qe aporté en 12.x, pero más organizadito y funcional(testeado) =D

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Call WriteMultiMessage(VictimIndex, eMessages.UserKill, AttackerIndex)

abajo pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

        If UserList(AttackerIndex).flags.EnReto = 1 Then
        UserList(AttackerIndex).Stats.GLD = UserList(AttackerIndex).Stats.GLD + retos.oro
        Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El usuario " & UserList(AttackerIndex).name & " ha ganado el reto.", FontTypeNames.FONTTYPE_INFO))
         Call TirarTodo(VictimIndex)
         Call WarpUserChar(VictimIndex, 1, 50, 50, True)
         Call WarpUserChar(AttackerIndex, 1, 50, 50, True)
         retos.hayReto = 0
         retos.oro = 0
         retos.retadorA= ""
         retos.retadorB= ""
        frmmain.timerretos.enabled = false
        End If

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Private Sub HandleMeditate(byval userindex as integer)

arribap one

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Private Sub HandleNicoRetos(ByVal userindex As Integer)
Rem Sistema de Retos 1vs1 (/RETAR)
Rem 18/08/2010
Rem para Nico (A)
 
    If UserList(userindex).incomingData.length < 3 Then
        Err.Raise UserList(userindex).incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
    
On Error GoTo Errhandler
    
        '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 userneim As String
        Dim auser As Integer
        Dim oro As Long
        
        userneim = buffer.ReadASCIIString
        auser = NameIndex(userneim)
        oro = buffer.ReadLong
        
        If auser <= 0 Then       
      call writeconsolemsg(userindex, "Usuario Offline", fonttypenames.fonttype_info) 
        elseIf UserList(userindex).flags.Muerto Then
        Call WriteConsoleMsg(userindex, "Estás muerto", FontTypeNames.FONTTYPE_INFO)
       elseIf UserList(auser).flags.Muerto Then
        Call WriteConsoleMsg(userindex, "Está muerto", FontTypeNames.FONTTYPE_INFO)
     elseIf UserList(userindex).Counters.Pena > 0 Then
      Call WriteConsoleMsg(userindex, "Estás preso", FontTypeNames.FONTTYPE_INFO)
      elseIf UserList(auser).Counters.Pena > 0 Then
      Call WriteConsoleMsg(userindex, "Está preso", FontTypeNames.FONTTYPE_INFO)
    elseIf MapInfo(UserList(userindex).Pos.Map).Pk = True Then
      Call WriteConsoleMsg(userindex, "No puedes solicitarle a alguien duelear si no estas en una zona segura!", FontTypeNames.FONTTYPE_INFO)
   elseIf MapInfo(UserList(auser).Pos.Map).Pk = True Then
      Call WriteConsoleMsg(userindex, "No puedes solicitarle a alguien duelear si él no esta en una zona segura!", FontTypeNames.FONTTYPE_INFO)
     elseIf oro > UserList(userindex).Stats.GLD Then
      Call WriteConsoleMsg(userindex, "No puedes retar por mas de el oro qe tienes!", FontTypeNames.FONTTYPE_INFOBOLD)
     elseIf oro > UserList(auser).Stats.GLD Then
      Call WriteConsoleMsg(userindex, "El otro usuario no tiene el oro suficiente!", FontTypeNames.FONTTYPE_INFOBOLD)
     elseIf Retos.hayReto = 1 Then
      Call WriteConsoleMsg(userindex, "Ya hay un reto en marcha, espere a que finalize!", FontTypeNames.FONTTYPE_INFO)
    elseIf UserList(userindex).Stats.ELV < 35 Then
      Call WriteConsoleMsg(userindex, "Minimo nivel para duelear : 35", FontTypeNames.FONTTYPE_INFO)
    elseIf UserList(auser).Stats.ELV < 35 Then
      Call WriteConsoleMsg(userindex, "No puedes retar a alguien menor de nivel 35!", FontTypeNames.FONTTYPE_INFO)
      elseif oro < 200000 Then
     Call WriteConsoleMsg(userindex, "No puedes retar por menos de 200000 monedas!", FontTypeNames.FONTTYPE_INFOBOLD)
     elseIf UserList(userindex).flags.recibiosolicitud = 1 Then
     Call WriteConsoleMsg(userindex, "No puedes retar a alguien si te solicitaron duelear!", FontTypeNames.FONTTYPE_INFO)
     elseIf UserList(auser).flags.recibiosolicitud = 1 Then
     Call WriteConsoleMsg(userindex, "No puedes retar a alguien si le solicitaron duelear!", FontTypeNames.FONTTYPE_INFO)
     elseIf UserList(userindex).flags.enviosolicitud = 1 Then
     Call WriteConsoleMsg(userindex, "No puedes retar a alguien si ya solicitaste duelear!", FontTypeNames.FONTTYPE_INFO)
     elseIf UserList(auser).flags.enviosolicitud = 1 Then
     Call WriteConsoleMsg(userindex, "No puedes retar a alguien si a ese envio solicitud de duelear a otro usuario!", FontTypeNames.FONTTYPE_INFO)
else
     
    UserList(auser).flags.recibiosolicitud = 1
    retos.oro = oro
    UserList(userindex).flags.enviosolicitud = 1
 
   Retos.RetadorA = userindex
   Retos.RetadorB= auser
    
    Call WriteConsoleMsg(auser, "El usuario " & UserList(userindex).name & " de nivel " & UserList(userindex).Stats.ELV & " y de clase " & UserList(userindex).clase & UserList(userindex).raza & " te ha retado a un duelo de modalidad 1 vs 1 por " & Retos.oro & " monedas de oro y por los items del inventario, si deseas aceptar teclea /ACEPTAR " & UserList(userindex).name & "", FontTypeNames.FONTTYPE_INFO)
    
            Call UserList(userindex).incomingData.CopyBuffer(buffer)
    
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
 
Private Sub HandleNicoAceptar(ByVal userindex As Integer)
Rem *************************************
Rem Sistema de Retos 1vs1 (/RETAR)
Rem 18/08/2010
Rem para Nico (A)
Rem *************************************
 
    If UserList(userindex).incomingData.length < 3 Then
        Err.Raise UserList(userindex).incomingData.NotEnoughDataErrCode
        Exit Sub
    End If
    
On Error GoTo Errhandler
    
        '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 userneim As String
        Dim auser As Integer
        
        userneim = buffer.ReadASCIIString
        auser = NameIndex(userneim)
        
        If auser <= 0 Then
        call writeconsolemsg(userindex, "Usuario Offline.", fonttypenames.fonttype_infobold)        
        elseIf UserList(auser).flags.enviosolicitud = 0 Then
        Call WriteConsoleMsg(userindex, "Ese usuario no mando solicitud de reto", FontTypeNames.FONTTYPE_INFO)
   elseIf UserList(userindex).flags.recibiosolicitud = 0 Then
         Call WriteConsoleMsg(userindex, "Nadie te ofreció reto", FontTypeNames.FONTTYPE_INFO)
else
         
         retos.hayReto = 1
         
         Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El usuario " & UserList(userindex).name & " y " & UserList(auser).name & " van a combatir en un reto por " & retos.oro & " monedas de oro.", FontTypeNames.FONTTYPE_INFO))
         
         Dim xplayerwan, yplayerwan, xplayerchu, yplayerchu As Byte
         
         xplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerUno"))
         yplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerUno"))
         xplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerDos"))
         yplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerDos"))
        
         
         Call WarpUserChar(userindex, 275, xplayerwan, yplayerwan, True)
         Call WarpUserChar(auser, 275, xplayerchu, yplayerchu, True)
         
         UserList(userindex).Stats.GLD = UserList(userindex).Stats.GLD - retos.oro
         UserList(auser).Stats.GLD = UserList(auser).Stats.GLD - retos.oro
         
         UserList(userindex).flags.EnReto = 1
         UserList(auser).flags.EnReto = 1
          frmmain.timerRETOS.enabled = true
 
            Call UserList(userindex).incomingData.CopyBuffer(buffer)
    
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

crear un timer, con estas propiedades(en el frmmain)

Name = TimerRetos
Interval = 60000
Enabled = False

de código le ponemos

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

if hayReto = 0 then exit sub
If Retos.Counter < 5 then
retos.counter = retos.counter + 1
else
call warpuserchar(retos.retadorA, 1 , 50 , 50, true)
call warpuserchar(retos.retadorB, 1, 50 , 50, true
call senddata(sendtarget.toall, 0, preparemessageconsolemsg("El duelo entre " & userlist(retador1).name & " Y " & userlist(retador2).name & " ha llegado a los 5 minutos sin ningún ganador!.", fonttypenames.fonttype_talk)
userlist(retos.retadorA).stats.gld = userlist(retos.retadorA).stats.gld + retos.Oro
userlist(retos.retadorB).stats.gld = userlist(retos.retadorB).stats.gld + retos.Oro
timerRETOS.enabled = false
retos.hayreto = 0
retos.retadorA = 0
Retos.RetadoRB = 0
end if

anda al modulo declaraciones y abajo de option explicit pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Public Type Reto
hayReto As Byte
retadorA as integer
retadorB as integer
oro As Long
counter as byte
End Type
 
Public retos As Reto

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    'mato los comercios seguros

Y arriba poner...

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

if userlist(userindex).flags.enreto = 1 then
call senddata(sendtarget.toall, 0 , preparemessageconsolemsg("El usuario " & userlist(userindex).name & " ha deslogeado en reto", fonttypenames.fonttype_talk)
call warpuserchar(userindex, 1 , 50 , 50)
  frmmain.timerRETOS.enabled = false
end if

buscar

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

        Case ClientPacketID.Meditate                '/MEDITAR
            Call HandleMeditate(userindex)

abajo pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

        Case ClientPacketID.Retar                '/RETO
            Call HandleNicoRetos(userindex)
 
        Case ClientPacketID.AReto                '/ACEPTAR
            Call HandleNicoAceptar(userindex)

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    Meditate                '/MEDITAR

abajo pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    Retar                '/RETO
    AReto               '/ACEPTAR

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

type userflags

abajo pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

EnReto as byte
recibioSolicitud as byte
envioSolicitud as byte

listo el sv

CLIENTE

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    Meditate                '/MEDITAR

abajo pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    Retar                '/RETO
    AReto               '/ACEPTAR

Busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

            Case "/PENAS"
                If notNullArguments Then
                    Call WritePunishments(ArgumentosRaw)
                Else
                    'Avisar que falta el parametro
                    Call ShowConsoleMsg("Faltan parámetros. Utilice /penas NICKNAME.")
                End If

abajo pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

            Case "/RETAR"
                 If notNullArguments And CantidadArgumentos >= 2 Then
                    If ArgumentosAll(1) > 200000000000 Then
                        Call ShowConsoleMsg("Solo se retar por un máximo de 200000000000 monedas de oro.")
                    Else
                        Call WriteNicoRetos(ArgumentosAll(0), ArgumentosAll(1))
                    End If
                 End If
 
            Case "/ACEPTAR"
                If notNullArguments Then
                    Call WriteNicoAceptar(ArgumentosRaw)
                Else
                    'Avisar que falta el parametro
                    Call ShowConsoleMsg("Faltan parámetros. Utilice /ACEPTAR NICKNAME.")
                End If

busca

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Public Sub WritePunishments(ByVal UserName As String, byval oro as long)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modification: 05/17/06
'Writes the "Punishments" message to the outgoing data buffer
'***************************************************
    With outgoingData
        Call .WriteByte(ClientPacketID.Punishments)
        
        Call .WriteASCIIString(UserName)
        
    End With
End Sub

arriba pone

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Public Sub WriteNicoRetos(ByVal UserNeim As String, byval Oro as Long)
'***************************************************
 
'***************************************************
    With outgoingData
        Call .WriteByte(ClientPacketID.REto)
        
        Call .WriteASCIIString(Userneim)
        call .writelong(oro)
    End With
End Sub
 
Public Sub WriteNicoAceptarByVal UserNeim As String)
 
    With outgoingData
        Call .WriteByte(ClientPacketID.AReto)
        
        Call .WriteASCIIString(UserNeim)
    End With
End Sub

/RETAR NICK ORO
/ACEPTAR NICK

si quieren hacerlo con un form, tienen que poner.. 2 text box (nombres txtNick y txtOro) y un label, commandbutton, o image y le hacen doble click y ponen

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

call parseusercommand("/RETAR " & txtNick.text & " " & txtOro.text)

nos re vimos

maTih.-

» 07 Sep 2010 14:45

Esa Matih, muchisimas gracias por Aportarlo para esta versión, no hay muchos cambios, pero en definitiba sirve...

...

Saludos
Xtreem

» 07 Sep 2010 15:01

Bien ahí sin utilizar los Exit Sub, pero te olvidaste de cerrar los bloques If

» 07 Sep 2010 16:58

ArzenaTh escribió:Bien ahí sin utilizar los Exit Sub, pero te olvidaste de cerrar los bloques If

Tenes razón, igual esta bien hecho en sí el código.

Muy buen aporte.

» 08 Sep 2010 12:58

Mejor que el que postearon el otro Dia

BUENISIMO TE FELICITO.
Implementando...

» 08 Sep 2010 20:38

ArzenaTh escribió:Bien ahí sin utilizar los Exit Sub, pero te olvidaste de cerrar los bloques If

siempre se me pasa algo ajajja ahora lo arreglo..

II XTREEM II escribió:Esa Matih, muchisimas gracias por Aportarlo para esta versión, no hay muchos cambios, pero en definitiba sirve... ...

Saludos
Xtreem

si, igual este esta mucho mejor hecho, usa un timer para que no duren 16586 horas los duelos, (5 minutos), use un type asi esta mucho mas organizado, si deslogeas en reto te lleva a ulla, aca usas el buffer y no lo lees con el incomigdata(que puede que se rompa todo) en fin esta mejor hecho que el otro y cualculo que sin bugs, usas dos variables retadorA y retadorB para indentificar INDEX de los usuarios en reto , usas La variable enreto, para no usar el odioso mapinfo(map).numusers =P y esto

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

         Dim xplayerwan, yplayerwan, xplayerchu, yplayerchu As Byte
         
         xplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerUno"))
         yplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerUno"))
         xplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerDos"))
         yplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerDos"))
       
         
         Call WarpUserChar(userindex, 275, xplayerwan, yplayerwan, True)
         Call WarpUserChar(auser, 275, xplayerchu, yplayerchu, True)

como lo hice para un amigo, carga las posiciones desde el server ini , pueden borrar todo eso y dejarlo asi

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

         Call WarpUserChar(userindex, 275, 55, 77, True)'275 MAPA, 55 X, 77 Y 
         Call WarpUserChar(auser, 275, 33,66, True) '275 MAPA, 33 X, 66 Y 

Nethird escribió:Mejor que el que postearon el otro Dia
BUENISIMO TE FELICITO.
Implementando...

nose si mejor, son cosas distintas =P, esto es un sistema de retos, el otro una sala de duelos, en fin son cosas diferentes =P

nos vemos

off : cuando termine el 2vs2 con form lo aporto o edito aca

maTih.-

» 08 Sep 2010 21:07

maTih.- escribió:
ArzenaTh escribió:Bien ahí sin utilizar los Exit Sub, pero te olvidaste de cerrar los bloques If

siempre se me pasa algo ajajja ahora lo arreglo..

II XTREEM II escribió:Esa Matih, muchisimas gracias por Aportarlo para esta versión, no hay muchos cambios, pero en definitiba sirve... ...

Saludos
Xtreem

si, igual este esta mucho mejor hecho, usa un timer para que no duren 16586 horas los duelos, (5 minutos), use un type asi esta mucho mas organizado, si deslogeas en reto te lleva a ulla, aca usas el buffer y no lo lees con el incomigdata(que puede que se rompa todo) en fin esta mejor hecho que el otro y cualculo que sin bugs, usas dos variables retadorA y retadorB para indentificar INDEX de los usuarios en reto , usas La variable enreto, para no usar el odioso mapinfo(map).numusers =P y esto

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
Dim xplayerwan, yplayerwan, xplayerchu, yplayerchu As Byte

xplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerUno"))
yplayerwan = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerUno"))
xplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosXdelPlayerDos"))
yplayerchu = val(GetVar(App.Path & "server.ini", "INIT", "PosYdelPlayerDos"))

Call WarpUserChar(userindex, 275, xplayerwan, yplayerwan, True)
Call WarpUserChar(auser, 275, xplayerchu, yplayerchu, True)

como lo hice para un amigo, carga las posiciones desde el server ini , pueden borrar todo eso y dejarlo asi

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
Call WarpUserChar(userindex, 275, 55, 77, True)'275 MAPA, 55 X, 77 Y
Call WarpUserChar(auser, 275, 33,66, True) '275 MAPA, 33 X, 66 Y

Nethird escribió:Mejor que el que postearon el otro Dia
BUENISIMO TE FELICITO.
Implementando...

nose si mejor, son cosas distintas =P, esto es un sistema de retos, el otro una sala de duelos, en fin son cosas diferentes =P

nos vemos

off : cuando termine el 2vs2 con form lo aporto o edito aca

maTih.-

eih mati muy buen codigo pero corregi. te falto declarar counter as integer , tambien arregla retador1 y retador2 por A y B pero = da variable no definida nose porq

» 08 Sep 2010 21:14

en donde te tira variable no definida

corregido el counter as byte

maTih.-

» 08 Sep 2010 21:54

maTih.- escribió:en donde te tira variable no definida

corregido el counter as byte

maTih.-

en el timerretos esta linea Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El duelo entre " & UserList(retador1).name & " Y " & UserList(retador2).name & " ha llegado a los 5 minutos sin ningún ganador!.", FontTypeNames.FONTTYPE_TALK))

Corrregi el 1 y el 2 y le puse A y B y sigue dando variable no definida (?)

» 08 Sep 2010 22:06

Muy buen aporte, te destacas bn en todas las versiones

.

Pds: Es una adaptacion de uno tuyo de 12.x o me equiboco??

Saludos.

» 09 Sep 2010 09:07

Me tira error en el timer (SERVIDOR)

la linea:

If hayReto = 0 Then Exit Sub

en HayReto ya me figate si estaba en el type y si nose que onda

» 09 Sep 2010 11:17

maTih.-

Samke escribió:Muy buen aporte, te destacas bn en todas las versiones .

Pds: Es una adaptacion de uno tuyo de 12.x o me equiboco??

Saludos.

este lo hice de 0 para un amigo del msn, igual es parecido al otro pero como ya explique son cosas diferentes.

CrashKEN escribió:Me tira error en el timer (SERVIDOR)

la linea:

If hayReto = 0 Then Exit Sub

en HayReto ya me figate si estaba en el type y si nose que onda

un error mio.. la variable HayReto esta dentro de un bloque type entonces tenes que ubicar el type adelante , quedando asi

if retos.hayreto = 0 then exit sub

comodin escribió:
maTih.- escribió:en donde te tira variable no definida

corregido el counter as byte

maTih.-

en el timerretos esta linea Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("El duelo entre " & UserList(retador1).name & " Y " & UserList(retador2).name & " ha llegado a los 5 minutos sin ningún ganador!.", FontTypeNames.FONTTYPE_TALK))

Corrregi el 1 y el 2 y le puse A y B y sigue dando variable no definida (?)

lo mismo que para crashken, esta dentro de un type esa variable entonces va asi..

retos.retadorA

y retos.RetadorB

maTih.-

» 09 Sep 2010 19:52

mathi en alguna parte del

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Private Sub HandleNicoAceptar(ByVal UserIndex As Integer)

hay un exit sub mal ya que tira muchas veces no me acuerdo que texto

#

Este post ha sido eliminado por Franeg95 en 13 Sep 2010 16:43.
Razón: Respuesta innecesaria, no aporta nada de nada

» 13 Sep 2010 18:52

Buenisimo aporte, se nota que sabes mucho pero mucho de VB, te felicito estas a fondo.

Saludos.

Sistema de Retos 1vs1

¿Quién está conectado?