ÍndiceCalendarioFAQBuscarMiembrosGrupos de UsuariosRegistrarseConectarse
Afiliados

Comparte | 
 

 Sistema de Retos 1vs1 (13.0)

Ver el tema anterior Ver el tema siguiente Ir abajo 
AutorMensaje
Dark Wizard
newbie
newbie


Mensajes : 12

MensajeTema: Sistema de Retos 1vs1 (13.0)   Jue Dic 30 2010, 01:21

Bueno chicos... Buscando algunos tutos para aportar a la comunidad, encontre este, Sirve para agregarle sistema de retos 1vs1 a tu alkon 13.0...

[b]Abran Server.vbp

Busquen:
[codigo]Call WriteMultiMessage(VictimIndex, eMessages.UserKill, AttackerIndex)[/codigo]

Y abajo pongan:
[codigo] 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[/codigo]

Busquen:
[codigo]Private Sub HandleMeditate(byval userindex as integer)[/codigo]

Y arriva pongan:
[codigo] 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[/codigo]

Lugeo, creamos un timer con estas propiedades(en el frmmain)
[codigo]Name = TimerRetos
Interval = 60000
Enabled = False[/codigo]

Y de codigo le ponemos
[codigo]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[/codigo]

Vayan al mòdulo declaraciones y abajo de option explicit pongan:
[codigo]Public Type Reto
hayReto As Byte
retadorA as integer
retadorB as integer
oro As Long
counter as byte
End Type

Public retos As Reto[/codigo]

Luego Busquen:
[codigo] 'mato los comercios seguros[/codigo]

Y arriva ponen:
[codigo]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[/codigo]

Buscar:
[codigo]Case ClientPacketID.Meditate '/MEDITAR
Call HandleMeditate(userindex)[/codigo]

Abajo pongan:
[codigo]Case ClientPacketID.Retar '/RETO
Call HandleNicoRetos(userindex)

Case ClientPacketID.AReto '/ACEPTAR
Call HandleNicoAceptar(userindex)[/codigo]

Busquen:
[codigo]Meditate '/MEDITAR[/codigo]

Abajo Pongan:
[codigo] Retar '/RETO
AReto '/ACEPTAR[/codigo]

Busquen:
[codigo]type userflags[/cogigo]

Abajo Pongan:
[codigo]EnReto as byte
recibioSolicitud as byte
envioSolicitud as byte[/codigo]

Al fin terminamos con servidor!

Ahora vamos al cliente:

Busquen:
[codigo]Meditate '/MEDITAR[/codigo]

Abajo Ponene:
[codigo]
Retar '/RETO
AReto '/ACEPTAR[/codigo]

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

Abajo Pongan:
[codigo]
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[/codigo]

Busquen:
[codigo]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[/codigo]

Arriva Ponen:
[codigo] 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[/codigo]

Les quedarìa el siguiente comando:

/RETAR "NICK" + "ORO"
/ACEPTAR "NICK"



Espero que les haya servido...

Aclaro: No fue copy and paste Cool

Fuente: Gs-Zone
Volver arriba Ir abajo
Ver perfil de usuario
FralshK
Usuario AO
Usuario AO


Mensajes : 281
Edad : 18
Localización : ViCENtee LooooPEZ

MensajeTema: Re: Sistema de Retos 1vs1 (13.0)   Jue Dic 30 2010, 12:05

Excelente aporte yo no programo pero esta bueno..Segui así!

EDIT: Trata de hacer que se entienda más porque no entiendo nada osea el codigo ponelo de otro color asi se entiende un poquito más.
Volver arriba Ir abajo
Ver perfil de usuario http://servers-ao.foro-activo.es
Ichigo
aficionado
aficionado


Mensajes : 118
Edad : 18

MensajeTema: Re: Sistema de Retos 1vs1 (13.0)   Jue Ene 13 2011, 19:26

Fue copy and paste, asqueroso la forma de la plantilla.
No se entiende nada, encima está lleno de errores.
Antes de aportar fíjense lo que aportan.
Volver arriba Ir abajo
Ver perfil de usuario
Slimer
aficionado
aficionado


Mensajes : 107
Edad : 18
Localización : Buenos Aires

MensajeTema: Re: Sistema de Retos 1vs1 (13.0)   Miér Ene 19 2011, 17:53

No entiendo nada de programación, pero se ve que no se entiende mucho...
Volver arriba Ir abajo
Ver perfil de usuario http://servers-ao.foro-activo.es/u5-
Contenido patrocinado




MensajeTema: Re: Sistema de Retos 1vs1 (13.0)   Hoy a las 01:12

Volver arriba Ir abajo
 
Sistema de Retos 1vs1 (13.0)
Ver el tema anterior Ver el tema siguiente Volver arriba 
Página 1 de 1.
 Temas similares
-
» TEMA IMPORTANTE: TORNEOS Y RETOS
» ACTUALIZACION SISTEMA!!!!!!!!!!! ¿VUELVE PSN?
» Comienzan los retos en torneos online: ENTRAD IMPORTANTE!
» RETOS SOCIAL CLUB
» El PLacer de matar un lammer 1vs1 a blood nightz

Permisos de este foro:No puedes responder a temas en este foro.
 :: Caja de trabajo :: Programacion-
Cambiar a: