Itens Arrow´s ( flechas )

    Compartilhe
    avatar
    Kurogane
    Administrador
    Administrador

    Mensagens : 14
    Level : 4
    Data de inscrição : 01/11/2010
    Idade : 24

    default Itens Arrow´s ( flechas )

    Mensagem por Kurogane em Ter Nov 01, 2011 4:52 pm

    Introdução :
    Certos Itens Poderão ter a opção de flecha , que será um projetil atirado pelo item até uma certa distancia calculada pelo Editor .


    ~Requerimento~
    •Noção de Programação(VB6) 3/5
    •Estudo de Programação(VB6) 2~3/5
    •Computador/Net (Capitão Obvio xD)

    Ao Abrir o Client Side
    vá na FrmEditor_Item e Crie uma frame com qualquer name e dentro dela crie: 4 labeis e 4 scrolBlox com as seguintes configurações:

    Código:
    Label1
    Name: lblflechaPic
    Caption: Pic: 0

    Label2
    Name: lblflecharange
    Caption: Range: 0

    Label3
    Name: lblflechaSpeed
    Caption: Speed: 0

    Label4
    Name: lblflechaDamage
    Caption: Damage: 0

    Entre na Sub do Editor de Item , se você não sabe entrar Veja a Imagem no Spollier e faça igual :

    Spoiler:

    Código:
    ' projectile
    Private Sub scrlflehcaDamage_Change()
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
        lblProjectileDamage.Caption = "Damage: " & scrlProjectileDamage.Value
        Item(EditorIndex).ProjecTile.Damage = scrlProjectileDamage.Value
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "scrlProjectilePic_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    ' projectile
    Private Sub scrlflehcaPic_Change()
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
        lblProjectilePic.Caption = "Pic: " & scrlProjectilePic.Value
        Item(EditorIndex).ProjecTile.Pic = scrlProjectilePic.Value
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "scrlProjectilePic_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    ' ProjecTile
    Private Sub scrlflehcaRange_Change()
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
        lblProjectileRange.Caption = "Range: " & scrlProjectileRange.Value
        Item(EditorIndex).ProjecTile.Range = scrlProjectileRange.Value
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "scrlProjectileRange_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    ' projectile
    Private Sub scrlflehcaSpeed_Change()
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
        lblProjectileSpeed.Caption = "Speed: " & scrlProjectileSpeed.Value
        Item(EditorIndex).ProjecTile.Speed = scrlProjectileSpeed.Value
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "scrlRarity_Change", "frmEditor_Item", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Aperta Ctrl + F e Deixe a Configurações Assim :

    Ao Lado de fin What Coloque :
    Código:
    Public Const MAX_PARTY_MEMBERS As Long = 4
    e click em Find Next
    Ao Achar essa Linha , debaixo dela Adicione :
    Código:
    Public Const MAX_PLAYER_PROJECTILES As Long = 20
    Novamente Procure Por :
    Código:
    Sub SetPlayerEquipment(ByVal Index As Long, ByVal InvNum As Long, ByVal EquipmentSlot As Equipment)
    Depois de :
    Código:
    End Sub
    Adicione :
    Código:
    ' projectiles
    Public Sub CheckProjectiles()
    Dim i As Long

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        i = 1

        While FileExist(GFX_PATH & "Projectiles\" & i & GFX_EXT)
            NumProjectiles = NumProjectiles + 1
            i = i + 1
        Wend
       
        If NumProjectiles = 0 Then Exit Sub

        ReDim DDS_Projectile(1 To NumProjectiles)
        ReDim DDSD_Projectile(1 To NumProjectiles)
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "CheckItems", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    Sub ClearProjectile(ByVal Index As Long, ByVal PlayerProjectile As Long)
        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler

        With Player(Index).ProjecTile(PlayerProjectile)
            .Direction = 0
            .Pic = 0
            .TravelTime = 0
            .x = 0
            .Y = 0
            .Range = 0
            .Damage = 0
            .Speed = 0
        End With
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "ClearProjectile", "modDatabase", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub

    em Seguida Procure por :
    Código:
    Public DDS_Bars As DirectDrawSurface7
    De Baixo desta linha adicione
    Código:
    Public DDS_Projectile() As DirectDrawSurface7
    Procure Por :
    Código:
    Public DDSD_Bars As DDSURFACEDESC2
    Abaixo Adicione :
    Código:
    Public DDSD_Projectile() As DDSURFACEDESC2
    Novamente Procure Por :
    Código:
    Public NumSpellIcons As Long
    E Adicione Abaixo :
    Código:
    Public NumProjectiles As Long
    + 1 Vez Procure Por :
    Código:
    For i = 1 To NumFaces
            Set DDS_Face(i) = Nothing
            ZeroMemory ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i))
        Next
    Abaixo Adicione :
    Código:
     For i = 1 To NumProjectiles
            Set DDS_Projectile(i) = Nothing
            ZeroMemory ByVal VarPtr(DDSD_Projectile(i)), LenB(DDSD_Projectile(i))
        Next
    Procure Por :
    Código:
    ' draw animations
        If NumAnimations > 0 Then
            For i = 1 To MAX_BYTE
                If AnimInstance(i).Used(0) Then
                    BltAnimation i, 0
                End If
            Next
        End If
    Abaixo Adicione :
    Código:
    ' blt projec tiles for each player
        For i = 1 To Player_HighIndex
            For x = 1 To MAX_PLAYER_PROJECTILES
                If Player(i).ProjecTile(x).Pic > 0 Then
                    BltProjectile i, x
                End If
            Next
        Next

    Agora adicione isso no final do modDirectDraw7:

    Código:
    ' player Projectiles
    Public Sub BltProjectile(ByVal Index As Long, ByVal PlayerProjectile As Long)
    Dim x As Long, Y As Long, PicNum As Long, i As Long
    Dim rec As DxVBLib.RECT

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        ' check for subscript error
        If Index < 1 Or PlayerProjectile < 1 Or PlayerProjectile > MAX_PLAYER_PROJECTILES Then Exit Sub
       
        ' check to see if it's time to move the Projectile
        If GetTickCount > Player(Index).ProjecTile(PlayerProjectile).TravelTime Then
            With Player(Index).ProjecTile(PlayerProjectile)
                ' set next travel time and the current position and then set the actual direction based on RMXP arrow tiles.
                Select Case .Direction
                    ' down
                    Case 0
                        .Y = .Y + 1
                        ' check if they reached maxrange
                        If .Y = (GetPlayerY(Index) + .Range) + 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                    ' up
                    Case 1
                        .Y = .Y - 1
                        ' check if they reached maxrange
                        If .Y = (GetPlayerY(Index) - .Range) - 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                    ' right
                    Case 2
                        .x = .x + 1
                        ' check if they reached max range
                        If .x = (GetPlayerX(Index) + .Range) + 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                    ' left
                    Case 3
                        .x = .x - 1
                        ' check if they reached maxrange
                        If .x = (GetPlayerX(Index) - .Range) - 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                End Select
                .TravelTime = GetTickCount + .Speed
            End With
        End If
       
        ' set the x, y & pic values for future reference
        x = Player(Index).ProjecTile(PlayerProjectile).x
        Y = Player(Index).ProjecTile(PlayerProjectile).Y
        PicNum = Player(Index).ProjecTile(PlayerProjectile).Pic
       
        ' check if left map
        If x > Map.MaxX Or Y > Map.MaxY Or x < 0 Or Y < 0 Then
            ClearProjectile Index, PlayerProjectile
            Exit Sub
        End If
       
        ' check if we hit a block
        If Map.Tile(x, Y).Type = TILE_TYPE_BLOCKED Then
            ClearProjectile Index, PlayerProjectile
            Exit Sub
        End If
       
        ' check for player hit
        For i = 1 To Player_HighIndex
            If x = GetPlayerX(i) And Y = GetPlayerY(i) Then
                ' they're hit, remove it
                If Not x = Player(MyIndex).x Or Not Y = GetPlayerY(MyIndex) Then
                    ClearProjectile Index, PlayerProjectile
                    Exit Sub
                End If
            End If
        Next
       
        ' check for npc hit
        For i = 1 To MAX_MAP_NPCS
            If x = MapNpc(i).x And Y = MapNpc(i).Y Then
                ' they're hit, remove it
                ClearProjectile Index, PlayerProjectile
                Exit Sub
            End If
        Next
       
        ' if projectile is not loaded, load it, female dog.
        If DDS_Projectile(PicNum) Is Nothing Then
            Call InitDDSurf("projectiles\" & PicNum, DDSD_Projectile(PicNum), DDS_Projectile(PicNum))
        End If
       
        ' get positioning in the texture
        With rec
            .top = 0
            .Bottom = SIZE_Y
            .Left = Player(Index).ProjecTile(PlayerProjectile).Direction * SIZE_X
            .Right = .Left + SIZE_X
        End With

        ' blt the projectile
        Call Engine_BltFast(ConvertMapX(x * PIC_X), ConvertMapY(Y * PIC_Y), DDS_Projectile(PicNum), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "BltProjectile", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub
    Procure por :
    Código:
      SPartyVitals
    Abaixo Adicione :
    Código:
    SHandleProjectile
    Procure Por :
    Código:
     CPartyLeave
    Abaixo Adicione:
    Código:
      CProjecTileAttack
    Procure Por :
    Código:
    If frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_CONSUME Then
                frmEditor_Item.fraVitals.Visible = True
                frmEditor_Item.scrlAddHp.text = .AddHP
                frmEditor_Item.scrlAddMP.text = .AddMP
                frmEditor_Item.scrlAddExp.text = .AddEXP
                frmEditor_Item.scrlCastSpell.text = .CastSpell
                frmEditor_Item.chkInstant.Value = .instaCast
            Else
                frmEditor_Item.fraVitals.Visible = False
            End If
    Acima disto adicione :
    Código:
    If frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_WEAPON Then
            frmEditor_Item.Frame4.Visible = True
            With Item(EditorIndex).ProjecTile
                frmEditor_Item.scrlflehcaDamage.Value = .Damage
                frmEditor_Item.scrlflechaPic.Value = .Pic
                frmEditor_Item.scrlflechaRange.Value = .Range
                frmEditor_Item.scrlflechaSpeed.Value = .Speed
            End With
        End If

    Procure Por :
    Código:
    Public Sub CheckAttack()
    Dim Buffer As clsBuffer
    Dim attackspeed As Long

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        If ControlDown Then
       
            If SpellBuffer > 0 Then Exit Sub ' currently casting a spell, can't attack
            If StunDuration > 0 Then Exit Sub ' stunned, can't attack

            ' speed from weapon
            If GetPlayerEquipment(MyIndex, Weapon) > 0 Then
                attackspeed = Item(GetPlayerEquipment(MyIndex, Weapon)).Speed
            Else
                attackspeed = 1000
            End If

            If Player(MyIndex).AttackTimer + attackspeed < GetTickCount Then
                If Player(MyIndex).Attacking = 0 Then

                    With Player(MyIndex)
                        .Attacking = 1
                        .AttackTimer = GetTickCount
                    End With

                    Set Buffer = New clsBuffer
                    Buffer.WriteLong CAttack
                    SendData Buffer.ToArray()
                    Set Buffer = Nothing
                End If
            End If
        End If

        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "CheckAttack", "modGameLogic", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub
    Substitua Por :
    Código:
    Public Sub CheckAttack()
    Dim Buffer As clsBuffer
    Dim attackspeed As Long

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        If ControlDown Then
           
            If SpellBuffer > 0 Then Exit Sub ' currently casting a spell, can't attack
            If StunDuration > 0 Then Exit Sub ' stunned, can't attack

            ' speed from weapon
            If GetPlayerEquipment(MyIndex, Weapon) > 0 Then
                attackspeed = Item(GetPlayerEquipment(MyIndex, Weapon)).Speed
            Else
                attackspeed = 1000
            End If

            If Player(MyIndex).AttackTimer + attackspeed < GetTickCount Then
                If Player(MyIndex).Attacking = 0 Then

                    With Player(MyIndex)
                        .Attacking = 1
                        .AttackTimer = GetTickCount
                    End With
                   
                    If GetPlayerEquipment(MyIndex, Weapon) > 0 Then
                        If Item(GetPlayerEquipment(MyIndex, Weapon)).ProjecTile.Pic > 0 Then
                            ' projectile
                            Set Buffer = New clsBuffer
                                Buffer.WriteLong CProjecTileAttack
                                SendData Buffer.ToArray()
                                Set Buffer = Nothing
                                Exit Sub
                        End If
                    End If
                           
                    ' non projectile
                    Set Buffer = New clsBuffer
                    Buffer.WriteLong CAttack
                    SendData Buffer.ToArray()
                    Set Buffer = Nothing
                End If
            End If
        End If

        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "CheckAttack", "modGameLogic", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub
    Procure por :
    Código:
     Call CheckSpellIcons
    Abaixo Adicione :
    Código:
    Call CheckProjectiles
    Procure Por :
    Código:
     HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
    Abaixo Adicione :
    Código:
    HandleDataSub(SHandleProjectile) = GetAddress(AddressOf HandleProjectile)

    No Final da ModHandleData Adicione :
    Código:
    Sub HandleProjectile(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim PlayerProjectile As Long
    Dim Buffer As clsBuffer

        ' If debug mode, handle error then exit out
        If Options.Debug = 1 Then On Error GoTo errorhandler
       
        ' create a new instance of the buffer
        Set Buffer = New clsBuffer
       
        ' read bytes from data()
        Buffer.WriteBytes Data()
       
        ' recieve projectile number
        PlayerProjectile = Buffer.ReadLong
        Index = Buffer.ReadLong
       
        ' populate the values
        With Player(Index).ProjecTile(PlayerProjectile)
       
            ' set the direction
            .Direction = Buffer.ReadLong
           
            ' set the direction to support file format
            Select Case .Direction
                Case DIR_DOWN
                    .Direction = 0
                Case DIR_UP
                    .Direction = 1
                Case DIR_RIGHT
                    .Direction = 2
                Case DIR_LEFT
                    .Direction = 3
            End Select
           
            ' set the pic
            .Pic = Buffer.ReadLong
            ' set the coordinates
            .x = GetPlayerX(Index)
            .Y = GetPlayerY(Index)
            ' get the range
            .Range = Buffer.ReadLong
            ' get the damge
            .Damage = Buffer.ReadLong
            ' get the speed
            .Speed = Buffer.ReadLong
           
        End With
       
        ' Error handler
        Exit Sub
    errorhandler:
        HandleError "HandleProjectile", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext
        Err.Clear
        Exit Sub
    End Sub
    Procure Por :
    Código:
    Private Type PlayerRec
    Acima Adicione :
    Código:
    Public Type ProjectileRec
        TravelTime As Long
        Direction As Long
        x As Long
        Y As Long
        Pic As Long
        Range As Long
        Damage As Long
        Speed As Long
    End Type
    Procure por PlayerRec e Antes de End Type Adicione:
    Código:
    ' projectiles
        ProjecTile(1 To MAX_PLAYER_PROJECTILES) As ProjectileRec
    Procure Por ItemRec e Antes de End Type Adicione :
    Código:
     ProjecTile As ProjectileRec


    Agora Vamos Para o Servidor

    Servidor Side
    Procure Por Function CanPlayerattackPlayer e Muda ela inteira para :

    Código:
    Function CanPlayerAttackPlayer(ByVal attacker As Long, ByVal victim As Long, Optional ByVal IsSpell As Boolean = False, Optional ByVal IsProjectile As Boolean = False) As Boolean

        If Not IsSpell And Not IsProjectile Then
            ' Check attack timer
            If GetPlayerEquipment(attacker, Weapon) > 0 Then
                If GetTickCount < TempPlayer(attacker).AttackTimer + Item(GetPlayerEquipment(attacker, Weapon)).Speed Then Exit Function
            Else
                If GetTickCount < TempPlayer(attacker).AttackTimer + 1000 Then Exit Function
            End If
        End If

        ' Check for subscript out of range
        If Not IsPlaying(victim) Then Exit Function

        ' Make sure they are on the same map
        If Not GetPlayerMap(attacker) = GetPlayerMap(victim) Then Exit Function

        ' Make sure we dont attack the player if they are switching maps
        If TempPlayer(victim).GettingMap = YES Then Exit Function

        If Not IsSpell And Not IsProjectile Then
            ' Check if at same coordinates
            Select Case GetPlayerDir(attacker)
                Case DIR_UP
       
                    If Not ((GetPlayerY(victim) + 1 = GetPlayerY(attacker)) And (GetPlayerX(victim) = GetPlayerX(attacker))) Then Exit Function
                Case DIR_DOWN
       
                    If Not ((GetPlayerY(victim) - 1 = GetPlayerY(attacker)) And (GetPlayerX(victim) = GetPlayerX(attacker))) Then Exit Function
                Case DIR_LEFT
       
                    If Not ((GetPlayerY(victim) = GetPlayerY(attacker)) And (GetPlayerX(victim) + 1 = GetPlayerX(attacker))) Then Exit Function
                Case DIR_RIGHT
       
                    If Not ((GetPlayerY(victim) = GetPlayerY(attacker)) And (GetPlayerX(victim) - 1 = GetPlayerX(attacker))) Then Exit Function
                Case Else
                    Exit Function
            End Select
        End If

        ' Check if map is attackable
        If Not Map(GetPlayerMap(attacker)).Moral = MAP_MORAL_NONE Then
            If GetPlayerPK(victim) = NO Then
                Call PlayerMsg(attacker, "This is a safe zone!", BrightRed)
                Exit Function
            End If
        End If

        ' Make sure they have more then 0 hp
        If GetPlayerVital(victim, Vitals.HP) <= 0 Then Exit Function

        ' Check to make sure that they dont have access
        If GetPlayerAccess(attacker) > ADMIN_MONITOR Then
            Call PlayerMsg(attacker, "Admins cannot attack other players.", BrightBlue)
            Exit Function
        End If

        ' Check to make sure the victim isn't an admin
        If GetPlayerAccess(victim) > ADMIN_MONITOR Then
            Call PlayerMsg(attacker, "You cannot attack " & GetPlayerName(victim) & "!", BrightRed)
            Exit Function
        End If

        ' Make sure attacker is high enough level
        If GetPlayerLevel(attacker) < 10 Then
            Call PlayerMsg(attacker, "You are below level 10, you cannot attack another player yet!", BrightRed)
            Exit Function
        End If

        ' Make sure victim is high enough level
        If GetPlayerLevel(victim) < 10 Then
            Call PlayerMsg(attacker, GetPlayerName(victim) & " is below level 10, you cannot attack this player yet!", BrightRed)
            Exit Function
        End If

        CanPlayerAttackPlayer = True
    End Function

    Procure Por :
    Código:
    Public Const MAX_PARTY_MEMBERS As Long = 4
    Abaixo Adicione :
    Código:
    Public Const MAX_PLAYER_PROJECTILES As Long = 20

    No Final da ModDatabase Adicione :
    Código:
    Sub ClearProjectile(ByVal Index As Long, ByVal PlayerProjectile As Long)
        ' clear the projectile
        With TempPlayer(Index).ProjecTile(PlayerProjectile)
            .Direction = 0
            .Pic = 0
            .TravelTime = 0
            .X = 0
            .Y = 0
            .Range = 0
            .Damage = 0
            .Speed = 0
        End With
    End Sub

    Procure Por :
    Código:
        SPartyVitals
    Abaixo Adicione :
    Código:
        SHandleProjectile
    Procure Por :
    Código:
        CPartyLeave
    Abaixo Adicione :
    Código:
    CProjecTileAttack
    No Final do ModGameLogic Adicione :
    Código:
    Public Sub HandleProjecTile(ByVal Index As Long, ByVal PlayerProjectile As Long)
    Dim X As Long, Y As Long, i As Long

        ' check for subscript out of range
        If Index < 1 Or Index > MAX_PLAYERS Or PlayerProjectile < 1 Or PlayerProjectile > MAX_PLAYER_PROJECTILES Then Exit Sub
           
        ' check to see if it's time to move the Projectile
        If GetTickCount > TempPlayer(Index).ProjecTile(PlayerProjectile).TravelTime Then
            With TempPlayer(Index).ProjecTile(PlayerProjectile)
                ' set next travel time and the current position and then set the actual direction based on RMXP arrow tiles.
                Select Case .Direction
                    ' down
                    Case DIR_DOWN
                        .Y = .Y + 1
                        ' check if they reached maxrange
                        If .Y = (GetPlayerY(Index) + .Range) + 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                    ' up
                    Case DIR_UP
                        .Y = .Y - 1
                        ' check if they reached maxrange
                        If .Y = (GetPlayerY(Index) - .Range) - 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                    ' right
                    Case DIR_RIGHT
                        .X = .X + 1
                        ' check if they reached max range
                        If .X = (GetPlayerX(Index) + .Range) + 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                    ' left
                    Case DIR_LEFT
                        .X = .X - 1
                        ' check if they reached maxrange
                        If .X = (GetPlayerX(Index) - .Range) - 1 Then ClearProjectile Index, PlayerProjectile: Exit Sub
                End Select
                .TravelTime = GetTickCount + .Speed
            End With
        End If
       
        X = TempPlayer(Index).ProjecTile(PlayerProjectile).X
        Y = TempPlayer(Index).ProjecTile(PlayerProjectile).Y
       
        ' check if left map
        If X > Map(GetPlayerMap(Index)).MaxX Or Y > Map(GetPlayerMap(Index)).MaxY Or X < 0 Or Y < 0 Then
            ClearProjectile Index, PlayerProjectile
            Exit Sub
        End If
       
        ' check if hit player
        For i = 1 To Player_HighIndex
            ' make sure they're actually playing
            If IsPlaying(i) Then
                ' check coordinates
                If X = Player(i).X And Y = GetPlayerY(i) Then
                    ' make sure it's not the attacker
                    If Not X = Player(Index).X Or Not Y = GetPlayerY(Index) Then
                        ' check if player can attack
                        If CanPlayerAttackPlayer(Index, i, False, True) = True Then
                            ' attack the player and kill the project tile
                            PlayerAttackPlayer Index, i, TempPlayer(Index).ProjecTile(PlayerProjectile).Damage
                            ClearProjectile Index, PlayerProjectile
                            Exit Sub
                        Else
                            ClearProjectile Index, PlayerProjectile
                            Exit Sub
                        End If
                    End If
                End If
            End If
        Next
       
        ' check for npc hit
        For i = 1 To MAX_MAP_NPCS
            If X = MapNpc(GetPlayerMap(Index)).NPC(i).X And Y = MapNpc(GetPlayerMap(Index)).NPC(i).Y Then
                ' they're hit, remove it and deal that damage
                If CanPlayerAttackNpc(Index, i, True) Then
                    PlayerAttackNpc Index, i, TempPlayer(Index).ProjecTile(PlayerProjectile).Damage
                    ClearProjectile Index, PlayerProjectile
                    Exit Sub
                Else
                    ClearProjectile Index, PlayerProjectile
                    Exit Sub
                End If
            End If
        Next
       
        ' hit a block
        If Map(GetPlayerMap(Index)).Tile(X, Y).Type = TILE_TYPE_BLOCKED Then
            ' hit a block, clear it.
            ClearProjectile Index, PlayerProjectile
            Exit Sub
        End If
       
    End Sub
    Procure Por :
    Código:
        HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
    abaixo Adicione :
    Código:
    HandleDataSub(CProjecTileAttack) = GetAddress(AddressOf HandleProjecTileAttack)

    No Final do ModHandleData Adicione :

    Código:
    Private Sub HandleProjecTileAttack(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
    Dim curProjecTile As Long, i As Long, CurEquipment As Long

        ' prevent subscript
        If Index > MAX_PLAYERS Or Index < 1 Then Exit Sub
       
        ' get the players current equipment
        CurEquipment = GetPlayerEquipment(Index, Weapon)
       
        ' check if they've got equipment
        If CurEquipment < 1 Or CurEquipment > MAX_ITEMS Then Exit Sub
       
        ' set the curprojectile
        For i = 1 To MAX_PLAYER_PROJECTILES
            If TempPlayer(Index).ProjecTile(i).Pic = 0 Then
                ' just incase there is left over data
                ClearProjectile Index, i
                ' set the curprojtile
                curProjecTile = i
                Exit For
            End If
        Next
       
        ' check for subscript
        If curProjecTile < 1 Then Exit Sub
       
        ' populate the data in the player rec
        With TempPlayer(Index).ProjecTile(curProjecTile)
            .Damage = Item(CurEquipment).ProjecTile.Damage
            .Direction = GetPlayerDir(Index)
            .Pic = Item(CurEquipment).ProjecTile.Pic
            .Range = Item(CurEquipment).ProjecTile.Range
            .Speed = Item(CurEquipment).ProjecTile.Speed
            .X = GetPlayerX(Index)
            .Y = GetPlayerY(Index)
        End With
                   
        ' trololol, they have no more projectile space left
        If curProjecTile < 1 Or curProjecTile > MAX_PLAYER_PROJECTILES Then Exit Sub
       
        ' update the projectile on the map
        SendProjectileToMap Index, curProjecTile
       
    End Sub

    Procure Por :

    Código:
    ' Checks to update player vitals every 5 seconds - Can be tweaked
            If Tick > LastUpdatePlayerVitals Then
                UpdatePlayerVitals
                LastUpdatePlayerVitals = GetTickCount + 5000
            End If

    Abaixo Adicione :

    Código:
    For i = 1 To Player_HighIndex
                If IsPlaying(i) Then
                    For X = 1 To MAX_PLAYER_PROJECTILES
                        If TempPlayer(i).ProjecTile(X).Pic > 0 Then
                            ' handle the projec tile
                            HandleProjecTile i, X
                        End If
                    Next
                End If
            Next

    No Final do ModServeTPC Adicione :

    Código:
    Sub SendProjectileToMap(ByVal Index As Long, ByVal PlayerProjectile As Long)
    Dim Buffer As clsBuffer
       
        Set Buffer = New clsBuffer
        Buffer.WriteLong SHandleProjectile
        Buffer.WriteLong PlayerProjectile
        Buffer.WriteLong Index
        With TempPlayer(Index).ProjecTile(PlayerProjectile)
            Buffer.WriteLong .Direction
            Buffer.WriteLong .Pic
            Buffer.WriteLong .Range
            Buffer.WriteLong .Damage
            Buffer.WriteLong .Speed
        End With
        SendDataToMap GetPlayerMap(Index), Buffer.ToArray()
        Set Buffer = Nothing
    End Sub

    Procure Por :

    Código:
    Private Type PlayerRec

    Acima Adicione :

    Código:
    Public Type ProjectileRec
        TravelTime As Long
        Direction As Long
        X As Long
        Y As Long
        Pic As Long
        Range As Long
        Damage As Long
        Speed As Long
    End Type

    No Final da Sub TemPlayererrec Adicione :

    Código:
    ProjecTile(1 To MAX_PLAYER_PROJECTILES) As ProjectileRec

    E no Final do ItemRec Adicione :

    Código:
     ProjecTile As ProjectileRec

    Pronto Tudo Terminado , Agora Já Está Pronto só executar


    ~Créditos :Ricardo e CaptainWabit

    Ricardo
    Administrador
    Administrador

    Mensagens : 5
    Level : 0
    Data de inscrição : 01/11/2011

    default Re: Itens Arrow´s ( flechas )

    Mensagem por Ricardo em Qua Nov 02, 2011 12:00 am

    Outro falude, creditos meu e de um carinha da touch death foruns
    avatar
    Thales12
    Administrador
    Administrador

    Mensagens : 140
    Level : 8
    Data de inscrição : 01/11/2011
    Idade : 23
    Localização : Rio de Janeiro

    default Re: Itens Arrow´s ( flechas )

    Mensagem por Thales12 em Qua Nov 02, 2011 1:31 am

    ~Créditos :Ricardo e CaptainWabit

    tu e cego ricardo ? '-'
    olha os creditos ai e.e

    Ricardo
    Administrador
    Administrador

    Mensagens : 5
    Level : 0
    Data de inscrição : 01/11/2011

    default Re: Itens Arrow´s ( flechas )

    Mensagem por Ricardo em Qua Nov 02, 2011 10:56 am

    Vo fala nada Thales, eu sei que vocês mudaram agora
    avatar
    FuckStyle
    Membro Ativo

    Mensagens : 49
    Level : 3
    Data de inscrição : 02/11/2011

    default Re: Itens Arrow´s ( flechas )

    Mensagem por FuckStyle em Qua Nov 02, 2011 12:50 pm

    Desculpe pelo spam Sad


    Última edição por FuckStyle em Qui Nov 03, 2011 3:15 pm, editado 1 vez(es)
    avatar
    Thales12
    Administrador
    Administrador

    Mensagens : 140
    Level : 8
    Data de inscrição : 01/11/2011
    Idade : 23
    Localização : Rio de Janeiro

    default Re: Itens Arrow´s ( flechas )

    Mensagem por Thales12 em Qua Nov 02, 2011 4:26 pm

    Ricardo escreveu:Vo fala nada Thales, eu sei que vocês mudaram agora

    se tivesse mudado estaria ali, ultima modificação tal dia etc.. ! '-'

    FuckStyle escreveu: Kkkkkkkkkkk

    FuckStyle isso e spam --'
    pow cara tu e moderador e dando uns molhes desses ? '-'
    tem q dar o exemplo '-'
    no proximo spam irei te punir

    Ricardo
    Administrador
    Administrador

    Mensagens : 5
    Level : 0
    Data de inscrição : 01/11/2011

    default Re: Itens Arrow´s ( flechas )

    Mensagem por Ricardo em Qui Nov 03, 2011 12:42 pm

    Não porque eu não sou cego viu...
    avatar
    FuckStyle
    Membro Ativo

    Mensagens : 49
    Level : 3
    Data de inscrição : 02/11/2011

    default Re: Itens Arrow´s ( flechas )

    Mensagem por FuckStyle em Qui Nov 03, 2011 3:14 pm

    Descupa ae thales e.e

    mas,Ricardo seu credito ja ta ali para de reclama e.e

    Conteúdo patrocinado

    default Re: Itens Arrow´s ( flechas )

    Mensagem por Conteúdo patrocinado


      Data/hora atual: Seg Dez 17, 2018 7:39 am