Client~Side
Crie uma frame com qualquer name e dentro dela crie: 4 labeis e 4 scrolBlox com as seguintes configurações:
E no final da frmEditor_Item adicione:
Procure por:
E abaixo adicione:
Adicione isso no final do modDatabase:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
Agora adicione isso no final do modDirectDraw7:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
Procure por:
E acima adicione:
Mude toda a Public Sub CheckAttack() para:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
No final do modHandleData adicione:
Procure por:
E acima adicione:
No final do PlayerRec antes do End Type adicione:
No final do ItemRec antes do End Type adicione:
Serve~Side
Mude toda a Function CanPlayerAttackPlayer para:
Procure por:
E abaixo adicione:
No findal do modDataBase adicione:
Procure por:
E abaixo adicione:
Procure por:
E abaixo adicione:
Adicione isso no final do modGameLogic:
Procure por:
E abaixo adicione:
No final do modHandleData adicione:
Procure por:
E abaixo adicione:
Adicione isso no final do modServeTcp:
Procure por:
E acima adicione:
Adicione isso no final do TempPlayerrec:
E isso no final do ItemRec:
Creditos:
Captain Wabbit
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