Modulo captura la bandera.

Ir abajo

Modulo captura la bandera.

Mensaje por Toyz el 7/3/2016, 5:00 am

Código:
Option Explicit
'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public TiempoCaptura As Integer
Public Banderas() As tBandera
Public CountBanderas As Integer
Public NumBanderas As Integer

Private Enum eBandos
    ciu = 0
    Pk = 1
End Enum

Private Type tBandera
    Enabled As Boolean
    Porcent As Integer
    Position As WorldPos
    Bando As eBandos
End Type

Public Const Bandera_Gemas As Integer = 0
Public Const Bandera_Ciu As Integer = 1279
Public Const Bandera_Pk As Integer = 1278

Public Puntos_Criminal As Long
Public Puntos_Ciudadanos As Long

Public Flag_Counter As Integer

Public Act_Banderas As Boolean

Public Sub FlagMain()

    ReDim Banderas(1 To 1) As tBandera
    CountBanderas = 0
    NumBanderas = 0
    TiempoCaptura = 16 / 2
    Act_Banderas = False

End Sub

Public Sub EfectoBandera(ByVal UserIndex As Integer, ByVal Index As Integer)

On Error GoTo err:
    If Act_Banderas = True Then
        With UserList(UserIndex).Counters
            Dim GetTickCountF As Long
            Dim FontTypeColor As FontTypeNames
   
            Dim Point As Long
            GetTickCountF = (GetTickCount And &H7FFFFFFF)
            If GetTickCountF - .CounterBandera > 2000 And UserList(UserIndex).flags.Muerto = 0 Then
                If Criminal(UserIndex) Then
                    Debug.Print "TiempoCaptura: " & Banderas(Index).Porcent & " - " & TiempoCaptura
                    If -Banderas(Index).Porcent < TiempoCaptura Then
                        Banderas(Index).Porcent = Banderas(Index).Porcent - 1
                    Else
                        Banderas(Index).Porcent = -TiempoCaptura
                    End If
                    Point = Round((-Banderas(Index).Porcent / 100) / ((TiempoCaptura * 2) / 100) * 100) + 50
                    If Point > 100 Then Point = 100
                    If Point < -100 Then Point = -100
                    Select Case Point
                        Case 75 To 100
                            FontTypeColor = FontTypeNames.FONTTYPE_CONSEJOCAOS
                        Case 25 To 75
                            FontTypeColor = FontTypeNames.FONTTYPE_EJECUCION
                        Case 0 To 25
                            FontTypeColor = FontTypeNames.FONTTYPE_CONSEJO
                    End Select
                   
                    Call WriteConsoleMsg(UserIndex, "Captura: " & Point & "%", FontTypeColor)
                    If -Banderas(Index).Porcent >= TiempoCaptura And Banderas(Index).Bando = eBandos.ciu Then Call CapturaFlag(Index, eBandos.Pk)
                ElseIf Not Criminal(UserIndex) Then
                    Debug.Print "TiempoCaptura: " & Banderas(Index).Porcent & " - " & TiempoCaptura
                    If Banderas(Index).Porcent < TiempoCaptura Then
                        Banderas(Index).Porcent = Banderas(Index).Porcent + 1
                    Else
                        Banderas(Index).Porcent = TiempoCaptura
                    End If
                    Point = Round((Banderas(Index).Porcent / 100) / ((TiempoCaptura * 2) / 100) * 100) + 50
                    If Point > 100 Then Point = 100
                    If Point < -100 Then Point = -100
                    If Banderas(Index).Porcent >= TiempoCaptura And Banderas(Index).Bando = eBandos.Pk Then Call CapturaFlag(Index, eBandos.ciu)
                   
                    Select Case Point
                        Case 75 To 100
                            FontTypeColor = FontTypeNames.FONTTYPE_CONSEJO
                        Case 25 To 75
                            FontTypeColor = FontTypeNames.FONTTYPE_EJECUCION
                        Case 0 To 25
                            FontTypeColor = FontTypeNames.FONTTYPE_CONSEJOCAOS
                    End Select
                    Call WriteConsoleMsg(UserIndex, "Captura: " & Point & "%", FontTypeColor)
                End If
                .CounterBandera = GetTickCountF
            End If
        End With
    End If
Exit Sub
err:
Call LogError("EfectoBandera: " & err.Description & " - " & Erl())
End Sub

Public Sub Captura_PasarSegundo()
'Dim i As Long
'Debug.Print "######################### " & Flag_Counter
'For i = 1 To CountBanderas
    'Debug.Print "Bandera #" & i & " " & Banderas(i).Position.Map & "-" & Banderas(i).Position.X & "-" & Banderas(i).Position.Y
'Next i
'Debug.Print vbCrLf
If Act_Banderas Then
    If Flag_Counter < 0 Then
        'Criminales
        Puntos_Criminal = Puntos_Criminal - Flag_Counter
        'frmMain.txtPk.Text = Puntos_Criminal
    ElseIf Flag_Counter > 0 Then
        'Ciudadanos
        Puntos_Ciudadanos = Puntos_Ciudadanos + Flag_Counter
        'frmMain.txtCiu.Text = Puntos_Ciudadanos
    End If
End If
End Sub

Private Sub ChangeFlagCounter(ByVal Bando As eBandos)
    Flag_Counter = Flag_Counter + IIf(Bando = eBandos.ciu, 1, -1)
    Debug.Print "Diferencia de banderas: " & Flag_Counter
    'frmMain.lblBandera.Caption = "Banderas: " & CountBanderas & " (Dif: " & Flag_Counter & ")"
End Sub

Public Function OpenNewFlag() As Integer
Dim i As Long
For i = 1 To CountBanderas
    If Not Banderas(i).Enabled Then
        OpenNewFlag = i
        Exit Function
    End If
Next i
End Function

Public Sub CrearFlag(ByRef Objeto As Obj, ByRef Pos As WorldPos)
Dim TempPos As WorldPos
TempPos = Pos
TempPos.Y = TempPos.Y - 1
Dim Bando As eBandos
If Objeto.objIndex = Bandera_Ciu Then
    Bando = eBandos.ciu
ElseIf Objeto.objIndex = Bandera_Pk Then
    Bando = eBandos.Pk
Else
    Call SendData(SendTarget.ToAll, 0, PrepareMessageConsoleMsg("Banderas> Error. Index de creacion invalido.", FontTypeNames.FONTTYPE_SERVER))
    Exit Sub
End If

Dim NewIndex As Integer
NewIndex = OpenNewFlag
If NewIndex = 0 Then
    CountBanderas = CountBanderas + 1
    ReDim Preserve Banderas(1 To CountBanderas)
    NewIndex = CountBanderas
End If
NumBanderas = NumBanderas + 1

Call ChangeFlagCounter(Bando)

Banderas(NewIndex).Enabled = True
Banderas(NewIndex).Bando = Bando

Banderas(NewIndex).Porcent = IIf(Bando = eBandos.ciu, TiempoCaptura, -TiempoCaptura)

Banderas(NewIndex).Position = TempPos
Dim X As Long
Dim Y As Long
For X = TempPos.X - 1 To TempPos.X + 1
    For Y = TempPos.Y - 1 To TempPos.Y + 1
        If InMapBounds(Pos.Map, X, Y) Then
            MapData(Pos.Map, X, Y).Bandera = NewIndex
        End If
    Next Y
Next X
End Sub
Public Function HayBandera(ByVal Map As Integer, ByVal posX As Integer, ByVal posY As Integer) As Boolean
Dim X As Long
Dim Y As Long
For X = posX - 1 To posX + 1
    For Y = posY - 1 To posY + 1
        If InMapBounds(Map, X, Y) Then
            If MapData(Map, X, Y).Bandera > 0 Then
                HayBandera = True
                Exit Function
            End If
        End If
    Next Y
Next X

HayBandera = False
End Function
Public Sub DeleteFlag(ByVal Index As Integer, ByVal Map As Integer, ByVal posX As Integer, ByVal posY As Integer)
On Error GoTo err:
Debug.Print "Delete banderaA!!!!!!!!!"
'Dim i As Long
Call ChangeFlagCounter(IIf(Banderas(Index).Bando = eBandos.ciu, eBandos.Pk, eBandos.ciu))

Banderas(Index).Bando = 0
Banderas(Index).Porcent = 0

'If CountBanderas = Index Then
'    Banderas(Index).Enabled = False
'    Do While Banderas(CountBanderas).Enabled = False
'        CountBanderas = CountBanderas - 1
'        Debug.Print "RESTAMOS!!" & Rnd
'        DoEvents
'    Loop
'    If CountBanderas > 0 Then
'        ReDim Preserve Banderas(1 To CountBanderas)
'    End If
'Else
    Banderas(Index).Enabled = False
'End If
NumBanderas = NumBanderas - 1

'Dim i As Long
'Flag_Counter = 0
'For i = 1 To CountBanderas
'    Flag_Counter = Flag_Counter + IIf(Banderas(i).Bando = eBandos.ciu, 1, -1)
'Next i

Dim X As Long
Dim Y As Long
For X = posX - 1 To posX + 1
    For Y = posY - 1 To posY + 1
        If InMapBounds(Map, X, Y) Then
            If MapData(Map, X, Y).Bandera = Index Then
                MapData(Map, X, Y).Bandera = 0
            Else
                Debug.Print "No es index :("
            End If
        End If
    Next Y
Next X
Exit Sub
err:
Call LogError("DeleteFlag: " & err.Description & " - " & Erl())
End Sub

Private Sub CapturaFlag(ByVal Index As Integer, ByVal Bando As eBandos)
MapData(Banderas(Index).Position.Map, Banderas(Index).Position.X, Banderas(Index).Position.Y).ObjInfo.objIndex = 0
MapData(Banderas(Index).Position.Map, Banderas(Index).Position.X, Banderas(Index).Position.Y).ObjInfo.Amount = 0

Dim Objeto As Obj
Objeto.Amount = 1
If Bando = eBandos.ciu Then
    Objeto.objIndex = Bandera_Ciu
    Call ChangeFlagCounter(eBandos.ciu)
    Debug.Print "CIUDAS CAPTURAN BANDERA!!"
ElseIf Bando = eBandos.Pk Then
    Objeto.objIndex = Bandera_Pk
    Call ChangeFlagCounter(eBandos.Pk)
    Debug.Print "CRIMIS CAPTURAN BANDERA!!"
End If

Banderas(Index).Bando = Bando
Call MakeObj(Objeto, Banderas(Index).Position.Map, Banderas(Index).Position.X, Banderas(Index).Position.Y)
End Sub


_______________

Como saben yo aporto bastante en Servers-Argentum y les quiero decir que todos tienen derecho de usar y de aportar en otra comunidad mis aportes pero sólo con un requisito y es tan simple que dejar los créditos. Gracias.
Si conocen otra comunidad y en esa misma mis aportes no están aportados, si tenés tiempo y ganas, aportalo! A mucha gente le puede servir. No te olvides del requisito Razz

MIS MEJORES APORTES:

Compra/venta de personajes:
https://goo.gl/A44Av0

Juegos del Hambre:
https://goo.gl/u6aNUG

Deathmatch automático:
https://goo.gl/GQF4fK

Sistema de retos vía MMR con búsqueda, emparejamiento, etc:
https://goo.gl/40uP0f

Sistemas de eventos automáticos de 1vs1 hasta 10vs10:
https://goo.gl/XYKygc

1VS1 - AIM - MELEE - Gana Sigue (Se liberan cupos)
https://goo.gl/qq83wx

Retos 3vs3 - [Items, 2 rounds, múltiples arenas, oro]
https://goo.gl/x8SMnV

Eliminar sistema de Skill (COMPLETO)
https://goo.gl/mKxHzC
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por Metrosersuah el 3/4/2016, 1:51 am

linda base, se agradece por el aporte
avatar
Metrosersuah
Nivel 5
Nivel 5

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 234
Localización : 4 Paredes
Fecha de inscripción : 13/02/2016

Ver perfil de usuario http://www.argentumonline.com.ar

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por EL_santo43 el 3/4/2016, 11:57 am

Se puede hacer mucho mas facil. En vez de llamarlo desde un timer, ubicarlo en el dotileevent que es llamado cada vez que el usuario cambia su posicion. La parte de los usuarios estaria faltando todo lo que es el mabejo de usuarios del evento, que es la parte mas pajosa a la hora deprogramar un evento de teams. Saludos.

EL_santo43
Nivel 1
Nivel 1

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 10
Localización : En mi casa.
Fecha de inscripción : 10/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por Axters el 2/5/2016, 2:22 pm

Que boludes eso de dejar solo 1 modulo, si queres aportarlo, aportalo para todos no para los que tengan conocimientos nomas, yo capas me das eso y lo puedo hacer pero si otro no sabe mucho y quiere ponerlo? ...

Axters
Nivel 10
Nivel 10

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 1102
Edad : 18
Localización : Adrogue
Fecha de inscripción : 19/05/2012

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por Toyz el 2/5/2016, 5:55 pm

@Axters escribió:Que boludes eso de dejar solo 1 modulo, si queres aportarlo, aportalo para todos no para los que tengan conocimientos nomas, yo capas me das eso y lo puedo hacer pero si otro no sabe mucho y quiere ponerlo? ...

Primero que nada no tengo la obligación para dejarlo para todos, lo dejo para gente que se esmere y lo implemente en su servidor.

El sistema ya está codeado en ese modulo, lo único que hay que hacer son unas simples llamadas y los paquetes, si no sabes hacer eso, desde ya, te digo que no te pongas hacer un AO.
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por BenjaXZ el 2/5/2016, 6:47 pm

Me mata porque todos los aportes que hiciste ninguno es tuyo, y no dejas la fuente.
avatar
BenjaXZ
Nivel 6
Nivel 6

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 439
Localización : Dolores
Fecha de inscripción : 29/05/2012

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por Toyz el 2/5/2016, 9:04 pm

@BenjaXZ escribió:Me mata porque todos los aportes que hiciste ninguno es tuyo, y no dejas la fuente.

De la página 3 para delante, son todos mios. Menos este, yo no lo programé, pero está bien programado. Desconozco quien lo programó, lo tengo guardado hace meses, quizá un año.

PD: Revivieron algunos que no son mios, así que me tomé 1 minuto para recopilar los mios Smile


http://www.servers-argentum.org/t34855-ifs-drag-and-drop-y-comerciando-antidupeo
http://www.servers-argentum.org/t35120-aporte1-criatura-te-habla (programado por un amigo)
http://www.servers-argentum.org/t35138-aporte-sistema-de-famas-desteriumao-13-0
http://www.servers-argentum.org/t35163-aporte-pocion-de-invisibilidad
http://www.servers-argentum.org/t34959-adaptaciones-de-13-3-a-13-0-parte-1-servidor
http://www.servers-argentum.org/t35542-poner-triggers-en-juego-mucho-mas-facil-13-0
http://www.servers-argentum.org/t35529-mensajes-con-paramarray-y-no-optional-mejora-en-mensajes
http://www.servers-argentum.org/t35526-mejora-al-mandar-mensaje-en-consola-explicado-parte-2
http://www.servers-argentum.org/t35521-si-la-flecha-no-targetea-el-npc-tira-la-flecha-al-suelo
http://www.servers-argentum.org/t35520-no-gastar-municiones-si-no-le-pegas-al-npc
http://www.servers-argentum.org/t35517-plus-barras-de-vida-abajo-del-npc
http://www.servers-argentum.org/t35510-el-gallo-te-ha-pegado-genero-en-npcs
http://www.servers-argentum.org/t35507-label-marca-los-usuarios-online
http://www.servers-argentum.org/t35506-infraccion-facilidad-para-armar-eventos-manuales
http://www.servers-argentum.org/t35501-nick-no-poder-escribir-en-x-mapa-eventos
http://www.servers-argentum.org/t35494-barra-de-vida-debajo-de-los-npc-s-dx7-dx8-plus-13-0 (Uno de los que mejor hice)
http://www.servers-argentum.org/t35490-hacer-gamemaster-ingame
http://www.servers-argentum.org/t35491-sistema-de-reputacion-style-tpao
http://www.servers-argentum.org/t35465-coordenadas-en-render-dx7
http://www.servers-argentum.org/t35470-contador-de-las-veces-que-moriste-plus
http://www.servers-argentum.org/t35467-aprende-a-usar-do-while-y-for
http://www.servers-argentum.org/t35405-mapa-coordenadas-en-render-mas-negrita-en-dx8
http://www.servers-argentum.org/t35429-multiplicar-oro-misterio-resuelto-13-0
http://www.servers-argentum.org/t35440-npc-desangran-13-0
http://www.servers-argentum.org/t35441-npcs-desangran-megaplus-dx8-13-0
http://www.servers-argentum.org/t35299-estrella-de-donador-al-lado-del-nick-dx7
http://www.servers-argentum.org/t35361-al-pasar-el-mouse-por-arriba-del-item-dice-nombre-y-cantidad
http://www.servers-argentum.org/t35416-sanar-en-renderscreen-13-0-dx8
http://www.servers-argentum.org/t35421-todos-los-mensajes-de-consola-seteados-desde-el-cliente
http://www.servers-argentum.org/t35408-cuando-sanas-dice-la-cantidad-en-render-style-aesir-online
http://www.servers-argentum.org/t35406-color-en-rmsg-segun-que-tipo-de-gm
http://www.servers-argentum.org/t34562-cuenta-regresiva-mas-estilo
http://www.servers-argentum.org/t35391-al-comer-te-da-sed-style-aesir-plus-13-0
http://www.servers-argentum.org/t35122-aporte2-hechizo-teletransportador (este no lo programé yo, creo)
http://www.servers-argentum.org/t35304-si-queres-salir-te-saca-la-invisibilidad-13-0-style-tdn
http://www.servers-argentum.org/t35366-aporte-no-se-puede-desembarcar-en-el-mar-style-tds (este no lo programe yo)
avatar
Toyz
Administrador
Administrador

¿BANEADO? : No.
Premios :
[1er puesto] Usuario del año 2016
Cantidad de envíos : 5045
Edad : 17
Localización : Global.
Fecha de inscripción : 28/09/2014

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por BenjaXZ el 3/5/2016, 2:25 pm

Por favor... Nada es tuyo no tengo ganas de leer, y menos las pavadas que decís.
avatar
BenjaXZ
Nivel 6
Nivel 6

¿BANEADO? : No.
Premios : Ninguno.
Cantidad de envíos : 439
Localización : Dolores
Fecha de inscripción : 29/05/2012

Ver perfil de usuario

Volver arriba Ir abajo

Re: Modulo captura la bandera.

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


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