Retos en F1 con Frm

por Los Aldeanos Lun Sep 23, 2013 9:00 pm

Buenas Foro, hoy les traigo un nuevo [APORTE]. Es un Sistema de Retos con Formulario y lo podemos útilizar Apretando [F1].

Foto : Retos en F1 con Frm 10a0af18a3e14c0cf30861a58f34e79df0285459

Retos en F1 con Frm 10a0af18a3e14c0cf30861a58f34e79df0285459

...Empezemos...

[CLIENTE] :

Spoiler:

Abajo de :

Código:: Meditate '/MEDITAR

Ponemos :

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

Abajo de :

Código:: Case "/Meditar"

Colocamos :

Código:: Case "/RETAR" If notNullArguments And CantidadArgumentos >= 2 Then If ArgumentosAll(1) > 20000000 Then Call ShowConsoleMsg("Solo se puede retar por un máximo de 20.000.000 monedas") Else Call WriteRetos(ArgumentosAll(0), ArgumentosAll(1)) End If End If Case "/ACEPTAR" If notNullArguments Then Call WriteARETO(ArgumentosRaw) Else 'Avisar que falta el parametro Call ShowConsoleMsg("Faltan parámetros. Utilice /ACEPTAR NICKNAME.") End If

Y al final del "Protocol" :

Código:: Public Sub WriteRetos(ByVal UserName As String, ByVal Oro As Long) With outgoingData Call .WriteByte(ClientPacketID.Retos) Call .WriteASCIIString(UserName) Call .WriteLong(Oro) End With End Sub Public Sub WriteARETO(ByVal UserName As String) With outgoingData Call .WriteByte(ClientPacketID.AReto) Call .WriteASCIIString(UserName) End With End Sub

Buscamos :

Código:: Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

Y Reemplazamos hasta el :

Código:: 'Checks if the key is valid

Por :

Código:: Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) '*************************************************** 'Autor: Unknown 'Last Modification: 18/11/2009 '18/11/2009: ZaMa - Ahora se pueden poner comandos en los mensajes personalizados (execpto guildchat y privados) '*************************************************** #If SeguridadAlkon Then If LOGGING Then Call CheatingDeath.StoreKey(KeyCode, False) #End If If (Not SendTxt.Visible) And (Not SendCMSTXT.Visible) Then If KeyCode = vbKeyF1 Then frmRetos.Show , frmMain End If 'Checks if the key is valid

(IMPORTANTE) :

Y por Ültimo Tocamos [Ctrl + D] y Agregamos el FrmRetos Y Generamos el [Cliente]

Link del FRM : http://www.mediafire.com/download/gdm53yxwo3ht8s2/FrmRetos.rar

[SERVIDOR] :

Spoiler:

Abajo de :

Código:: Meditate '/MEDITAR

Ponemos :

Código:: retos '/RETAR AReto '/ARETO

Abajo de :

Código:: Case ClientPacketID.Meditate '/MEDITAR

Colocamos :

Código:: Case ClientPacketID.retos Call HandleRetos(UserIndex) Case ClientPacketID.AReto Call HandleAReto(UserIndex)

Al final del "Protocol" :

Código:: Private Sub HandleRetos(ByVal UserIndex As Integer) Dim UserName As String Dim UserSend As Integer Dim Oro As Long If UserList(UserIndex).incomingData.length < 3 Then Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode Exit Sub End If With UserList(UserIndex) Call .incomingData.ReadByte UserName = .incomingData.ReadASCIIString Oro = .incomingData.ReadLong UserSend = NameIndex(UserName) If UserList(UserIndex).flags.Muerto Then Call WriteConsoleMsg(UserIndex, "Estás muerto", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserSend).flags.Muerto Then Call WriteConsoleMsg(UserIndex, "Está muerto", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserIndex).name = UserList(UserSend).name Then Call WriteConsoleMsg(UserIndex, "No puedes enviarte solicitud a ti mismo!!", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If MapInfo(276).NumUsers = 2 Then Call WriteConsoleMsg(UserIndex, "Ya hay un reto en proceso, espera a que termine para retar a alguien.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If Not .Pos.Map = 1 Then Call WriteConsoleMsg(UserIndex, "No puedes enviar solicitud de reto si no estás en Ullathorpe.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserSend <= 0 Then Call WriteConsoleMsg(UserIndex, "Usuario Offline.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserIndex).flags.Plantando = 1 Then Call WriteConsoleMsg(UserIndex, "Ya estás peleando con otro usuario.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserSend).flags.Plantando = 1 Then Call WriteConsoleMsg(UserIndex, "Ya está peleando con otro usuario.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If Oro < 100000 Then Call WriteConsoleMsg(UserIndex, "No puedes duelear por menos de 100000 monedas de oro.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserSend).flags.LeOfrecieronn = 1 Then Call WriteConsoleMsg(UserIndex, "El usuario está esperando otra invitación de duelo.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If Oro > UserList(UserIndex).Stats.GLD Then Call WriteConsoleMsg(UserIndex, "No tienes esta cantidad de oro.", FontTypeNames.FONTTYPE_INFO) ElseIf Oro < 0 Then Call WriteConsoleMsg(UserIndex, "No puedes pelear por cantidades negativas.", FontTypeNames.FONTTYPE_INFO) ElseIf UserList(UserSend).Stats.GLD < Oro Then Call WriteConsoleMsg(UserIndex, "El usuario no tiene la cantidad de oro suficiente.", FontTypeNames.FONTTYPE_INFO) Exit Sub Else UserList(UserIndex).flags.Ofreciendoo = 1 UserList(UserSend).flags.LeOfrecieronn = 1 UserList(UserIndex).flags.PrecioPlante = Oro UserList(UserSend).flags.PrecioPlante = Oro Call WriteConsoleMsg(UserIndex, "Le mandaste solicitud de reto a " & UserList(UserSend).name & ".", FontTypeNames.FONTTYPE_INFO) Call WriteConsoleMsg(UserSend, " Reto> " & UserList(UserIndex).name & " quiere combatir en un duelo por:" & Oro & " monedas de oro. Si aceptas escribe /ACEPTAR " & UserList(UserIndex).name, FontTypeNames.FONTTYPE_INFO) End If Exit Sub End With End Sub Private Sub HandleAReto(ByVal UserIndex As Integer) Dim UserName As String Dim UserSend As Integer If UserList(UserIndex).incomingData.length < 3 Then Err.Raise UserList(UserIndex).incomingData.NotEnoughDataErrCode Exit Sub End If With UserList(UserIndex) Call .incomingData.ReadByte UserName = .incomingData.ReadASCIIString UserSend = NameIndex(UserName) If Not .Pos.Map = 1 Then Call WriteConsoleMsg(UserIndex, "No puedes aceptar un reto si no estás en Ullathorpe.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If .Pos.Map = 20 Then Call WriteConsoleMsg(UserIndex, "No puedes aceptar un reto si estás en la cárcel!.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserSend <= 0 Then Call WriteConsoleMsg(UserIndex, "Usuario Offline.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserSend).flags.Ofreciendoo = 0 Then Call WriteConsoleMsg(UserIndex, "El usuario " & UserList(UserSend).name & " no te mandó solicitud de reto.", FontTypeNames.FONTTYPE_INFO) Exit Sub End If If UserList(UserSend).flags.PrecioPlante > UserList(UserIndex).Stats.GLD Then Call WriteConsoleMsg(UserIndex, "No tienes esta cantidad de oro.", FontTypeNames.FONTTYPE_INFO) Else Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Reto> " & UserList(UserIndex).name & " y " & UserList(UserSend).name & " van a combatir en un duelo por " & UserList(UserSend).flags.PrecioPlante & " monedas de oro.", FontTypeNames.FONTTYPE_SERVER)) UserList(UserIndex).Stats.GLD = UserList(UserIndex).Stats.GLD - UserList(UserIndex).flags.PrecioPlante UserList(UserSend).Stats.GLD = UserList(UserSend).Stats.GLD - UserList(UserSend).flags.PrecioPlante UserList(UserIndex).flags.Plantando = 1 UserList(UserSend).flags.Plantando = 1 UserList(UserIndex).flags.Contrincante = UserSend UserList(UserSend).flags.Contrincante = UserIndex Call WriteUpdateGold(UserIndex) Call WriteUpdateGold(UserSend) Call WarpUserChar(UserIndex, MapaRetos, 29, 61, True) 'mapa y posicion de duelo del participante 1 Call WarpUserChar(UserSend, MapaRetos, 43, 71, True) 'mapa y posicion de duelo del participante 2 frmMain.TimerRetos.Enabled = True Call SendData(SendTarget.toMap, MapaRetos, PrepareMessagePauseToggle()) End If Exit Sub End With End Sub

En el Módulo Declaraciones : Declaramos...

Código:: Public Const MapaRetos As Integer = 276 'Cambian la x por su mapa de retos

Creamos en el FrmMain un Timer con el Nombre [TimerRetos]. Y de Intervalo le ponemos [1000].

Y de Código le ponemos :

Código:: Private Sub TimerRetos_Timer() Static N As Byte N = N + 1 If N = 1 Then Call SendData(SendTarget.toMap, MapaRetos, PrepareMessageConsoleMsg("Reto> 5", FontTypeNames.FONTTYPE_GUILD)) End If If N = 2 Then Call SendData(SendTarget.toMap, MapaRetos, PrepareMessageConsoleMsg("Reto> 4", FontTypeNames.FONTTYPE_GUILD)) End If If N = 3 Then Call SendData(SendTarget.toMap, MapaRetos, PrepareMessageConsoleMsg("Reto> 3", FontTypeNames.FONTTYPE_GUILD)) End If If N = 4 Then Call SendData(SendTarget.toMap, MapaRetos, PrepareMessageConsoleMsg("Reto> 2", FontTypeNames.FONTTYPE_GUILD)) End If If N = 5 Then Call SendData(SendTarget.toMap, MapaRetos, PrepareMessageConsoleMsg("Reto> 1", FontTypeNames.FONTTYPE_GUILD)) End If If N >= 6 Then Call SendData(SendTarget.toMap, MapaRetos, PrepareMessageConsoleMsg("Reto> YA", FontTypeNames.FONTTYPE_GUILD)) Call SendData(SendTarget.toMap, MapaRetos, PrepareMessagePauseToggle()) TimerRetos.Enabled = False N = 0 End If

Buscamos :

Código:: Public Type UserFlags

Arriba de :

Código:: Muerto As Byte '¿Esta muerto?

Ponemos...

Código:: Contrincante As Integer Ofreciendoo As Integer LeOfrecieronn As Integer Plantando As Integer PrecioPlante As Long

Listo

!, Espero que les sirva. Saludos.

Creo que al morir, no te lleva a "Ullathorpe" Es lo unico que le faltaba.

Si alguien lo implementa que ponga esto :

Código:: If WarpUserChar(1, 50, 50) Then Call WriteConsoleMsg("Estas muerto fuiste llevado a Ullathorpe", FontTypeNames.FONTTYPE_CONSEJO) : Exit Sub

Abajo de esto :

Código:: Call WarpUserChar(UserIndex, MapaRetos, 29, 61, True) 'mapa y posicion de duelo del participante 1 Call WarpUserChar(UserSend, MapaRetos, 43, 71, True) 'mapa y posicion de duelo del participante 2 frmMain.TimerRetos.Enabled = True Call SendData(SendTarget.toMap, MapaRetos, PrepareMessagePauseToggle()) End If

Que me avise si funciono. Saludos. Esta bueno porque los lleva a cierto mapa los paraliza y hace conteo todo Smile

.