Conexão Maker

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

    Sistema de Flecha por Item

    Thales12
    Thales12
    Administrador
    Administrador


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

    Sistema de Flecha por Item Empty Sistema de Flecha por Item

    Mensagem por Thales12 Seg Fev 13, 2012 12:24 am

    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

      Data/hora atual: Qui Mar 28, 2024 9:09 am