[APORTE] Deathmatch Automatico.

Tema: [APORTE] Deathmatch Automatico. Jue Feb 23, 2012 7:25 am

Bueno hoy vengo es un deathmatch automatico extraído de Revival AO(Programado por SaturoS) bueno aquí les dejo el código.
En servidor, van y buscan:

Código:

Public Type User Flags

Debajo agregan:

Código:

death As Boolean

Buscan:

Código:

Public KATA As Boolean

Debajo agregan:

Código:

Public terminodeat As Boolean

Luego crean un módulo llamado Deathmach y lo rellenan con lo siguiente:

Código:

Option Explicit
Private cantdeath As Integer
Private Const mapadeath As Integer = 88
Private Const posideath As Integer = 50
Private Const posideathy As Integer = 50
Public deathac As Boolean
Public deathesp As Boolean
Public Cantidad As Integer
Private Const esperadeath = 52
Private Const esperadeathy = 27
Private Death_Luchadores() As Integer

Sub death_entra(ByVal userindex)
On Error GoTo errordm:
Dim i As Integer
If deathac = False Then
Call SendData(SendTarget.toindex, 0, 0, "||No hay ninguna deathmatch!" & FONTTYPE_INFO)
Exit Sub
End If
If deathesp = False Then
Call SendData(SendTarget.toindex, 0, 0, "||La deathmatch ya ha comenzado, te quedaste fuera!" & FONTTYPE_INFO)
Exit Sub
End If

For i = LBound(Death_Luchadores) To UBound(Death_Luchadores)
If (Death_Luchadores(i) = userindex) Then
Call SendData(SendTarget.toindex, userindex, 0, "||Ya estas dentro!" & FONTTYPE_WARNING)
Exit Sub
End If
Next i

For i = LBound(Death_Luchadores) To UBound(Death_Luchadores)
If (Death_Luchadores(i) = -1) Then
Death_Luchadores(i) = userindex
Dim NuevaPos As WorldPos
Dim FuturePos As WorldPos
FuturePos.Map = mapadeath
FuturePos.x = esperadeath: FuturePos.y = esperadeathy
Call ClosestLegalPos(FuturePos, NuevaPos)

If NuevaPos.x <> 0 And NuevaPos.y <> 0 Then Call WarpUserChar(Death_Luchadores(i), NuevaPos.Map, NuevaPos.x, NuevaPos.y, True)
UserList(Death_Luchadores(i)).flags.death = True

Call SendData(SendTarget.toindex, userindex, 0, "||Estas dentro de la deathmatch!" & FONTTYPE_INFO)

'Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: Entra el participante " & UserList(userindex).name & FONTTYPE_INFO)

If (i = UBound(Death_Luchadores)) Then
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: Empieza la DeathMach!!" & FONTTYPE_DEATH)
deathesp = False
Call Deathauto_empieza
End If

Exit Sub
End If
Next i
errordm:
End Sub
Sub death_comienza(ByVal wetas As Integer)
On Error GoTo errordm
If deathac = True Then
Call SendData(SendTarget.toindex, 0, 0, "||Ya hay un deathmatch!!" & FONTTYPE_INFO)
Exit Sub
End If
If deathesp = True Then
Call SendData(SendTarget.toindex, 0, 0, "||La deathmatch ya ha comenzado!" & FONTTYPE_INFO)
Exit Sub
End If
cantdeath = wetas
Cantidad = cantdeath
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: Esta empezando un nuevo deathmatch para " & cantdeath & " participantes. Para participar envia /DEATH - (Cae Inventario) " & FONTTYPE_DEATH)
Call SendData(SendTarget.toall, 0, 0, "TW48")
deathac = True
deathesp = True
ReDim Death_Luchadores(1 To cantdeath) As Integer
Dim i As Integer
For i = LBound(Death_Luchadores) To UBound(Death_Luchadores)
Death_Luchadores(i) = -1
Next i
errordm:
End Sub

Sub death_muere(ByVal userindex As Integer)
On Error GoTo errord
If UserList(userindex).flags.death = True Then
Call WarpUserChar(userindex, 1, 50, 50, True)
UserList(userindex).flags.death = False
Cantidad = Cantidad - 1
If Cantidad = 1 Or MapInfo(mapadeath).NumUsers = 1 Then
terminodeat = True
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: Termina la DeathMatch! El Ganador Debe escribir /GANADOR para recibir su recompensa!!!" & FONTTYPE_DEATH)
End If
If Cantidad = 0 Then
terminodeat = False
deathesp = False
deathac = False
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: El ganador de la deatmatch desconecto. Se anulan los premios!!!" & FONTTYPE_DEATH)
End If
End If
errord:
End Sub

Sub Death_Cancela()
On Error GoTo errordm
If deathac = False And deathesp = False Then
Exit Sub
End If
deathesp = False
deathac = False
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: DeathMatch Automatica Cancelada Por Game Master" & FONTTYPE_DEATH)
Dim i As Integer
For i = LBound(Death_Luchadores) To UBound(Death_Luchadores)
If (Death_Luchadores(i) <> -1) Then
Dim NuevaPos As WorldPos
Dim FuturePos As WorldPos
FuturePos.Map = 1
FuturePos.x = 50: FuturePos.y = 50
Call ClosestLegalPos(FuturePos, NuevaPos)
If NuevaPos.x <> 0 And NuevaPos.y <> 0 Then Call WarpUserChar(Death_Luchadores(i), NuevaPos.Map, NuevaPos.x, NuevaPos.y, True)
UserList(Death_Luchadores(i)).flags.death = False
End If
Next i
errordm:
End Sub

Sub Deathauto_Cancela()
On Error GoTo errordmm
If deathac = False And deathesp = False Then
Exit Sub
End If
deathesp = False
deathac = False
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch: DeathMatch Automatica cancelada por falta de participantes." & FONTTYPE_DEATH)
Dim i As Integer
For i = LBound(Death_Luchadores) To UBound(Death_Luchadores)
If (Death_Luchadores(i) <> -1) Then
Dim NuevaPos As WorldPos
Dim FuturePos As WorldPos
FuturePos.Map = 1
FuturePos.x = 50: FuturePos.y = 50
Call ClosestLegalPos(FuturePos, NuevaPos)
If NuevaPos.x <> 0 And NuevaPos.y <> 0 Then Call WarpUserChar(Death_Luchadores(i), NuevaPos.Map, NuevaPos.x, NuevaPos.y, True)
UserList(Death_Luchadores(i)).flags.death = False
End If
Next i
errordmm:
End Sub

Sub Deathauto_empieza()
On Error GoTo errordm

Dim i As Integer
For i = LBound(Death_Luchadores) To UBound(Death_Luchadores)
If (Death_Luchadores(i) <> -1) Then
Dim NuevaPos As WorldPos
Dim FuturePos As WorldPos
FuturePos.Map = mapadeath
FuturePos.x = posideath: FuturePos.y = posideathy
Call ClosestLegalPos(FuturePos, NuevaPos)
If NuevaPos.x <> 0 And NuevaPos.y <> 0 Then Call WarpUserChar(Death_Luchadores(i), NuevaPos.Map, NuevaPos.x, NuevaPos.y, True)

End If
Next i
errordm:
End Sub

Sub Reset_Weas(ByVal info As String)
On Error GoTo errordm
If info = "d" Then
tukiql = 0
End If
If info = "g" Then
bandasqls = 0
End If
If info = "t" Then
xao = 0
End If
errordm:
End Sub

Ahora buscan en el subuserdie:

Código:

If UserList(userindex).char.loops = LoopAdEternum Then
UserList(userindex).char.FX = 0
UserList(userindex).char.loops = 0
End If

Debajo agregan lo siguiente:

Código:

If UserList(userindex).flags.death = True Then
Call death_muere(userindex)
End If

En el Subclosetsocket buscamos:

Código:

If userindex = LastUser Then
Do Until UserList(LastUser).flags.UserLogged
LastUser = LastUser - 1
If LastUser < 1 Then Exit Do
Loop
End If

Y debajo agregamos:

Código:

If UserList(userindex).flags.death = True Then
Call death_muere(userindex)
End If

Ahora donde ponen los comandos de GM

Código:

If UCase$(Left$(rData, 9)) = "/DEATMAC " Then
rData = Right$(rData, Len(rData) - 9)
Dim DEATQL As Integer
DEATQL = CInt(rData)
If (DEATQL > 0 And DEATQL < 32) Then Call death_comienza(DEATQL)
End If

Código:

If UCase(rData) = "/CANCELARD" Then
Call Death_Cancela
Exit Sub
End If

Y en comandos de usuario poner:

Código:

Case "/DEATH"
If UserList(userindex).flags.Invisible = 1 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a eventos estando invisible!." & FONTTYPE_WARNING)
Exit Sub
End If

If UserList(userindex).flags.Oculto = 1 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a eventos estando invisible!." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).pos.Map = 62 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a eventos en torneo!." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).flags.EstaDueleando1 = True Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a deathmatch estando plantes!." & FONTTYPE_WARNING)
Exit Sub
End If
If userindex = Team.Pj1 Or userindex = Team.Pj2 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes participar en eventos si esperas retos!!!" & FONTTYPE_INFO)
Exit Sub
End If
If UserList(userindex).flags.Muerto = 1 Then
Call SendData(SendTarget.toindex, userindex, 0, "||Estas muerto!!!" & FONTTYPE_INFO)
Exit Sub
End If
If UserList(userindex).pos.Map = 66 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a torneo estando en duelos." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).pos.Map = 61 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a torneo estando en duelos." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).pos.Map = 67 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a torneo estando en carcel." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).pos.Map = 78 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a torneo estando en retos." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).pos.Map = 79 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a torneo estando en torneos." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).pos.Map = 87 Then
Call SendData(SendTarget.toindex, userindex, 0, "||No puedes ir a torneo estando en retos." & FONTTYPE_WARNING)
Exit Sub
End If
If UserList(userindex).Stats.ELV < 50 Then
Call SendData(toindex, userindex, 0, "||Debes ser lvl 50 o mas para entrar al deathmatch!" & FONTTYPE_INFO)
Exit Sub
End If

Call death_entra(userindex)
Exit Sub

Case "/GANADOR"
If UserList(userindex).flags.death = True Then
If terminodeat = True Then
Call WarpUserChar(userindex, 1, 50, 50, True)
UserList(userindex).Stats.GLD = UserList(userindex).Stats.GLD + 1000000
UserList(userindex).Stats.PuntosDeath = UserList(userindex).Stats.PuntosDeath + 1
Call CompruebaDeaths(userindex)
Call SendUserStatsBox(userindex)
Call SendData(toall, userindex, 0, "||GANADOR DEATHMATCH: " & UserList(userindex).name & FONTTYPE_DEATH)
Call SendData(toall, userindex, 0, "||PREMIO: 1.000.000, Equipo Recaudado y 1 punto de DeathMatch." & FONTTYPE_DEATH)
UserList(userindex).flags.death = False
terminodeat = False
deathesp = False
deathac = False
Cantidad = 0
End If
End If
Exit Sub

Si quieren que se hagan automáticos agregan en el frmMain de servidor un timer con lo siguiente:

Citación :

Nombre: deat
Enabled: True
Interval: 30000(CADA MEDIA HORA).

Y adentro agregan:

Código:

Private Sub deat_Timer()
On Error GoTo errordm:
tukiql = tukiql + 1
Select Case tukiql
Case 53
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch> En 10 minutos se realizará un deathmatch automatico." & FONTTYPE_GUILD)
Case 58
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch> En 5 minutos se realizará un deathmatch automatico." & FONTTYPE_GUILD)
Case 62
Call SendData(SendTarget.toall, 0, 0, "||DeathMatch> En 1 minutos se realizará un deathmatch automatico." & FONTTYPE_GUILD)
Case 63
Call death_comienza(RandomNumber(8, 16))
Case 65
If deathesp = True Then
Call Deathauto_Cancela
tukiql = 2
Else
tukiql = 2
End If
End Select
errordm:
End Sub

Creo que eso es todo...
Si hay algún error avisar...
Es para la 11.5.

Tema: Re: [APORTE] Deathmatch Automatico. Vie Feb 24, 2012 12:34 am

este aporte si que esta bueno ... ademas es tuyo ya que pusiste q lo exrajiste ... che si no te jode extrae el de torneos automaticos creo q en el revival esta pero no esta activado...

Tema: Re: [APORTE] Deathmatch Automatico. Vie Feb 24, 2012 4:22 am

Dentro de poco largo un Torneo Automatico.

» Al morir te lleva al X mapa automatico.
» [APORTE] Herramientas de Graficación
» [APORTE] Comando para atacar GMS.
» [APORTE] Ver FPS bajos en la consola
» [APORTE] Comando /CASTILLO.

[APORTE] Deathmatch Automatico.

[APORTE] Deathmatch Automatico.

Temas similares

Temas similares