Well I basically copied the Class system & modified it so it's Races instead. But I don't know how to make it so it says the Race on the Character Selection Screen. & For some reason I am now unable to login.(Should be too do with the Race system?)
Here's the whole Race script:
CLIENTSIDE
Code:
--- modClientTCP ---
Sub SendAddChar(ByVal Name As String, ByVal Sex As Long, ByVal ClassNum As Long, ByVal Slot As Long) ' ByVal RaceNum As Long) Unblock this & I get errors
Dim Packet As String
Packet = CAddChar & SEP_CHAR & Trim$(Name) & SEP_CHAR & Sex & SEP_CHAR & ClassNum & SEP_CHAR & Slot & END_CHAR ' & SEP_CHAR & RaceNum & END_CHAR Unblock this & I get errors
Call SendData(Packet)
End Sub
Sub SendGetRaces()
Dim Packet As String
Packet = CGetRaces & END_CHAR
Call SendData(Packet)
End Sub
Public Sub SendSaveSpell(ByVal SpellNum As Long)
Dim Packet As String
With Spell(SpellNum)
Packet = CSaveSpell & SEP_CHAR & SpellNum & SEP_CHAR & Trim$(.Name) & SEP_CHAR & .ClassReq & SEP_CHAR & .RaceReq & SEP_CHAR & .LevelReq & SEP_CHAR & .Type & SEP_CHAR & .Data1 & SEP_CHAR & .Data2 & SEP_CHAR & .Data3 & END_CHAR
End With
Call SendData(Packet)
End Sub
Code:
--- modDatabase ---
Function GetPlayerRace(ByVal Index As Long) As Long
GetPlayerRace = Player(Index).Race
End Function
Sub SetPlayerRace(ByVal Index As Long, ByVal RaceNum As Long)
Player(Index).Race = RaceNum
End Sub
Code:
--- modEnumerations ---
CGetRaces
Code:
--- modGameEditors ---
Public Sub SpellEditorInit()
Dim i As Long
frmSpellEditor.cmbClassReq.AddItem "All Classes"
For i = 1 To Max_Classes
frmSpellEditor.cmbClassReq.AddItem Trim$(Class(i).Name)
Next i
frmSpellEditor.cmbRaceReq.AddItem "All Races"
For i = 1 To Max_Races
frmSpellEditor.cmbRaceReq.AddItem Trim$(Race(i).Name)
Next i
frmSpellEditor.txtName.Text = Trim$(Spell(EditorIndex).Name)
frmSpellEditor.cmbClassReq.ListIndex = Spell(EditorIndex).ClassReq
frmSpellEditor.cmbRaceReq.ListIndex = Spell(EditorIndex).RaceReq
frmSpellEditor.scrlLevelReq.Value = Spell(EditorIndex).LevelReq
frmSpellEditor.cmbType.ListIndex = Spell(EditorIndex).Type
If Spell(EditorIndex).Type <> SPELL_TYPE_GIVEITEM Then
frmSpellEditor.fraVitals.Visible = True
frmSpellEditor.fraGiveItem.Visible = False
frmSpellEditor.scrlVitalMod.Value = Spell(EditorIndex).Data1
Else
frmSpellEditor.fraVitals.Visible = False
frmSpellEditor.fraGiveItem.Visible = True
frmSpellEditor.scrlItemNum.Value = Spell(EditorIndex).Data1
frmSpellEditor.scrlItemValue.Value = Spell(EditorIndex).Data2
End If
frmSpellEditor.Show vbModal
End Sub
Public Sub SpellEditorOk()
Spell(EditorIndex).Name = frmSpellEditor.txtName.Text
Spell(EditorIndex).ClassReq = frmSpellEditor.cmbClassReq.ListIndex
Spell(EditorIndex).RaceReq = frmSpellEditor.cmbRaceReq.ListIndex
Spell(EditorIndex).LevelReq = frmSpellEditor.scrlLevelReq.Value
Spell(EditorIndex).Type = frmSpellEditor.cmbType.ListIndex
If Spell(EditorIndex).Type <> SPELL_TYPE_GIVEITEM Then
Spell(EditorIndex).Data1 = frmSpellEditor.scrlVitalMod.Value
Else
Spell(EditorIndex).Data1 = frmSpellEditor.scrlItemNum.Value
Spell(EditorIndex).Data2 = frmSpellEditor.scrlItemValue.Value
End If
Spell(EditorIndex).Data3 = 0
Call SendSaveSpell(EditorIndex)
InSpellEditor = False
Unload frmSpellEditor
End Sub
Code:
--- modGlobals ---
' Maximum races
Public Max_Races As Byte
Code:
--- modHandleData ---
' :::::::::::::::::::::::::::::::::::::::
' :: New character races data packet ::
' :::::::::::::::::::::::::::::::::::::::
Case "newcharraces"
n = 1
' Max races
Max_Races = Val(Parse(n))
ReDim Race(1 To Max_Races) As RaceRec
n = n + 1
For i = 1 To Max_Races
Race(i).Name = Parse(n)
n = n + 1
Next i
' Used for if the player is creating a new character
frmNewChar.Visible = True
frmSendGetData.Visible = False
frmNewChar.cmbRace.Clear
For i = 1 To Max_Races
frmNewChar.cmbRace.AddItem Trim$(Race(i).Name)
Next i
frmNewChar.cmbRace.ListIndex = 0
n = frmNewChar.cmbRace.ListIndex + 1
Exit Sub
' :::::::::::::::::::::::::
' :: Races data packet ::
' :::::::::::::::::::::::::
Case "racesdata"
n = 1
' Max races
Max_Races = Val(Parse(n))
ReDim Race(1 To Max_Races) As RaceRec
n = n + 1
For i = 1 To Max_Races
Race(i).Name = Parse(n)
n = n + 1
Next i
Exit Sub
Case "editspell"
n = Val(Parse(1))
' Update the spell
Spell(n).Name = Parse(2)
Spell(n).ClassReq = Val(Parse(3))
Spell(n).LevelReq = Val(Parse(4))
Spell(n).Type = Val(Parse(5))
Spell(n).Data1 = Val(Parse(6))
Spell(n).Data2 = Val(Parse(7))
Spell(n).Data3 = Val(Parse(8))
Spell(n).RaceReq = Val(Parse(9))
' Initialize the spell editor
Call SpellEditorInit
Exit Sub
Code:
--- modTypes---
Public Race() As RaceRec
Type PlayerRec
' General
Name As String * NAME_LENGTH
Class As Byte
Race As Byte
Sprite As Integer
Level As Byte
Exp As Long
Access As Byte
PK As Byte
Type RaceRec
Name As String * NAME_LENGTH
End Type
Type SpellRec
Name As String * NAME_LENGTH
ClassReq As Byte
RaceReq As Byte
LevelReq As Byte
Type As Byte
Data1 As Integer
Data2 As Integer
Data3 As Integer
End Type
SERVERSIDE
Code:
--- modDatabase ---
Sub AddChar(ByVal Index As Long, ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Byte, ByVal CharNum As Long, ByVal RaceNum As Byte)
Dim f As Long
Dim n As Long
If LenB(Trim$(Player(Index).Char(CharNum).Name)) = 0 Then
TempPlayer(Index).CharNum = CharNum
Player(Index).Char(CharNum).Name = Name
Player(Index).Char(CharNum).Sex = Sex
Player(Index).Char(CharNum).Class = ClassNum
Player(Index).Char(CharNum).Race = RaceNum
If Player(Index).Char(CharNum).Sex = SEX_MALE Then
Player(Index).Char(CharNum).Sprite = Class(ClassNum).Sprite
Else
Player(Index).Char(CharNum).Sprite = Class(ClassNum).Sprite
End If
Player(Index).Char(CharNum).Level = 1
For n = 1 To Stats.Stat_Count - 1
Player(Index).Char(CharNum).Stat(n) = Class(ClassNum).Stat(n)
Next n
Player(Index).Char(CharNum).Map = START_MAP
Player(Index).Char(CharNum).x = START_X
Player(Index).Char(CharNum).y = START_Y
Player(Index).Char(CharNum).Vital(Vitals.HP) = GetPlayerMaxVital(Index, Vitals.HP)
Player(Index).Char(CharNum).Vital(Vitals.MP) = GetPlayerMaxVital(Index, Vitals.MP)
Player(Index).Char(CharNum).Vital(Vitals.SP) = GetPlayerMaxVital(Index, Vitals.SP)
' Append name to file
f = FreeFile
Open App.Path & "\accounts\charlist.txt" For Append As #f
Print #f, Name
Close #f
Call SavePlayer(Index)
Exit Sub
End If
End Sub
' *************
' ** Races **
' *************
Public Sub CreateRacesINI()
Dim FileName As String
Dim File As String
FileName = App.Path & "\data\races.ini"
Max_Races = 4
If Not FileExist(FileName, True) Then
File = FreeFile
Open FileName For Output As File
Print #File, "[INIT]"
Print #File, "MaxRaces=" & Max_Races
Close File
End If
End Sub
Sub LoadRaces()
Dim FileName As String
Dim i As Long
If CheckRaces Then
ReDim Race(1 To Max_Races) As RaceRec
Call SaveRaces
Else
FileName = App.Path & "\data\races.ini"
Max_Races = Val(GetVar(FileName, "INIT", "MaxRaces"))
ReDim Race(1 To Max_Races) As RaceRec
End If
Call ClearRaces
For i = 1 To Max_Races
Race(i).Name = GetVar(FileName, "RACE" & i, "Name")
Next i
End Sub
Sub SaveRaces()
Dim FileName As String
Dim i As Long
FileName = App.Path & "\data\races.ini"
For i = 1 To Max_Races
Call PutVar(FileName, "RACE" & i, "Name", Trim$(Race(i).Name))
Next i
End Sub
Function CheckRaces() As Boolean
Dim FileName As String
FileName = App.Path & "\data\races.ini"
CheckRaces = False
If Not FileExist(FileName, True) Then
Call CreateRacesINI
CheckRaces = True
End If
End Function
Code:
--- modEnumerations ---
CGetRaces
Code:
--- modGameLogic ---
Sub JoinGame(ByVal Index As Long)
Dim i As Long
' Set the flag so we know the person is in the game
TempPlayer(Index).InGame = True
' Send a global message that he/she joined
If GetPlayerAccess(Index) <= ADMIN_MONITER Then
Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", JoinLeftColor)
Else
Call GlobalMsg(GetPlayerName(Index) & " has joined " & GAME_NAME & "!", White)
End If
'Update the log
frmServer.lvwInfo.ListItems(Index).SubItems(1) = GetPlayerIP(Index)
frmServer.lvwInfo.ListItems(Index).SubItems(2) = GetPlayerLogin(Index)
frmServer.lvwInfo.ListItems(Index).SubItems(3) = GetPlayerName(Index)
' Send an ok to client to start receiving in game data
Call SendDataTo(Index, "loginok" & SEP_CHAR & Index & END_CHAR)
' Send some more little goodies, no need to explain these
Call CheckEquippedItems(Index)
Call SendClasses(Index)
Call SendRaces(Index)
Call SendItems(Index)
Call SendNpcs(Index)
Call SendShops(Index)
Call SendSpells(Index)
Call SendInventory(Index)
Call SendWornEquipment(Index)
For i = 1 To Vitals.Vital_Count - 1
Call SendVital(Index, i)
Next i
Call SendStats(Index)
' Warp the player to his saved location
Call PlayerWarp(Index, GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))
' Send welcome messages
Call SendWelcome(Index)
' Send the flag so they know they can start doing stuff
Call SendDataTo(Index, "ingame" & END_CHAR)
End Sub
Sub ClearRaces()
Dim i As Long
For i = 1 To Max_Races
Call ZeroMemory(ByVal VarPtr(Race(i)), LenB(Race(i)))
Race(i).Name = vbNullString
Next i
End Sub
Sub ClearPlayer(ByVal Index As Long)
Call ZeroMemory(ByVal VarPtr(Player(Index)), LenB(Player(Index)))
Player(Index).Login = vbNullString
Player(Index).Password = vbNullString
TempPlayer(Index).Buffer = vbNullString
Dim i As Byte
For i = 0 To MAX_CHARS
Player(Index).Char(i).Name = vbNullString
Player(Index).Char(i).Class = 1
Player(Index).Char(i).Race = 2
Next i
frmServer.lvwInfo.ListItems(Index).SubItems(1) = vbNullString
frmServer.lvwInfo.ListItems(Index).SubItems(2) = vbNullString
frmServer.lvwInfo.ListItems(Index).SubItems(3) = vbNullString
End Sub
Sub ClearChar(ByVal Index As Long, ByVal CharNum As Long)
Call ZeroMemory(ByVal VarPtr(Player(Index).Char(CharNum)), LenB(Player(Index).Char(CharNum)))
Player(Index).Char(CharNum).Name = vbNullString
Player(Index).Char(CharNum).Class = 1
Player(Index).Char(CharNum).Race = 2
End Sub
Function GetPlayerRace(ByVal Index As Long) As Long
GetPlayerRace = Player(Index).Char(TempPlayer(Index).CharNum).Race
End Function
Sub SetPlayerRace(ByVal Index As Long, ByVal RaceNum As Long)
Player(Index).Char(TempPlayer(Index).CharNum).Race = RaceNum
End Sub
Function GetRaceName(ByVal RaceNum As Long) As String
GetRaceName = Trim$(Race(RaceNum).Name)
End Function
Code:
--- modGeneral ---
Call SetStatus("Loading races...")
Call LoadRaces
Code:
--- modGlobals ---
' Maximum races
Public Max_Races As Byte
Code:
--- modHandleData ---
Dim Race As Long
' :::::::::::::::::::::::::::::::::::::::::::::::
' :: Requesting races for making a character ::
' :::::::::::::::::::::::::::::::::::::::::::::::
Case CGetRaces
If Not IsPlaying(Index) Then
Call SendNewCharRaces(Index)
End If
Exit Sub
Case CAddChar
If Not IsPlaying(Index) Then
Name = Parse(1)
Sex = Val(Parse(2))
Class = Val(Parse(3))
CharNum = Val(Parse(4))
Race = Val(Parse(4))
' Everything went ok, add the character
Call AddChar(Index, Name, Sex, Class, CharNum, Race)
Call AddLog("Character " & Name & " added to " & GetPlayerLogin(Index) & "'s account.", PLAYER_LOG)
Call AlertMsg(Index, "Character has been created!")
End If
Exit Sub
If n > 0 Then
' Make sure they are the right class
If Spell(n).ClassReq - 1 = GetPlayerClass(Index) Or Spell(n).ClassReq = 0 Then
' Make sure they are the right level
' Make sure they are the right race
If Spell(n).RaceReq - 1 = GetPlayerRace(Index) Or Spell(n).RaceReq = 0 Then
' Make sure they are the right level
i = GetSpellReqLevel(n)
If i <= GetPlayerLevel(Index) Then
i = FindOpenSpellSlot(Index)
' Make sure they have an open spell slot
If i > 0 Then
' Make sure they dont already have the spell
If Not HasSpell(Index, n) Then
Call SetPlayerSpell(Index, i, n)
Call TakeItem(Index, GetPlayerInvItemNum(Index, InvNum), 0)
Call PlayerMsg(Index, "You study the spell carefully...", Yellow)
Call PlayerMsg(Index, "You have learned a new spell!", White)
Else
Call TakeItem(Index, GetPlayerInvItemNum(Index, InvNum), 0)
Call PlayerMsg(Index, "You have already learned this spell! The spells crumbles into dust.", BrightRed)
End If
Else
Call PlayerMsg(Index, "You have learned all that you can learn!", BrightRed)
End If
Else
Call PlayerMsg(Index, "You must be level " & i & " to learn this spell.", White)
End If
Else
Call PlayerMsg(Index, "This spell can only be learned by a " & GetRaceName(Spell(n).RaceReq - 1) & ".", White)
End If
Else
Call PlayerMsg(Index, "This spell can only be learned by a " & GetClassName(Spell(n).ClassReq - 1) & ".", White)
End If
Else
Call PlayerMsg(Index, "This scroll is not connected to a spell, please inform an admin!", White)
End If
End Select
End If
Exit Sub
' Update the spell
Spell(n).Name = Parse(2)
Spell(n).ClassReq = Val(Parse(3))
Spell(n).LevelReq = Val(Parse(4))
Spell(n).Type = Val(Parse(5))
Spell(n).Data1 = Val(Parse(6))
Spell(n).Data2 = Val(Parse(7))
Spell(n).Data3 = Val(Parse(8))
Spell(n).RaceReq = Val(Parse(9))
Code:
--- modServerTCP ---
Sub SendChars(ByVal Index As Long)
Dim Packet As String
Dim i As Long
Packet = "allchars"
For i = 1 To MAX_CHARS
Packet = Packet & SEP_CHAR & Trim$(Player(Index).Char(i).Name) & SEP_CHAR & Trim$(Class(Player(Index).Char(i).Class).Name) & SEP_CHAR & Player(Index).Char(i).Level ' & SEP_CHAR & Player(Index).Char(i).Race
Next i
Packet = Packet & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Sub SendRaces(ByVal Index As Long)
Dim Packet As String
Dim i As Long
Packet = "racesdata" & SEP_CHAR & Max_Races
For i = 1 To Max_Races
Packet = Packet & SEP_CHAR & GetRaceName(i)
Next i
Packet = Packet & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Sub SendNewCharRaces(ByVal Index As Long)
Dim Packet As String
Dim i As Long
Packet = "newcharraces" & SEP_CHAR & Max_Races
For i = 1 To Max_Races
Packet = Packet & SEP_CHAR & GetRaceName(i)
Next i
Packet = Packet & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Sub SendEditSpellTo(ByVal Index As Long, ByVal SpellNum As Long)
Dim Packet As String
Packet = "editspell" & SEP_CHAR & SpellNum & SEP_CHAR & Trim$(Spell(SpellNum).Name) & SEP_CHAR & Spell(SpellNum).ClassReq & SEP_CHAR & Spell(SpellNum).LevelReq & SEP_CHAR & Spell(SpellNum).Type & SEP_CHAR & Spell(SpellNum).Data1 & SEP_CHAR & Spell(SpellNum).Data2 & SEP_CHAR & Spell(SpellNum).Data3 & SEP_CHAR & Spell(SpellNum).RaceReq & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Sub SendTrade(ByVal Index As Long, ByVal ShopNum As Long)
Dim Packet As String
Dim i As Long, x As Long, y As Long, z As Long
Packet = "trade" & SEP_CHAR & ShopNum & SEP_CHAR & Shop(ShopNum).FixesItems
For i = 1 To MAX_TRADES
Packet = Packet & SEP_CHAR & Shop(ShopNum).TradeItem(i).GiveItem & SEP_CHAR & Shop(ShopNum).TradeItem(i).GiveValue & SEP_CHAR & Shop(ShopNum).TradeItem(i).GetItem & SEP_CHAR & Shop(ShopNum).TradeItem(i).GetValue
' Item #
x = Shop(ShopNum).TradeItem(i).GetItem
If Item(x).Type = ITEM_TYPE_SPELL Then
' Spell class requirement
y = Spell(Item(x).Data1).ClassReq
' Spell race requirement
z = Spell(Item(x).Data1).RaceReq
If y = 0 Then
Call PlayerMsg(Index, Trim$(Item(x).Name) & " can be used by all classes.", Yellow)
Else
Call PlayerMsg(Index, Trim$(Item(x).Name) & " can only be used by a " & GetClassName(y - 1) & ".", Yellow)
End If
If z = 0 Then
Call PlayerMsg(Index, Trim$(Item(x).Name) & " can be used by all races.", Yellow)
Else
Call PlayerMsg(Index, Trim$(Item(x).Name) & " can only be used by a " & GetRaceName(y - 1) & ".", Yellow)
End If
End If
Next i
Packet = Packet & END_CHAR
Call SendDataTo(Index, Packet)
End Sub
Code:
--- modTypes ---
Public Race() As RaceRec
Type PlayerRec
' General
Name As String * NAME_LENGTH
Sex As Byte
Class As Byte
Race As Byte
Sprite As Integer
Level As Byte
Exp As Long
Access As Byte
PK As Byte
Type RaceRec
Name As String * NAME_LENGTH
End Type
Type SpellRec
Name As String * NAME_LENGTH
ClassReq As Byte
RaceReq As Byte
LevelReq As Byte
Type As Byte
Data1 As Integer
Data2 As Integer
Data3 As Integer
End Type
Code:
--- races.ini ---
[INIT]
MaxRaces=4
[RACE1]
Name=Man
[RACE2]
Name=Elf
[RACE3]
Name=Dwarf
[RACE4]
Name=Halfling
I also want to know how to increase the Max Characters. I change the Constants from 3 to 5, but I get errors. Please help. This is pretty messy, yep. :S
If ya need to know more, ask.
ERRORS:
1. Try to Login to the actual game:
Quote:
Run-time error '9':
Subscript out of range
"Class(i).Stat(Stats.Defense) = Val(Parse(n + 6))" is highlighted in "Case "classesdata"" in "modHandleData".
PICTURES:
Login
Register
FAQ
Search
Members
Why did my name pop up here? xD
