Itens Arrow´s ( flechas )

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