Arena RPG Maker
Olá, visitante!
Seja bem-vindo ao fórum Arena RPG Maker, caso queira aprender sobre criação de jogos, está no fórum certo. Esperamos que possa aprender tanto quanto possa nos ensinar aqui.

Atenciosamente,
Equipe Arena RPG Maker.
Arena RPG Maker
Olá, visitante!
Seja bem-vindo ao fórum Arena RPG Maker, caso queira aprender sobre criação de jogos, está no fórum certo. Esperamos que possa aprender tanto quanto possa nos ensinar aqui.

Atenciosamente,
Equipe Arena RPG Maker.
Arena RPG Maker

Estamos de volta o/ ... Ou não.Eu amo a -Dark
Doações para o fórum abertas, clique aqui e saiba mais.
Últimos assuntos
» Ainda temos gente aqui?
item - Sistema de flechas por item EmptyQui 25 Nov 2021, 14:04 por Halt

» [Dúvida] Como tirar a porcentagem de esquiva
item - Sistema de flechas por item EmptySex 19 Nov 2021, 17:14 por Halt

» Pokémon Genesis Online! (PGO)
item - Sistema de flechas por item EmptyQua 05 Jul 2017, 18:08 por Lexar

» Tileset Converter to MV
item - Sistema de flechas por item EmptySex 12 maio 2017, 14:07 por Douggi

» Pack Resources, Sprites e etc
item - Sistema de flechas por item EmptyQua 23 Dez 2015, 12:30 por raydengv

» Download RPG Maker 2003 + RTP em português
item - Sistema de flechas por item EmptyTer 22 Dez 2015, 11:14 por ::KimMax::

» Fantasy Art Online
item - Sistema de flechas por item EmptyDom 18 Out 2015, 18:42 por daviih123

» Você vai ter medo do Nerve gear?
item - Sistema de flechas por item EmptySáb 25 Jul 2015, 17:02 por Kirito-kun

» O Barato é louco
item - Sistema de flechas por item EmptySáb 27 Jun 2015, 16:26 por Halt

» Download RPG Maker 2000 + RTP em português
item - Sistema de flechas por item EmptyQui 21 maio 2015, 20:28 por Wismael


Você não está conectado. Conecte-se ou registre-se

Ver o tópico anterior Ver o tópico seguinte Ir para baixo  Mensagem [Página 1 de 1]

1Tutorial Sistema de flechas por item Sex 11 Jan 2013, 13:39

Halt

Halt
Administrador
Administrador
jadieljr escreveu:
Client~Side

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

Label1
Name: lblProjectilePic
Caption: Pic: 0

Label2
Name: lblProjectileRange
Caption: Range: 0

Label3
Name: lblProjectileSpeed
Caption: Speed: 0

Label4
Name: lblProjectileDamage
Caption: Damage: 0


E no final da frmEditor_Item adicione:

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:

Código:
Public Const MAX_PARTY_MEMBERS As Long = 4


E abaixo adicione:

Código:
Public Const MAX_PLAYER_PROJECTILES As Long = 20


Adicione isso no final do modDatabase:

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:

Código:
Public DDS_Bars As DirectDrawSurface7


E abaixo adicione:

Código:
Public DDS_Projectile() As DirectDrawSurface7


Procure por:

Código:
Public DDSD_Bars As DDSURFACEDESC2


E abaixo adicione:

Código:
Public DDSD_Projectile() As DDSURFACEDESC2


Procure por:

Código:
Public NumSpellIcons As Long


E abaixo adicione:

Código:
Public NumProjectiles As Long


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


E 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


E 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


E abaixo adicione:

Código:
    SHandleProjectile


Procure por:

Código:
    CPartyLeave


E 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


E acima adicione:

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:

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


E abaixo adicione:

Código:
    Call CheckProjectiles


Procure por:

Código:
    HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)


E abaixo adicione:

Código:
    HandleDataSub(SHandleProjectile) = GetAddress(AddressOf HandleProjectile)


No final do 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


E 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 do PlayerRec antes do End Type adicione:

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


No final do ItemRec antes do End Type adicione:

Código:
    ProjecTile As ProjectileRec


Serve~Side

Mude toda a Function CanPlayerAttackPlayer 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


E abaixo adicione:

Código:
Public Const MAX_PLAYER_PROJECTILES As Long = 20


No findal do 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


E abaixo adicione:

Código:
    SHandleProjectile


Procure por:

Código:
    CPartyLeave


E abaixo adicione:

Código:
    CProjecTileAttack


Adicione isso no final do modGameLogic:

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)


E 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


E 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


Adicione isso no final do modServeTcp:

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


E 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


Adicione isso no final do TempPlayerrec:

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


E isso no final do ItemRec:

Código:
    ProjecTile As ProjectileRec


Creditos:

Captain Wabbit

https://arenarpgmaker.forumeiros.com

Ver o tópico anterior Ver o tópico seguinte Ir para o topo  Mensagem [Página 1 de 1]

Permissões neste sub-fórum
Não podes responder a tópicos