Coded by GSD, Tut by PresiseFA
Difficulty: 5/5
::::::::::::::::::
:: client side ::
::::::::::::::::::
ok, first in modDirectX, at the top, under:
Public DD_BackBuffer As DirectDrawSurface7
add:
Public DD_ArrowAnim As DirectDrawSurface7
then, under:
Public DDSD_BackBuffer As DDSURFACEDESC2
add:
Public DDSD_ArrowAnim As DDSURFACEDESC2
then, in Sub InitSurfaces, under:
' Init items ddsd type and load the bitmap
DDSD_Item.lFlags = DDSD_CAPS
DDSD_Item.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set DD_ItemSurf = DD.CreateSurfaceFromFile(App.Path & "\Items.bmp", DDSD_Item)
DD_ItemSurf.SetColorKey DDCKEY_SRCBLT, key
add:
' Init arrows ddsd type and load the bitmap
DDSD_ArrowAnim.lFlags = DDSD_CAPS
DDSD_ArrowAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
Set DD_ArrowAnim = DD.CreateSurfaceFromFile(App.Path & "\arrows.bmp", DDSD_ArrowAnim)
DD_ArrowAnim.SetColorKey DDCKEY_SRCBLT, key
then, in Sub DestroyDirectX, under:
Set DD_ItemSurf = Nothing
add:
Set DD_ArrowAnim = Nothing
then, at the very bottom of modDirectX, add this sub:
Sub BltArrow(ByVal Index As Long)
Dim X As Long, Y As Long, i As Long, z As Long
Dim BX As Long, BY As Long
For z = 1 To MAX_PLAYER_ARROWS
If Player(Index).Arrow(z).Arrow > 0 Then
rec.top = Player(Index).Arrow(z).ArrowAnim * PIC_Y
rec.Bottom = rec.top + PIC_Y
rec.Left = Player(Index).Arrow(z).ArrowPosition * PIC_X
rec.Right = rec.Left + PIC_X
If GetTickCount > Player(Index).Arrow(z).ArrowTime + 30 Then
Player(Index).Arrow(z).ArrowTime = GetTickCount
Player(Index).Arrow(z).ArrowVarX = Player(Index).Arrow(z).ArrowVarX + 10
Player(Index).Arrow(z).ArrowVarY = Player(Index).Arrow(z).ArrowVarY + 10
End If
If Player(Index).Arrow(z).ArrowPosition = 0 Then
X = Player(Index).Arrow(z).ArrowX
Y = Player(Index).Arrow(z).ArrowY + Int(Player(Index).Arrow(z).ArrowVarY / 32)
If Y > Player(Index).Arrow(z).ArrowY + Arrows(Player(Index).Arrow(z).ArrowNum).Range - 2 Then
Player(Index).Arrow(z).Arrow = 0
End If
If Y <= MAX_MAPY Then
Call DD_BackBuffer.BltFast((Player(Index).Arrow(z).ArrowX - NewPlayerX) * PIC_X + sx - NewXOffset, (Player(Index).Arrow(z).ArrowY - NewPlayerY) * PIC_Y + sx - NewYOffset + Player(Index).Arrow(z).ArrowVarY, DD_ArrowAnim, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End If
End If
If Player(Index).Arrow(z).ArrowPosition = 1 Then
X = Player(Index).Arrow(z).ArrowX
Y = Player(Index).Arrow(z).ArrowY - Int(Player(Index).Arrow(z).ArrowVarY / 32)
If Y < Player(Index).Arrow(z).ArrowY - Arrows(Player(Index).Arrow(z).ArrowNum).Range + 2 Then
Player(Index).Arrow(z).Arrow = 0
End If
If Y >= 0 Then
Call DD_BackBuffer.BltFast((Player(Index).Arrow(z).ArrowX - NewPlayerX) * PIC_X + sx - NewXOffset, (Player(Index).Arrow(z).ArrowY - NewPlayerY) * PIC_Y + sx - NewYOffset - Player(Index).Arrow(z).ArrowVarY, DD_ArrowAnim, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End If
End If
If Player(Index).Arrow(z).ArrowPosition = 2 Then
X = Player(Index).Arrow(z).ArrowX + Int(Player(Index).Arrow(z).ArrowVarX / 32)
Y = Player(Index).Arrow(z).ArrowY
If X > Player(Index).Arrow(z).ArrowX + Arrows(Player(Index).Arrow(z).ArrowNum).Range - 2 Then
Player(Index).Arrow(z).Arrow = 0
End If
If X <= MAX_MAPX Then
Call DD_BackBuffer.BltFast((Player(Index).Arrow(z).ArrowX - NewPlayerX) * PIC_X + sx - NewXOffset + Player(Index).Arrow(z).ArrowVarX, (Player(Index).Arrow(z).ArrowY - NewPlayerY) * PIC_Y + sx - NewYOffset, DD_ArrowAnim, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End If
End If
If Player(Index).Arrow(z).ArrowPosition = 3 Then
X = Player(Index).Arrow(z).ArrowX - Int(Player(Index).Arrow(z).ArrowVarX / 32)
Y = Player(Index).Arrow(z).ArrowY
If X < Player(Index).Arrow(z).ArrowX - Arrows(Player(Index).Arrow(z).ArrowNum).Range + 2 Then
Player(Index).Arrow(z).Arrow = 0
End If
If X >= 0 Then
Call DD_BackBuffer.BltFast((Player(Index).Arrow(z).ArrowX - NewPlayerX) * PIC_X + sx - NewXOffset - Player(Index).Arrow(z).ArrowVarX, (Player(Index).Arrow(z).ArrowY - NewPlayerY) * PIC_Y + sx - NewYOffset, DD_ArrowAnim, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End If
End If
If X >= 0 And X <= MAX_MAPX Then
If Y >= 0 And Y <= MAX_MAPY Then
If Map.Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex)).Type = TILE_TYPE_BLOCKED Then
Player(Index).Arrow(z).Arrow = 0
End If
End If
End If
For i = 1 To MAX_PLAYERS
If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
If GetPlayerX(i) = X And GetPlayerY(i) = Y Then
If Index = MyIndex Then
Call SendData("arrowhit" & SEP_CHAR & 0 & SEP_CHAR & i & SEP_CHAR & X & SEP_CHAR & Y & SEP_CHAR & END_CHAR)
End If
If Index <> i Then Player(Index).Arrow(z).Arrow = 0
Exit Sub
End If
End If
Next i
For i = 1 To MAX_MAP_NPCS
If MapNpc(i).Num > 0 Then
If MapNpc(i).X = X And MapNpc(i).Y = Y Then
If Index = MyIndex Then
Call SendData("arrowhit" & SEP_CHAR & 1 & SEP_CHAR & i & SEP_CHAR & X & SEP_CHAR & Y & SEP_CHAR & END_CHAR)
End If
Player(Index).Arrow(z).Arrow = 0
Exit Sub
End If
End If
Next i
'For BX = 0 To MAX_MAPX
' For BY = 0 To MAX_MAPY
' If Map(GetPlayerMap(MyIndex)).Tile(BX, BY).Type = TILE_TYPE_NPC_SPAWN Then
' For i = 1 To MAX_ATTRIBUTE_NPCS
' If MapAttributeNpc(i, BX, BY).X = X And MapAttributeNpc(i, BX, BY).Y = Y Then
' If Index = MyIndex Then
' Call SendData("arrowhit" & SEP_CHAR & 2 & SEP_CHAR & i & SEP_CHAR & X & SEP_CHAR & Y & SEP_CHAR & BX & SEP_CHAR & BY & SEP_CHAR & END_CHAR)
' End If
' Player(Index).Arrow(z).Arrow = 0
' Exit Sub
' End If
'Next i
' End If
' Next BY
'Next BX
End If
Next z
End Sub
Now, open up frmItemEditor, and in the fraEquipment, add a checkbox, name it chkBow, double click it, and add this:
Private Sub chkBow_Click()
Dim i As Long
If chkBow.Value = Unchecked Then
cmbBow.Clear
cmbBow.AddItem "None", 0
cmbBow.ListIndex = 0
cmbBow.Enabled = False
lblName.Caption = ""
Else
cmbBow.Clear
For i = 1 To MAX_ARROWS
cmbBow.AddItem i & ": " & Arrows(i).Name
Next i
cmbBow.ListIndex = 0
cmbBow.Enabled = True
End If
End Sub
Now, again in fraEquipment, add a combo box, name it cmbBow, double click it, and add this:
Private Sub cmbBow_Click()
lblName.Caption = Arrows(cmbBow.ListIndex + 1).Name
picBow.Top = (Arrows(cmbBow.ListIndex + 1).Pic * 32) * -1
End Sub
Now make a label next to cmbBow, and name it lblName.
[EDIT BY GSD]Right here should be picBow inside another picture box.... So:
Make a picture box and make the scale mode pixel.
Now make another picture box called picBox INSIDE the other picture box you make. Make the top and left equal 0, autoresize equal true and scale mode equal pixel.[/EDIT BY GSD]
Now double click anything on the form, and add this sub:
Private Sub Form_Load()
picBow.Picture = LoadPicture(App.Path & "\arrows.bmp")
End Sub
Now, open up frmIndex, and in cmdOK, under:
If InSpellEditor = True Then
Call SendData("EDITSPELL" & SEP_CHAR & EditorIndex & SEP_CHAR & END_CHAR)
End If
add:
If InArrowEditor = True Then
Call SendData("EDITARROW" & SEP_CHAR & EditorIndex & SEP_CHAR & END_CHAR)
End If
Now we have to add a new form, to edit the arrows. Add a new form, and name it frmEditArrows, on it, you need to make the following things:
Type: label Name: label1 caption: Name
Type: txtbox Name: txtName
Type: label Name: lblArrow caption: Arrow
Type: horizontal scroll bar Name: scrlArrow
[EDIT BY GSD]Right here should be picArrows inside another picture box.... So:
Make a picture box and make the scale mode pixel.
Now make another picture box called picArrows INSIDE the other picture box you make. Make the top and left equal 0, autoresize equal true and scale mode equal pixel.[/EDIT BY GSD]
Type: label Name: lblRange caption: Range
Type: horizontal scroll bar Name: scrlRange
Type: command button Name: cmdOK caption: OK
Type: command button Name: command1 caption: Cancel
Then, double click anywhere on the form, and add this code:
Private Sub cmdOk_Click()
Call ArrowEditorOk
End Sub
Private Sub Command1_Click()
Call ArrowEditorCancel
End Sub
Private Sub scrlArrow_Change()
lblArrow.Caption = "Arrow: " & scrlArrow.Value
picArrows.Top = (scrlArrow.Value * 32) * -1
End Sub
Private Sub scrlRange_Change()
lblRange.Caption = "Range: " & scrlRange.Value
End Sub
Now, open up modTypes, and add these towards the top:
Public Const MAX_ARROWS = 100
Public Const MAX_PLAYER_ARROWS = 100
then, along with the rest of the types, add this:
Type PlayerArrowRec
Arrow As Byte
ArrowNum As Long
ArrowAnim As Long
ArrowTime As Long
ArrowVarX As Long
ArrowVarY As Long
ArrowX As Long
ArrowY As Long
ArrowPosition As Byte
End Type
then, at the bottom of Type PlayerRec, add this:
Arrow(1 To MAX_PLAYER_ARROWS) As PlayerArrowRec
again, add this in with the other types:
Type ArrowRec
Name As String
Pic As Long
Range As Byte
End Type
Public Arrows(1 To MAX_ARROWS) As ArrowRec
Now, on to modGameLogic, open it up, and search for this:
' used for index based editor
and under:
Public InSpellEditor As Boolean
add:
Public InArrowEditor As Boolean
then in Sub Main, under:
InShopEditor = False
add:
InArrowEditor = False
Then, in GameLoop, above:
' Blit out players
add:
' Blit out arrows
For i = 1 To MAX_PLAYERS
If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
Call BltArrow(i)
End If
Next i
Now, lets add the command to edit the arrows:
search for this:
' // Developer Admin Commands //
and somewhere under that, add:
' Editing arrow request
If Mid(MyText, 1, 13) = "/editarrow" Then
Call SendRequestEditArrow
MyText = ""
Exit Sub
End If
Then, at the bottom of modGameLogic, add these subs:
Public Sub ArrowEditorInit()
frmEditArrows.scrlArrow.Max = MAX_ARROWS
If Arrows(EditorIndex).Pic = 0 Then Arrows(EditorIndex).Pic = 1
frmEditArrows.scrlArrow.Value = Arrows(EditorIndex).Pic
frmEditArrows.txtName.Text = Arrows(EditorIndex).Name
If Arrows(EditorIndex).Range = 0 Then Arrows(EditorIndex).Range = 1
frmEditArrows.scrlRange.Value = Arrows(EditorIndex).Range
frmEditArrows.picArrows.Picture = LoadPicture(App.Path & "\GFX\arrows.bmp")
frmEditArrows.Show vbModal
End Sub
Public Sub ArrowEditorOk()
Arrows(EditorIndex).Pic = frmEditArrows.scrlArrow.Value
Arrows(EditorIndex).Range = frmEditArrows.scrlRange.Value
Arrows(EditorIndex).Name = frmEditArrows.txtName.Text
Call SendSaveArrow(EditorIndex)
Call ArrowEditorCancel
End Sub
Public Sub ArrowEditorCancel()
InArrowEditor = False
Unload frmEditArrows
End Sub
Now, in Sub ItemEditorInit, at the top, add this:
Dim i As Long
then, under:
If (frmItemEditor.cmbType.ListIndex >= ITEM_TYPE_WEAPON) And (frmItemEditor.cmbType.ListIndex <= ITEM_TYPE_SHIELD) Or (frmItemEditor.cmbType.ListIndex >= ITEM_TYPE_BOOTS) And (frmItemEditor.cmbType.ListIndex <= ITEM_TYPE_BOW) Then
frmItemEditor.fraEquipment.Visible = True
frmItemEditor.scrlDurability.Value = Item(EditorIndex).Data1
frmItemEditor.scrlStrength.Value = Item(EditorIndex).Data2
replace the .data3 information with this:
If Item(EditorIndex).Data3 > 0 Then
frmItemEditor.chkBow.Value = Checked
Else
frmItemEditor.chkBow.Value = Unchecked
End If
frmItemEditor.cmbBow.Clear
If frmItemEditor.chkBow.Value = Checked Then
For i = 1 To 100
frmItemEditor.cmbBow.AddItem i & ": " & Arrows(i).Name
Next i
frmItemEditor.cmbBow.ListIndex = Item(EditorIndex).Data3 - 1
frmItemEditor.picBow.Top = (Arrows(Item(EditorIndex).Data3).Pic * 32) * -1
frmItemEditor.cmbBow.Enabled = True
Else
frmItemEditor.cmbBow.AddItem "None"
frmItemEditor.cmbBow.ListIndex = 0
frmItemEditor.cmbBow.Enabled = False
End If
then, in Sub ItemEditorOK, under:
If (frmItemEditor.cmbType.ListIndex >= ITEM_TYPE_WEAPON) And (frmItemEditor.cmbType.ListIndex <= ITEM_TYPE_SHIELD) Or (frmItemEditor.cmbType.ListIndex >= ITEM_TYPE_BOOTS) And (frmItemEditor.cmbType.ListIndex <= ITEM_TYPE_BOW) Then
Item(EditorIndex).Data1 = frmItemEditor.scrlDurability.Value
Item(EditorIndex).Data2 = frmItemEditor.scrlStrength.Value
replace the .data3 with this:
If frmItemEditor.chkBow.Value = Checked Then
Item(EditorIndex).Data3 = frmItemEditor.cmbBow.ListIndex + 1
Else
Item(EditorIndex).Data3 = 0
End If
End If
now, open up modClientTCP, and in Sub HandleData, add this anywhere:
' ::::::::::::::::::::::::::::
' :: Arrow editor packet ::
' ::::::::::::::::::::::::::::
If (LCase(Parse(0)) = "arroweditor") Then
InArrowEditor = True
frmIndex.Show
frmIndex.lstIndex.Clear
For i = 1 To MAX_ARROWS
frmIndex.lstIndex.AddItem i & ": " & Trim(Arrows(i).Name)
Next i
frmIndex.lstIndex.ListIndex = 0
Exit Sub
End If
If (LCase(Parse(0)) = "updatearrow") Then
n = Val(Parse(1))
Arrows(n).Name = Parse(2)
Arrows(n).Pic = Val(Parse(3))
Arrows(n).Range = Val(Parse(4))
Exit Sub
End If
If (LCase(Parse(0)) = "editarrow") Then
n = Val(Parse(1))
Arrows(n).Name = Parse(2)
Call ArrowEditorInit
Exit Sub
End If
If (LCase(Parse(0)) = "updatearrow") Then
n = Val(Parse(1))
Arrows(n).Name = Parse(2)
Arrows(n).Pic = Val(Parse(3))
Arrows(n).Range = Val(Parse(4))
Exit Sub
End If
If (LCase(Parse(0)) = "checkarrows") Then
n = Val(Parse(1))
z = Val(Parse(2))
i = Val(Parse(3))
For x = 1 To MAX_PLAYER_ARROWS
If Player(n).Arrow(x).Arrow = 0 Then
Player(n).Arrow(x).Arrow = 1
Player(n).Arrow(x).ArrowNum = z
Player(n).Arrow(x).ArrowAnim = Arrows(z).Pic
Player(n).Arrow(x).ArrowTime = GetTickCount
Player(n).Arrow(x).ArrowVarX = 0
Player(n).Arrow(x).ArrowVarY = 0
Player(n).Arrow(x).ArrowY = GetPlayerY(n)
Player(n).Arrow(x).ArrowX = GetPlayerX(n)
If i = DIR_DOWN Then
Player(n).Arrow(x).ArrowY = GetPlayerY(n) + 1
Player(n).Arrow(x).ArrowPosition = 0
If Player(n).Arrow(x).ArrowY - 1 > MAX_MAPY Then
Player(n).Arrow(x).Arrow = 0
Exit Sub
End If
End If
If i = DIR_UP Then
Player(n).Arrow(x).ArrowY = GetPlayerY(n) - 1
Player(n).Arrow(x).ArrowPosition = 1
If Player(n).Arrow(x).ArrowY + 1 < 0 Then
Player(n).Arrow(x).Arrow = 0
Exit Sub
End If
End If
If i = DIR_RIGHT Then
Player(n).Arrow(x).ArrowX = GetPlayerX(n) + 1
Player(n).Arrow(x).ArrowPosition = 2
If Player(n).Arrow(x).ArrowX - 1 > MAX_MAPX Then
Player(n).Arrow(x).Arrow = 0
Exit Sub
End If
End If
If i = DIR_LEFT Then
Player(n).Arrow(x).ArrowX = GetPlayerX(n) - 1
Player(n).Arrow(x).ArrowPosition = 3
If Player(n).Arrow(x).ArrowX + 1 < 0 Then
Player(n).Arrow(x).Arrow = 0
Exit Sub
End If
End If
Exit For
End If
Next x
Exit Sub
End If
now, at the bottom of modClientTCP, add these subs:
Sub SendRequestEditArrow()
Dim Packet As String
Packet = "REQUESTEDITARROW" & SEP_CHAR & END_CHAR
Call SendData(Packet)
End Sub
Sub SendSaveArrow(ByVal ArrowNum As Long)
Dim Packet As String
Packet = "SAVEARROW" & SEP_CHAR & ArrowNum & SEP_CHAR & Trim(Arrows(ArrowNum).Name) & SEP_CHAR & Arrows(ArrowNum).Pic & SEP_CHAR & Arrows(ArrowNum).Range & SEP_CHAR & END_CHAR
Call SendData(Packet)
End Sub
At the top of modGameLogic, add these:
Public NewPlayerX As Long
Public NewPlayerY As Long
Public NewXOffset As Long
Public NewYOffset As Long
Public NewX As Long
Public NewY As Long
Public sx As Long
Thats it for the client side of this tutorial. On to the server side!
::::::::::::::::::::
:: Server Side ::
::::::::::::::::::::
open up modDatabase and at the bottom of it, add these subs:
Sub LoadArrows()
Dim FileName As String
Dim I As Long
Call CheckArrows
FileName = App.Path & "\Arrows.ini"
For I = 1 To MAX_ARROWS
Call SetStatus("Loading Arrows... " & I & "/" & MAX_ARROWS)
Arrows(I).Name = GetVar(FileName, "Arrow" & I, "ArrowName")
Arrows(I).Pic = GetVar(FileName, "Arrow" & I, "ArrowPic")
Arrows(I).Range = GetVar(FileName, "Arrow" & I, "ArrowRange")
DoEvents
Next I
End Sub
Sub CheckArrows()
If Not FileExist("Arrows.ini") Then
Dim I As Long
For I = 1 To MAX_ARROWS
Call SetStatus("Saving arrows... " & I & "/" & MAX_ARROWS)
DoEvents
Call PutVar(App.Path & "\Arrows.ini", "Arrow" & I, "ArrowName", "")
Call PutVar(App.Path & "\Arrows.ini", "Arrow" & I, "ArrowPic", 0)
Call PutVar(App.Path & "\Arrows.ini", "Arrow" & I, "ArrowRange", 0)
Next I
End If
End Sub
Sub ClearArrows()
Dim I As Long
For I = 1 To MAX_ARROWS
Arrows(I).Name = ""
Arrows(I).Pic = 0
Arrows(I).Range = 0
Next I
End Sub
Sub SaveArrow(ByVal ArrowNum As Long)
Dim FileName As String
FileName = App.Path & "\Arrows.ini"
Call PutVar(FileName, "Arrow" & ArrowNum, "ArrowName", Trim(Arrows(ArrowNum).Name))
Call PutVar(FileName, "Arrow" & ArrowNum, "ArrowPic", Val(Arrows(ArrowNum).Pic))
Call PutVar(FileName, "Arrow" & ArrowNum, "ArrowRange", Val(Arrows(ArrowNum).Range))
End Sub
now open up modTypes, and add this, im sure you know where by now
Public Const MAX_ARROWS = 100
Type ArrowRec
Name As String
Pic As Long
Range As Byte
End Type
Public Arrows(1 To MAX_ARROWS) As ArrowRec
now, open up modGameLogic, and in Sub JoinGame, under:
Call SendItems(Index)
add:
Call SendArrows(index)
now, open up modGeneral, and in Sub InitSever, under:
Call SetStatus("Clearing spells...")
Call ClearSpells
add:
Call SetStatus("Clearing arrows...")
Call ClearArrows
then, under:
Call SetStatus("Loading spells...")
Call LoadSpells
add:
Call SetStatus("Loading arrows...")
Call LoadArrows
now, open up modServerTCP, and in Sub HandleData, at the top of the Player Attack Packet, but below:
If LCase(Parse(0)) = "attack" Then
add this:
If GetPlayerWeaponSlot(index) > 0 Then
If Item(GetPlayerInvItemNum(index, GetPlayerWeaponSlot(index))).Data3 > 0 Then
Call SendDataToMap(GetPlayerMap(index), "checkarrows" & SEP_CHAR & index & SEP_CHAR & Item(GetPlayerInvItemNum(index, GetPlayerWeaponSlot(index))).Data3 & SEP_CHAR & GetPlayerDir(index) & SEP_CHAR & END_CHAR)
Exit Sub
End If
End If
then, anywhere in Sub HandleData, add these:
'::::::::::::::::::::::::
':: request edit arrow ::
'::::::::::::::::::::::::
If LCase(Parse(0)) = "requesteditarrow" Then
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call HackingAttempt(Index, "Admin Cloning")
Exit Sub
End If
Call SendDataTo(Index, "arrowEDITOR" & SEP_CHAR & END_CHAR)
Exit Sub
End If
'::::::::::::::::
':: edit arrow ::
'::::::::::::::::
If LCase(Parse(0)) = "editarrow" Then
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call HackingAttempt(Index, "Admin Cloning")
Exit Sub
End If
n = Val(Parse(1))
If n < 0 Or n > MAX_ARROWS Then
Call HackingAttempt(Index, "Invalid arrow Index")
Exit Sub
End If
Call AddLog(GetPlayerName(Index) & " editing arrow #" & n & ".", ADMIN_LOG)
Call SendEditArrowTo(Index, n)
Exit Sub
End If
'::::::::::::::::
':: save arrow ::
'::::::::::::::::
If LCase(Parse(0)) = "savearrow" Then
If GetPlayerAccess(Index) < ADMIN_DEVELOPER Then
Call HackingAttempt(Index, "Admin Cloning")
Exit Sub
End If
n = Val(Parse(1))
If n < 0 Or n > MAX_ITEMS Then
Call HackingAttempt(Index, "Invalid arrow Index")
Exit Sub
End If
Arrows(n).Name = Parse(2)
Arrows(n).Pic = Val(Parse(3))
Arrows(n).Range = Val(Parse(4))
Call SendUpdateArrowToAll(n)
Call SaveArrow(n)
Call AddLog(GetPlayerName(Index) & " saved arrow #" & n & ".", ADMIN_LOG)
Exit Sub
End If
':::::::::::::::::
':: check arrow ::
':::::::::::::::::
If LCase(Parse(0)) = "checkarrows" Then
n = Arrows(Val(Parse(1))).Pic
Call SendDataToMap(GetPlayerMap(Index), "checkarrows" & SEP_CHAR & Index & SEP_CHAR & n & SEP_CHAR & END_CHAR)
Exit Sub
End If
If LCase(Parse(0)) = "arrowhit" Then
n = Val(Parse(1))
z = Val(Parse(2))
x = Val(Parse(3))
y = Val(Parse(4))
If n = TARGET_TYPE_PLAYER Then
' Make sure we dont try to attack ourselves
If z <> Index Then
' Can we attack the player?
'If CanAttackPlayer(index, z) Then
If Not CanPlayerBlockHit(z) Then
' Get the damage we can do
If Not CanPlayerCriticalHit(Index) Then
Damage = GetPlayerDamage(Index) - GetPlayerProtection(z)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "attack" & SEP_CHAR & END_CHAR)
Else
n = GetPlayerDamage(Index)
Damage = n + Int(Rnd * Int(n / 2)) + 1 - GetPlayerProtection(z)
'Call BattleMsg(Index, "You feel a surge of energy upon shooting!", BrightCyan, 0)
'Call BattleMsg(z, GetPlayerName(Index) & " shoots with amazing accuracy!", BrightCyan, 1)
Call PlayerMsg(Index, "You feel a surge of energy upon shooting!", BrightCyan)
Call PlayerMsg(z, GetPlayerName(Index) & " shoots with amazing accuracy!", BrightCyan)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "critical" & SEP_CHAR & END_CHAR)
End If
If Damage > 0 Then
Call AttackPlayer(Index, z, Damage)
Else
'Call BattleMsg(Index, "Your attack does nothing.", BrightRed, 0)
'Call BattleMsg(z, GetPlayerName(z) & "'s attack did nothing.", BrightRed, 1)
Call PlayerMsg(Index, "Your attack does nothing.", BrightRed)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "miss" & SEP_CHAR & END_CHAR)
End If
Else
'Call BattleMsg(Index, GetPlayerName(z) & " blocked your hit!", BrightCyan, 0)
'Call BattleMsg(z, "You blocked " & GetPlayerName(Index) & "'s hit!", BrightCyan, 1)
Call PlayerMsg(Index, GetPlayerName(z) & "'s " & Trim(Item(GetPlayerInvItemNum(z, GetPlayerShieldSlot(z))).Name) & " has blocked your hit!", BrightCyan)
Call PlayerMsg(z, "Your " & Trim(Item(GetPlayerInvItemNum(z, GetPlayerShieldSlot(z))).Name) & " has blocked " & GetPlayerName(Index) & "'s hit!", BrightCyan)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "miss" & SEP_CHAR & END_CHAR)
End If
Exit Sub
'End If
End If
ElseIf n = TARGET_TYPE_NPC Then
' Can we attack the npc?
'If CanAttackNpc(index, z) Then
' Get the damage we can do
If Not CanPlayerCriticalHit(Index) Then
Damage = GetPlayerDamage(Index) - Int(Npc(MapNpc(GetPlayerMap(Index), z).Num).DEF / 2)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "attack" & SEP_CHAR & END_CHAR)
Else
n = GetPlayerDamage(Index)
Damage = n + Int(Rnd * Int(n / 2)) + 1 - Int(Npc(MapNpc(GetPlayerMap(Index), z).Num).DEF / 2)
'Call BattleMsg(Index, "You feel a surge of energy upon shooting!", BrightCyan, 0)
Call PlayerMsg(Index, "You feel a surge of energy upon swinging!", BrightCyan)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "critical" & SEP_CHAR & END_CHAR)
End If
If Damage > 0 Then
Call AttackNpc(Index, z, Damage)
Call SendDataTo(Index, "BLITPLAYERDMG" & SEP_CHAR & Damage & SEP_CHAR & z & SEP_CHAR & END_CHAR)
Else
'Call BattleMsg(Index, "Your attack does nothing.", BrightRed, 0)
Call PlayerMsg(Index, "Your attack does nothing.", BrightRed)
Call SendDataTo(Index, "BLITPLAYERDMG" & SEP_CHAR & Damage & SEP_CHAR & z & SEP_CHAR & END_CHAR)
Call SendDataToMap(GetPlayerMap(Index), "sound" & SEP_CHAR & "miss" & SEP_CHAR & END_CHAR)
End If
Exit Sub
End If
Exit Sub
End If
then, at the end of modServerTCP, add these subs:
Sub SendArrows(ByVal index As Long)
Dim Packet As String
Dim I As Long
For I = 1 To MAX_ARROWS
Call SendUpdateArrowTo(index, I)
Next I
End Sub
Sub SendUpdateArrowToAll(ByVal ItemNum As Long)
Dim Packet As String
Packet = "UPDATEArrow" & SEP_CHAR & ItemNum & SEP_CHAR & Trim(Arrows(ItemNum).Name) & SEP_CHAR & Arrows(ItemNum).Pic & SEP_CHAR & Arrows(ItemNum).Range & SEP_CHAR & END_CHAR
Call SendDataToAll(Packet)
End Sub
Sub SendUpdateArrowTo(ByVal index As Long, ByVal ItemNum As Long)
Dim Packet As String
Packet = "UPDATEArrow" & SEP_CHAR & ItemNum & SEP_CHAR & Trim(Arrows(ItemNum).Name) & SEP_CHAR & Arrows(ItemNum).Pic & SEP_CHAR & Arrows(ItemNum).Range & SEP_CHAR & END_CHAR
Call SendDataTo(index, Packet)
End Sub
Sub SendEditArrowTo(ByVal index As Long, ByVal EmoNum As Long)
Dim Packet As String
Packet = "EDITArrow" & SEP_CHAR & EmoNum & SEP_CHAR & Trim(Arrows(EmoNum).Name) & SEP_CHAR & END_CHAR
Call SendDataTo(index, Packet)
End Sub
thats it for the tut! you now have working ranged weapons!
make sure you download this file:
http://neverfound.faproductions.net/images/arrows.bmp
|