[EO]Sistema de Projeteis Com Munições

Client~Side

Crie uma frame com qualquer name e dentro dela crie: 4 labeis e 4 scrollbar com as seguintes configurações:

Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Label1
Name: lblProjectilePic
Caption: Pic: 0
scrlProjectilePic

Label2
Name: lblProjectileRange
Caption: Range: 0
scrlProjectileRange

Label3
Name: lblProjectileSpeed
Caption: Speed: 0
scrlProjectileSpeed

Label4
Name: lblProjectileDamage
Caption: Damage: 0
scrlProjectileDamage

E no final da frmEditor_Item adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

' projectile
Private Sub scrlProjectileDamage_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 scrlProjectilePic_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 scrlProjectileRange_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 scrlProjectileSpeed_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

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public Const MAX_PARTY_MEMBERS As Long = 4

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public Const MAX_PLAYER_PROJECTILES As Long = 20

Adicione isso no final do modDatabase:
Code: -------------------------------------------------------------Selecionar conteúdo

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

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public DDS_Bars As DirectDrawSurface7

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public DDS_Projectile() As DirectDrawSurface7

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public DDSD_Bars As DDSURFACEDESC2

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public DDSD_Projectile() As DDSURFACEDESC2

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public NumSpellIcons As Long

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public NumProjectiles As Long

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

For i = 1 To NumFaces
        Set DDS_Face(i) = Nothing
        ZeroMemory ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i))
    Next

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

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

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

SPartyVitals

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

SHandleProjectile

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

CPartyLeave

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

CProjecTileAttack

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

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

E acima adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

If frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_WEAPON Then
        frmEditor_Item.Frame4.Visible = True
        With Item(EditorIndex).ProjecTile
            frmEditor_Item.scrlProjectileDamage.Value = .Damage
            frmEditor_Item.scrlProjectilePic.Value = .Pic
            frmEditor_Item.scrlProjectileRange.Value = .Range
            frmEditor_Item.scrlProjectileSpeed.Value = .Speed
        End With
    End If

Mude toda a Public Sub CheckAttack() para:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

  Call CheckSpellIcons

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Call CheckProjectiles

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

  HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

HandleDataSub(SHandleProjectile) = GetAddress(AddressOf HandleProjectile)

No final do modHandleData adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Private Type PlayerRec

E acima adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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 do PlayerRec antes do End Type adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

' projectiles
    ProjecTile(1 To MAX_PLAYER_PROJECTILES) As ProjectileRec

No final do ItemRec antes do End Type adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

 ProjecTile As ProjectileRec

Serve~Side

Mude toda a Function CanPlayerAttackPlayer para:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public Const MAX_PARTY_MEMBERS As Long = 4

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public Const MAX_PLAYER_PROJECTILES As Long = 20

No findal do modDataBase adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

SPartyVitals

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

SHandleProjectile

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

CPartyLeave

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

CProjecTileAttack

Adicione isso no final do modGameLogic:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

HandleDataSub(CProjecTileAttack) = GetAddress(AddressOf HandleProjecTileAttack)

No final do modHandleData adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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:~
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

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

E abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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

Adicione isso no final do modServeTcp:
Code: -------------------------------------------------------------Selecionar conteúdo

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:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Private Type PlayerRec

E acima adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

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

Adicione isso no final do TempPlayerrec:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

 ProjecTile(1 To MAX_PLAYER_PROJECTILES) As ProjectileRec

E isso no final do ItemRec:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

ProjecTile As ProjectileRec

não esquecer de criar uma pasta em graphics com nome de Projectiles com as imagens dentro [Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]

agora vamo adicionar flechas balas etc...


Client

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

Public Type BuffRec
    Use As Byte
    SpellNum As Long
    tempo As Long
    target As Long

Abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

ammo as long
ammoreq as long

agora em frmEditor_item crie uma frame qalqer e crie uma checkbox com o nome de:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

ChkAmmo

e uma Scrollbar com nome de:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

scrlAmmo

e uma labem vom nome de:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

lblammo

dé 2 clicks em scrlAmmo e cole isso dentro:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

If scrlAmmo.Value > 0 Then
lblAmmo.Caption = "Weapon: " + Item(scrlAmmo.Value).name
Else
lblAmmo.Caption = "Weapon: None"
End If

Item(EditorIndex).Ammo = scrlAmmo.Value

depois 2 clicks em Chkammo e cole isto:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
Item(EditorIndex).ammoreq =Chkammo.Value

no frmeditor_item em baixo de:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

scrlPaperdoll.Max = NumPaperdolls

adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

ScrlAmmo.max = MAX_ITEMS

Procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

frmEditor_Item.txtDesc.text = Trim$(.Desc)

Abaixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

frmEditor_Item.ScrlAmmo.Value = Item(EditorIndex).Ammo
frmEditor_Item.Chkammo.Value = Item(EditorIndex).ammoreq

Server

em modtypes procure por:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

    LoopTime(0 To 1) As Long

em baixo adicione:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

ammo as long
ammoreq as long

em Modhandledata na sub Handleprojectileattack procura por
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

CurEquipment = GetPlayerEquipment(Index, Weapon)

adicione isso abaixo:
Code: -------------------------------------------------------------Selecionar conteúdo

Código:

If Item(CurEquipment).ammoreq > 0 Then

If HasItem(Index, Item(CurEquipment).ammo) <= 0 Then
Call PlayerMsg(Index, "You Dont Have Any Arrows!", BrightRed)
Exit Sub
End If
Call TakeInvItem(Index, Item(CurEquipment).ammo, 1)
End If