Retos en F1 con Frm

Ir abajo

Retos en F1 con Frm

Mensaje por Los Aldeanos el 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 :

...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 : 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 Very Happy!, 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.
Los Aldeanos
Los Aldeanos



Aportes : 4
Mensajes : 6
Puntos : 14

Ver perfil de usuario

Volver arriba Ir abajo

Re: Retos en F1 con Frm

Mensaje por Sderty el Lun Sep 23, 2013 9:33 pm

Acordate de dejar la fuente si lo sacaste de algún lugar :p
Sderty
Sderty



Aportes : 13

Mensajes : 44
Puntos : 75
Edad : 21
Localización : Caba Flores.-

Ver perfil de usuario

Volver arriba Ir abajo

Re: Retos en F1 con Frm

Mensaje por Los Aldeanos el Lun Sep 23, 2013 9:34 pm

Sderty escribió:Acordate de dejar la fuente si lo sacaste de algún lugar :p
Este código lo había extraído de algun juego :c, lo aporte en Gs Zone. Y lo traje a este nuevo foro wi (?.
Los Aldeanos
Los Aldeanos



Aportes : 4
Mensajes : 6
Puntos : 14

Ver perfil de usuario

Volver arriba Ir abajo

Re: Retos en F1 con Frm

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

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