diff --git a/README.md b/README.md
new file mode 100644
index 0000000..337c6fa
--- /dev/null
+++ b/README.md
@@ -0,0 +1 @@
+# Crystalshire
\ No newline at end of file
diff --git a/authentication/authentication.vbp b/authentication/authentication.vbp
new file mode 100644
index 0000000..170b3ac
--- /dev/null
+++ b/authentication/authentication.vbp
@@ -0,0 +1,46 @@
+Type=Exe
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
+Reference=*\G{00000206-0000-0010-8000-00AA006D2EA4}#2.6#0#C:\Program Files (x86)\Common Files\System\ado\msado26.tlb#Microsoft ActiveX Data Objects 2.6 Library
+Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCN.OCX
+Form=src\frmMain.frm
+Module=modMain; src\modMain.bas
+Module=modHandleData; src\modHandleData.bas
+Module=modTCP; src\modTCP.bas
+Module=modVars; src\modVars.bas
+Class=clsBuffer; src\clsBuffer.cls
+Class=clsMD5; src\clsMD5.cls
+Module=modSQL; src\modSQL.bas
+Module=modSysTray; src\modSysTray.bas
+IconForm="frmMain"
+Startup="Sub Main"
+HelpFile=""
+Title="Authentication"
+ExeName32="Authentication.exe"
+Command32=""
+Name="Authentication"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Robin Perris Corp."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+
+[MS Transaction Server]
+AutoRefresh=1
diff --git a/authentication/log.txt b/authentication/log.txt
new file mode 100644
index 0000000..d10a156
--- /dev/null
+++ b/authentication/log.txt
@@ -0,0 +1,3 @@
+8/13/2015 5:13:02 AM: Connected to Game Server: False
+8/13/2015 5:13:02 AM: Connected to SQL Server: False
+8/13/2015 5:13:02 AM: Initialization complete. AuthServer loaded.
diff --git a/authentication/src/clsBuffer.cls b/authentication/src/clsBuffer.cls
new file mode 100644
index 0000000..e7d2202
--- /dev/null
+++ b/authentication/src/clsBuffer.cls
@@ -0,0 +1,175 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+ Persistable = 0 'NotPersistable
+ DataBindingBehavior = 0 'vbNone
+ DataSourceBehavior = 0 'vbNone
+ MTSTransactionMode = 0 'NotAnMTSObject
+END
+Attribute VB_Name = "clsBuffer"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Buffer() As Byte
+Private BufferSize As Long
+Private WriteHead As Long
+Private ReadHead As Long
+
+Private Sub Class_Initialize()
+ Flush
+End Sub
+
+Public Sub PreAllocate(ByVal nLength As Long)
+ WriteHead = 0
+ ReadHead = 0
+ BufferSize = nLength - 1
+ ReDim Buffer(0 To BufferSize)
+End Sub
+
+Public Sub Allocate(ByVal nLength As Long)
+ If BufferSize = 0 And nLength > 1 Then nLength = nLength - 1
+ BufferSize = BufferSize + nLength
+ ReDim Preserve Buffer(0 To BufferSize)
+End Sub
+
+Public Sub Flush()
+ WriteHead = 0
+ ReadHead = 0
+ BufferSize = 0
+ ReDim Buffer(0)
+End Sub
+
+Public Sub Trim()
+ ' If the readhead is past the buffersize, this means everything has been read in the array, flush it
+ If ReadHead >= Count Then Flush
+End Sub
+
+Public Sub WriteByte(ByVal nByte As Byte)
+
+ If WriteHead > BufferSize Then Allocate 1
+
+ Buffer(WriteHead) = nByte
+ WriteHead = WriteHead + 1
+End Sub
+
+Public Sub WriteBytes(ByRef nByte() As Byte)
+Dim nLength As Long
+
+ On Error Resume Next
+
+ nLength = (UBound(nByte) - LBound(nByte)) + 1
+
+ If WriteHead + nLength - 1 > BufferSize Then Allocate nLength
+
+ CopyMemory Buffer(WriteHead), nByte(0), nLength
+ WriteHead = WriteHead + nLength
+End Sub
+
+Public Sub WriteInteger(ByVal nInteger As Integer)
+
+ If WriteHead + 1 > BufferSize Then Allocate 2
+
+ CopyMemory Buffer(WriteHead), nInteger, 2
+ WriteHead = WriteHead + 2
+End Sub
+
+Public Sub WriteLong(ByVal nLong As Long)
+
+ If WriteHead + 3 > BufferSize Then Allocate 4
+
+ CopyMemory Buffer(WriteHead), nLong, 4
+ WriteHead = WriteHead + 4
+End Sub
+
+Public Sub WriteString(ByRef nString As String)
+Dim sBytes() As Byte
+Dim sLength As Long
+
+ sLength = Len(nString)
+ sBytes = StrConv(nString, vbFromUnicode)
+
+ WriteLong sLength
+
+ If sLength <= 0 Then Exit Sub
+
+ If WriteHead + sLength - 1 > BufferSize Then Allocate sLength
+
+ CopyMemory Buffer(WriteHead), sBytes(0), sLength
+ WriteHead = WriteHead + sLength
+End Sub
+
+Public Function ReadByte(Optional MoveReadHead As Boolean = True) As Byte
+
+ If ReadHead > BufferSize Then Exit Function
+
+ ReadByte = Buffer(ReadHead)
+ If MoveReadHead Then ReadHead = ReadHead + 1
+End Function
+
+Public Function ReadBytes(ByVal nLength As Long, Optional MoveReadHead As Boolean = True) As Byte()
+Dim Data() As Byte
+
+ If nLength = 0 Then Exit Function
+ If ReadHead + nLength - 1 > BufferSize Then Exit Function
+
+ ReDim Data(nLength - 1)
+
+ CopyMemory Data(0), Buffer(ReadHead), nLength
+ If MoveReadHead Then ReadHead = ReadHead + nLength
+
+ ReadBytes = Data
+End Function
+
+Public Function ReadInteger(Optional MoveReadHead As Boolean = True) As Integer
+
+ If ReadHead + 1 > BufferSize Then Exit Function
+
+ CopyMemory ReadInteger, Buffer(ReadHead), 2
+ If MoveReadHead Then ReadHead = ReadHead + 2
+End Function
+
+Public Function ReadLong(Optional MoveReadHead As Boolean = True) As Long
+
+ If ReadHead + 3 > BufferSize Then Exit Function
+
+ CopyMemory ReadLong, Buffer(ReadHead), 4
+ If MoveReadHead Then ReadHead = ReadHead + 4
+End Function
+
+Public Function ReadString(Optional MoveReadHead As Boolean = True) As String
+Dim sLength As Long
+Dim sBytes() As Byte
+
+ sLength = ReadLong(False)
+ If sLength <= 0 Then
+ If MoveReadHead Then ReadHead = ReadHead + 4
+ Exit Function
+ End If
+
+ ReDim sBytes(sLength - 1)
+
+ CopyMemory sBytes(0), Buffer(ReadHead + 4), sLength
+
+ ReadString = StrConv(sBytes, vbUnicode)
+ If MoveReadHead Then ReadHead = ReadHead + sLength + 4
+End Function
+
+Public Function Count() As Long
+ Count = (UBound(Buffer) - LBound(Buffer)) + 1
+End Function
+
+Public Function Length() As Long
+ Length = Count - ReadHead
+End Function
+
+Public Function ToArray() As Byte()
+ ToArray = Buffer()
+End Function
+
+Public Function ToString() As String
+ ToString = StrConv(Buffer, vbUnicode)
+End Function
+
diff --git a/authentication/src/clsMD5.cls b/authentication/src/clsMD5.cls
new file mode 100644
index 0000000..5457186
--- /dev/null
+++ b/authentication/src/clsMD5.cls
@@ -0,0 +1,585 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+ Persistable = 0 'NotPersistable
+ DataBindingBehavior = 0 'vbNone
+ DataSourceBehavior = 0 'vbNone
+ MTSTransactionMode = 0 'NotAnMTSObject
+END
+Attribute VB_Name = "clsMD5"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'/******************************************************************************
+' * Copyright (C) 2000 by Robert Hubley. *
+' * All rights reserved. *
+' * *
+' * This software is provided ``AS IS'' and any express or implied *
+' * warranties, including, but not limited to, the implied warranties of *
+' * merchantability and fitness for a particular purpose, are disclaimed. *
+' * In no event shall the authors be liable for any direct, indirect, *
+' * incidental, special, exemplary, or consequential damages (including, but *
+' * not limited to, procurement of substitute goods or services; loss of use, *
+' * data, or profits; or business interruption) however caused and on any *
+' * theory of liability, whether in contract, strict liability, or tort *
+' * (including negligence or otherwise) arising in any way out of the use of *
+' * this software, even if advised of the possibility of such damage. *
+' * *
+' ******************************************************************************
+'
+' CLASS: MD5
+'
+' DESCRIPTION:
+' This is a class which encapsulates a set of MD5 Message Digest functions.
+' MD5 algorithm produces a 128 bit digital fingerprint (signature) from an
+' dataset of arbitrary length. For details see RFC 1321 (summarized below).
+' This implementation is derived from the RSA Data Security, Inc. MD5 Message-Digest
+' algorithm reference implementation (originally written in C)
+'
+' AUTHOR:
+' Robert M. Hubley 12/1999
+'
+'
+' NOTES:
+' Network Working Group R. Rivest
+' Request for Comments: 1321 MIT Laboratory for Computer Science
+' and RSA Data Security, Inc.
+' April 1992
+'
+'
+' The MD5 Message-Digest Algorithm
+'
+' Summary
+'
+' This document describes the MD5 message-digest algorithm. The
+' algorithm takes as input a message of arbitrary length and produces
+' as output a 128-bit "fingerprint" or "message digest" of the input.
+' It is conjectured that it is computationally infeasible to produce
+' two messages having the same message digest, or to produce any
+' message having a given prespecified target message digest. The MD5
+' algorithm is intended for digital signature applications, where a
+' large file must be "compressed" in a secure manner before being
+' encrypted with a private (secret) key under a public-key cryptosystem
+' such as RSA.
+'
+' The MD5 algorithm is designed to be quite fast on 32-bit machines. In
+' addition, the MD5 algorithm does not require any large substitution
+' tables; the algorithm can be coded quite compactly.
+'
+' The MD5 algorithm is an extension of the MD4 message-digest algorithm
+' 1,2]. MD5 is slightly slower than MD4, but is more "conservative" in
+' design. MD5 was designed because it was felt that MD4 was perhaps
+' being adopted for use more quickly than justified by the existing
+' critical review; because MD4 was designed to be exceptionally fast,
+' it is "at the edge" in terms of risking successful cryptanalytic
+' attack. MD5 backs off a bit, giving up a little in speed for a much
+' greater likelihood of ultimate security. It incorporates some
+' suggestions made by various reviewers, and contains additional
+' optimizations. The MD5 algorithm is being placed in the public domain
+' for review and possible adoption as a standard.
+'
+' RFC Author:
+' Ronald L.Rivest
+' Massachusetts Institute of Technology
+' Laboratory for Computer Science
+' NE43 -324545 Technology Square
+' Cambridge, MA 02139-1986
+' Phone: (617) 253-5880
+' EMail: Rivest@ theory.lcs.mit.edu
+'
+'
+'
+' CHANGE HISTORY:
+'
+' 0.1.0 RMH 1999/12/29 Original version
+'
+'
+
+
+'=
+'= Class Constants
+'=
+Private Const OFFSET_4 = 4294967296#
+Private Const MAXINT_4 = 2147483647
+
+Private Const S11 = 7
+Private Const S12 = 12
+Private Const S13 = 17
+Private Const S14 = 22
+Private Const S21 = 5
+Private Const S22 = 9
+Private Const S23 = 14
+Private Const S24 = 20
+Private Const S31 = 4
+Private Const S32 = 11
+Private Const S33 = 16
+Private Const S34 = 23
+Private Const S41 = 6
+Private Const S42 = 10
+Private Const S43 = 15
+Private Const S44 = 21
+
+
+'=
+'= Class Variables
+'=
+Private State(4) As Long
+Private ByteCounter As Long
+Private ByteBuffer(63) As Byte
+
+
+'=
+'= Class Properties
+'=
+Property Get RegisterA() As String
+ RegisterA = State(1)
+End Property
+
+Property Get RegisterB() As String
+ RegisterB = State(2)
+End Property
+
+Property Get RegisterC() As String
+ RegisterC = State(3)
+End Property
+
+Property Get RegisterD() As String
+ RegisterD = State(4)
+End Property
+
+
+'=
+'= Class Functions
+'=
+
+'
+' Function to quickly digest a file into a hex string
+'
+Public Function DigestFileToHexStr(FileName As String) As String
+ Open FileName For Binary Access Read As #1
+ MD5Init
+ Do While Not EOF(1)
+ Get #1, , ByteBuffer
+ If Loc(1) < LOF(1) Then
+ ByteCounter = ByteCounter + 64
+ MD5Transform ByteBuffer
+ End If
+ Loop
+ ByteCounter = ByteCounter + (LOF(1) Mod 64)
+ Close #1
+ MD5Final
+ DigestFileToHexStr = GetValues
+End Function
+
+'
+' Function to digest a text string and output the result as a string
+' of hexadecimal characters.
+'
+Public Function DigestStrToHexStr(SourceString As String) As String
+ MD5Init
+ MD5Update Len(SourceString), StringToArray(SourceString)
+ MD5Final
+ DigestStrToHexStr = GetValues
+End Function
+
+'
+' A utility function which converts a string into an array of
+' bytes.
+'
+Private Function StringToArray(InString As String) As Byte()
+ Dim I As Integer
+ Dim bytBuffer() As Byte
+ ReDim bytBuffer(Len(InString))
+ For I = 0 To Len(InString) - 1
+ bytBuffer(I) = Asc(Mid(InString, I + 1, 1))
+ Next I
+ StringToArray = bytBuffer
+End Function
+
+'
+' Concatenate the four state vaules into one string
+'
+Public Function GetValues() As String
+ GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
+End Function
+
+'
+' Convert a Long to a Hex string
+'
+Private Function LongToString(Num As Long) As String
+ Dim a As Byte
+ Dim b As Byte
+ Dim c As Byte
+ Dim d As Byte
+
+ a = Num And &HFF&
+ If a < 16 Then
+ LongToString = "0" & Hex(a)
+ Else
+ LongToString = Hex(a)
+ End If
+
+ b = (Num And &HFF00&) \ 256
+ If b < 16 Then
+ LongToString = LongToString & "0" & Hex(b)
+ Else
+ LongToString = LongToString & Hex(b)
+ End If
+
+ c = (Num And &HFF0000) \ 65536
+ If c < 16 Then
+ LongToString = LongToString & "0" & Hex(c)
+ Else
+ LongToString = LongToString & Hex(c)
+ End If
+
+ If Num < 0 Then
+ d = ((Num And &H7F000000) \ 16777216) Or &H80&
+ Else
+ d = (Num And &HFF000000) \ 16777216
+ End If
+
+ If d < 16 Then
+ LongToString = LongToString & "0" & Hex(d)
+ Else
+ LongToString = LongToString & Hex(d)
+ End If
+
+End Function
+
+'
+' Initialize the class
+' This must be called before a digest calculation is started
+'
+Public Sub MD5Init()
+ ByteCounter = 0
+ State(1) = UnsignedToLong(1732584193#)
+ State(2) = UnsignedToLong(4023233417#)
+ State(3) = UnsignedToLong(2562383102#)
+ State(4) = UnsignedToLong(271733878#)
+End Sub
+
+'
+' MD5 Final
+'
+Public Sub MD5Final()
+ Dim dblBits As Double
+
+ Dim padding(72) As Byte
+ Dim lngBytesBuffered As Long
+
+ padding(0) = &H80
+
+ dblBits = ByteCounter * 8
+
+ ' Pad out
+ lngBytesBuffered = ByteCounter Mod 64
+ If lngBytesBuffered <= 56 Then
+ MD5Update 56 - lngBytesBuffered, padding
+ Else
+ MD5Update 120 - ByteCounter, padding
+ End If
+
+
+ padding(0) = UnsignedToLong(dblBits) And &HFF&
+ padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
+ padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
+ padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
+ padding(4) = 0
+ padding(5) = 0
+ padding(6) = 0
+ padding(7) = 0
+
+ MD5Update 8, padding
+End Sub
+
+'
+' Break up input stream into 64 byte chunks
+'
+Public Sub MD5Update(InputLen As Long, InputBuffer() As Byte)
+ Dim II As Integer
+ Dim I As Integer
+ Dim J As Integer
+ Dim K As Integer
+ Dim lngBufferedBytes As Long
+ Dim lngBufferRemaining As Long
+ Dim lngRem As Long
+
+ lngBufferedBytes = ByteCounter Mod 64
+ lngBufferRemaining = 64 - lngBufferedBytes
+ ByteCounter = ByteCounter + InputLen
+ ' Use up old buffer results first
+ If InputLen >= lngBufferRemaining Then
+ For II = 0 To lngBufferRemaining - 1
+ ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
+ Next II
+ MD5Transform ByteBuffer
+
+ lngRem = (InputLen) Mod 64
+ ' The transfer is a multiple of 64 lets do some transformations
+ For I = lngBufferRemaining To InputLen - II - lngRem Step 64
+ For J = 0 To 63
+ ByteBuffer(J) = InputBuffer(I + J)
+ Next J
+ MD5Transform ByteBuffer
+ Next I
+ lngBufferedBytes = 0
+ Else
+ I = 0
+ End If
+
+ ' Buffer any remaining input
+ For K = 0 To InputLen - I - 1
+ ByteBuffer(lngBufferedBytes + K) = InputBuffer(I + K)
+ Next K
+
+End Sub
+
+'
+' MD5 Transform
+'
+Private Sub MD5Transform(Buffer() As Byte)
+ Dim x(16) As Long
+ Dim a As Long
+ Dim b As Long
+ Dim c As Long
+ Dim d As Long
+
+ a = State(1)
+ b = State(2)
+ c = State(3)
+ d = State(4)
+
+ Decode 64, x, Buffer
+
+ ' Round 1
+ FF a, b, c, d, x(0), S11, -680876936
+ FF d, a, b, c, x(1), S12, -389564586
+ FF c, d, a, b, x(2), S13, 606105819
+ FF b, c, d, a, x(3), S14, -1044525330
+ FF a, b, c, d, x(4), S11, -176418897
+ FF d, a, b, c, x(5), S12, 1200080426
+ FF c, d, a, b, x(6), S13, -1473231341
+ FF b, c, d, a, x(7), S14, -45705983
+ FF a, b, c, d, x(8), S11, 1770035416
+ FF d, a, b, c, x(9), S12, -1958414417
+ FF c, d, a, b, x(10), S13, -42063
+ FF b, c, d, a, x(11), S14, -1990404162
+ FF a, b, c, d, x(12), S11, 1804603682
+ FF d, a, b, c, x(13), S12, -40341101
+ FF c, d, a, b, x(14), S13, -1502002290
+ FF b, c, d, a, x(15), S14, 1236535329
+
+ ' Round 2
+ GG a, b, c, d, x(1), S21, -165796510
+ GG d, a, b, c, x(6), S22, -1069501632
+ GG c, d, a, b, x(11), S23, 643717713
+ GG b, c, d, a, x(0), S24, -373897302
+ GG a, b, c, d, x(5), S21, -701558691
+ GG d, a, b, c, x(10), S22, 38016083
+ GG c, d, a, b, x(15), S23, -660478335
+ GG b, c, d, a, x(4), S24, -405537848
+ GG a, b, c, d, x(9), S21, 568446438
+ GG d, a, b, c, x(14), S22, -1019803690
+ GG c, d, a, b, x(3), S23, -187363961
+ GG b, c, d, a, x(8), S24, 1163531501
+ GG a, b, c, d, x(13), S21, -1444681467
+ GG d, a, b, c, x(2), S22, -51403784
+ GG c, d, a, b, x(7), S23, 1735328473
+ GG b, c, d, a, x(12), S24, -1926607734
+
+ ' Round 3
+ HH a, b, c, d, x(5), S31, -378558
+ HH d, a, b, c, x(8), S32, -2022574463
+ HH c, d, a, b, x(11), S33, 1839030562
+ HH b, c, d, a, x(14), S34, -35309556
+ HH a, b, c, d, x(1), S31, -1530992060
+ HH d, a, b, c, x(4), S32, 1272893353
+ HH c, d, a, b, x(7), S33, -155497632
+ HH b, c, d, a, x(10), S34, -1094730640
+ HH a, b, c, d, x(13), S31, 681279174
+ HH d, a, b, c, x(0), S32, -358537222
+ HH c, d, a, b, x(3), S33, -722521979
+ HH b, c, d, a, x(6), S34, 76029189
+ HH a, b, c, d, x(9), S31, -640364487
+ HH d, a, b, c, x(12), S32, -421815835
+ HH c, d, a, b, x(15), S33, 530742520
+ HH b, c, d, a, x(2), S34, -995338651
+
+ ' Round 4
+ II a, b, c, d, x(0), S41, -198630844
+ II d, a, b, c, x(7), S42, 1126891415
+ II c, d, a, b, x(14), S43, -1416354905
+ II b, c, d, a, x(5), S44, -57434055
+ II a, b, c, d, x(12), S41, 1700485571
+ II d, a, b, c, x(3), S42, -1894986606
+ II c, d, a, b, x(10), S43, -1051523
+ II b, c, d, a, x(1), S44, -2054922799
+ II a, b, c, d, x(8), S41, 1873313359
+ II d, a, b, c, x(15), S42, -30611744
+ II c, d, a, b, x(6), S43, -1560198380
+ II b, c, d, a, x(13), S44, 1309151649
+ II a, b, c, d, x(4), S41, -145523070
+ II d, a, b, c, x(11), S42, -1120210379
+ II c, d, a, b, x(2), S43, 718787259
+ II b, c, d, a, x(9), S44, -343485551
+
+
+ State(1) = LongOverflowAdd(State(1), a)
+ State(2) = LongOverflowAdd(State(2), b)
+ State(3) = LongOverflowAdd(State(3), c)
+ State(4) = LongOverflowAdd(State(4), d)
+
+' /* Zeroize sensitive information.
+'*/
+' MD5_memset ((POINTER)x, 0, sizeof (x));
+
+End Sub
+
+Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte)
+ Dim intDblIndex As Integer
+ Dim intByteIndex As Integer
+ Dim dblSum As Double
+
+ intDblIndex = 0
+ For intByteIndex = 0 To Length - 1 Step 4
+ dblSum = InputBuffer(intByteIndex) + _
+ InputBuffer(intByteIndex + 1) * 256# + _
+ InputBuffer(intByteIndex + 2) * 65536# + _
+ InputBuffer(intByteIndex + 3) * 16777216#
+ OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
+ intDblIndex = intDblIndex + 1
+ Next intByteIndex
+End Sub
+
+'
+' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
+' Rotation is separate from addition to prevent recomputation.
+'
+Private Function FF(a As Long, _
+ b As Long, _
+ c As Long, _
+ d As Long, _
+ x As Long, _
+ s As Long, _
+ ac As Long) As Long
+ a = LongOverflowAdd4(a, (b And c) Or (Not (b) And d), x, ac)
+ a = LongLeftRotate(a, s)
+ a = LongOverflowAdd(a, b)
+End Function
+
+Private Function GG(a As Long, _
+ b As Long, _
+ c As Long, _
+ d As Long, _
+ x As Long, _
+ s As Long, _
+ ac As Long) As Long
+ a = LongOverflowAdd4(a, (b And d) Or (c And Not (d)), x, ac)
+ a = LongLeftRotate(a, s)
+ a = LongOverflowAdd(a, b)
+End Function
+
+Private Function HH(a As Long, _
+ b As Long, _
+ c As Long, _
+ d As Long, _
+ x As Long, _
+ s As Long, _
+ ac As Long) As Long
+ a = LongOverflowAdd4(a, b Xor c Xor d, x, ac)
+ a = LongLeftRotate(a, s)
+ a = LongOverflowAdd(a, b)
+End Function
+
+Private Function II(a As Long, _
+ b As Long, _
+ c As Long, _
+ d As Long, _
+ x As Long, _
+ s As Long, _
+ ac As Long) As Long
+ a = LongOverflowAdd4(a, c Xor (b Or Not (d)), x, ac)
+ a = LongLeftRotate(a, s)
+ a = LongOverflowAdd(a, b)
+End Function
+
+'
+' Rotate a long to the right
+'
+Function LongLeftRotate(value As Long, bits As Long) As Long
+ Dim lngSign As Long
+ Dim lngI As Long
+ bits = bits Mod 32
+ If bits = 0 Then LongLeftRotate = value: Exit Function
+ For lngI = 1 To bits
+ lngSign = value And &HC0000000
+ value = (value And &H3FFFFFFF) * 2
+ value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And _
+ &H40000000) And &H80000000)
+ Next
+ LongLeftRotate = value
+End Function
+
+'
+' Function to add two unsigned numbers together as in C.
+' Overflows are ignored!
+'
+Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
+ Dim lngHighWord As Long
+ Dim lngLowWord As Long
+ Dim lngOverflow As Long
+
+ lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
+ lngOverflow = lngLowWord \ 65536
+ lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
+ LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
+End Function
+
+'
+' Function to add two unsigned numbers together as in C.
+' Overflows are ignored!
+'
+Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
+ Dim lngHighWord As Long
+ Dim lngLowWord As Long
+ Dim lngOverflow As Long
+
+ lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
+ lngOverflow = lngLowWord \ 65536
+ lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + _
+ ((Val2 And &HFFFF0000) \ 65536) + _
+ ((val3 And &HFFFF0000) \ 65536) + _
+ ((val4 And &HFFFF0000) \ 65536) + _
+ lngOverflow) And &HFFFF&
+ LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
+End Function
+
+'
+' Convert an unsigned double into a long
+'
+Private Function UnsignedToLong(value As Double) As Long
+ If value < 0 Or value >= OFFSET_4 Then Error 6 ' Overflow
+ If value <= MAXINT_4 Then
+ UnsignedToLong = value
+ Else
+ UnsignedToLong = value - OFFSET_4
+ End If
+ End Function
+
+'
+' Convert a long to an unsigned Double
+'
+Private Function LongToUnsigned(value As Long) As Double
+ If value < 0 Then
+ LongToUnsigned = value + OFFSET_4
+ Else
+ LongToUnsigned = value
+ End If
+End Function
+
+
+
diff --git a/authentication/src/frmMain.frm b/authentication/src/frmMain.frm
new file mode 100644
index 0000000..c8f873c
--- /dev/null
+++ b/authentication/src/frmMain.frm
@@ -0,0 +1,110 @@
+VERSION 5.00
+Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "Mswinsck.ocx"
+Begin VB.Form frmMain
+ BorderStyle = 1 'Fixed Single
+ Caption = "Authentication Server"
+ ClientHeight = 4455
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 6015
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ ScaleHeight = 4455
+ ScaleWidth = 6015
+ StartUpPosition = 3 'Windows Default
+ Begin VB.Timer tmrStatus
+ Interval = 5000
+ Left = 1320
+ Top = 120
+ End
+ Begin MSWinsockLib.Winsock Socket
+ Index = 0
+ Left = 720
+ Top = 120
+ _ExtentX = 741
+ _ExtentY = 741
+ _Version = 393216
+ End
+ Begin MSWinsockLib.Winsock ServerSocket
+ Left = 120
+ Top = 120
+ _ExtentX = 741
+ _ExtentY = 741
+ _Version = 393216
+ End
+ Begin VB.TextBox txtLog
+ Height = 4215
+ Left = 120
+ Locked = -1 'True
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 0
+ Top = 120
+ Width = 5775
+ End
+End
+Attribute VB_Name = "frmMain"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Form_Terminate()
+ DestroyServer
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+ DestroyServer
+End Sub
+
+Private Sub ServerSocket_Close()
+ If ServerSocket.State <> sckConnected Then ConnectToGameServer
+End Sub
+
+Private Sub ServerSocket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
+ 'Debug.Print Number, Description, Scode
+ If ServerSocket.State <> sckConnected Then ConnectToGameServer
+End Sub
+
+Private Sub Socket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
+ AcceptConnection Index, requestID
+End Sub
+
+Private Sub Socket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
+ IncomingData Index, bytesTotal
+End Sub
+
+Private Sub Socket_Close(Index As Integer)
+ CloseSocket Index
+End Sub
+
+Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+ Dim lmsg As Long
+ lmsg = x / Screen.TwipsPerPixelX
+
+ Select Case lmsg
+ Case WM_LBUTTONDBLCLK
+ frmMain.WindowState = vbNormal
+ frmMain.Show
+ End Select
+End Sub
+
+Private Sub Form_Resize()
+ If frmMain.WindowState = vbMinimized Then
+ frmMain.Hide
+ End If
+End Sub
+
+Private Sub tmrStatus_Timer()
+ DBSetStatus
+End Sub
diff --git a/authentication/src/modHandleData.bas b/authentication/src/modHandleData.bas
new file mode 100644
index 0000000..040a915
--- /dev/null
+++ b/authentication/src/modHandleData.bas
@@ -0,0 +1,115 @@
+Attribute VB_Name = "modHandleData"
+Option Explicit
+
+Public Function GetAddress(FunAddr As Long) As Long
+ GetAddress = FunAddr
+End Function
+
+Public Sub InitMessages()
+ HandleDataSub(CAuthLogin) = GetAddress(AddressOf HandleLogin)
+End Sub
+
+Sub HandleData(ByVal Index As Long, ByRef Data() As Byte)
+Dim Buffer As clsBuffer, MsgType As Long, packetCallback As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ MsgType = Buffer.ReadLong
+
+ If (MsgType < 0) Or (MsgType >= CMSG_COUNT) Then
+ HackingAttempt Index
+ Exit Sub
+ End If
+
+ packetCallback = HandleDataSub(MsgType)
+ If packetCallback <> 0 Then
+ CallWindowProc HandleDataSub(MsgType), Index, Buffer.ReadBytes(Buffer.Length), 0, 0
+ End If
+End Sub
+
+Private Sub HandleLogin(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer
+Dim Username As String, password As String
+Dim loginToken As String
+Dim vMAJOR As Long, vMINOR As Long, vREVISION As Long
+
+Dim userInfo As ADODB.Recordset
+Dim actPass As String, actSalt As String, actUserID As String, tmpPass As String, actUserGroup As String
+
+ On Error GoTo errorhandler
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ Username = Buffer.ReadString
+ password = Buffer.ReadString
+ vMAJOR = Buffer.ReadLong
+ vMINOR = Buffer.ReadLong
+ vREVISION = Buffer.ReadLong
+
+ ' right version
+ If vMAJOR <> CLIENT_MAJOR Or vMINOR <> CLIENT_MINOR Or vREVISION <> CLIENT_REVISION Then
+ SendAlertMsg Index, DIALOGUE_MSG_OUTDATED
+ Exit Sub
+ End If
+
+ If Len(Username) < 3 Or Len(password) < 3 Then
+ SendAlertMsg Index, DIALOGUE_MSG_USERLENGTH, MENU_LOGIN
+ Exit Sub
+ End If
+
+ ' try and connect to database
+ If Not ConnectToSqlServer Then
+ SendAlertMsg Index, DIALOGUE_MSG_MYSQL
+ Exit Sub
+ End If
+
+ ' get the recordset
+ Set userInfo = GetUser(Username, password)
+
+ If Not userInfo.EOF Then
+ ' username found
+ actUserID = userInfo.Fields("uid").value
+ actPass = userInfo.Fields("password").value
+ actSalt = userInfo.Fields("salt").value
+
+ ' check password
+ tmpPass = SaltPassword(MD5(password), actSalt)
+ If tmpPass <> actPass Then
+ SendAlertMsg Index, DIALOGUE_MSG_WRONGPASS, MENU_LOGIN
+ Exit Sub
+ End If
+
+ ' check usergroups
+ actUserGroup = userInfo.Fields("usergroup").value
+
+ ' Need activating
+ Select Case actUserGroup
+ Case 5
+ SendAlertMsg Index, DIALOGUE_MSG_ACTIVATED, MENU_LOGIN
+ Exit Sub
+ Case 7
+ SendAlertMsg Index, DIALOGUE_MSG_BANNED
+ Exit Sub
+ End Select
+ Else
+ SendAlertMsg Index, DIALOGUE_MSG_WRONGPASS, MENU_LOGIN
+ Exit Sub
+ End If
+
+ ' Send new account group to the game server
+ SendUsergroup Username, Val(actUserGroup)
+
+ ' Everything passed, create the token and send it off
+ loginToken = RandomString("AN-##AA-ANHHAN-H")
+
+ SendLoginTokenToGameServer Username, loginToken
+ SendLoginTokenToPlayer Index, loginToken
+
+ DoEvents
+ CloseSocket Index
+
+errorhandler:
+ Exit Sub
+End Sub
diff --git a/authentication/src/modMain.bas b/authentication/src/modMain.bas
new file mode 100644
index 0000000..b059944
--- /dev/null
+++ b/authentication/src/modMain.bas
@@ -0,0 +1,172 @@
+Attribute VB_Name = "modMain"
+Option Explicit
+
+Public Type PlayerUDT
+ Buffer As clsBuffer
+ ' Network Data
+ DataTimer As Long
+ DataBytes As Long
+ DataPackets As Long
+ PacketInIndex As Byte ' Holds the index of what packetkey for incoming packets
+ PacketOutIndex As Byte ' Holds the index of what packetkey for outgoing packets
+End Type
+
+Public Player(1 To MAX_PLAYERS) As PlayerUDT
+
+Sub ClearPlayer(ByVal Index As Long)
+ ZeroMemory ByVal VarPtr(Player(Index)), LenB(Player(Index))
+ Set Player(Index).Buffer = New clsBuffer
+End Sub
+
+Sub Main()
+Dim I As Long
+
+ Randomize Timer ' Randomizes the system timer
+
+ frmMain.Show
+
+ frmMain.Socket(0).RemoteHost = frmMain.Socket(0).LocalIP ' Sets up the server ip
+ frmMain.Socket(0).LocalPort = AUTH_SERVER_PORT ' Sets up the default port
+ frmMain.Socket(0).Listen ' Start listening
+
+ ' Setup our gameServerConnection
+ SetStatus "Connected to Game Server: " & ConnectToGameServer
+
+ 'ConnectToSqlServer
+ SetStatus "Connected to SQL Server: " & ConnectToSqlServer
+
+ InitMessages ' Need to init messages for packets
+
+ For I = 1 To MAX_PLAYERS
+ ClearPlayer I
+ Load frmMain.Socket(I) ' load sockets
+ Next
+
+ Set classMD5 = New clsMD5
+
+ LoadSystemTray
+
+ SetStatus "Initialization complete. AuthServer loaded."
+End Sub
+
+Public Sub DestroyServer()
+Dim I As Long
+
+ On Error Resume Next
+
+ 'DisconnectFromSqlServer
+
+ For I = 1 To MAX_PLAYERS
+ Set Player(I).Buffer = Nothing
+ Unload frmMain.Socket(I)
+ Next
+
+ DestroySystemTray
+
+ Unload frmMain
+ DisconnectFromSqlServer
+ End
+End Sub
+
+Function RandomString(ByVal mask As String) As String
+Dim I As Integer, acode As Integer, options As String, char As String
+
+ ' initialize result with proper lenght
+ RandomString = mask
+
+ For I = 1 To Len(mask)
+ ' get the character
+ char = Mid$(mask, I, 1)
+ Select Case char
+ Case "?"
+ char = Chr$(1 + Rnd * 127)
+ options = ""
+ Case "#"
+ options = "0123456789"
+ Case "A"
+ options = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+ Case "N"
+ options = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0" _
+ & "123456789"
+ Case "H"
+ options = "0123456789ABCDEF"
+ Case Else
+ ' don't modify the character
+ options = ""
+ End Select
+
+ ' select a random char in the option string
+ If Len(options) Then
+ ' select a random char
+ ' note that we add an extra char, in case RND returns 1
+ char = Mid$(options & Right$(options, 1), 1 + Int(Rnd * Len(options)), 1)
+ End If
+
+ ' insert the character in result string
+ Mid(RandomString, I, 1) = char
+ Next
+End Function
+
+Public Sub AddText(ByVal rTxt As TextBox, ByVal Msg As String)
+Dim s As String
+
+ NumLines = NumLines + 1
+
+ If NumLines >= MAX_LINES Then
+ frmMain.txtLog.Text = vbNullString
+ NumLines = 0
+ End If
+ s = Msg & vbCrLf
+ rTxt.SelStart = Len(rTxt.Text)
+ rTxt.SelText = s
+ rTxt.SelStart = Len(rTxt.Text) - 1
+
+ AddLog Msg
+End Sub
+
+Sub AddLog(ByVal Text As String)
+Dim FileName As String
+Dim F As Long
+
+ FileName = App.Path & "/log.txt"
+
+ If Not FileExist(FileName) Then
+ F = FreeFile
+ Open FileName For Output As #F
+ Close #F
+ End If
+
+ F = FreeFile
+ Open FileName For Append As #F
+ Print #F, DateValue(Now) & " " & Time & ": " & Text
+ Close #F
+
+End Sub
+
+Sub SetStatus(ByRef Status As String)
+ AddText frmMain.txtLog, Status
+End Sub
+
+Public Function IsAlphaNumeric(s As String) As Boolean
+ If Not s Like "*[!0-9A-Za-z]*" Then IsAlphaNumeric = True
+End Function
+
+Public Function IsAlpha(s As String) As Boolean
+ If Not s Like "*[!A-Za-z]*" Then IsAlpha = True
+End Function
+
+Public Function FileExist(ByVal FileName As String) As Boolean
+ If Dir$(FileName) = vbNullString Then
+ FileExist = False
+ Else
+ FileExist = True
+ End If
+End Function
+
+Public Function SaltPassword(ByVal password As String, ByVal salt As String) As String
+ SaltPassword = MD5(MD5(salt) & password)
+End Function
+
+Public Function MD5(ByVal theString As String) As String
+ MD5 = LCase$(classMD5.DigestStrToHexStr(theString))
+End Function
diff --git a/authentication/src/modSQL.bas b/authentication/src/modSQL.bas
new file mode 100644
index 0000000..6373018
--- /dev/null
+++ b/authentication/src/modSQL.bas
@@ -0,0 +1,127 @@
+Attribute VB_Name = "modSQL"
+Option Explicit
+
+'this is for connection and recordset
+Public CN As New ADODB.Connection
+Public RS_USER As New ADODB.Recordset
+
+'variables to connect to mysqlserver
+Public strServer As String
+Public strUsername As String
+Public strPassword As String
+Public strPort As String
+Public strDatabase As String
+Public strSQL As String
+Public strCOMMAND As ADODB.Command
+Public xlsFilename As Variant
+
+Public Function ConnectToSqlServer() As Boolean
+On Error GoTo errhandler
+
+ 'Set CN = Nothing
+
+ strServer = "SERVER"
+ strUsername = "USER"
+ strPassword = "PASSWORD"
+ strPort = "PORT"
+ strDatabase = "DBNAME"
+
+ Set CN = New ADODB.Connection
+ CN.CursorLocation = adUseClient
+ CN.ConnectionString = "Driver={MySQL ODBC 3.51 Driver};Server=" & strServer & ";PORT=" & strPort & ";Database=" & strDatabase & ";Uid=" & strUsername & ";Pwd=" & strPassword & ";"
+ CN.Open
+
+ ConnectToSqlServer = True
+ Exit Function
+errhandler:
+ 'Debug.Print Err.Number, Err.Description
+ ConnectToSqlServer = False
+End Function
+
+Function GetUser(Username As String, password As String) As ADODB.Recordset
+Dim oRS As ADODB.Recordset
+Dim SqlStr As String
+Dim rsPassword As String
+Dim rsPasswordSalt As String
+
+ On Error GoTo errorhandler
+
+ ' DblChcek if connected to sql
+ If CN.State <> adStateOpen Then
+ ' Try to reconnect
+ If Not ConnectToSqlServer Then Exit Function
+ End If
+
+ 'Define your SQL String
+ SqlStr = "Select * From mybb_users Where username = '" & Username & "'"
+
+ 'Open the recordset
+ Set oRS = New ADODB.Recordset
+ oRS.Open SqlStr, CN, adOpenStatic, adLockReadOnly
+ Set oRS.ActiveConnection = Nothing
+
+ Set GetUser = oRS.Clone
+
+ 'Destroy ADO objects
+ oRS.Close
+ Set oRS = Nothing
+ Exit Function
+
+errorhandler:
+
+End Function
+
+Sub DBSetStatus()
+Dim sqlcmd As String
+
+ ' We want to only set the server status if both auth and game server are online
+ ' as such we do a server connection check first.
+
+ If Not ConnectToGameServer Then
+ ' We can't connect to game server - make it so we try more often til it's back up
+ frmMain.tmrStatus.Interval = 5000
+ Debug.Print "Cannot connect to game server - Will not send status to database."
+ Exit Sub
+ End If
+
+ ' If we can now connect to the game server then we want to increase the call
+ frmMain.tmrStatus.Interval = 60000
+
+ SimpleQuery "SET TIME_ZONE='+00:00'"
+ SimpleQuery "delete from crystalshire.mybb_serverstatus where servername = 'london'"
+ SimpleQuery "insert into mybb_serverstatus (servername, connected) values ('london', Now())"
+End Sub
+
+Function SimpleQuery(SqlStr) As Boolean
+Dim cmd As New ADODB.Command
+Dim oRS As ADODB.Recordset
+
+ ' default to failed
+ SimpleQuery = False
+
+ ' DblChcek if connected to sql
+ If CN.State <> adStateOpen Then
+ ' Try to reconnect
+ If Not ConnectToSqlServer Then Exit Function
+ End If
+
+ ' Build the command
+ With cmd
+ .ActiveConnection = CN
+ .CommandText = SqlStr
+ .CommandType = adCmdText
+ End With
+
+ Debug.Print cmd.CommandText
+
+ ' Query
+ Set oRS = New ADODB.Recordset
+ oRS.Open cmd.CommandText, CN
+ Set oRS.ActiveConnection = Nothing
+ Set oRS = Nothing
+End Function
+
+Public Sub DisconnectFromSqlServer()
+ CN.Close
+ Set CN = Nothing
+End Sub
diff --git a/authentication/src/modSysTray.bas b/authentication/src/modSysTray.bas
new file mode 100644
index 0000000..c7dd8f8
--- /dev/null
+++ b/authentication/src/modSysTray.bas
@@ -0,0 +1,72 @@
+Attribute VB_Name = "modSysTray"
+Option Explicit
+
+Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
+Public Const KEYEVENTF_KEYUP = &H2
+Public Const VK_LWIN = &H5B
+
+'Declare a user-defined variable to pass to the Shell_NotifyIcon
+'function.
+Public Type NOTIFYICONDATA
+ cbSize As Long
+ hWnd As Long
+ uId As Long
+ uFlags As Long
+ uCallBackMessage As Long
+ hIcon As Long
+ szTip As String * 64
+End Type
+
+'Declare the constants for the API function. These constants can be
+'found in the header file Shellapi.h.
+'The following constants are the messages sent to the
+'Shell_NotifyIcon function to add, modify, or delete an icon from the System Tray
+Public Const NIM_ADD = &H0
+Public Const NIM_MODIFY = &H1
+Public Const NIM_DELETE = &H2
+'The following constant is the message sent when a mouse event occurs
+'within the rectangular boundaries of the icon in the System Tray
+'area.
+Public Const WM_MOUSEMOVE = &H200
+'The following constants are the flags that indicate the valid
+'members of the NOTIFYICONDATA data type.
+Public Const NIF_MESSAGE = &H1
+Public Const NIF_ICON = &H2
+Public Const NIF_TIP = &H4
+'The following constants are used to determine the mouse input on the
+'the icon in the taskbar status area.
+'Left-click constants.
+Public Const WM_LBUTTONDBLCLK = &H203 'Double-click
+Public Const WM_LBUTTONDOWN = &H201 'Button down
+Public Const WM_LBUTTONUP = &H202 'Button up
+'Right-click constants.
+Public Const WM_RBUTTONDBLCLK = &H206 'Double-click
+Public Const WM_RBUTTONDOWN = &H204 'Button down
+Public Const WM_RBUTTONUP = &H205 'Button up
+'Declare the API function call.
+Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
+'Dimension a variable as the user-defined data type.
+Global nid As NOTIFYICONDATA
+
+Public Sub DestroySystemTray()
+ nid.cbSize = Len(nid)
+ nid.hWnd = frmMain.hWnd
+ nid.uId = vbNull
+ nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
+ nid.uCallBackMessage = WM_MOUSEMOVE
+ nid.hIcon = frmMain.Icon
+ nid.szTip = "Authentication Server" & vbNullChar
+ Call Shell_NotifyIcon(NIM_DELETE, nid) ' Add to the sys tray
+End Sub
+
+Public Sub LoadSystemTray()
+ nid.cbSize = Len(nid)
+ nid.hWnd = frmMain.hWnd
+ nid.uId = vbNull
+ nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
+ nid.uCallBackMessage = WM_MOUSEMOVE
+ nid.hIcon = frmMain.Icon
+ nid.szTip = "Authentication Server" & vbNullChar 'You can add your game name or something.
+ Call Shell_NotifyIcon(NIM_ADD, nid) 'Add to the sys tray
+End Sub
+
diff --git a/authentication/src/modTCP.bas b/authentication/src/modTCP.bas
new file mode 100644
index 0000000..b474e77
--- /dev/null
+++ b/authentication/src/modTCP.bas
@@ -0,0 +1,216 @@
+Attribute VB_Name = "modTCP"
+Option Explicit
+
+Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+Public Function Current_IP(ByVal Index As Long) As String
+ Current_IP = frmMain.Socket(Index).RemoteHostIP
+End Function
+
+Function ConnectToGameServer() As Boolean
+Dim Wait As Long
+
+ ' Check to see if we are already connected, if so just exit
+ If IsConnectedGameServer Then
+ ConnectToGameServer = True
+ Exit Function
+ End If
+
+ Wait = GetTickCount
+ frmMain.ServerSocket.Close
+ frmMain.ServerSocket.RemoteHost = GAME_SERVER_IP
+ frmMain.ServerSocket.RemotePort = SERVER_AUTH_PORT
+ frmMain.ServerSocket.Connect
+
+ ' Wait until connected or 3 seconds have passed and report the server being down
+ 'Do While (Not IsConnectedGameServer) And (GetTickCount <= Wait + 3000)
+ ' Sleep 1
+ ' DoEvents
+ 'Loop
+
+ ConnectToGameServer = IsConnectedGameServer
+End Function
+
+Sub AcceptConnection(ByVal Index As Long, ByVal SocketId As Long)
+Dim I As Long
+
+ If Index = 0 Then
+ I = FindOpenPlayerSlot
+
+ If I <> 0 Then
+ ' Whoho, we can connect them
+ frmMain.Socket(I).Close
+ frmMain.Socket(I).Accept SocketId
+ SocketConnected I
+ End If
+ End If
+End Sub
+
+Sub SocketConnected(ByVal Index As Long)
+ AddText frmMain.txtLog, "Received connection from " & Current_IP(Index) & "."
+End Sub
+
+Sub IncomingData(ByVal Index As Long, ByVal DataLength As Long)
+Dim Buffer() As Byte
+Dim pLength As Long
+
+ ' Check for data flooding
+ If Player(Index).DataBytes > 1000 Then
+ Exit Sub
+ End If
+
+ ' Check for packet flooding
+ If Player(Index).DataPackets > 25 Then
+ Exit Sub
+ End If
+
+ ' Check if elapsed time has passed
+ Player(Index).DataBytes = Player(Index).DataBytes + DataLength
+ If GetTickCount >= Player(Index).DataTimer Then
+ Player(Index).DataTimer = GetTickCount + 1000
+ Player(Index).DataBytes = 0
+ Player(Index).DataPackets = 0
+ End If
+
+ ' Get the data from the socket now
+ frmMain.Socket(Index).GetData Buffer(), vbUnicode, DataLength
+ Player(Index).Buffer.WriteBytes Buffer()
+
+ If Player(Index).Buffer.Length >= 4 Then
+ pLength = Player(Index).Buffer.ReadLong(False)
+
+ If pLength < 0 Then
+ Exit Sub
+ End If
+ End If
+
+ Do While pLength > 0 And pLength <= Player(Index).Buffer.Length - 4
+ If pLength <= Player(Index).Buffer.Length - 4 Then
+ Player(Index).DataPackets = Player(Index).DataPackets + 1
+ Player(Index).Buffer.ReadLong
+ HandleData Index, Player(Index).Buffer.ReadBytes(pLength)
+ End If
+
+ pLength = 0
+ If Player(Index).Buffer.Length >= 4 Then
+ pLength = Player(Index).Buffer.ReadLong(False)
+
+ If pLength < 0 Then
+ Exit Sub
+ End If
+ End If
+ Loop
+
+ Player(Index).Buffer.Trim
+End Sub
+
+Sub CloseSocket(ByVal Index As Long)
+ ClearPlayer Index
+ AddText frmMain.txtLog, "Connection from " & Current_IP(Index) & " has been terminated."
+ frmMain.Socket(Index).Close
+End Sub
+
+Function FindOpenPlayerSlot() As Long
+Dim I As Long
+
+ For I = 1 To MAX_PLAYERS
+ If Not IsConnected(I) Then
+ FindOpenPlayerSlot = I
+ Exit Function
+ End If
+ Next
+End Function
+
+Function IsConnected(ByVal Index As Long) As Boolean
+ If frmMain.Socket(Index).State = sckConnected Then IsConnected = True
+End Function
+
+Function IsConnectedGameServer() As Boolean
+ IsConnectedGameServer = frmMain.ServerSocket.State = sckConnected
+End Function
+
+Sub SendDataTo(ByVal Index As Long, ByRef Data() As Byte)
+Dim Buffer As clsBuffer
+Dim tempData() As Byte
+
+ If IsConnected(Index) Then
+ Set Buffer = New clsBuffer
+ tempData = Data
+
+ Buffer.PreAllocate 4 + (UBound(tempData) - LBound(tempData)) + 1
+ Buffer.WriteLong (UBound(tempData) - LBound(tempData)) + 1
+ Buffer.WriteBytes tempData()
+
+ frmMain.Socket(Index).SendData Buffer.ToArray()
+
+ End If
+End Sub
+
+Sub SendDataToGameServer(ByRef Data() As Byte)
+Dim Buffer As clsBuffer
+Dim tempData() As Byte
+
+ Set Buffer = New clsBuffer
+ tempData = Data
+
+ If Not ConnectToGameServer Then Exit Sub
+
+ Buffer.PreAllocate 4 + (UBound(tempData) - LBound(tempData)) + 1
+ Buffer.WriteLong (UBound(tempData) - LBound(tempData)) + 1
+ Buffer.WriteBytes tempData()
+
+ frmMain.ServerSocket.SendData Buffer.ToArray()
+End Sub
+
+Sub HackingAttempt(ByVal Index As Long)
+ SendAlertMsg Index, DIALOGUE_MSG_CONNECTION
+End Sub
+
+Sub SendAlertMsg(ByVal Index As Long, ByVal Msg As Long, Optional ByVal menuReset As Long = 0, Optional ByVal kick As Boolean = True)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SAlertMsg
+ Buffer.WriteLong Msg
+ Buffer.WriteLong menuReset
+ If kick Then Buffer.WriteLong 1 Else Buffer.WriteLong 0
+
+ SendDataTo Index, Buffer.ToArray()
+
+ DoEvents
+
+ CloseSocket Index
+End Sub
+
+Public Sub SendLoginTokenToPlayer(Index As Long, loginToken As String)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSetPlayerLoginToken
+ Buffer.WriteString loginToken
+
+ SendDataTo Index, Buffer.ToArray()
+End Sub
+
+Public Sub SendLoginTokenToGameServer(Username As String, loginToken As String)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong ASetPlayerLoginToken
+ Buffer.WriteString Username
+ Buffer.WriteString loginToken
+ SendDataToGameServer Buffer.ToArray()
+End Sub
+
+Public Sub SendUsergroup(Username As String, usergroup As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong ASetUsergroup
+ Buffer.WriteString Username
+ Buffer.WriteLong usergroup
+ SendDataToGameServer Buffer.ToArray()
+End Sub
diff --git a/authentication/src/modVars.bas b/authentication/src/modVars.bas
new file mode 100644
index 0000000..8e59f1f
--- /dev/null
+++ b/authentication/src/modVars.bas
@@ -0,0 +1,245 @@
+Attribute VB_Name = "modVars"
+Option Explicit
+
+Public NumLines As Long
+Public Const MAX_LINES As Long = 100
+
+Public Declare Function GetTickCount Lib "kernel32" () As Long
+Public Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
+Public Declare Sub ZeroMemory Lib "Kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
+Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByRef Msg() As Byte, ByVal wParam As Long, ByVal lParam As Long) As Long
+
+Public Const CLIENT_MAJOR As Byte = 1
+Public Const CLIENT_MINOR As Byte = 8
+Public Const CLIENT_REVISION As Byte = 0
+
+Public Const GAME_SERVER_IP As String = "127.0.0.1" ' "46.23.70.66"
+Public Const GAME_SERVER_PORT As Long = 7001 ' the port used by the main game server
+Public Const AUTH_SERVER_PORT As Long = 7002 ' the port used for people to connect to auth server
+Public Const SERVER_AUTH_PORT As Long = 7003 ' the portal used for server to talk to auth server
+
+Public Const GAME_NAME As String = "Crystalshire"
+Public Const GAME_WEBSITE As String = "http://www.crystalshire.com"
+
+Public Const MAX_PLAYERS As Byte = 200
+
+Public classMD5 As clsMD5
+
+' Packets sent by authentication server to game server
+Public Enum AuthPackets
+ ASetPlayerLoginToken
+ ASetUsergroup
+End Enum
+
+' Packets sent by server to client
+Public Enum ServerPackets
+ SAlertMsg = 1
+ SLoginOk
+ SNewCharClasses
+ SClassesData
+ SInGame
+ SPlayerInv
+ SPlayerInvUpdate
+ SPlayerWornEq
+ SPlayerHp
+ SPlayerMp
+ SPlayerStats
+ SPlayerData
+ SPlayerMove
+ SNpcMove
+ SPlayerDir
+ SNpcDir
+ SPlayerXY
+ SPlayerXYMap
+ SAttack
+ SNpcAttack
+ SCheckForMap
+ SMapData
+ SMapItemData
+ SMapNpcData
+ SMapDone
+ SGlobalMsg
+ SAdminMsg
+ SPlayerMsg
+ SMapMsg
+ SSpawnItem
+ SItemEditor
+ SUpdateItem
+ SREditor
+ SSpawnNpc
+ SNpcDead
+ SNpcEditor
+ SUpdateNpc
+ SMapKey
+ SEditMap
+ SShopEditor
+ SUpdateShop
+ SSpellEditor
+ SUpdateSpell
+ SSpells
+ SLeft
+ SResourceCache
+ SResourceEditor
+ SUpdateResource
+ SSendPing
+ SDoorAnimation
+ SActionMsg
+ SPlayerEXP
+ SBlood
+ SAnimationEditor
+ SUpdateAnimation
+ SAnimation
+ SMapNpcVitals
+ SCooldown
+ SClearSpellBuffer
+ SSayMsg
+ SOpenShop
+ SResetShopAction
+ SStunned
+ SMapWornEq
+ SBank
+ STrade
+ SCloseTrade
+ STradeUpdate
+ STradeStatus
+ STarget
+ SHotbar
+ SHighIndex
+ SSound
+ STradeRequest
+ SPartyInvite
+ SPartyUpdate
+ SPartyVitals
+ SChatUpdate
+ SConvEditor
+ SUpdateConv
+ SStartTutorial
+ SChatBubble
+ SSetPlayerLoginToken
+ ' Make sure SMSG_COUNT is below everything else
+ SMSG_COUNT
+End Enum
+
+' Packets sent by client to server
+Public Enum ClientPackets
+ CNewAccount = 1
+ CDelAccount
+ CLogin
+ CAddChar
+ CUseChar
+ CSayMsg
+ CEmoteMsg
+ CBroadcastMsg
+ CPlayerMsg
+ CPlayerMove
+ CPlayerDir
+ CUseItem
+ CAttack
+ CUseStatPoint
+ CPlayerInfoRequest
+ CWarpMeTo
+ CWarpToMe
+ CWarpTo
+ CSetSprite
+ CGetStats
+ CRequestNewMap
+ CMapData
+ CNeedMap
+ CMapGetItem
+ CMapDropItem
+ CMapRespawn
+ CMapReport
+ CKickPlayer
+ CBanList
+ CBanDestroy
+ CBanPlayer
+ CRequestEditMap
+ CRequestEditItem
+ CSaveItem
+ CRequestEditNpc
+ CSaveNpc
+ CRequestEditShop
+ CSaveShop
+ CRequestEditSpell
+ CSaveSpell
+ CSetAccess
+ CWhosOnline
+ CSetMotd
+ CTarget
+ CSpells
+ CCast
+ CQuit
+ CSwapInvSlots
+ CRequestEditResource
+ CSaveResource
+ CCheckPing
+ CUnequip
+ CRequestPlayerData
+ CRequestItems
+ CRequestNPCS
+ CRequestResources
+ CSpawnItem
+ CRequestEditAnimation
+ CSaveAnimation
+ CRequestAnimations
+ CRequestSpells
+ CRequestShops
+ CRequestLevelUp
+ CForgetSpell
+ CCloseShop
+ CBuyItem
+ CSellItem
+ CChangeBankSlots
+ CDepositItem
+ CWithdrawItem
+ CCloseBank
+ CAdminWarp
+ CTradeRequest
+ CAcceptTrade
+ CDeclineTrade
+ CTradeItem
+ CUntradeItem
+ CHotbarChange
+ CHotbarUse
+ CSwapSpellSlots
+ CAcceptTradeRequest
+ CDeclineTradeRequest
+ CPartyRequest
+ CAcceptParty
+ CDeclineParty
+ CPartyLeave
+ CChatOption
+ CRequestEditConv
+ CSaveConv
+ CRequestConvs
+ CFinishTutorial
+ CAuthLogin
+ ' Make sure CMSG_COUNT is below everything else
+ CMSG_COUNT
+End Enum
+
+Public HandleDataSub(CMSG_COUNT) As Long
+
+' dialogue alert strings
+Public Const DIALOGUE_MSG_CONNECTION As Byte = 1
+Public Const DIALOGUE_MSG_BANNED As Byte = 2
+Public Const DIALOGUE_MSG_KICKED As Byte = 3
+Public Const DIALOGUE_MSG_OUTDATED As Byte = 4
+Public Const DIALOGUE_MSG_USERLENGTH As Byte = 5
+Public Const DIALOGUE_MSG_ILLEGALNAME As Byte = 6
+Public Const DIALOGUE_MSG_REBOOTING As Byte = 7
+Public Const DIALOGUE_MSG_NAMETAKEN As Byte = 8
+Public Const DIALOGUE_MSG_NAMELENGTH As Byte = 9
+Public Const DIALOGUE_MSG_NAMEILLEGAL As Byte = 10
+Public Const DIALOGUE_MSG_MYSQL As Byte = 11
+Public Const DIALOGUE_MSG_WRONGPASS As Byte = 12
+Public Const DIALOGUE_MSG_ACTIVATED As Byte = 13
+
+' Menu
+Public Const MENU_MAIN As Byte = 1
+Public Const MENU_LOGIN As Byte = 2
+Public Const MENU_REGISTER As Byte = 3
+Public Const MENU_CREDITS As Byte = 4
+Public Const MENU_CLASS As Byte = 5
+Public Const MENU_NEWCHAR As Byte = 6
+Public Const MENU_CHARS As Byte = 7
diff --git a/client/client.vbp b/client/client.vbp
new file mode 100644
index 0000000..8a33100
--- /dev/null
+++ b/client/client.vbp
@@ -0,0 +1,74 @@
+Type=Exe
+Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#..\..\..\..\..\Windows\SysWow64\dx8vb.dll#DirectX 8 for Visual Basic Type Library
+Reference=*\G{56A868B0-0AD4-11CE-B03A-0020AF0BA770}#1.0#0#quartz.dll#ActiveMovie control type library
+Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX
+Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
+Form=src\frmMain.frm
+Module=modText; Src\modText.bas
+Module=modTypes; Src\modTypes.bas
+Module=modGameLogic; Src\modGameLogic.bas
+Module=modClientTCP; Src\modClientTCP.bas
+Form=Src\frmMapProperties.frm
+Form=Src\frmEditor_Item.frm
+Module=modDatabase; Src\modDatabase.bas
+Form=Src\frmEditor_NPC.frm
+Form=Src\frmEditor_Shop.frm
+Module=modConstants; Src\modConstants.bas
+Module=modGlobals; Src\modGlobals.bas
+Module=modGeneral; Src\modGeneral.bas
+Module=modGameEditors; Src\modGameEditors.bas
+Module=modEnumerations; Src\modEnumerations.bas
+Module=modHandleData; Src\modHandleData.bas
+Module=modInput; Src\modInput.bas
+Class=clsBuffer; Src\clsBuffer.cls
+Form=Src\frmEditor_Map.frm
+Form=Src\frmEditor_Resource.frm
+Form=Src\frmEditor_Animation.frm
+Form=Src\frmEditor_Spell.frm
+Module=modDirectX8; src\modDirectX8.bas
+Module=modMusic; src\modMusic.bas
+Form=src\frmEditor_Conv.frm
+Module=modInterface; src\modInterface.bas
+Module=modInterfaceEvents; src\modInterfaceEvents.bas
+Module=modVideo; src\modVideo.bas
+Form=src\frmEditor_Events.frm
+Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL32.OCX
+Module=modEvents; src\modEvents.bas
+IconForm="frmMain"
+Startup="Sub Main"
+HelpFile=""
+NoControlUpgrade=1
+Title="Crystalshire"
+ExeName32="client.exe"
+Command32=""
+Name="Crystalshire"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=3
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Robin Perris Corp."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=-1
+BoundsCheck=-1
+OverflowCheck=-1
+FlPointCheck=-1
+FDIVCheck=-1
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0
+
+[MS Transaction Server]
+AutoRefresh=1
+
+[CodeSMART]
+Task_UID=27_06_11_09_23_49
diff --git a/client/src/clsBuffer.cls b/client/src/clsBuffer.cls
new file mode 100644
index 0000000..b621f1a
--- /dev/null
+++ b/client/src/clsBuffer.cls
@@ -0,0 +1,165 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+ Persistable = 0 'NotPersistable
+ DataBindingBehavior = 0 'vbNone
+ DataSourceBehavior = 0 'vbNone
+ MTSTransactionMode = 0 'NotAnMTSObject
+END
+Attribute VB_Name = "clsBuffer"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+Private Buffer() As Byte
+Private buffersize As Long
+Private WriteHead As Long
+Private ReadHead As Long
+
+Private Sub Class_Initialize()
+ Flush
+End Sub
+
+Public Sub PreAllocate(ByVal nLength As Long)
+ WriteHead = 0
+ ReadHead = 0
+ buffersize = nLength - 1
+ ReDim Buffer(0 To buffersize)
+End Sub
+
+Public Sub Allocate(ByVal nLength As Long)
+
+ If buffersize = 0 And nLength > 1 Then nLength = nLength - 1
+ buffersize = buffersize + nLength
+ ReDim Preserve Buffer(0 To buffersize)
+End Sub
+
+Public Sub Flush()
+ WriteHead = 0
+ ReadHead = 0
+ buffersize = 0
+ ReDim Buffer(0)
+End Sub
+
+Public Sub Trim()
+ Dim c As Long
+
+ ' If the readhead is past the buffersize, this means everything has been read in the array, flush it
+ If ReadHead >= count Then
+ Flush
+ End If
+
+End Sub
+
+Public Sub WriteByte(ByVal nByte As Byte)
+
+ If WriteHead > buffersize Then Allocate 1
+ Buffer(WriteHead) = nByte
+ WriteHead = WriteHead + 1
+End Sub
+
+Public Sub WriteBytes(ByRef nByte() As Byte)
+ Dim nLength As Long
+ nLength = (UBound(nByte) - LBound(nByte)) + 1
+
+ If WriteHead + nLength - 1 > buffersize Then Allocate nLength
+ CopyMemory Buffer(WriteHead), nByte(0), nLength
+ WriteHead = WriteHead + nLength
+End Sub
+
+Public Sub WriteInteger(ByVal nInteger As Integer)
+
+ If WriteHead + 1 > buffersize Then Allocate 2
+ CopyMemory Buffer(WriteHead), nInteger, 2
+ WriteHead = WriteHead + 2
+End Sub
+
+Public Sub WriteLong(ByVal nLong As Long)
+
+ If WriteHead + 3 > buffersize Then Allocate 4
+ CopyMemory Buffer(WriteHead), nLong, 4
+ WriteHead = WriteHead + 4
+End Sub
+
+Public Sub WriteString(ByRef nString As String)
+ Dim sBytes() As Byte
+ Dim sLength As Long
+ sLength = Len(nString)
+ sBytes = StrConv(nString, vbFromUnicode)
+ WriteLong sLength
+
+ If sLength <= 0 Then Exit Sub
+ If WriteHead + sLength - 1 > buffersize Then Allocate sLength
+ CopyMemory Buffer(WriteHead), sBytes(0), sLength
+ WriteHead = WriteHead + sLength
+End Sub
+
+Public Function ReadByte(Optional MoveReadHead As Boolean = True) As Byte
+
+ If ReadHead > buffersize Then Exit Function
+ ReadByte = Buffer(ReadHead)
+
+ If MoveReadHead Then ReadHead = ReadHead + 1
+End Function
+
+Public Function ReadBytes(ByVal nLength As Long, Optional MoveReadHead As Boolean = True) As Byte()
+ Dim data() As Byte
+
+ If nLength = 0 Then Exit Function
+ If ReadHead + nLength - 1 > buffersize Then Exit Function
+ ReDim data(nLength - 1)
+ CopyMemory data(0), Buffer(ReadHead), nLength
+
+ If MoveReadHead Then ReadHead = ReadHead + nLength
+ ReadBytes = data
+End Function
+
+Public Function ReadInteger(Optional MoveReadHead As Boolean = True) As Integer
+
+ If ReadHead + 1 > buffersize Then Exit Function
+ CopyMemory ReadInteger, Buffer(ReadHead), 2
+
+ If MoveReadHead Then ReadHead = ReadHead + 2
+End Function
+
+Public Function ReadLong(Optional MoveReadHead As Boolean = True) As Long
+
+ If ReadHead + 3 > buffersize Then Exit Function
+ CopyMemory ReadLong, Buffer(ReadHead), 4
+
+ If MoveReadHead Then ReadHead = ReadHead + 4
+End Function
+
+Public Function ReadString(Optional MoveReadHead As Boolean = True) As String
+ Dim sLength As Long
+ Dim sBytes() As Byte
+ sLength = ReadLong(False)
+
+ If sLength <= 0 Then
+ If MoveReadHead Then ReadHead = ReadHead + 4
+ Exit Function
+ End If
+
+ ReDim sBytes(sLength - 1)
+ CopyMemory sBytes(0), Buffer(ReadHead + 4), sLength
+ ReadString = StrConv(sBytes, vbUnicode)
+
+ If MoveReadHead Then ReadHead = ReadHead + sLength + 4
+End Function
+
+Public Function count() As Long
+ count = (UBound(Buffer) - LBound(Buffer)) + 1
+End Function
+
+Public Function length() As Long
+ length = count - ReadHead
+End Function
+
+Public Function ToArray() As Byte()
+ ToArray = Buffer()
+End Function
+
+Public Function ToString() As String
+ ToString = StrConv(Buffer, vbUnicode)
+End Function
diff --git a/client/src/frmDrop.frm b/client/src/frmDrop.frm
new file mode 100644
index 0000000..b16fa0f
--- /dev/null
+++ b/client/src/frmDrop.frm
@@ -0,0 +1,139 @@
+VERSION 5.00
+Begin VB.Form frmDrop
+ BorderStyle = 1 'Fixed Single
+ ClientHeight = 1710
+ ClientLeft = 15
+ ClientTop = 15
+ ClientWidth = 5415
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Tahoma"
+ Size = 9.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmDrop.frx":0000
+ KeyPreview = -1 'True
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 114
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 361
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Begin VB.TextBox txtDrop
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 360
+ Left = 1440
+ TabIndex = 1
+ Top = 600
+ Width = 3855
+ End
+ Begin VB.CommandButton cmdOk
+ Caption = "Ok"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 120
+ TabIndex = 2
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 2760
+ TabIndex = 3
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.Label Label2
+ Caption = "Amount"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 120
+ TabIndex = 5
+ Top = 600
+ UseMnemonic = 0 'False
+ Width = 1095
+ End
+ Begin VB.Label Label1
+ Caption = "Item"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ UseMnemonic = 0 'False
+ Width = 1095
+ End
+ Begin VB.Label lblName
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 1320
+ TabIndex = 4
+ Top = 120
+ Width = 3855
+ End
+End
+Attribute VB_Name = "frmDrop"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+' ******************************************
+' ** Wind's Nocturne **
+' ******************************************
diff --git a/client/src/frmDrop.frx b/client/src/frmDrop.frx
new file mode 100644
index 0000000..72e7565
Binary files /dev/null and b/client/src/frmDrop.frx differ
diff --git a/client/src/frmEditor_Animation.frm b/client/src/frmEditor_Animation.frm
new file mode 100644
index 0000000..89a7762
--- /dev/null
+++ b/client/src/frmEditor_Animation.frm
@@ -0,0 +1,432 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Animation
+ BorderStyle = 1 'Fixed Single
+ Caption = "Animation Editor"
+ ClientHeight = 7350
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 9975
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 7350
+ ScaleWidth = 9975
+ StartUpPosition = 2 'CenterScreen
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 5760
+ TabIndex = 21
+ Top = 6840
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 7440
+ TabIndex = 20
+ Top = 6840
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 4080
+ TabIndex = 19
+ Top = 6840
+ Width = 1455
+ End
+ Begin VB.Frame Frame1
+ Caption = "Animation Properties"
+ Height = 6615
+ Left = 3360
+ TabIndex = 3
+ Top = 120
+ Width = 6495
+ Begin VB.PictureBox picSprite
+ Appearance = 0 'Flat
+ AutoRedraw = -1 'True
+ BackColor = &H80000005&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H80000008&
+ Height = 2940
+ Index = 0
+ Left = 120
+ ScaleHeight = 196
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 196
+ TabIndex = 30
+ Top = 3480
+ Width = 2940
+ End
+ Begin VB.ComboBox cmbSound
+ Height = 300
+ Left = 4080
+ Style = 2 'Dropdown List
+ TabIndex = 29
+ Top = 240
+ Width = 2295
+ End
+ Begin VB.HScrollBar scrlLoopTime
+ Height = 255
+ Index = 1
+ Left = 3360
+ TabIndex = 27
+ Top = 3120
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlLoopTime
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 25
+ Top = 3120
+ Width = 3015
+ End
+ Begin VB.TextBox txtName
+ Height = 285
+ Left = 840
+ TabIndex = 23
+ Top = 240
+ Width = 2535
+ End
+ Begin VB.HScrollBar scrlFrameCount
+ Height = 255
+ Index = 1
+ Left = 3360
+ TabIndex = 17
+ Top = 2520
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlLoopCount
+ Height = 255
+ Index = 1
+ Left = 3360
+ TabIndex = 15
+ Top = 1920
+ Width = 2895
+ End
+ Begin VB.PictureBox picSprite
+ Appearance = 0 'Flat
+ AutoRedraw = -1 'True
+ BackColor = &H80000005&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H80000008&
+ Height = 2940
+ Index = 1
+ Left = 3360
+ ScaleHeight = 196
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 196
+ TabIndex = 13
+ Top = 3480
+ Width = 2940
+ End
+ Begin VB.HScrollBar scrlSprite
+ Height = 255
+ Index = 1
+ Left = 3360
+ TabIndex = 12
+ Top = 1320
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlFrameCount
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 10
+ Top = 2520
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlLoopCount
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 8
+ Top = 1920
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlSprite
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 6
+ Top = 1320
+ Width = 3015
+ End
+ Begin VB.Label Label3
+ Caption = "Sound:"
+ Height = 255
+ Left = 3480
+ TabIndex = 28
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.Label lblLoopTime
+ Caption = "Loop Time: 0"
+ Height = 255
+ Index = 1
+ Left = 3360
+ TabIndex = 26
+ Top = 2880
+ Width = 2655
+ End
+ Begin VB.Label lblLoopTime
+ Caption = "Loop Time: 0"
+ Height = 255
+ Index = 0
+ Left = 120
+ TabIndex = 24
+ Top = 2880
+ Width = 2655
+ End
+ Begin VB.Label Label1
+ Caption = "Name:"
+ Height = 255
+ Left = 120
+ TabIndex = 22
+ Top = 240
+ Width = 1575
+ End
+ Begin VB.Label Label9
+ AutoSize = -1 'True
+ Caption = "Layer 1 (Above Player)"
+ Height = 180
+ Left = 3360
+ TabIndex = 18
+ Top = 720
+ Width = 1740
+ End
+ Begin VB.Label lblFrameCount
+ AutoSize = -1 'True
+ Caption = "Frame Count: 0"
+ Height = 180
+ Index = 1
+ Left = 3360
+ TabIndex = 16
+ Top = 2280
+ Width = 1170
+ End
+ Begin VB.Label lblLoopCount
+ AutoSize = -1 'True
+ Caption = "Loop Count: 0"
+ Height = 180
+ Index = 1
+ Left = 3360
+ TabIndex = 14
+ Top = 1680
+ Width = 1065
+ End
+ Begin VB.Label lblSprite
+ AutoSize = -1 'True
+ Caption = "Sprite: 0"
+ Height = 180
+ Index = 1
+ Left = 3360
+ TabIndex = 11
+ Top = 1080
+ Width = 660
+ End
+ Begin VB.Label lblFrameCount
+ AutoSize = -1 'True
+ Caption = "Frame Count: 0"
+ Height = 180
+ Index = 0
+ Left = 120
+ TabIndex = 9
+ Top = 2280
+ Width = 1170
+ End
+ Begin VB.Label lblLoopCount
+ AutoSize = -1 'True
+ Caption = "Loop Count: 0"
+ Height = 180
+ Index = 0
+ Left = 120
+ TabIndex = 7
+ Top = 1680
+ Width = 1065
+ End
+ Begin VB.Label lblSprite
+ AutoSize = -1 'True
+ Caption = "Sprite: 0"
+ Height = 180
+ Index = 0
+ Left = 120
+ TabIndex = 5
+ Top = 1080
+ Width = 660
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Layer 0 (Below Player)"
+ Height = 180
+ Left = 120
+ TabIndex = 4
+ Top = 720
+ Width = 1695
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Enabled = 0 'False
+ Height = 375
+ Left = 240
+ TabIndex = 2
+ Top = 6840
+ Width = 2895
+ End
+ Begin VB.Frame Frame3
+ Caption = "Animation List"
+ Height = 6615
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 6300
+ ItemData = "frmEditor_Animation.frx":0000
+ Left = 120
+ List = "frmEditor_Animation.frx":0002
+ TabIndex = 1
+ Top = 240
+ Width = 2895
+ End
+ End
+End
+Attribute VB_Name = "frmEditor_Animation"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmbSound_Click()
+
+ If cmbSound.ListIndex >= 0 Then
+ Animation(EditorIndex).sound = cmbSound.List(cmbSound.ListIndex)
+ Else
+ Animation(EditorIndex).sound = "None."
+ End If
+
+End Sub
+
+Private Sub cmdCancel_Click()
+ AnimationEditorCancel
+End Sub
+
+Private Sub cmdDelete_Click()
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ANIMATIONS Then Exit Sub
+ ClearAnimation EditorIndex
+ tmpIndex = lstIndex.ListIndex
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Animation(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+ AnimationEditorInit
+End Sub
+
+Private Sub cmdSave_Click()
+ AnimationEditorOk
+End Sub
+
+Private Sub Form_Load()
+ Dim i As Long
+
+ For i = 0 To 1
+ scrlSprite(i).Max = Count_Anim
+ scrlLoopCount(i).Max = 100
+ scrlFrameCount(i).Max = 100
+ scrlLoopTime(i).Max = 1000
+ Next
+
+End Sub
+
+Private Sub lstIndex_Click()
+ AnimationEditorInit
+End Sub
+
+Private Sub scrlFrameCount_Change(index As Integer)
+ lblFrameCount(index).caption = "Frame Count: " & scrlFrameCount(index).value
+ Animation(EditorIndex).Frames(index) = scrlFrameCount(index).value
+End Sub
+
+Private Sub scrlFrameCount_Scroll(index As Integer)
+ scrlFrameCount_Change index
+End Sub
+
+Private Sub scrlLoopCount_Change(index As Integer)
+ lblLoopCount(index).caption = "Loop Count: " & scrlLoopCount(index).value
+ Animation(EditorIndex).LoopCount(index) = scrlLoopCount(index).value
+End Sub
+
+Private Sub scrlLoopCount_Scroll(index As Integer)
+ scrlLoopCount_Change index
+End Sub
+
+Private Sub scrlLoopTime_Change(index As Integer)
+ lblLoopTime(index).caption = "Loop Time: " & scrlLoopTime(index).value
+ Animation(EditorIndex).looptime(index) = scrlLoopTime(index).value
+End Sub
+
+Private Sub scrlLoopTime_Scroll(index As Integer)
+ scrlLoopTime_Change index
+End Sub
+
+Private Sub scrlSprite_Change(index As Integer)
+ lblSprite(index).caption = "Sprite: " & scrlSprite(index).value
+ Animation(EditorIndex).sprite(index) = scrlSprite(index).value
+End Sub
+
+Private Sub scrlSprite_Scroll(index As Integer)
+ scrlSprite_Change index
+End Sub
+
+Private Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ANIMATIONS Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Animation(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Animation(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
diff --git a/client/src/frmEditor_Animation.frx b/client/src/frmEditor_Animation.frx
new file mode 100644
index 0000000..593f470
Binary files /dev/null and b/client/src/frmEditor_Animation.frx differ
diff --git a/client/src/frmEditor_Conv.frm b/client/src/frmEditor_Conv.frm
new file mode 100644
index 0000000..0e7d266
--- /dev/null
+++ b/client/src/frmEditor_Conv.frm
@@ -0,0 +1,512 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Conv
+ BorderStyle = 1 'Fixed Single
+ Caption = "Conversation Editor"
+ ClientHeight = 8310
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 7710
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ ScaleHeight = 554
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 514
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 4920
+ TabIndex = 23
+ Top = 7800
+ Width = 1095
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 6240
+ TabIndex = 22
+ Top = 7800
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 3480
+ TabIndex = 21
+ Top = 7800
+ Width = 1215
+ End
+ Begin VB.Frame fraConv
+ Caption = "Conversation - 1"
+ Height = 6495
+ Left = 3360
+ TabIndex = 6
+ Top = 1200
+ Width = 4215
+ Begin VB.HScrollBar scrlData3
+ Height = 255
+ Left = 1680
+ Max = 1000
+ TabIndex = 30
+ Top = 6120
+ Value = 1
+ Width = 2415
+ End
+ Begin VB.HScrollBar scrlData2
+ Height = 255
+ Left = 1680
+ Max = 1000
+ TabIndex = 28
+ Top = 5760
+ Value = 1
+ Width = 2415
+ End
+ Begin VB.HScrollBar scrlData1
+ Height = 255
+ Left = 1680
+ Max = 1000
+ TabIndex = 26
+ Top = 5400
+ Value = 1
+ Width = 2415
+ End
+ Begin VB.ComboBox cmbEvent
+ Height = 315
+ ItemData = "frmEditor_Conv.frx":0000
+ Left = 120
+ List = "frmEditor_Conv.frx":0013
+ Style = 2 'Dropdown List
+ TabIndex = 25
+ Top = 5040
+ Width = 3975
+ End
+ Begin VB.HScrollBar scrlConv
+ Height = 255
+ Left = 120
+ Min = 1
+ TabIndex = 20
+ Top = 240
+ Value = 1
+ Width = 3975
+ End
+ Begin VB.ComboBox cmbReply
+ Height = 315
+ Index = 4
+ Left = 3000
+ Style = 2 'Dropdown List
+ TabIndex = 17
+ Top = 4335
+ Width = 1095
+ End
+ Begin VB.TextBox txtReply
+ Height = 285
+ Index = 4
+ Left = 120
+ TabIndex = 16
+ Top = 4350
+ Width = 2775
+ End
+ Begin VB.ComboBox cmbReply
+ Height = 315
+ Index = 3
+ Left = 3000
+ Style = 2 'Dropdown List
+ TabIndex = 15
+ Top = 3975
+ Width = 1095
+ End
+ Begin VB.TextBox txtReply
+ Height = 285
+ Index = 3
+ Left = 120
+ TabIndex = 14
+ Top = 3990
+ Width = 2775
+ End
+ Begin VB.ComboBox cmbReply
+ Height = 315
+ Index = 2
+ Left = 3000
+ Style = 2 'Dropdown List
+ TabIndex = 13
+ Top = 3615
+ Width = 1095
+ End
+ Begin VB.TextBox txtReply
+ Height = 285
+ Index = 2
+ Left = 120
+ TabIndex = 12
+ Top = 3630
+ Width = 2775
+ End
+ Begin VB.ComboBox cmbReply
+ Height = 315
+ Index = 1
+ Left = 3000
+ Style = 2 'Dropdown List
+ TabIndex = 11
+ Top = 3225
+ Width = 1095
+ End
+ Begin VB.TextBox txtReply
+ Height = 285
+ Index = 1
+ Left = 120
+ TabIndex = 10
+ Top = 3240
+ Width = 2775
+ End
+ Begin VB.TextBox txtConv
+ Height = 2055
+ Left = 120
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 8
+ Top = 840
+ Width = 3975
+ End
+ Begin VB.Label lblData3
+ AutoSize = -1 'True
+ Caption = "Data3: 0"
+ Height = 195
+ Left = 120
+ TabIndex = 31
+ Top = 6120
+ UseMnemonic = 0 'False
+ Width = 750
+ End
+ Begin VB.Label lblData2
+ AutoSize = -1 'True
+ Caption = "Data2: 0"
+ Height = 195
+ Left = 120
+ TabIndex = 29
+ Top = 5760
+ UseMnemonic = 0 'False
+ Width = 750
+ End
+ Begin VB.Label lblData1
+ AutoSize = -1 'True
+ Caption = "Data1: 0"
+ Height = 195
+ Left = 120
+ TabIndex = 27
+ Top = 5400
+ UseMnemonic = 0 'False
+ Width = 750
+ End
+ Begin VB.Label Label4
+ Caption = "Event:"
+ Height = 255
+ Left = 120
+ TabIndex = 24
+ Top = 4800
+ Width = 1815
+ End
+ Begin VB.Label Label3
+ Caption = "Replies:"
+ Height = 255
+ Left = 120
+ TabIndex = 9
+ Top = 3000
+ Width = 1815
+ End
+ Begin VB.Label Label2
+ Caption = "Text:"
+ Height = 255
+ Left = 120
+ TabIndex = 7
+ Top = 600
+ Width = 2895
+ End
+ End
+ Begin VB.Frame Frame1
+ Caption = "Info"
+ Height = 975
+ Left = 3360
+ TabIndex = 3
+ Top = 120
+ Width = 4215
+ Begin VB.HScrollBar scrlChatCount
+ Height = 255
+ Left = 1680
+ Max = 100
+ Min = 1
+ TabIndex = 19
+ Top = 600
+ Value = 1
+ Width = 2415
+ End
+ Begin VB.TextBox txtName
+ Height = 255
+ Left = 840
+ TabIndex = 4
+ Top = 240
+ Width = 3255
+ End
+ Begin VB.Label lblChatCount
+ AutoSize = -1 'True
+ Caption = "Chat Count: 1"
+ Height = 195
+ Left = 120
+ TabIndex = 18
+ Top = 600
+ UseMnemonic = 0 'False
+ Width = 1215
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Name:"
+ Height = 180
+ Left = 120
+ TabIndex = 5
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ End
+ Begin VB.Frame Frame3
+ Caption = "Conversation List"
+ Height = 7575
+ Left = 120
+ TabIndex = 1
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ Height = 7080
+ Left = 120
+ TabIndex = 2
+ Top = 240
+ Width = 2895
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Height = 375
+ Left = 240
+ TabIndex = 0
+ Top = 7800
+ Width = 2895
+ End
+End
+Attribute VB_Name = "frmEditor_Conv"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Dim curConv As Long
+
+Private Sub cmbEvent_Click()
+
+ Select Case cmbEvent.ListIndex
+
+ Case 0, 2 ' None, Bank
+ ' set max values
+ scrlData1.Max = 1
+ scrlData2.Max = 1
+ scrlData3.Max = 1
+ ' hide / unhide
+ scrlData1.visible = False
+ scrlData2.visible = False
+ scrlData3.visible = False
+ lblData1.visible = False
+ lblData2.visible = False
+ lblData3.visible = False
+
+ Case 1 ' Shop
+ ' set max values
+ scrlData1.Max = MAX_SHOPS
+ scrlData2.Max = 1
+ scrlData3.Max = 1
+ ' hide / unhide
+ scrlData1.visible = True
+ scrlData2.visible = False
+ scrlData3.visible = False
+ lblData1.visible = True
+ lblData2.visible = False
+ lblData3.visible = False
+ ' set strings
+ lblData1.caption = "Shop: None"
+
+ Case 3 ' Give Item
+ ' set max values
+ scrlData1.Max = MAX_ITEMS
+ scrlData2.Max = 32000
+ scrlData3.Max = 1
+ ' hide / unhide
+ scrlData1.visible = True
+ scrlData2.visible = True
+ scrlData3.visible = False
+ lblData1.visible = True
+ lblData2.visible = True
+ lblData3.visible = False
+ ' set strings
+ lblData1.caption = "Item: None"
+ lblData2.caption = "Amount: " & scrlData2.value
+
+ Case 4 ' Unique
+ scrlData1.Max = 32000
+ scrlData2.Max = 32000
+ scrlData3.Max = 32000
+ ' hide
+ scrlData1.visible = True
+ scrlData2.visible = True
+ scrlData3.visible = True
+ lblData1.visible = True
+ lblData2.visible = True
+ lblData3.visible = True
+ ' set the strings
+ lblData1.caption = "Data1: 0"
+ lblData2.caption = "Data2: 0"
+ lblData3.caption = "Data3: 0"
+ End Select
+
+ If EditorIndex > 0 And EditorIndex <= MAX_CONVS Then
+ If curConv = 0 Then Exit Sub
+ Conv(EditorIndex).Conv(curConv).Event = cmbEvent.ListIndex
+ End If
+
+End Sub
+
+Private Sub cmdDelete_Click()
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Or EditorIndex > MAX_CONVS Then Exit Sub
+ ClearConv EditorIndex
+ tmpIndex = lstIndex.ListIndex
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Conv(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+ ConvEditorInit
+End Sub
+
+Private Sub cmdSave_Click()
+ Call ConvEditorOk
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call ConvEditorCancel
+End Sub
+
+Private Sub Form_Load()
+ cmbEvent.ListIndex = 0
+End Sub
+
+Private Sub lstIndex_Click()
+ Call ConvEditorInit
+End Sub
+
+Private Sub scrlChatCount_Change()
+ lblChatCount.caption = "Chat Count: " & scrlChatCount.value
+ Conv(EditorIndex).chatCount = scrlChatCount.value
+ scrlConv.Max = scrlChatCount.value
+ ReDim Preserve Conv(EditorIndex).Conv(1 To scrlChatCount.value) As ConvRec
+End Sub
+
+Private Sub scrlConv_Change()
+ Dim x As Long
+ curConv = scrlConv.value
+ fraConv.caption = "Conversation - " & curConv
+
+ With Conv(EditorIndex).Conv(curConv)
+ txtConv.text = .Conv
+
+ For x = 1 To 4
+ txtReply(x).text = .rText(x)
+ cmbReply(x).ListIndex = .rTarget(x)
+ Next
+
+ cmbEvent.ListIndex = .Event
+ scrlData1.value = .Data1
+ scrlData2.value = .Data2
+ scrlData3.value = .Data3
+ End With
+
+End Sub
+
+Private Sub scrlData1_Change()
+
+ Select Case cmbEvent.ListIndex
+
+ Case 1 ' shop
+
+ If scrlData1.value > 0 Then
+ lblData1.caption = "Shop: " & Trim$(Shop(scrlData1.value).name)
+ Else
+ lblData1.caption = "Shop: None"
+ End If
+
+ Case 3 ' Give item
+
+ If scrlData1.value > 0 Then
+ lblData1.caption = "Item: " & Trim$(Shop(scrlData1.value).name)
+ Else
+ lblData1.caption = "Item: None"
+ End If
+
+ Case 4 ' Unique
+ lblData1.caption = "Data1: " & scrlData1.value
+ End Select
+
+ Conv(EditorIndex).Conv(curConv).Data1 = scrlData1.value
+End Sub
+
+Private Sub scrlData2_Change()
+
+ Select Case cmbEvent.ListIndex
+
+ Case 3 ' Give item
+ lblData2.caption = "Amount: " & scrlData2.value
+
+ Case 4 ' Unique
+ lblData1.caption = "Data2: " & scrlData2.value
+ End Select
+
+ Conv(EditorIndex).Conv(curConv).Data2 = scrlData2.value
+End Sub
+
+Private Sub scrlData3_Change()
+
+ Select Case cmbEvent.ListIndex
+
+ Case 4 ' Unique
+ lblData1.caption = "Data3: " & scrlData3.value
+ End Select
+
+ Conv(EditorIndex).Conv(curConv).Data3 = scrlData3.value
+End Sub
+
+Private Sub txtConv_Change()
+ Conv(EditorIndex).Conv(curConv).Conv = txtConv.text
+End Sub
+
+Private Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Or EditorIndex > MAX_CONVS Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Conv(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Conv(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
+
+Private Sub txtReply_Change(index As Integer)
+ Conv(EditorIndex).Conv(curConv).rText(index) = txtReply(index).text
+End Sub
+
+Private Sub cmbReply_Click(index As Integer)
+ Conv(EditorIndex).Conv(curConv).rTarget(index) = cmbReply(index).ListIndex
+End Sub
diff --git a/client/src/frmEditor_Conv.frx b/client/src/frmEditor_Conv.frx
new file mode 100644
index 0000000..1611576
Binary files /dev/null and b/client/src/frmEditor_Conv.frx differ
diff --git a/client/src/frmEditor_Events.frm b/client/src/frmEditor_Events.frm
new file mode 100644
index 0000000..52f91b3
--- /dev/null
+++ b/client/src/frmEditor_Events.frm
@@ -0,0 +1,1787 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL32.OCX"
+Begin VB.Form frmEditor_Events
+ BorderStyle = 1 'Fixed Single
+ Caption = "Event Editor"
+ ClientHeight = 9870
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 12855
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 658
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 857
+ StartUpPosition = 2 'CenterScreen
+ Begin VB.Frame fraGraphic
+ Caption = "Graphic Selection"
+ Height = 9135
+ Left = 120
+ TabIndex = 119
+ Top = 120
+ Visible = 0 'False
+ Width = 12615
+ Begin VB.PictureBox picGraphicSel
+ BackColor = &H00FFFFFF&
+ BorderStyle = 0 'None
+ Height = 7800
+ Left = 240
+ ScaleHeight = 520
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 808
+ TabIndex = 126
+ Top = 720
+ Width = 12120
+ End
+ Begin VB.CommandButton cmdGraphicCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 11040
+ TabIndex = 125
+ Top = 8640
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdGraphicOK
+ Caption = "OK"
+ Height = 375
+ Left = 9480
+ TabIndex = 124
+ Top = 8640
+ Width = 1455
+ End
+ Begin VB.ComboBox cmbGraphic
+ Height = 315
+ ItemData = "frmEditor_Events.frx":0000
+ Left = 720
+ List = "frmEditor_Events.frx":000D
+ Style = 2 'Dropdown List
+ TabIndex = 121
+ Top = 240
+ Width = 2175
+ End
+ Begin VB.HScrollBar scrlGraphic
+ Height = 255
+ Left = 4440
+ TabIndex = 120
+ Top = 240
+ Width = 2535
+ End
+ Begin VB.Label Label6
+ Caption = "Type:"
+ Height = 255
+ Left = 120
+ TabIndex = 123
+ Top = 270
+ Width = 855
+ End
+ Begin VB.Label lblGraphic
+ Caption = "Number: 1"
+ Height = 255
+ Left = 3000
+ TabIndex = 122
+ Top = 240
+ Width = 2055
+ End
+ End
+ Begin VB.Frame fraDialogue
+ Height = 7455
+ Left = 6240
+ TabIndex = 91
+ Top = 1560
+ Visible = 0 'False
+ Width = 6375
+ Begin VB.Frame fraWarpPlayer
+ Caption = "Warp Player"
+ Height = 3015
+ Left = 1200
+ TabIndex = 134
+ Top = 2040
+ Width = 4095
+ Begin VB.CommandButton cmdWPCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 2760
+ TabIndex = 142
+ Top = 2520
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdWPOkay
+ Caption = "Ok"
+ Height = 375
+ Left = 1440
+ TabIndex = 141
+ Top = 2520
+ Width = 1215
+ End
+ Begin VB.HScrollBar scrlWPY
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 140
+ Top = 1800
+ Width = 3855
+ End
+ Begin VB.HScrollBar scrlWPX
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 138
+ Top = 1200
+ Width = 3855
+ End
+ Begin VB.HScrollBar scrlWPMap
+ Height = 255
+ Left = 120
+ TabIndex = 136
+ Top = 600
+ Width = 3855
+ End
+ Begin VB.Label lblWPY
+ Caption = "Y: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 139
+ Top = 1560
+ Width = 3135
+ End
+ Begin VB.Label lblWPX
+ Caption = "X: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 137
+ Top = 960
+ Width = 3135
+ End
+ Begin VB.Label lblWPMap
+ Caption = "Map: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 135
+ Top = 360
+ Width = 3135
+ End
+ End
+ Begin VB.Frame fraChatBubble
+ Caption = "Chat Bubble"
+ Height = 5295
+ Left = 1200
+ TabIndex = 109
+ Top = 960
+ Visible = 0 'False
+ Width = 4095
+ Begin VB.ComboBox cmbChatBubble
+ Height = 315
+ ItemData = "frmEditor_Events.frx":002B
+ Left = 120
+ List = "frmEditor_Events.frx":002D
+ Style = 2 'Dropdown List
+ TabIndex = 118
+ Top = 4320
+ Width = 3855
+ End
+ Begin VB.ComboBox cmbChatBubbleType
+ Height = 315
+ ItemData = "frmEditor_Events.frx":002F
+ Left = 120
+ List = "frmEditor_Events.frx":003F
+ Style = 2 'Dropdown List
+ TabIndex = 116
+ Top = 3720
+ Width = 3855
+ End
+ Begin VB.CommandButton cmdChatBubbleOk
+ Caption = "Ok"
+ Height = 375
+ Left = 1440
+ TabIndex = 114
+ Top = 4800
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdChatBubbleCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 2760
+ TabIndex = 113
+ Top = 4800
+ Width = 1215
+ End
+ Begin VB.HScrollBar scrlChatBubble
+ Height = 255
+ Left = 120
+ Max = 18
+ TabIndex = 111
+ Top = 3120
+ Value = 1
+ Width = 3855
+ End
+ Begin VB.TextBox txtChatBubble
+ Height = 2535
+ Left = 120
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 110
+ Top = 240
+ Width = 3855
+ End
+ Begin VB.Label Label13
+ Caption = "Target:"
+ Height = 255
+ Left = 120
+ TabIndex = 117
+ Top = 4080
+ Width = 3735
+ End
+ Begin VB.Label Label11
+ Caption = "Target Type:"
+ Height = 255
+ Left = 120
+ TabIndex = 115
+ Top = 3480
+ Width = 3255
+ End
+ Begin VB.Label lblChatBubble
+ Caption = "Colour: Black"
+ Height = 255
+ Left = 120
+ TabIndex = 112
+ Top = 2880
+ Width = 3255
+ End
+ End
+ Begin VB.Frame fraPlayerVar
+ Caption = "Player Variable"
+ Height = 1695
+ Left = 1200
+ TabIndex = 127
+ Top = 2760
+ Visible = 0 'False
+ Width = 4095
+ Begin VB.CommandButton cmdVariableCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 2760
+ TabIndex = 133
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdVariableOK
+ Caption = "Ok"
+ Height = 375
+ Left = 1440
+ TabIndex = 132
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.TextBox txtVariable
+ Height = 285
+ Left = 960
+ TabIndex = 131
+ Top = 840
+ Width = 3015
+ End
+ Begin VB.ComboBox cmbVariable
+ Height = 315
+ Left = 960
+ Style = 2 'Dropdown List
+ TabIndex = 129
+ Top = 360
+ Width = 3015
+ End
+ Begin VB.Label Label15
+ Caption = "Set to:"
+ Height = 255
+ Left = 120
+ TabIndex = 130
+ Top = 840
+ Width = 1815
+ End
+ Begin VB.Label Label14
+ Caption = "Variable:"
+ Height = 255
+ Left = 120
+ TabIndex = 128
+ Top = 360
+ Width = 3855
+ End
+ End
+ Begin VB.Frame fraAddText
+ Caption = "Add Text"
+ Height = 4095
+ Left = 1200
+ TabIndex = 92
+ Top = 1560
+ Visible = 0 'False
+ Width = 4095
+ Begin VB.CommandButton cmdAddText_Cancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 2760
+ TabIndex = 102
+ Top = 3600
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdAddText_Ok
+ Caption = "Ok"
+ Height = 375
+ Left = 1440
+ TabIndex = 101
+ Top = 3600
+ Width = 1215
+ End
+ Begin VB.OptionButton optAddText_Global
+ Caption = "Global"
+ Height = 255
+ Left = 1920
+ TabIndex = 100
+ Top = 3240
+ Width = 855
+ End
+ Begin VB.OptionButton optAddText_Map
+ Caption = "Map"
+ Height = 255
+ Left = 1080
+ TabIndex = 99
+ Top = 3240
+ Width = 735
+ End
+ Begin VB.OptionButton optAddText_Game
+ Caption = "Game"
+ Height = 255
+ Left = 120
+ TabIndex = 98
+ Top = 3240
+ Value = -1 'True
+ Width = 975
+ End
+ Begin VB.HScrollBar scrlAddText_Colour
+ Height = 255
+ Left = 120
+ Max = 18
+ TabIndex = 96
+ Top = 2640
+ Value = 1
+ Width = 3855
+ End
+ Begin VB.TextBox txtAddText_Text
+ Height = 1815
+ Left = 120
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 94
+ Top = 480
+ Width = 3855
+ End
+ Begin VB.Label Label12
+ Caption = "Channel:"
+ Height = 255
+ Left = 120
+ TabIndex = 97
+ Top = 3000
+ Width = 1575
+ End
+ Begin VB.Label lblAddText_Colour
+ Caption = "Colour: Black"
+ Height = 255
+ Left = 120
+ TabIndex = 95
+ Top = 2400
+ Width = 3255
+ End
+ Begin VB.Label Label7
+ Caption = "Text:"
+ Height = 255
+ Left = 120
+ TabIndex = 93
+ Top = 240
+ Width = 1935
+ End
+ End
+ End
+ Begin VB.Frame fraCommands
+ Caption = "Commands"
+ Height = 7455
+ Left = 6240
+ TabIndex = 43
+ Top = 1560
+ Visible = 0 'False
+ Width = 6375
+ Begin VB.PictureBox picCommands
+ BorderStyle = 0 'None
+ Height = 6015
+ Index = 1
+ Left = 240
+ ScaleHeight = 6015
+ ScaleWidth = 5775
+ TabIndex = 45
+ Top = 720
+ Width = 5775
+ Begin VB.Frame Frame12
+ Caption = "Player Control"
+ Height = 5055
+ Left = 3000
+ TabIndex = 59
+ Top = 0
+ Width = 2775
+ Begin VB.CommandButton Command19
+ Caption = "Change Sex"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 69
+ Top = 4560
+ Width = 2535
+ End
+ Begin VB.CommandButton Command18
+ Caption = "Change Sprite"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 68
+ Top = 4080
+ Width = 2535
+ End
+ Begin VB.CommandButton Command17
+ Caption = "Change Class"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 67
+ Top = 3600
+ Width = 2535
+ End
+ Begin VB.CommandButton Command16
+ Caption = "Change Skills"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 66
+ Top = 3120
+ Width = 2535
+ End
+ Begin VB.CommandButton Command15
+ Caption = "Change Level"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 65
+ Top = 2640
+ Width = 2535
+ End
+ Begin VB.CommandButton Command14
+ Caption = "Change EXP"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 64
+ Top = 2160
+ Width = 2535
+ End
+ Begin VB.CommandButton Command13
+ Caption = "Change SP"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 63
+ Top = 1680
+ Width = 2535
+ End
+ Begin VB.CommandButton Command12
+ Caption = "Change HP"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 62
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton Command11
+ Caption = "Change Items"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 61
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.CommandButton Command8
+ Caption = "Change Gold"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 60
+ Top = 240
+ Width = 2535
+ End
+ End
+ Begin VB.Frame Frame11
+ Caption = "Flow Control"
+ Height = 1215
+ Left = 0
+ TabIndex = 56
+ Top = 4560
+ Width = 2775
+ Begin VB.CommandButton Command10
+ Caption = "Conditional Branch"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 58
+ Top = 240
+ Width = 2535
+ End
+ Begin VB.CommandButton Command9
+ Caption = "Exit Process"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 57
+ Top = 720
+ Width = 2535
+ End
+ End
+ Begin VB.Frame Frame10
+ Caption = "Event Progression"
+ Height = 1695
+ Left = 0
+ TabIndex = 52
+ Top = 2760
+ Width = 2775
+ Begin VB.CommandButton Command7
+ Caption = "Self Switch"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 55
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton Command6
+ Caption = "Event Switch"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 54
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.CommandButton cmdPlayerVar
+ Caption = "Player Variable"
+ Height = 375
+ Left = 120
+ TabIndex = 53
+ Top = 240
+ Width = 2535
+ End
+ End
+ Begin VB.Frame Frame9
+ Caption = "Message"
+ Height = 2655
+ Left = 0
+ TabIndex = 47
+ Top = 0
+ Width = 2775
+ Begin VB.CommandButton cmdChatBubble
+ Caption = "Show Chat Bubble"
+ Height = 375
+ Left = 120
+ TabIndex = 108
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton Command4
+ Caption = "Input Number"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 51
+ Top = 2160
+ Width = 2535
+ End
+ Begin VB.CommandButton Command3
+ Caption = "Show Choices"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 50
+ Top = 1680
+ Width = 2535
+ End
+ Begin VB.CommandButton Command2
+ Caption = "Show Text"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 49
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.CommandButton cmdAddText
+ Caption = "Add Chatbox Text"
+ Height = 375
+ Left = 120
+ TabIndex = 48
+ Top = 240
+ Width = 2535
+ End
+ End
+ End
+ Begin VB.PictureBox picCommands
+ BorderStyle = 0 'None
+ Height = 5775
+ Index = 2
+ Left = 240
+ ScaleHeight = 5775
+ ScaleWidth = 5775
+ TabIndex = 46
+ Top = 720
+ Visible = 0 'False
+ Width = 5775
+ Begin VB.Frame Frame16
+ Caption = "Music and Sound"
+ Height = 3135
+ Left = 3000
+ TabIndex = 83
+ Top = 0
+ Width = 2775
+ Begin VB.CommandButton Command35
+ Caption = "Stop Sound"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 89
+ Top = 2640
+ Width = 2535
+ End
+ Begin VB.CommandButton Command34
+ Caption = "Play Sound"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 88
+ Top = 2160
+ Width = 2535
+ End
+ Begin VB.CommandButton Command33
+ Caption = "Fadeout BGS"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 87
+ Top = 1680
+ Width = 2535
+ End
+ Begin VB.CommandButton Command32
+ Caption = "Play BGS"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 86
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton Command31
+ Caption = "Fadeout BGM"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 85
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.CommandButton Command30
+ Caption = "Play BGM"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 84
+ Top = 240
+ Width = 2535
+ End
+ End
+ Begin VB.Frame Frame15
+ Caption = "Screen Effects"
+ Height = 2655
+ Left = 0
+ TabIndex = 77
+ Top = 3120
+ Width = 2775
+ Begin VB.CommandButton Command29
+ Caption = "Shake Screen"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 82
+ Top = 2160
+ Width = 2535
+ End
+ Begin VB.CommandButton Command28
+ Caption = "Flash Screen"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 81
+ Top = 1680
+ Width = 2535
+ End
+ Begin VB.CommandButton Command27
+ Caption = "Tint Screen"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 80
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton Command26
+ Caption = "Fadein"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 79
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.CommandButton Command23
+ Caption = "Fadeout"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 78
+ Top = 240
+ Width = 2535
+ End
+ End
+ Begin VB.Frame Frame14
+ Caption = "Animation"
+ Height = 1215
+ Left = 0
+ TabIndex = 74
+ Top = 1800
+ Width = 2775
+ Begin VB.CommandButton Command25
+ Caption = "Play Animation"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 76
+ Top = 240
+ Width = 2535
+ End
+ Begin VB.CommandButton Command24
+ Caption = "Play Emoticon"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 75
+ Top = 720
+ Width = 2535
+ End
+ End
+ Begin VB.Frame Frame13
+ Caption = "Movement"
+ Height = 1695
+ Left = 0
+ TabIndex = 70
+ Top = 0
+ Width = 2775
+ Begin VB.CommandButton Command22
+ Caption = "Scroll Map"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 73
+ Top = 1200
+ Width = 2535
+ End
+ Begin VB.CommandButton Command21
+ Caption = "Warp Party"
+ Enabled = 0 'False
+ Height = 375
+ Left = 120
+ TabIndex = 72
+ Top = 720
+ Width = 2535
+ End
+ Begin VB.CommandButton cmdWarpPlayer
+ Caption = "Warp Player"
+ Height = 375
+ Left = 120
+ TabIndex = 71
+ Top = 240
+ Width = 2535
+ End
+ End
+ End
+ Begin VB.CommandButton cmdCancelCommand
+ Caption = "Cancel"
+ Height = 375
+ Left = 4560
+ TabIndex = 90
+ Top = 6840
+ Width = 1455
+ End
+ Begin MSComctlLib.TabStrip tabCommands
+ Height = 7095
+ Left = 120
+ TabIndex = 44
+ Top = 240
+ Width = 6015
+ _ExtentX = 10610
+ _ExtentY = 12515
+ TabMinWidth = 1764
+ _Version = 393216
+ BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
+ NumTabs = 2
+ BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "1"
+ ImageVarType = 2
+ EndProperty
+ BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "2"
+ ImageVarType = 2
+ EndProperty
+ EndProperty
+ End
+ End
+ Begin VB.Frame Frame17
+ Caption = "Commands"
+ Height = 735
+ Left = 6240
+ TabIndex = 103
+ Top = 8280
+ Width = 6255
+ Begin VB.CommandButton cmdClearCommand
+ Caption = "Clear"
+ Height = 375
+ Left = 4680
+ TabIndex = 107
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdDeleteCommand
+ Caption = "Delete"
+ Height = 375
+ Left = 3120
+ TabIndex = 106
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdEditCommand
+ Caption = "Edit"
+ Height = 375
+ Left = 1560
+ TabIndex = 105
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdAddCommand
+ Caption = "Add"
+ Height = 375
+ Left = 120
+ TabIndex = 104
+ Top = 240
+ Width = 1335
+ End
+ End
+ Begin VB.CommandButton cmdOK
+ Caption = "OK"
+ Height = 375
+ Left = 9720
+ TabIndex = 42
+ Top = 9360
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 11280
+ TabIndex = 41
+ Top = 9360
+ Width = 1455
+ End
+ Begin VB.Frame Frame8
+ Caption = "General"
+ Height = 855
+ Left = 120
+ TabIndex = 32
+ Top = 120
+ Width = 12615
+ Begin VB.CommandButton cmdClearPage
+ Caption = "Clear Page"
+ Height = 375
+ Left = 10920
+ TabIndex = 39
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdDeletePage
+ Caption = "Delete Page"
+ Enabled = 0 'False
+ Height = 375
+ Left = 9360
+ TabIndex = 38
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdPastePage
+ Caption = "Paste Page"
+ Enabled = 0 'False
+ Height = 375
+ Left = 7800
+ TabIndex = 37
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCopyPage
+ Caption = "Copy Page"
+ Height = 375
+ Left = 6240
+ TabIndex = 36
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdNewPage
+ Caption = "New Page"
+ Height = 375
+ Left = 4680
+ TabIndex = 35
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.TextBox txtName
+ Height = 285
+ Left = 840
+ TabIndex = 34
+ Top = 300
+ Width = 3135
+ End
+ Begin VB.Label Label5
+ Caption = "Name:"
+ Height = 255
+ Left = 120
+ TabIndex = 33
+ Top = 330
+ Width = 735
+ End
+ End
+ Begin VB.Frame Frame7
+ Height = 1335
+ Left = 2760
+ TabIndex = 31
+ Top = 7680
+ Width = 3375
+ End
+ Begin VB.Frame Frame6
+ Caption = "Trigger"
+ Height = 975
+ Left = 2760
+ TabIndex = 29
+ Top = 6600
+ Width = 3375
+ Begin VB.ComboBox cmbTrigger
+ Height = 315
+ ItemData = "frmEditor_Events.frx":005D
+ Left = 120
+ List = "frmEditor_Events.frx":006A
+ Style = 2 'Dropdown List
+ TabIndex = 30
+ Top = 360
+ Width = 3135
+ End
+ End
+ Begin VB.Frame Frame5
+ Caption = "Priority"
+ Height = 975
+ Left = 2760
+ TabIndex = 27
+ Top = 5520
+ Width = 3375
+ Begin VB.ComboBox cmbPriority
+ Height = 315
+ ItemData = "frmEditor_Events.frx":0094
+ Left = 120
+ List = "frmEditor_Events.frx":00A1
+ Style = 2 'Dropdown List
+ TabIndex = 28
+ Top = 360
+ Width = 3135
+ End
+ End
+ Begin VB.Frame Frame4
+ Caption = "Options"
+ Height = 1935
+ Left = 360
+ TabIndex = 22
+ Top = 7080
+ Width = 2295
+ Begin VB.CheckBox chkWalkThrough
+ Caption = "Walk Through"
+ Height = 255
+ Left = 120
+ TabIndex = 26
+ Top = 1440
+ Width = 1695
+ End
+ Begin VB.CheckBox chkDirFix
+ Caption = "Direction Fix"
+ Height = 255
+ Left = 120
+ TabIndex = 25
+ Top = 1080
+ Width = 1575
+ End
+ Begin VB.CheckBox chkStepAnim
+ Caption = "Stepping Animation"
+ Height = 255
+ Left = 120
+ TabIndex = 24
+ Top = 720
+ Width = 2055
+ End
+ Begin VB.CheckBox chkWalkAnim
+ Caption = "Walking Animation"
+ Height = 255
+ Left = 120
+ TabIndex = 23
+ Top = 360
+ Width = 2055
+ End
+ End
+ Begin VB.Frame Frame3
+ Caption = "Movement"
+ Height = 1935
+ Left = 2760
+ TabIndex = 15
+ Top = 3480
+ Width = 3375
+ Begin VB.ComboBox cmbMoveFreq
+ Height = 315
+ ItemData = "frmEditor_Events.frx":00DD
+ Left = 840
+ List = "frmEditor_Events.frx":00F0
+ Style = 2 'Dropdown List
+ TabIndex = 21
+ Top = 1320
+ Width = 2415
+ End
+ Begin VB.ComboBox cmbMoveSpeed
+ Height = 315
+ ItemData = "frmEditor_Events.frx":011C
+ Left = 840
+ List = "frmEditor_Events.frx":0132
+ Style = 2 'Dropdown List
+ TabIndex = 19
+ Top = 840
+ Width = 2415
+ End
+ Begin VB.ComboBox cmbMoveType
+ Height = 315
+ ItemData = "frmEditor_Events.frx":0175
+ Left = 840
+ List = "frmEditor_Events.frx":017F
+ Style = 2 'Dropdown List
+ TabIndex = 17
+ Top = 360
+ Width = 2415
+ End
+ Begin VB.Label Label10
+ Caption = "Freq:"
+ Height = 255
+ Left = 120
+ TabIndex = 20
+ Top = 1350
+ Width = 1695
+ End
+ Begin VB.Label Label9
+ Caption = "Speed:"
+ Height = 255
+ Left = 120
+ TabIndex = 18
+ Top = 870
+ Width = 1695
+ End
+ Begin VB.Label Label8
+ Caption = "Type:"
+ Height = 255
+ Left = 120
+ TabIndex = 16
+ Top = 390
+ Width = 1695
+ End
+ End
+ Begin VB.Frame Frame2
+ Caption = "Graphic"
+ Height = 3495
+ Left = 360
+ TabIndex = 13
+ Top = 3480
+ Width = 2295
+ Begin VB.PictureBox picGraphic
+ Appearance = 0 'Flat
+ BackColor = &H80000005&
+ BorderStyle = 0 'None
+ ForeColor = &H80000008&
+ Height = 2895
+ Left = 240
+ ScaleHeight = 193
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 121
+ TabIndex = 14
+ Top = 360
+ Width = 1815
+ End
+ End
+ Begin VB.Frame Frame1
+ Caption = "Conditions"
+ Height = 1815
+ Left = 360
+ TabIndex = 2
+ Top = 1560
+ Width = 5775
+ Begin VB.CheckBox chkHasItem
+ Caption = "Has Item"
+ Height = 255
+ Left = 120
+ TabIndex = 12
+ Top = 1350
+ Width = 1695
+ End
+ Begin VB.ComboBox cmbHasItem
+ Enabled = 0 'False
+ Height = 315
+ ItemData = "frmEditor_Events.frx":0192
+ Left = 1920
+ List = "frmEditor_Events.frx":0194
+ Style = 2 'Dropdown List
+ TabIndex = 11
+ Top = 1320
+ Width = 1695
+ End
+ Begin VB.CheckBox chkSelfSwitch
+ Caption = "Self Switch"
+ Height = 255
+ Left = 120
+ TabIndex = 9
+ Top = 870
+ Width = 1695
+ End
+ Begin VB.ComboBox cmbSelfSwitch
+ Enabled = 0 'False
+ Height = 315
+ ItemData = "frmEditor_Events.frx":0196
+ Left = 1920
+ List = "frmEditor_Events.frx":01A9
+ Style = 2 'Dropdown List
+ TabIndex = 8
+ Top = 840
+ Width = 1695
+ End
+ Begin VB.CheckBox chkPlayerVar
+ Caption = "Player Variable"
+ Height = 255
+ Left = 120
+ TabIndex = 5
+ Top = 390
+ Width = 1695
+ End
+ Begin VB.ComboBox cmbPlayerVar
+ Enabled = 0 'False
+ Height = 315
+ Left = 1920
+ Style = 2 'Dropdown List
+ TabIndex = 4
+ Top = 360
+ Width = 1695
+ End
+ Begin VB.TextBox txtPlayerVariable
+ Enabled = 0 'False
+ Height = 285
+ Left = 3960
+ TabIndex = 3
+ Top = 390
+ Width = 735
+ End
+ Begin VB.Label Label4
+ Caption = "is ON"
+ Height = 255
+ Left = 3720
+ TabIndex = 10
+ Top = 870
+ Width = 855
+ End
+ Begin VB.Label Label2
+ Caption = "is"
+ Height = 255
+ Left = 3720
+ TabIndex = 7
+ Top = 390
+ Width = 255
+ End
+ Begin VB.Label Label3
+ Caption = "or above"
+ Height = 255
+ Left = 4800
+ TabIndex = 6
+ Top = 390
+ Width = 855
+ End
+ End
+ Begin VB.ListBox lstCommands
+ Height = 6495
+ Left = 6240
+ TabIndex = 1
+ Top = 1680
+ Width = 6255
+ End
+ Begin MSComctlLib.TabStrip tabPages
+ Height = 8175
+ Left = 120
+ TabIndex = 40
+ Top = 1080
+ Width = 12615
+ _ExtentX = 22251
+ _ExtentY = 14420
+ MultiRow = -1 'True
+ ShowTips = 0 'False
+ TabMinWidth = 529
+ _Version = 393216
+ BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
+ NumTabs = 1
+ BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
+ Caption = "1"
+ ImageVarType = 2
+ EndProperty
+ EndProperty
+ End
+ Begin VB.Label Label1
+ Caption = "List of commands:"
+ Height = 255
+ Left = 6240
+ TabIndex = 0
+ Top = 1560
+ Width = 6255
+ End
+End
+Attribute VB_Name = "frmEditor_Events"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private copyPage As EventPageRec
+Private isEdit As Boolean
+
+Private Sub chkDirFix_Click()
+ tmpEvent.EventPage(curPageNum).DirFix = chkDirFix.value
+End Sub
+
+Private Sub chkHasItem_Click()
+ tmpEvent.EventPage(curPageNum).chkHasItem = chkHasItem.value
+ If chkHasItem.value = 0 Then cmbHasItem.enabled = False Else cmbHasItem.enabled = True
+End Sub
+
+Private Sub chkPlayerVar_Click()
+ tmpEvent.EventPage(curPageNum).chkPlayerVar = chkPlayerVar.value
+ If chkPlayerVar.value = 0 Then
+ cmbPlayerVar.enabled = False
+ txtPlayerVariable.enabled = False
+ Else
+ cmbPlayerVar.enabled = True
+ txtPlayerVariable.enabled = True
+ End If
+End Sub
+
+Private Sub chkSelfSwitch_Click()
+ tmpEvent.EventPage(curPageNum).chkSelfSwitch = chkSelfSwitch.value
+ If chkSelfSwitch.value = 0 Then cmbSelfSwitch.enabled = False Else cmbSelfSwitch.enabled = True
+End Sub
+
+Private Sub chkStepAnim_Click()
+ tmpEvent.EventPage(curPageNum).StepAnim = chkStepAnim.value
+End Sub
+
+Private Sub chkWalkAnim_Click()
+ tmpEvent.EventPage(curPageNum).WalkAnim = chkWalkAnim.value
+End Sub
+
+Private Sub chkWalkThrough_Click()
+ tmpEvent.EventPage(curPageNum).WalkThrough = chkWalkThrough.value
+End Sub
+
+Private Sub cmbChatBubbleType_Click()
+Dim i As Long
+ cmbChatBubble.Clear
+ With tmpEvent.EventPage(curPageNum).Commands(curCommand)
+ .TargetType = cmbChatBubbleType.ListIndex
+ Select Case .TargetType
+ Case 0
+ cmbChatBubble.AddItem "None"
+ cmbChatBubble.enabled = False
+ Case TARGET_TYPE_PLAYER
+ cmbChatBubble.AddItem "The Player"
+ cmbChatBubble.enabled = False
+ Case TARGET_TYPE_NPC
+ cmbChatBubble.AddItem "None"
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(i).num > 0 Then
+ cmbChatBubble.AddItem i & ": " & Trim$(Npc(MapNpc(i).num).name)
+ Else
+ cmbChatBubble.AddItem i & ": Empty"
+ End If
+ Next
+ cmbChatBubble.enabled = True
+ Case TARGET_TYPE_EVENT
+ cmbChatBubble.AddItem "None"
+ For i = 1 To map.TileData.EventCount
+ cmbChatBubble.AddItem i & ": " & map.TileData.Events(i).name
+ Next
+ cmbChatBubble.enabled = True
+ End Select
+ cmbChatBubble.ListIndex = 0
+ End With
+End Sub
+
+Private Sub cmbGraphic_Click()
+ If cmbGraphic.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).GraphicType = cmbGraphic.ListIndex
+ ' set the max on the scrollbar
+ Select Case cmbGraphic.ListIndex
+ Case 0 ' None
+ scrlGraphic.value = 1
+ scrlGraphic.Max = 1
+ scrlGraphic.enabled = False
+ Case 1 ' character
+ scrlGraphic.Max = Count_Char
+ scrlGraphic.enabled = True
+ Case 2 ' Tileset
+ scrlGraphic.Max = Count_Tileset
+ scrlGraphic.enabled = True
+ End Select
+End Sub
+
+Private Sub cmbHasItem_Click()
+ If cmbHasItem.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).HasItemNum = cmbHasItem.ListIndex
+End Sub
+
+Private Sub cmbMoveSpeed_Click()
+ If cmbMoveSpeed.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).MoveSpeed = cmbMoveSpeed.ListIndex
+End Sub
+
+Private Sub cmbMoveType_Click()
+ If cmbMoveType.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).MoveType = cmbMoveType.ListIndex
+End Sub
+
+Private Sub cmbPlayerVar_Click()
+ If cmbPlayerVar.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).PlayerVarNum = cmbPlayerVar.ListIndex
+End Sub
+
+Private Sub cmbPriority_Click()
+ If cmbPriority.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).Priority = cmbPriority.ListIndex
+End Sub
+
+Private Sub cmbSelfSwitch_Click()
+ If cmbSelfSwitch.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).SelfSwitchNum = cmbSelfSwitch.ListIndex
+End Sub
+
+Private Sub cmbTrigger_Click()
+ If cmbTrigger.ListIndex = -1 Then Exit Sub
+ tmpEvent.EventPage(curPageNum).Trigger = cmbTrigger.ListIndex
+End Sub
+
+Private Sub cmdAddCommand_Click()
+ isEdit = False
+ tabCommands.SelectedItem = tabCommands.Tabs(1)
+ fraCommands.visible = True
+ picCommands(1).visible = True
+ picCommands(2).visible = False
+End Sub
+
+Private Sub cmdAddText_Cancel_Click()
+ If Not isEdit Then fraCommands.visible = True Else fraCommands.visible = False
+ fraDialogue.visible = False
+ fraAddText.visible = False
+End Sub
+
+Private Sub cmdAddText_Click()
+ ' reset form
+ txtAddText_Text.text = vbNullString
+ scrlAddText_Colour.value = 0
+ optAddText_Game.value = True
+ ' show
+ fraDialogue.visible = True
+ fraAddText.visible = True
+ ' hide
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdAddText_Ok_Click()
+ If Not isEdit Then
+ AddCommand EventType.evAddText
+ Else
+ EditCommand
+ End If
+ ' hide
+ fraDialogue.visible = False
+ fraAddText.visible = False
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdCancel_Click()
+ Unload Me
+End Sub
+
+Private Sub cmdCancelCommand_Click()
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdChatBubble_Click()
+ ' reset form
+ txtChatBubble.text = vbNullString
+ scrlChatBubble.value = 0
+ cmbChatBubbleType.ListIndex = 0
+ cmbChatBubble.Clear
+ cmbChatBubble.AddItem "The Player"
+ cmbChatBubble.enabled = False
+ ' show
+ fraDialogue.visible = True
+ fraChatBubble.visible = True
+ ' hide
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdChatBubbleCancel_Click()
+ If Not isEdit Then fraCommands.visible = True Else fraCommands.visible = False
+ fraDialogue.visible = False
+ fraChatBubble.visible = False
+End Sub
+
+Private Sub cmdChatBubbleOk_Click()
+ If Not isEdit Then
+ AddCommand EventType.evShowChatBubble
+ Else
+ EditCommand
+ End If
+ ' hide
+ fraDialogue.visible = False
+ fraChatBubble.visible = False
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdClearCommand_Click()
+Dim i As Long
+ If tmpEvent.EventPage(curPageNum).CommandCount = 0 Then Exit Sub
+ For i = 1 To tmpEvent.EventPage(curPageNum).CommandCount
+ ZeroMemory ByVal VarPtr(tmpEvent.EventPage(curPageNum).Commands(i)), LenB(tmpEvent.EventPage(curPageNum).Commands(i))
+ Next
+ EventListCommands
+End Sub
+
+Private Sub cmdClearPage_Click()
+ ZeroMemory ByVal VarPtr(tmpEvent.EventPage(curPageNum)), LenB(tmpEvent.EventPage(curPageNum))
+ EventEditorLoadPage curPageNum
+End Sub
+
+Private Sub cmdCopyPage_Click()
+ CopyMemory ByVal VarPtr(copyPage), ByVal VarPtr(tmpEvent.EventPage(curPageNum)), LenB(tmpEvent.EventPage(curPageNum))
+ cmdPastePage.enabled = True
+End Sub
+
+Private Sub cmdDeleteCommand_Click()
+Dim i As Long
+ If tmpEvent.EventPage(curPageNum).CommandCount = 0 Then Exit Sub
+ ZeroMemory ByVal VarPtr(tmpEvent.EventPage(curPageNum).Commands(curCommand)), LenB(tmpEvent.EventPage(curPageNum).Commands(curCommand))
+ ' move everything down a page
+ If tmpEvent.EventPage(curPageNum).CommandCount > 1 Then
+ For i = curCommand To tmpEvent.EventPage(curPageNum).CommandCount - 1
+
+ Next
+ Else
+ tmpEvent.EventPage(curPageNum).CommandCount = 0
+ End If
+End Sub
+
+Private Sub cmdDeletePage_Click()
+Dim i As Long
+ ZeroMemory ByVal VarPtr(tmpEvent.EventPage(curPageNum)), LenB(tmpEvent.EventPage(curPageNum))
+ ' move everything else down a notch
+ If curPageNum < tmpEvent.pageCount Then
+ For i = curPageNum To tmpEvent.pageCount - 1
+ CopyMemory ByVal VarPtr(tmpEvent.EventPage(i)), ByVal VarPtr(tmpEvent.EventPage(i + 1)), LenB(tmpEvent.EventPage(i + 1))
+ Next
+ End If
+ tmpEvent.pageCount = tmpEvent.pageCount - 1
+ ' set the tabs
+ tabPages.Tabs.Clear
+ For i = 1 To tmpEvent.pageCount
+ tabPages.Tabs.Add , , Str(i)
+ Next
+ ' set the tab back
+ If curPageNum <= tmpEvent.pageCount Then
+ tabPages.SelectedItem = tabPages.Tabs(curPageNum)
+ Else
+ tabPages.SelectedItem = tabPages.Tabs(tmpEvent.pageCount)
+ End If
+ ' make sure we disable
+ If tmpEvent.pageCount <= 1 Then
+ cmdDeletePage.enabled = False
+ End If
+End Sub
+
+Private Sub cmdEditCommand_Click()
+Dim i As Long
+ isEdit = True
+ With tmpEvent.EventPage(curPageNum).Commands(curCommand)
+ Select Case .Type
+ Case EventType.evAddText
+ ' reset form
+ txtAddText_Text.text = .text
+ scrlAddText_Colour.value = .Colour
+ Select Case .channel
+ Case 0
+ optAddText_Game.value = True
+ Case 1
+ optAddText_Map.value = True
+ Case 2
+ optAddText_Global.value = True
+ End Select
+ ' show
+ fraDialogue.visible = True
+ fraAddText.visible = True
+ Case EventType.evShowChatBubble
+ txtChatBubble.text = .text
+ scrlChatBubble.value = .Colour
+ cmbChatBubbleType.ListIndex = .TargetType
+ cmbChatBubble.Clear
+ If .TargetType = 0 Then .TargetType = 1
+ Select Case .TargetType
+ Case 0
+ cmbChatBubble.AddItem "None"
+ Case TARGET_TYPE_PLAYER
+ cmbChatBubble.AddItem "The Player"
+ Case TARGET_TYPE_NPC
+ cmbChatBubble.AddItem "None"
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(i).num > 0 Then
+ cmbChatBubble.AddItem i & ": " & Trim$(Npc(MapNpc(i).num).name)
+ Else
+ cmbChatBubble.AddItem i & ": Empty"
+ End If
+ Next
+ Case TARGET_TYPE_EVENT
+ cmbChatBubble.AddItem "None"
+ For i = 1 To map.TileData.EventCount
+ cmbChatBubble.AddItem i & ": " & map.TileData.Events(i).name
+ Next
+ End Select
+ If .target > 0 And .target <= cmbChatBubble.ListCount Then
+ cmbChatBubble.ListIndex = .target
+ Else
+ cmbChatBubble.ListIndex = 0
+ End If
+ ' show
+ fraDialogue.visible = True
+ fraChatBubble.visible = True
+ Case EventType.evPlayerVar
+ ' reset form
+ cmbVariable.Clear
+ cmbVariable.AddItem "None"
+ For i = 1 To MAX_BYTE
+ cmbVariable.AddItem i
+ Next
+ txtVariable.text = .Colour
+ cmbVariable.ListIndex = .target
+ ' show
+ fraDialogue.visible = True
+ fraPlayerVar.visible = True
+ Case EventType.evWarpPlayer
+ ' reset form
+ scrlWPMap.value = .target
+ scrlWPX.value = .x
+ scrlWPY.value = .y
+ ' show
+ fraDialogue.visible = True
+ fraWarpPlayer.visible = True
+ End Select
+ End With
+End Sub
+
+Private Sub cmdGraphicCancel_Click()
+ fraGraphic.visible = False
+End Sub
+
+Private Sub cmdGraphicOK_Click()
+ tmpEvent.EventPage(curPageNum).GraphicType = cmbGraphic.ListIndex
+ tmpEvent.EventPage(curPageNum).Graphic = scrlGraphic.value
+ tmpEvent.EventPage(curPageNum).GraphicX = GraphicSelX
+ tmpEvent.EventPage(curPageNum).GraphicY = GraphicSelY
+ fraGraphic.visible = False
+End Sub
+
+Private Sub cmdNewPage_Click()
+Dim pageCount As Long, i As Long
+ pageCount = tmpEvent.pageCount + 1
+ ' redim the array
+ ReDim Preserve tmpEvent.EventPage(1 To pageCount)
+ tmpEvent.pageCount = pageCount
+ ' set the tabs
+ tabPages.Tabs.Clear
+ For i = 1 To tmpEvent.pageCount
+ tabPages.Tabs.Add , , Str(i)
+ Next
+ cmdDeletePage.enabled = True
+End Sub
+
+Private Sub cmdOk_Click()
+ EventEditorOK
+End Sub
+
+Private Sub cmdPastePage_Click()
+ CopyMemory ByVal VarPtr(tmpEvent.EventPage(curPageNum)), ByVal VarPtr(copyPage), LenB(tmpEvent.EventPage(curPageNum))
+ EventEditorLoadPage curPageNum
+End Sub
+
+Private Sub cmdPlayerVar_Click()
+Dim i As Long
+ ' reset form
+ cmbVariable.Clear
+ cmbVariable.AddItem "None"
+ For i = 1 To MAX_BYTE
+ cmbVariable.AddItem i
+ Next
+ txtVariable.text = vbNullString
+ cmbVariable.ListIndex = 0
+ ' show
+ fraDialogue.visible = True
+ fraPlayerVar.visible = True
+ ' hide
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdVariableCancel_Click()
+ If Not isEdit Then fraCommands.visible = True Else fraCommands.visible = False
+ fraDialogue.visible = False
+ fraPlayerVar.visible = False
+End Sub
+
+Private Sub cmdVariableOK_Click()
+ If Not isEdit Then
+ AddCommand EventType.evPlayerVar
+ Else
+ EditCommand
+ End If
+ ' hide
+ fraDialogue.visible = False
+ fraPlayerVar.visible = False
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdWarpPlayer_Click()
+ ' reset form
+ scrlWPMap.value = 0
+ scrlWPX.value = 0
+ scrlWPY.value = 0
+ ' show
+ fraDialogue.visible = True
+ fraWarpPlayer.visible = True
+ ' hide
+ fraCommands.visible = False
+End Sub
+
+Private Sub cmdWPCancel_Click()
+ If Not isEdit Then fraCommands.visible = True Else fraCommands.visible = False
+ fraDialogue.visible = False
+ fraWarpPlayer.visible = False
+End Sub
+
+Private Sub cmdWPOkay_Click()
+ If Not isEdit Then
+ AddCommand EventType.evWarpPlayer
+ Else
+ EditCommand
+ End If
+ ' hide
+ fraDialogue.visible = False
+ fraWarpPlayer.visible = False
+ fraCommands.visible = False
+End Sub
+
+Private Sub lstCommands_Click()
+ curCommand = lstCommands.ListIndex + 1
+End Sub
+
+Private Sub picGraphic_Click()
+ fraGraphic.width = 841
+ fraGraphic.height = 609
+ fraGraphic.visible = True
+End Sub
+
+Private Sub picGraphicSel_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
+ GraphicSelX = CLng(x) \ 32
+ GraphicSelY = CLng(y) \ 32
+End Sub
+
+Private Sub scrlAddText_Colour_Change()
+ lblAddText_Colour.caption = "Colour: " & GetColourString(scrlAddText_Colour.value)
+End Sub
+
+Private Sub scrlChatBubble_Change()
+ lblChatBubble.caption = "Colour: " & GetColourString(scrlChatBubble.value)
+End Sub
+
+Private Sub scrlGraphic_Change()
+ lblGraphic.caption = "Graphic: " & scrlGraphic.value
+ tmpEvent.EventPage(curPageNum).Graphic = scrlGraphic.value
+End Sub
+
+Private Sub scrlWPMap_Change()
+ lblWPMap.caption = "Map: " & scrlWPMap.value
+End Sub
+
+Private Sub scrlWPX_Change()
+ lblWPX.caption = "X: " & scrlWPX.value
+End Sub
+
+Private Sub scrlWPY_Change()
+ lblWPY.caption = "Y: " & scrlWPY.value
+End Sub
+
+Private Sub tabCommands_Click()
+Dim i As Long
+ For i = 1 To 2
+ picCommands(i).visible = False
+ Next
+ picCommands(tabCommands.SelectedItem.index).visible = True
+End Sub
+
+Private Sub tabPages_Click()
+ If tabPages.SelectedItem.index <> curPageNum Then
+ curPageNum = tabPages.SelectedItem.index
+ EventEditorLoadPage curPageNum
+ End If
+End Sub
+
+Private Sub txtName_Validate(Cancel As Boolean)
+ tmpEvent.name = Trim$(txtName.text)
+End Sub
+
+Private Sub txtPlayerVariable_Validate(Cancel As Boolean)
+ tmpEvent.EventPage(curPageNum).PlayerVariable = Val(Trim$(txtPlayerVariable.text))
+End Sub
diff --git a/client/src/frmEditor_Events.frx b/client/src/frmEditor_Events.frx
new file mode 100644
index 0000000..1f48c20
Binary files /dev/null and b/client/src/frmEditor_Events.frx differ
diff --git a/client/src/frmEditor_Item.frm b/client/src/frmEditor_Item.frm
new file mode 100644
index 0000000..5b45754
--- /dev/null
+++ b/client/src/frmEditor_Item.frm
@@ -0,0 +1,1226 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Item
+ BorderStyle = 1 'Fixed Single
+ Caption = "Item Editor"
+ ClientHeight = 8415
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 9735
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmEditor_Item.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 561
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 649
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmdPaste
+ Caption = "Paste"
+ Height = 375
+ Left = 7320
+ TabIndex = 92
+ Top = 7920
+ Width = 735
+ End
+ Begin VB.CommandButton cmdCopy
+ Caption = "Copy"
+ Height = 375
+ Left = 6480
+ TabIndex = 91
+ Top = 7920
+ Width = 735
+ End
+ Begin VB.Frame fraEquipment
+ Caption = "Equipment Data"
+ Height = 3135
+ Left = 3360
+ TabIndex = 32
+ Top = 4680
+ Visible = 0 'False
+ Width = 6255
+ Begin VB.HScrollBar scrlProf
+ Height = 255
+ Left = 120
+ Max = 2
+ TabIndex = 90
+ Top = 2160
+ Width = 2055
+ End
+ Begin VB.PictureBox picPaperdoll
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 1080
+ Left = 3960
+ ScaleHeight = 72
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 144
+ TabIndex = 58
+ Top = 1920
+ Width = 2160
+ End
+ Begin VB.HScrollBar scrlPaperdoll
+ Height = 255
+ Left = 5040
+ TabIndex = 57
+ Top = 1560
+ Width = 1095
+ End
+ Begin VB.HScrollBar scrlSpeed
+ Height = 255
+ LargeChange = 100
+ Left = 4560
+ Max = 3000
+ Min = 100
+ SmallChange = 100
+ TabIndex = 40
+ Top = 840
+ Value = 100
+ Width = 1575
+ End
+ Begin VB.HScrollBar scrlStatBonus
+ Height = 255
+ Index = 5
+ LargeChange = 10
+ Left = 3000
+ Max = 255
+ TabIndex = 39
+ Top = 1560
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatBonus
+ Height = 255
+ Index = 4
+ LargeChange = 10
+ Left = 960
+ Max = 255
+ TabIndex = 38
+ Top = 1560
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatBonus
+ Height = 255
+ Index = 3
+ LargeChange = 10
+ Left = 5280
+ Max = 255
+ TabIndex = 37
+ Top = 1200
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatBonus
+ Height = 255
+ Index = 2
+ LargeChange = 10
+ Left = 3000
+ Max = 255
+ TabIndex = 36
+ Top = 1200
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlDamage
+ Height = 255
+ LargeChange = 10
+ Left = 1320
+ Max = 255
+ TabIndex = 35
+ Top = 840
+ Width = 1815
+ End
+ Begin VB.ComboBox cmbTool
+ Height = 300
+ ItemData = "frmEditor_Item.frx":3332
+ Left = 1320
+ List = "frmEditor_Item.frx":3342
+ Style = 2 'Dropdown List
+ TabIndex = 34
+ Top = 360
+ Width = 4815
+ End
+ Begin VB.HScrollBar scrlStatBonus
+ Height = 255
+ Index = 1
+ LargeChange = 10
+ Left = 960
+ Max = 255
+ TabIndex = 33
+ Top = 1200
+ Width = 855
+ End
+ Begin VB.Label lblProf
+ Caption = "Proficiency: None"
+ Height = 255
+ Left = 120
+ TabIndex = 89
+ Top = 1920
+ Width = 2055
+ End
+ Begin VB.Label lblPaperdoll
+ AutoSize = -1 'True
+ Caption = "Paperdoll: 0"
+ Height = 180
+ Left = 3960
+ TabIndex = 56
+ Top = 1560
+ Width = 915
+ End
+ Begin VB.Label lblSpeed
+ AutoSize = -1 'True
+ Caption = "Speed: 0.1 sec"
+ Height = 180
+ Left = 3240
+ TabIndex = 48
+ Top = 840
+ UseMnemonic = 0 'False
+ Width = 1140
+ End
+ Begin VB.Label lblStatBonus
+ AutoSize = -1 'True
+ Caption = "+ Will: 0"
+ Height = 180
+ Index = 5
+ Left = 2160
+ TabIndex = 47
+ Top = 1560
+ UseMnemonic = 0 'False
+ Width = 630
+ End
+ Begin VB.Label lblStatBonus
+ AutoSize = -1 'True
+ Caption = "+ Agi: 0"
+ Height = 180
+ Index = 4
+ Left = 120
+ TabIndex = 46
+ Top = 1560
+ UseMnemonic = 0 'False
+ Width = 615
+ End
+ Begin VB.Label lblStatBonus
+ AutoSize = -1 'True
+ Caption = "+ Int: 0"
+ Height = 180
+ Index = 3
+ Left = 4440
+ TabIndex = 45
+ Top = 1200
+ UseMnemonic = 0 'False
+ Width = 585
+ End
+ Begin VB.Label lblStatBonus
+ AutoSize = -1 'True
+ Caption = "+ End: 0"
+ Height = 180
+ Index = 2
+ Left = 2160
+ TabIndex = 44
+ Top = 1200
+ UseMnemonic = 0 'False
+ Width = 645
+ End
+ Begin VB.Label lblDamage
+ AutoSize = -1 'True
+ Caption = "Damage: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 43
+ Top = 840
+ UseMnemonic = 0 'False
+ Width = 825
+ End
+ Begin VB.Label Label8
+ AutoSize = -1 'True
+ Caption = "Object Tool:"
+ Height = 180
+ Left = 120
+ TabIndex = 42
+ Top = 360
+ Width = 945
+ End
+ Begin VB.Label lblStatBonus
+ AutoSize = -1 'True
+ Caption = "+ Str: 0"
+ Height = 180
+ Index = 1
+ Left = 120
+ TabIndex = 41
+ Top = 1200
+ UseMnemonic = 0 'False
+ Width = 585
+ End
+ End
+ Begin VB.Frame Frame2
+ Caption = "Info"
+ Height = 3375
+ Left = 3360
+ TabIndex = 17
+ Top = 120
+ Width = 6255
+ Begin VB.HScrollBar scrlLevelReq
+ Height = 255
+ LargeChange = 10
+ Left = 4200
+ Max = 99
+ TabIndex = 74
+ Top = 2760
+ Width = 1935
+ End
+ Begin VB.HScrollBar scrlAccessReq
+ Height = 255
+ Left = 4200
+ Max = 5
+ TabIndex = 72
+ Top = 2400
+ Width = 1935
+ End
+ Begin VB.ComboBox cmbClassReq
+ Height = 300
+ Left = 3840
+ Style = 2 'Dropdown List
+ TabIndex = 70
+ Top = 2040
+ Width = 2295
+ End
+ Begin VB.ComboBox cmbSound
+ Height = 300
+ Left = 3720
+ Style = 2 'Dropdown List
+ TabIndex = 69
+ Top = 1680
+ Width = 2415
+ End
+ Begin VB.TextBox txtDesc
+ Height = 1455
+ Left = 120
+ MaxLength = 255
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 60
+ Top = 1800
+ Width = 2655
+ End
+ Begin VB.HScrollBar scrlRarity
+ Height = 255
+ Left = 4200
+ Max = 5
+ TabIndex = 25
+ Top = 960
+ Width = 1935
+ End
+ Begin VB.ComboBox cmbBind
+ Height = 300
+ ItemData = "frmEditor_Item.frx":3363
+ Left = 4200
+ List = "frmEditor_Item.frx":3370
+ Style = 2 'Dropdown List
+ TabIndex = 24
+ Top = 600
+ Width = 1935
+ End
+ Begin VB.HScrollBar scrlPrice
+ Height = 255
+ LargeChange = 100
+ Left = 4200
+ Max = 30000
+ TabIndex = 23
+ Top = 240
+ Width = 1935
+ End
+ Begin VB.HScrollBar scrlAnim
+ Height = 255
+ Left = 5040
+ Max = 5
+ TabIndex = 22
+ Top = 1320
+ Width = 1095
+ End
+ Begin VB.ComboBox cmbType
+ Height = 300
+ ItemData = "frmEditor_Item.frx":3399
+ Left = 120
+ List = "frmEditor_Item.frx":33BE
+ Style = 2 'Dropdown List
+ TabIndex = 21
+ Top = 1200
+ Width = 2655
+ End
+ Begin VB.TextBox txtName
+ Height = 255
+ Left = 720
+ TabIndex = 20
+ Top = 240
+ Width = 2055
+ End
+ Begin VB.HScrollBar scrlPic
+ Height = 255
+ Left = 840
+ Max = 255
+ TabIndex = 19
+ Top = 600
+ Width = 1335
+ End
+ Begin VB.PictureBox picItem
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 480
+ Left = 2280
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 18
+ Top = 600
+ Width = 480
+ End
+ Begin VB.Label lblLevelReq
+ AutoSize = -1 'True
+ Caption = "Level req: 0"
+ Height = 180
+ Left = 2880
+ TabIndex = 75
+ Top = 2760
+ Width = 900
+ End
+ Begin VB.Label lblAccessReq
+ AutoSize = -1 'True
+ Caption = "Access Req: 0"
+ Height = 180
+ Left = 2880
+ TabIndex = 73
+ Top = 2400
+ Width = 1110
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Class Req:"
+ Height = 180
+ Left = 2880
+ TabIndex = 71
+ Top = 2040
+ Width = 825
+ End
+ Begin VB.Label Label4
+ Caption = "Sound:"
+ Height = 255
+ Left = 2880
+ TabIndex = 68
+ Top = 1680
+ Width = 1455
+ End
+ Begin VB.Label Label3
+ Caption = "Description:"
+ Height = 255
+ Left = 120
+ TabIndex = 59
+ Top = 1560
+ Width = 975
+ End
+ Begin VB.Label lblRarity
+ AutoSize = -1 'True
+ Caption = "Rarity: 0"
+ Height = 180
+ Left = 2880
+ TabIndex = 31
+ Top = 960
+ Width = 660
+ End
+ Begin VB.Label Label11
+ AutoSize = -1 'True
+ Caption = "Bind Type:"
+ Height = 180
+ Left = 2880
+ TabIndex = 30
+ Top = 600
+ Width = 810
+ End
+ Begin VB.Label lblPrice
+ AutoSize = -1 'True
+ Caption = "Price: 0"
+ Height = 180
+ Left = 2880
+ TabIndex = 29
+ Top = 240
+ Width = 600
+ End
+ Begin VB.Label lblAnim
+ AutoSize = -1 'True
+ Caption = "Anim: None"
+ Height = 180
+ Left = 2880
+ TabIndex = 28
+ Top = 1320
+ Width = 885
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Name:"
+ Height = 180
+ Left = 120
+ TabIndex = 27
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ Begin VB.Label lblPic
+ AutoSize = -1 'True
+ Caption = "Pic: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 26
+ Top = 600
+ UseMnemonic = 0 'False
+ Width = 450
+ End
+ End
+ Begin VB.Frame Frame1
+ Caption = "Requirements"
+ Height = 975
+ Left = 3360
+ TabIndex = 6
+ Top = 3600
+ Width = 6255
+ Begin VB.HScrollBar scrlStatReq
+ Height = 255
+ Index = 1
+ LargeChange = 10
+ Left = 720
+ Max = 255
+ TabIndex = 11
+ Top = 240
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatReq
+ Height = 255
+ Index = 2
+ LargeChange = 10
+ Left = 2880
+ Max = 255
+ TabIndex = 10
+ Top = 240
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatReq
+ Height = 255
+ Index = 3
+ LargeChange = 10
+ Left = 5160
+ Max = 255
+ TabIndex = 9
+ Top = 240
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatReq
+ Height = 255
+ Index = 4
+ LargeChange = 10
+ Left = 720
+ Max = 255
+ TabIndex = 8
+ Top = 600
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStatReq
+ Height = 255
+ Index = 5
+ LargeChange = 10
+ Left = 2880
+ Max = 255
+ TabIndex = 7
+ Top = 600
+ Width = 855
+ End
+ Begin VB.Label lblStatReq
+ AutoSize = -1 'True
+ Caption = "Str: 0"
+ Height = 180
+ Index = 1
+ Left = 120
+ TabIndex = 16
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 435
+ End
+ Begin VB.Label lblStatReq
+ AutoSize = -1 'True
+ Caption = "End: 0"
+ Height = 180
+ Index = 2
+ Left = 2280
+ TabIndex = 15
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ Begin VB.Label lblStatReq
+ AutoSize = -1 'True
+ Caption = "Int: 0"
+ Height = 180
+ Index = 3
+ Left = 4560
+ TabIndex = 14
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 435
+ End
+ Begin VB.Label lblStatReq
+ AutoSize = -1 'True
+ Caption = "Agi: 0"
+ Height = 180
+ Index = 4
+ Left = 120
+ TabIndex = 13
+ Top = 600
+ UseMnemonic = 0 'False
+ Width = 465
+ End
+ Begin VB.Label lblStatReq
+ AutoSize = -1 'True
+ Caption = "Will: 0"
+ Height = 180
+ Index = 5
+ Left = 2280
+ TabIndex = 12
+ Top = 600
+ UseMnemonic = 0 'False
+ Width = 480
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Enabled = 0 'False
+ Height = 375
+ Left = 240
+ TabIndex = 5
+ Top = 7920
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 3360
+ TabIndex = 4
+ Top = 7920
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 8160
+ TabIndex = 3
+ Top = 7920
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 4920
+ TabIndex = 2
+ Top = 7920
+ Width = 1455
+ End
+ Begin VB.Frame Frame3
+ Caption = "Item List"
+ Height = 7695
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ Height = 7260
+ Left = 120
+ TabIndex = 1
+ Top = 240
+ Width = 2895
+ End
+ End
+ Begin VB.Frame fraUnique
+ Caption = "Unique"
+ Height = 615
+ Left = 3360
+ TabIndex = 76
+ Top = 4680
+ Visible = 0 'False
+ Width = 3735
+ Begin VB.HScrollBar scrlUnique
+ Height = 255
+ Left = 1080
+ Max = 255
+ Min = 1
+ TabIndex = 77
+ Top = 240
+ Value = 1
+ Width = 2415
+ End
+ Begin VB.Label lblUnique
+ AutoSize = -1 'True
+ Caption = "Num: 0"
+ Height = 180
+ Left = 240
+ TabIndex = 78
+ Top = 240
+ Width = 555
+ End
+ End
+ Begin VB.Frame fraSpell
+ Caption = "Spell Data"
+ Height = 1215
+ Left = 3360
+ TabIndex = 52
+ Top = 4680
+ Visible = 0 'False
+ Width = 3735
+ Begin VB.HScrollBar scrlSpell
+ Height = 255
+ Left = 1080
+ Max = 255
+ Min = 1
+ TabIndex = 53
+ Top = 720
+ Value = 1
+ Width = 2415
+ End
+ Begin VB.Label lblSpellName
+ AutoSize = -1 'True
+ Caption = "Name: None"
+ Height = 180
+ Left = 240
+ TabIndex = 55
+ Top = 360
+ Width = 930
+ End
+ Begin VB.Label lblSpell
+ AutoSize = -1 'True
+ Caption = "Num: 0"
+ Height = 180
+ Left = 240
+ TabIndex = 54
+ Top = 720
+ Width = 555
+ End
+ End
+ Begin VB.Frame fraFood
+ Caption = "Food"
+ Height = 3135
+ Left = 3360
+ TabIndex = 79
+ Top = 4680
+ Visible = 0 'False
+ Width = 3735
+ Begin VB.HScrollBar scrlFoodInterval
+ Height = 255
+ LargeChange = 100
+ Left = 120
+ Max = 30000
+ TabIndex = 88
+ Top = 2280
+ Width = 3375
+ End
+ Begin VB.HScrollBar scrlFoodTick
+ Height = 255
+ Left = 120
+ TabIndex = 86
+ Top = 1680
+ Width = 3375
+ End
+ Begin VB.HScrollBar scrlFoodHeal
+ Height = 255
+ Left = 120
+ TabIndex = 84
+ Top = 1080
+ Width = 3375
+ End
+ Begin VB.OptionButton optSP
+ Caption = "SP"
+ Height = 255
+ Left = 840
+ TabIndex = 82
+ Top = 480
+ Width = 735
+ End
+ Begin VB.OptionButton optHP
+ Caption = "HP"
+ Height = 255
+ Left = 120
+ TabIndex = 81
+ Top = 480
+ Value = -1 'True
+ Width = 735
+ End
+ Begin VB.Label lblFoodInterval
+ Caption = "Interval: 0(ms)"
+ Height = 255
+ Left = 120
+ TabIndex = 87
+ Top = 2040
+ Width = 3375
+ End
+ Begin VB.Label lblFoodTick
+ Caption = "Tick Count: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 85
+ Top = 1440
+ Width = 2175
+ End
+ Begin VB.Label lblFoodHeal
+ Caption = "Heal per Tick: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 83
+ Top = 840
+ Width = 3015
+ End
+ Begin VB.Label Label5
+ Caption = "Heals HP or SP"
+ Height = 255
+ Left = 120
+ TabIndex = 80
+ Top = 240
+ Width = 3495
+ End
+ End
+ Begin VB.Frame fraVitals
+ Caption = "Consume Data"
+ Height = 3135
+ Left = 3360
+ TabIndex = 49
+ Top = 4680
+ Visible = 0 'False
+ Width = 3735
+ Begin VB.CheckBox chkInstant
+ Caption = "Instant Cast?"
+ Height = 255
+ Left = 120
+ TabIndex = 67
+ Top = 2760
+ Visible = 0 'False
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlCastSpell
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 65
+ Top = 2400
+ Visible = 0 'False
+ Width = 3495
+ End
+ Begin VB.HScrollBar scrlAddExp
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 63
+ Top = 1800
+ Width = 3495
+ End
+ Begin VB.HScrollBar scrlAddMP
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 61
+ Top = 1200
+ Width = 3495
+ End
+ Begin VB.HScrollBar scrlAddHp
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 50
+ Top = 600
+ Width = 3495
+ End
+ Begin VB.Label lblCastSpell
+ AutoSize = -1 'True
+ Caption = "Cast Spell: None"
+ Height = 180
+ Left = 120
+ TabIndex = 66
+ Top = 2160
+ UseMnemonic = 0 'False
+ Visible = 0 'False
+ Width = 1275
+ End
+ Begin VB.Label lblAddExp
+ AutoSize = -1 'True
+ Caption = "Add Exp: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 64
+ Top = 1560
+ UseMnemonic = 0 'False
+ Width = 840
+ End
+ Begin VB.Label lblAddMP
+ AutoSize = -1 'True
+ Caption = "Add MP: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 62
+ Top = 960
+ UseMnemonic = 0 'False
+ Width = 795
+ End
+ Begin VB.Label lblAddHP
+ AutoSize = -1 'True
+ Caption = "Add HP: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 51
+ Top = 360
+ UseMnemonic = 0 'False
+ Width = 780
+ End
+ End
+End
+Attribute VB_Name = "frmEditor_Item"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmbBind_Click()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ Item(EditorIndex).BindType = cmbBind.ListIndex
+End Sub
+
+Private Sub cmbClassReq_Click()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ Item(EditorIndex).ClassReq = cmbClassReq.ListIndex
+End Sub
+
+Private Sub cmbSound_Click()
+
+ If cmbSound.ListIndex >= 0 Then
+ Item(EditorIndex).sound = cmbSound.list(cmbSound.ListIndex)
+ Else
+ Item(EditorIndex).sound = "None."
+ End If
+
+End Sub
+
+Private Sub cmbTool_Click()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ Item(EditorIndex).Data3 = cmbTool.ListIndex
+End Sub
+
+Private Sub cmdCopy_Click()
+ ItemEditorCopy
+End Sub
+
+Private Sub cmdDelete_Click()
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ ClearItem EditorIndex
+ tmpIndex = lstIndex.ListIndex
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Item(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+ ItemEditorInit
+End Sub
+
+Private Sub cmdPaste_Click()
+ ItemEditorPaste
+End Sub
+
+Private Sub Form_Load()
+ scrlPic.Max = Count_Item
+ scrlAnim.Max = MAX_ANIMATIONS
+ scrlPaperdoll.Max = Count_Paperdoll
+End Sub
+
+Private Sub cmdSave_Click()
+ Call ItemEditorOk
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call ItemEditorCancel
+End Sub
+
+Private Sub cmbType_Click()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ If (cmbType.ListIndex >= ITEM_TYPE_WEAPON) And (cmbType.ListIndex <= ITEM_TYPE_SHIELD) Then
+ fraEquipment.visible = True
+ 'scrlDamage_Change
+ Else
+ fraEquipment.visible = False
+ End If
+
+ If cmbType.ListIndex = ITEM_TYPE_CONSUME Then
+ fraVitals.visible = True
+ 'scrlVitalMod_Change
+ Else
+ fraVitals.visible = False
+ End If
+
+ If (cmbType.ListIndex = ITEM_TYPE_SPELL) Then
+ fraSpell.visible = True
+ Else
+ fraSpell.visible = False
+ End If
+
+ If cmbType.ListIndex = ITEM_TYPE_UNIQUE Then
+ fraUnique.visible = True
+ Else
+ fraUnique.visible = False
+ End If
+
+ If cmbType.ListIndex = ITEM_TYPE_FOOD Then
+ fraFood.visible = True
+ Else
+ fraFood.visible = False
+ End If
+
+ Item(EditorIndex).Type = cmbType.ListIndex
+End Sub
+
+Private Sub lstIndex_Click()
+ ItemEditorInit
+End Sub
+
+Private Sub optHP_Click()
+ Item(EditorIndex).HPorSP = 1 ' hp
+End Sub
+
+Private Sub optSP_Click()
+ Item(EditorIndex).HPorSP = 2 ' sp
+End Sub
+
+Private Sub scrlAccessReq_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblAccessReq.caption = "Access Req: " & scrlAccessReq.value
+ Item(EditorIndex).AccessReq = scrlAccessReq.value
+End Sub
+
+Private Sub scrlAddHp_Change()
+ lblAddHP.caption = "Add HP: " & scrlAddHp.value
+ Item(EditorIndex).AddHP = scrlAddHp.value
+End Sub
+
+Private Sub scrlAddMp_Change()
+ lblAddMP.caption = "Add MP: " & scrlAddMP.value
+ Item(EditorIndex).AddMP = scrlAddMP.value
+End Sub
+
+Private Sub scrlAddExp_Change()
+ lblAddExp.caption = "Add Exp: " & scrlAddExp.value
+ Item(EditorIndex).AddEXP = scrlAddExp.value
+End Sub
+
+Private Sub scrlAnim_Change()
+ Dim sString As String
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ If scrlAnim.value = 0 Then
+ sString = "None"
+ Else
+ sString = Trim$(Animation(scrlAnim.value).name)
+ End If
+
+ lblAnim.caption = "Anim: " & sString
+ Item(EditorIndex).Animation = scrlAnim.value
+End Sub
+
+Private Sub scrlDamage_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblDamage.caption = "Damage: " & scrlDamage.value
+ Item(EditorIndex).Data2 = scrlDamage.value
+End Sub
+
+Private Sub scrlFoodHeal_Change()
+ lblFoodHeal.caption = "Heal Per Tick: " & scrlFoodHeal.value
+ Item(EditorIndex).FoodPerTick = scrlFoodHeal.value
+End Sub
+
+Private Sub scrlFoodInterval_Change()
+ lblFoodInterval.caption = "Interval: " & scrlFoodInterval.value & "(ms)"
+ Item(EditorIndex).FoodInterval = scrlFoodInterval.value
+End Sub
+
+Private Sub scrlFoodTick_Change()
+ lblFoodTick.caption = "Tick Count: " & scrlFoodTick.value
+ Item(EditorIndex).FoodTickCount = scrlFoodTick.value
+End Sub
+
+Private Sub scrlLevelReq_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblLevelReq.caption = "Level req: " & scrlLevelReq
+ Item(EditorIndex).LevelReq = scrlLevelReq.value
+End Sub
+
+Private Sub scrlPaperdoll_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblPaperdoll.caption = "Paperdoll: " & scrlPaperdoll.value
+ Item(EditorIndex).Paperdoll = scrlPaperdoll.value
+End Sub
+
+Private Sub scrlPic_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblPic.caption = "Pic: " & scrlPic.value
+ Item(EditorIndex).Pic = scrlPic.value
+End Sub
+
+Private Sub scrlPrice_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblPrice.caption = "Price: " & scrlPrice.value
+ Item(EditorIndex).Price = scrlPrice.value
+End Sub
+
+Private Sub scrlProf_Change()
+ Dim theProf As String
+
+ Select Case scrlProf.value
+
+ Case 0 ' None
+ theProf = "None"
+
+ Case 1 ' Sword/Armour
+ theProf = "Sword/Armour"
+
+ Case 2 ' Staff/Cloth
+ theProf = "Staff/Cloth"
+ End Select
+
+ lblProf.caption = "Proficiency: " & theProf
+ Item(EditorIndex).proficiency = scrlProf.value
+End Sub
+
+Private Sub scrlRarity_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblRarity.caption = "Rarity: " & scrlRarity.value
+ Item(EditorIndex).Rarity = scrlRarity.value
+End Sub
+
+Private Sub scrlSpeed_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ lblSpeed.caption = "Speed: " & scrlSpeed.value / 1000 & " sec"
+ Item(EditorIndex).speed = scrlSpeed.value
+End Sub
+
+Private Sub scrlStatBonus_Change(index As Integer)
+ Dim text As String
+
+ Select Case index
+
+ Case 1
+ text = "+ Str: "
+
+ Case 2
+ text = "+ End: "
+
+ Case 3
+ text = "+ Int: "
+
+ Case 4
+ text = "+ Agi: "
+
+ Case 5
+ text = "+ Will: "
+ End Select
+
+ lblStatBonus(index).caption = text & scrlStatBonus(index).value
+ Item(EditorIndex).Add_Stat(index) = scrlStatBonus(index).value
+End Sub
+
+Private Sub scrlStatReq_Change(index As Integer)
+ Dim text As String
+
+ Select Case index
+
+ Case 1
+ text = "Str: "
+
+ Case 2
+ text = "End: "
+
+ Case 3
+ text = "Int: "
+
+ Case 4
+ text = "Agi: "
+
+ Case 5
+ text = "Will: "
+ End Select
+
+ lblStatReq(index).caption = text & scrlStatReq(index).value
+ Item(EditorIndex).Stat_Req(index) = scrlStatReq(index).value
+End Sub
+
+Private Sub scrlSpell_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ If Len(Trim$(Spell(scrlSpell.value).name)) > 0 Then
+ lblSpellName.caption = "Name: " & Trim$(Spell(scrlSpell.value).name)
+ Else
+ lblSpellName.caption = "Name: None"
+ End If
+
+ lblSpell.caption = "Spell: " & scrlSpell.value
+ Item(EditorIndex).Data1 = scrlSpell.value
+End Sub
+
+Private Sub scrlUnique_Change()
+ lblUnique.caption = "Num: " & scrlUnique.value
+ Item(EditorIndex).Data1 = scrlUnique.value
+End Sub
+
+Private Sub txtDesc_Change()
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ Item(EditorIndex).Desc = txtDesc.text
+End Sub
+
+Public Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Or EditorIndex > MAX_ITEMS Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Item(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Item(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
diff --git a/client/src/frmEditor_Item.frx b/client/src/frmEditor_Item.frx
new file mode 100644
index 0000000..a88ec86
Binary files /dev/null and b/client/src/frmEditor_Item.frx differ
diff --git a/client/src/frmEditor_Map.frm b/client/src/frmEditor_Map.frm
new file mode 100644
index 0000000..1a25785
--- /dev/null
+++ b/client/src/frmEditor_Map.frm
@@ -0,0 +1,1572 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Map
+ BorderStyle = 1 'Fixed Single
+ Caption = "Map Editor"
+ ClientHeight = 9255
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 19470
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmEditor_Map.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 617
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 1298
+ StartUpPosition = 3 'Windows Default
+ Visible = 0 'False
+ Begin VB.CommandButton cmdApply
+ Caption = "Apply"
+ Height = 255
+ Left = 6480
+ TabIndex = 107
+ Top = 8160
+ Width = 1335
+ End
+ Begin VB.PictureBox picAttributes
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 9495
+ Left = 9600
+ ScaleHeight = 9495
+ ScaleWidth = 9735
+ TabIndex = 29
+ Top = 0
+ Visible = 0 'False
+ Width = 9735
+ Begin VB.Frame fraAppear
+ Caption = "Appear"
+ Height = 1815
+ Left = 3480
+ TabIndex = 110
+ Top = 3240
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.HScrollBar scrlAppearRange
+ Height = 255
+ Left = 120
+ Max = 10
+ TabIndex = 113
+ Top = 480
+ Value = 1
+ Width = 3135
+ End
+ Begin VB.CommandButton cmdAppearOkay
+ Caption = "Accept"
+ Height = 375
+ Left = 1080
+ TabIndex = 112
+ Top = 1320
+ Width = 1215
+ End
+ Begin VB.CheckBox chkAppearBottom
+ Caption = "Bottom?"
+ Height = 255
+ Left = 2280
+ TabIndex = 111
+ Top = 840
+ Width = 975
+ End
+ Begin VB.Label lblAppearRange
+ Caption = "Range: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 114
+ Top = 240
+ Width = 3135
+ End
+ End
+ Begin VB.Frame fraMapWarp
+ Caption = "Map Warp"
+ Height = 3015
+ Left = 3480
+ TabIndex = 59
+ Top = 2640
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.CheckBox chkWarpFall
+ Caption = "Fall?"
+ Height = 255
+ Left = 2520
+ TabIndex = 109
+ Top = 2040
+ Width = 735
+ End
+ Begin VB.CommandButton cmdMapWarp
+ Caption = "Accept"
+ Height = 375
+ Left = 1080
+ TabIndex = 66
+ Top = 2400
+ Width = 1215
+ End
+ Begin VB.HScrollBar scrlMapWarpY
+ Height = 255
+ Left = 120
+ TabIndex = 65
+ Top = 1680
+ Width = 3135
+ End
+ Begin VB.HScrollBar scrlMapWarpX
+ Height = 255
+ Left = 120
+ TabIndex = 63
+ Top = 1080
+ Width = 3135
+ End
+ Begin VB.HScrollBar scrlMapWarp
+ Height = 255
+ Left = 120
+ Min = 1
+ TabIndex = 61
+ Top = 480
+ Value = 1
+ Width = 3135
+ End
+ Begin VB.Label lblMapWarpY
+ Caption = "Y: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 64
+ Top = 1440
+ Width = 3135
+ End
+ Begin VB.Label lblMapWarpX
+ Caption = "X: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 62
+ Top = 840
+ Width = 3135
+ End
+ Begin VB.Label lblMapWarp
+ Caption = "Map: 1"
+ Height = 255
+ Left = 120
+ TabIndex = 60
+ Top = 240
+ Width = 3135
+ End
+ End
+ Begin VB.Frame fraMapItem
+ Caption = "Map Item"
+ Height = 1815
+ Left = 3480
+ TabIndex = 41
+ Top = 3480
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.CommandButton cmdMapItem
+ Caption = "Accept"
+ Height = 375
+ Left = 1200
+ TabIndex = 46
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.HScrollBar scrlMapItemValue
+ Height = 255
+ Left = 120
+ Min = 1
+ TabIndex = 45
+ Top = 840
+ Value = 1
+ Width = 2535
+ End
+ Begin VB.HScrollBar scrlMapItem
+ Height = 255
+ Left = 120
+ Max = 10
+ Min = 1
+ TabIndex = 44
+ Top = 480
+ Value = 1
+ Width = 2535
+ End
+ Begin VB.PictureBox picMapItem
+ Appearance = 0 'Flat
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H80000008&
+ Height = 480
+ Left = 2760
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 43
+ Top = 600
+ Width = 480
+ End
+ Begin VB.Label lblMapItem
+ Caption = "Item: None x0"
+ Height = 255
+ Left = 120
+ TabIndex = 42
+ Top = 240
+ Width = 3135
+ End
+ End
+ Begin VB.Frame fraNudge
+ Caption = "Nudge"
+ Height = 2775
+ Left = 3480
+ TabIndex = 99
+ Top = 3000
+ Visible = 0 'False
+ Width = 3255
+ Begin VB.CommandButton cmdNDone
+ Caption = "Done"
+ Height = 375
+ Left = 1080
+ TabIndex = 104
+ Top = 2280
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdNDown
+ Caption = "Down"
+ Height = 375
+ Left = 1200
+ TabIndex = 103
+ Top = 1440
+ Width = 855
+ End
+ Begin VB.CommandButton cmdNLeft
+ Caption = "Left"
+ Height = 375
+ Left = 360
+ TabIndex = 102
+ Top = 960
+ Width = 855
+ End
+ Begin VB.CommandButton cmdNRight
+ Caption = "Right"
+ Height = 375
+ Left = 2040
+ TabIndex = 101
+ Top = 960
+ Width = 855
+ End
+ Begin VB.CommandButton cmdNUp
+ Caption = "Up"
+ Height = 375
+ Left = 1200
+ TabIndex = 100
+ Top = 480
+ Width = 855
+ End
+ End
+ Begin VB.Frame fraChat
+ Caption = "Chat"
+ Height = 2655
+ Left = 3480
+ TabIndex = 90
+ Top = 3120
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.ListBox lstChat
+ Height = 780
+ Left = 240
+ TabIndex = 93
+ Top = 360
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlChat
+ Height = 255
+ Left = 240
+ Max = 3
+ TabIndex = 92
+ Top = 1560
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdChat
+ Caption = "Okay"
+ Height = 375
+ Left = 960
+ TabIndex = 91
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.Label lblChat
+ Caption = "Direction Req: Up"
+ Height = 255
+ Left = 240
+ TabIndex = 94
+ Top = 1320
+ Width = 2535
+ End
+ End
+ Begin VB.Frame fraTrap
+ Caption = "Trap"
+ Height = 1575
+ Left = 3480
+ TabIndex = 82
+ Top = 3480
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.HScrollBar scrlTrap
+ Height = 255
+ Left = 240
+ Max = 10000
+ TabIndex = 84
+ Top = 600
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdTrap
+ Caption = "Okay"
+ Height = 375
+ Left = 960
+ TabIndex = 83
+ Top = 960
+ Width = 1455
+ End
+ Begin VB.Label lblTrap
+ Caption = "Amount: 0"
+ Height = 255
+ Left = 240
+ TabIndex = 85
+ Top = 360
+ Width = 2535
+ End
+ End
+ Begin VB.Frame fraSlide
+ Caption = "Slide"
+ Height = 1455
+ Left = 3480
+ TabIndex = 86
+ Top = 3480
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.ComboBox cmbSlide
+ Height = 300
+ ItemData = "frmEditor_Map.frx":3332
+ Left = 240
+ List = "frmEditor_Map.frx":3342
+ Style = 2 'Dropdown List
+ TabIndex = 88
+ Top = 360
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdSlide
+ Caption = "Okay"
+ Height = 375
+ Left = 960
+ TabIndex = 87
+ Top = 840
+ Width = 1455
+ End
+ End
+ Begin VB.Frame fraHeal
+ Caption = "Heal"
+ Height = 1815
+ Left = 3480
+ TabIndex = 77
+ Top = 3480
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.ComboBox cmbHeal
+ Height = 300
+ ItemData = "frmEditor_Map.frx":335D
+ Left = 240
+ List = "frmEditor_Map.frx":3367
+ Style = 2 'Dropdown List
+ TabIndex = 81
+ Top = 240
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdHeal
+ Caption = "Okay"
+ Height = 375
+ Left = 960
+ TabIndex = 79
+ Top = 1200
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlHeal
+ Height = 255
+ Left = 240
+ Max = 10000
+ TabIndex = 78
+ Top = 840
+ Width = 2895
+ End
+ Begin VB.Label lblHeal
+ Caption = "Amount: 0"
+ Height = 255
+ Left = 240
+ TabIndex = 80
+ Top = 600
+ Width = 2535
+ End
+ End
+ Begin VB.Frame fraNpcSpawn
+ Caption = "Npc Spawn"
+ Height = 2655
+ Left = 3480
+ TabIndex = 36
+ Top = 3120
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.ListBox lstNpc
+ Height = 780
+ Left = 240
+ TabIndex = 40
+ Top = 360
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlNpcDir
+ Height = 255
+ Left = 240
+ Max = 3
+ TabIndex = 38
+ Top = 1560
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdNpcSpawn
+ Caption = "Okay"
+ Height = 375
+ Left = 960
+ TabIndex = 37
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.Label lblNpcDir
+ Caption = "Direction: Up"
+ Height = 255
+ Left = 240
+ TabIndex = 39
+ Top = 1320
+ Width = 2535
+ End
+ End
+ Begin VB.Frame fraResource
+ Caption = "Object"
+ Height = 1695
+ Left = 3480
+ TabIndex = 30
+ Top = 3480
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.CommandButton cmdResourceOk
+ Caption = "Okay"
+ Height = 375
+ Left = 960
+ TabIndex = 33
+ Top = 1080
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlResource
+ Height = 255
+ Left = 240
+ Max = 100
+ Min = 1
+ TabIndex = 32
+ Top = 600
+ Value = 1
+ Width = 2895
+ End
+ Begin VB.Label lblResource
+ Caption = "Object:"
+ Height = 255
+ Left = 240
+ TabIndex = 31
+ Top = 360
+ Width = 2535
+ End
+ End
+ Begin VB.Frame fraShop
+ Caption = "Shop"
+ Height = 1335
+ Left = 3480
+ TabIndex = 67
+ Top = 3720
+ Visible = 0 'False
+ Width = 3135
+ Begin VB.CommandButton cmdShop
+ Caption = "Accept"
+ Height = 375
+ Left = 960
+ TabIndex = 69
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.ComboBox cmbShop
+ Height = 300
+ Left = 120
+ Style = 2 'Dropdown List
+ TabIndex = 68
+ Top = 240
+ Width = 2895
+ End
+ End
+ Begin VB.Frame fraKeyOpen
+ Caption = "Key Open"
+ Height = 2295
+ Left = 3480
+ TabIndex = 53
+ Top = 3240
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.CommandButton cmdKeyOpen
+ Caption = "Accept"
+ Height = 375
+ Left = 1080
+ TabIndex = 58
+ Top = 1680
+ Width = 1215
+ End
+ Begin VB.HScrollBar scrlKeyY
+ Height = 255
+ Left = 120
+ TabIndex = 57
+ Top = 1080
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlKeyX
+ Height = 255
+ Left = 120
+ TabIndex = 55
+ Top = 480
+ Width = 3015
+ End
+ Begin VB.Label lblKeyY
+ Caption = "Y: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 56
+ Top = 840
+ Width = 3015
+ End
+ Begin VB.Label lblKeyX
+ Caption = "X: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 54
+ Top = 240
+ Width = 3015
+ End
+ End
+ Begin VB.Frame fraMapKey
+ Caption = "Map Key"
+ Height = 2655
+ Left = 3480
+ TabIndex = 47
+ Top = 3120
+ Visible = 0 'False
+ Width = 3375
+ Begin VB.HScrollBar scrlKeyTime
+ Height = 255
+ Left = 120
+ Max = 120
+ Min = -1
+ SmallChange = 10
+ TabIndex = 105
+ Top = 1560
+ Width = 3015
+ End
+ Begin VB.PictureBox picMapKey
+ Appearance = 0 'Flat
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H80000008&
+ Height = 480
+ Left = 2760
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 52
+ Top = 600
+ Width = 480
+ End
+ Begin VB.CommandButton cmdMapKey
+ Caption = "Accept"
+ Height = 375
+ Left = 1080
+ TabIndex = 51
+ Top = 2040
+ Width = 1215
+ End
+ Begin VB.CheckBox chkMapKey
+ Caption = "Take key away upon use."
+ Height = 255
+ Left = 120
+ TabIndex = 50
+ Top = 960
+ Value = 1 'Checked
+ Width = 2535
+ End
+ Begin VB.HScrollBar scrlMapKey
+ Height = 255
+ Left = 120
+ Max = 5
+ Min = 1
+ TabIndex = 49
+ Top = 600
+ Value = 1
+ Width = 2535
+ End
+ Begin VB.Label lblKeyTime
+ Caption = "Time: 0s"
+ Height = 255
+ Left = 120
+ TabIndex = 106
+ Top = 1320
+ Width = 3015
+ End
+ Begin VB.Label lblMapKey
+ Caption = "Item: None"
+ Height = 255
+ Left = 120
+ TabIndex = 48
+ Top = 240
+ Width = 3135
+ End
+ End
+ End
+ Begin VB.CommandButton cmdNudge
+ Caption = "Nudge"
+ Height = 255
+ Left = 5040
+ TabIndex = 98
+ Top = 8520
+ Width = 1335
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 255
+ Left = 6480
+ TabIndex = 10
+ Top = 8880
+ Width = 1335
+ End
+ Begin VB.CommandButton cmdProperties
+ Caption = "Properties"
+ Height = 255
+ Left = 6480
+ TabIndex = 12
+ Top = 8520
+ Width = 1335
+ End
+ Begin VB.Frame Frame2
+ Caption = "Type"
+ Height = 1335
+ Left = 7920
+ TabIndex = 25
+ Top = 7800
+ Width = 1455
+ Begin VB.OptionButton optEvents
+ Alignment = 1 'Right Justify
+ Caption = "Events"
+ Height = 255
+ Left = 360
+ TabIndex = 97
+ Top = 960
+ Width = 855
+ End
+ Begin VB.OptionButton optBlock
+ Alignment = 1 'Right Justify
+ Caption = "Block"
+ Height = 255
+ Left = 480
+ TabIndex = 72
+ Top = 720
+ Width = 735
+ End
+ Begin VB.OptionButton optAttribs
+ Alignment = 1 'Right Justify
+ Caption = "Attributes"
+ Height = 255
+ Left = 120
+ TabIndex = 27
+ Top = 480
+ Width = 1095
+ End
+ Begin VB.OptionButton optLayers
+ Alignment = 1 'Right Justify
+ Caption = "Layers"
+ Height = 255
+ Left = 360
+ TabIndex = 26
+ Top = 240
+ Value = -1 'True
+ Width = 855
+ End
+ End
+ Begin VB.HScrollBar scrlPictureX
+ Height = 255
+ Left = 0
+ TabIndex = 24
+ Top = 0
+ Visible = 0 'False
+ Width = 495
+ End
+ Begin VB.PictureBox picBack
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 7680
+ Left = 120
+ ScaleHeight = 512
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 512
+ TabIndex = 14
+ Top = 120
+ Width = 7680
+ Begin VB.PictureBox picBackSelect
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 960
+ Left = 0
+ ScaleHeight = 64
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 64
+ TabIndex = 15
+ Top = 0
+ Width = 960
+ End
+ End
+ Begin VB.VScrollBar scrlPictureY
+ Height = 375
+ Left = 0
+ Max = 255
+ TabIndex = 13
+ Top = 240
+ Visible = 0 'False
+ Width = 255
+ End
+ Begin VB.Frame fraTileSet
+ Caption = "Tileset: 0"
+ Height = 855
+ Left = 120
+ TabIndex = 0
+ Top = 8160
+ Width = 4815
+ Begin VB.HScrollBar scrlTileSet
+ Height = 255
+ Left = 120
+ Max = 10
+ Min = 1
+ TabIndex = 1
+ Top = 360
+ Value = 1
+ Width = 4455
+ End
+ End
+ Begin VB.CommandButton cmdSend
+ Caption = "Okay"
+ Height = 255
+ Left = 5040
+ TabIndex = 11
+ Top = 8160
+ Width = 1335
+ End
+ Begin VB.Frame fraAttribs
+ Caption = "Attributes"
+ Height = 7575
+ Left = 7920
+ TabIndex = 2
+ Top = 120
+ Visible = 0 'False
+ Width = 1455
+ Begin VB.OptionButton optAppear
+ Caption = "Appear"
+ Height = 270
+ Left = 120
+ TabIndex = 108
+ Top = 3840
+ Width = 1215
+ End
+ Begin VB.OptionButton optChat
+ Caption = "Chat"
+ Height = 270
+ Left = 120
+ TabIndex = 89
+ Top = 3600
+ Width = 1215
+ End
+ Begin VB.OptionButton optSlide
+ Caption = "Slide"
+ Height = 270
+ Left = 120
+ TabIndex = 76
+ Top = 3360
+ Width = 1215
+ End
+ Begin VB.OptionButton optTrap
+ Caption = "Trap"
+ Height = 270
+ Left = 120
+ TabIndex = 75
+ Top = 3120
+ Width = 1215
+ End
+ Begin VB.OptionButton optHeal
+ Caption = "Heal"
+ Height = 270
+ Left = 120
+ TabIndex = 74
+ Top = 2880
+ Width = 1215
+ End
+ Begin VB.OptionButton optBank
+ Caption = "Bank"
+ Height = 270
+ Left = 120
+ TabIndex = 73
+ Top = 2640
+ Width = 1215
+ End
+ Begin VB.OptionButton optShop
+ Caption = "Shop"
+ Height = 270
+ Left = 120
+ TabIndex = 70
+ Top = 2400
+ Width = 1215
+ End
+ Begin VB.OptionButton optNpcSpawn
+ Caption = "Npc Spawn"
+ Height = 270
+ Left = 120
+ TabIndex = 35
+ Top = 2160
+ Width = 1215
+ End
+ Begin VB.OptionButton optDoor
+ Caption = "Door"
+ Height = 255
+ Left = 120
+ TabIndex = 34
+ Top = 1920
+ Width = 1215
+ End
+ Begin VB.OptionButton optResource
+ Caption = "Resource"
+ Height = 240
+ Left = 120
+ TabIndex = 28
+ Top = 1680
+ Width = 1215
+ End
+ Begin VB.OptionButton optKeyOpen
+ Caption = "Key Open"
+ Height = 240
+ Left = 120
+ TabIndex = 9
+ Top = 1440
+ Width = 1215
+ End
+ Begin VB.OptionButton optBlocked
+ Caption = "Blocked"
+ Height = 255
+ Left = 120
+ TabIndex = 8
+ Top = 240
+ Value = -1 'True
+ Width = 1215
+ End
+ Begin VB.OptionButton optWarp
+ Caption = "Warp"
+ Height = 255
+ Left = 120
+ TabIndex = 7
+ Top = 480
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdClear2
+ Caption = "Clear"
+ Height = 390
+ Left = 120
+ TabIndex = 6
+ Top = 7080
+ Width = 1215
+ End
+ Begin VB.OptionButton optItem
+ Caption = "Item"
+ Height = 270
+ Left = 120
+ TabIndex = 5
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.OptionButton optNpcAvoid
+ Caption = "Npc Avoid"
+ Height = 270
+ Left = 120
+ TabIndex = 4
+ Top = 960
+ Width = 1215
+ End
+ Begin VB.OptionButton optKey
+ Caption = "Key"
+ Height = 270
+ Left = 120
+ TabIndex = 3
+ Top = 1200
+ Width = 1215
+ End
+ End
+ Begin VB.Frame fraLayers
+ Caption = "Layers"
+ Height = 7575
+ Left = 7920
+ TabIndex = 16
+ Top = 120
+ Width = 1455
+ Begin VB.HScrollBar scrlAutotile
+ Height = 255
+ Left = 120
+ Max = 5
+ TabIndex = 95
+ Top = 6240
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdFill
+ Caption = "Fill"
+ Height = 390
+ Left = 120
+ TabIndex = 20
+ Top = 7080
+ Width = 1215
+ End
+ Begin VB.OptionButton optLayer
+ Caption = "Fringe"
+ Height = 255
+ Index = 4
+ Left = 120
+ TabIndex = 23
+ Top = 960
+ Width = 1215
+ End
+ Begin VB.OptionButton optLayer
+ Caption = "Mask"
+ Height = 255
+ Index = 2
+ Left = 120
+ TabIndex = 22
+ Top = 480
+ Width = 1215
+ End
+ Begin VB.OptionButton optLayer
+ Caption = "Ground"
+ Height = 255
+ Index = 1
+ Left = 120
+ TabIndex = 21
+ Top = 240
+ Value = -1 'True
+ Width = 1215
+ End
+ Begin VB.OptionButton optLayer
+ Caption = "Fringe2"
+ Height = 255
+ Index = 5
+ Left = 120
+ TabIndex = 19
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.OptionButton optLayer
+ Caption = "Mask2"
+ Height = 255
+ Index = 3
+ Left = 120
+ TabIndex = 18
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdClear
+ Caption = "Clear"
+ Height = 375
+ Left = 120
+ TabIndex = 17
+ Top = 6600
+ Width = 1215
+ End
+ Begin VB.Label lblAutotile
+ Alignment = 2 'Center
+ Caption = "Normal"
+ Height = 255
+ Left = 120
+ TabIndex = 96
+ Top = 6000
+ Width = 1215
+ End
+ End
+ Begin VB.Label Label1
+ Alignment = 2 'Center
+ Caption = "Drag mouse to select multiple tiles"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = -1 'True
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 255
+ Left = 120
+ TabIndex = 71
+ Top = 7800
+ Width = 7695
+ End
+End
+Attribute VB_Name = "frmEditor_Map"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmdAppearOkay_Click()
+ EditorAppearRange = scrlAppearRange.value
+ EditorAppearBottom = chkAppearBottom.value
+ picAttributes.visible = False
+ fraAppear.visible = False
+End Sub
+
+Private Sub cmdApply_Click()
+ applyingMap = True
+ SendMap
+End Sub
+
+Private Sub cmdHeal_Click()
+ MapEditorHealType = cmbHeal.ListIndex + 1
+ MapEditorHealAmount = scrlHeal.value
+ picAttributes.visible = False
+ fraHeal.visible = False
+End Sub
+
+Private Sub cmdKeyOpen_Click()
+ KeyOpenEditorX = scrlKeyX.value
+ KeyOpenEditorY = scrlKeyY.value
+ picAttributes.visible = False
+ fraKeyOpen.visible = False
+End Sub
+
+Private Sub cmdMapItem_Click()
+ ItemEditorNum = scrlMapItem.value
+ ItemEditorValue = scrlMapItemValue.value
+ picAttributes.visible = False
+ fraMapItem.visible = False
+End Sub
+
+Private Sub cmdMapKey_Click()
+ KeyEditorNum = scrlMapKey.value
+ KeyEditorTake = chkMapKey.value
+ KeyEditorTime = scrlKeyTime.value
+ If KeyEditorTime = 0 Then KeyEditorTime = -1
+ picAttributes.visible = False
+ fraMapKey.visible = False
+End Sub
+
+Private Sub cmdMapWarp_Click()
+ EditorWarpMap = scrlMapWarp.value
+ EditorWarpX = scrlMapWarpX.value
+ EditorWarpY = scrlMapWarpY.value
+ EditorWarpFall = chkWarpFall.value
+ picAttributes.visible = False
+ fraMapWarp.visible = False
+End Sub
+
+Private Sub cmdNCache_Click()
+ initAutotiles
+End Sub
+
+Private Sub cmdNDone_Click()
+ fraNudge.visible = False
+ picAttributes.visible = False
+End Sub
+
+Private Sub cmdNDown_Click()
+ NudgeMap DIR_DOWN
+End Sub
+
+Private Sub cmdNLeft_Click()
+ NudgeMap DIR_LEFT
+End Sub
+
+Private Sub cmdNpcSpawn_Click()
+ SpawnNpcNum = lstNpc.ListIndex + 1
+ SpawnNpcDir = scrlNpcDir.value
+ picAttributes.visible = False
+ fraNpcSpawn.visible = False
+End Sub
+
+Private Sub cmdNRight_Click()
+ NudgeMap DIR_RIGHT
+End Sub
+
+Private Sub cmdNudge_Click()
+ picAttributes.visible = True
+ fraNudge.visible = True
+End Sub
+
+Private Sub cmdNUp_Click()
+ NudgeMap DIR_UP
+End Sub
+
+Private Sub cmdResourceOk_Click()
+ ResourceEditorNum = scrlResource.value
+ picAttributes.visible = False
+ fraResource.visible = False
+End Sub
+
+Private Sub cmdShop_Click()
+ EditorShop = cmbShop.ListIndex
+ picAttributes.visible = False
+ fraShop.visible = False
+End Sub
+
+Private Sub cmdSlide_Click()
+ MapEditorSlideDir = cmbSlide.ListIndex
+ picAttributes.visible = False
+ fraSlide.visible = False
+End Sub
+
+Private Sub cmdTrap_Click()
+ MapEditorHealAmount = scrlTrap.value
+ picAttributes.visible = False
+ fraTrap.visible = False
+End Sub
+
+Private Sub Form_Load()
+ ' move the entire attributes box on screen
+ picAttributes.left = 8
+ picAttributes.top = 8
+End Sub
+
+Private Sub optAppear_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraAppear.visible = True
+End Sub
+
+Private Sub optDoor_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraMapWarp.visible = True
+ scrlMapWarp.Max = MAX_MAPS
+ scrlMapWarpX.Max = MAX_BYTE
+ scrlMapWarpY.Max = MAX_BYTE
+End Sub
+
+Private Sub optEvents_Click()
+ selTileX = 0
+ selTileY = 0
+End Sub
+
+Private Sub optHeal_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraHeal.visible = True
+End Sub
+
+Private Sub optLayers_Click()
+
+ If optLayers.value Then
+ fraLayers.visible = True
+ fraAttribs.visible = False
+ End If
+
+End Sub
+
+Private Sub optAttribs_Click()
+
+ If optAttribs.value Then
+ fraLayers.visible = False
+ fraAttribs.visible = True
+ End If
+
+End Sub
+
+Private Sub optNpcSpawn_Click()
+ Dim n As Long
+
+ If lstNpc.ListCount <= 0 Then
+ lstNpc.Clear
+ For n = 1 To MAX_MAP_NPCS
+ If map.MapData.Npc(n) > 0 Then
+ lstNpc.AddItem n & ": " & Npc(map.MapData.Npc(n)).name
+ Else
+ lstNpc.AddItem n & ": No Npc"
+ End If
+ Next n
+ lstNpc.ListIndex = 0
+ End If
+
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraNpcSpawn.visible = True
+End Sub
+
+Private Sub optResource_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraResource.visible = True
+End Sub
+
+Private Sub optShop_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraShop.visible = True
+End Sub
+
+Private Sub optSlide_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraSlide.visible = True
+End Sub
+
+Private Sub optTrap_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraTrap.visible = True
+End Sub
+
+Private Sub picBackSelect_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
+ Call MapEditorChooseTile(Button, x, y)
+End Sub
+
+Private Sub picBackSelect_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+ shpLocTop = (y \ PIC_Y) * PIC_Y
+ shpLocLeft = (x \ PIC_X) * PIC_X
+ Call MapEditorDrag(Button, x, y)
+End Sub
+
+Private Sub cmdSend_Click()
+ Call MapEditorSend
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call MapEditorCancel
+End Sub
+
+Private Sub cmdProperties_Click()
+ Load frmEditor_MapProperties
+ MapEditorProperties
+ frmEditor_MapProperties.Show vbModal
+End Sub
+
+Private Sub optWarp_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraMapWarp.visible = True
+ scrlMapWarp.Max = MAX_MAPS
+ scrlMapWarpX.Max = MAX_BYTE
+ scrlMapWarpY.Max = MAX_BYTE
+End Sub
+
+Private Sub optItem_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraMapItem.visible = True
+ scrlMapItem.Max = MAX_ITEMS
+ lblMapItem.caption = Trim$(Item(scrlMapItem.value).name) & " x" & scrlMapItemValue.value
+End Sub
+
+Private Sub optKey_Click()
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraMapKey.visible = True
+ scrlMapKey.Max = MAX_ITEMS
+ lblMapKey.caption = "Item: " & Trim$(Item(scrlMapKey.value).name)
+End Sub
+
+Private Sub optKeyOpen_Click()
+ ClearAttributeDialogue
+ fraKeyOpen.visible = True
+ picAttributes.visible = True
+ scrlKeyX.Max = map.MapData.MaxX
+ scrlKeyY.Max = map.MapData.MaxY
+End Sub
+
+Private Sub cmdFill_Click()
+ MapEditorFillLayer
+End Sub
+
+Private Sub cmdClear_Click()
+ Call MapEditorClearLayer
+End Sub
+
+Private Sub cmdClear2_Click()
+ Call MapEditorClearAttribs
+End Sub
+
+Private Sub scrlAutotile_Change()
+
+ Select Case scrlAutotile.value
+
+ Case 0 ' normal
+ lblAutotile.caption = "Normal"
+
+ Case 1 ' autotile
+ lblAutotile.caption = "Autotile"
+
+ Case 2 ' fake autotile
+ lblAutotile.caption = "Fake"
+
+ Case 3 ' animated
+ lblAutotile.caption = "Animated"
+
+ Case 4 ' cliff
+ lblAutotile.caption = "Cliff"
+
+ Case 5 ' waterfall
+ lblAutotile.caption = "Waterfall"
+ End Select
+
+End Sub
+
+Private Sub scrlHeal_Change()
+ lblHeal.caption = "Amount: " & scrlHeal.value
+End Sub
+
+
+
+Private Sub scrlKeyTime_Change()
+ lblKeyTime.caption = "Time: " & scrlKeyTime.value & "s"
+End Sub
+
+Private Sub scrlKeyX_Change()
+ lblKeyX.caption = "X: " & scrlKeyX.value
+End Sub
+
+Private Sub scrlKeyX_Scroll()
+ scrlKeyX_Change
+End Sub
+
+Private Sub scrlKeyY_Change()
+ lblKeyY.caption = "Y: " & scrlKeyY.value
+End Sub
+
+Private Sub scrlKeyY_Scroll()
+ scrlKeyY_Change
+End Sub
+
+Private Sub scrlTrap_Change()
+ lblTrap.caption = "Amount: " & scrlTrap.value
+End Sub
+
+Private Sub scrlMapItem_Change()
+
+ If Item(scrlMapItem.value).Type = ITEM_TYPE_CURRENCY Then
+ scrlMapItemValue.enabled = True
+ Else
+ scrlMapItemValue.value = 1
+ scrlMapItemValue.enabled = False
+ End If
+
+ lblMapItem.caption = Trim$(Item(scrlMapItem.value).name) & " x" & scrlMapItemValue.value
+End Sub
+
+Private Sub scrlMapItem_Scroll()
+ scrlMapItem_Change
+End Sub
+
+Private Sub scrlMapItemValue_Change()
+ lblMapItem.caption = Trim$(Item(scrlMapItem.value).name) & " x" & scrlMapItemValue.value
+End Sub
+
+Private Sub scrlMapItemValue_Scroll()
+ scrlMapItemValue_Change
+End Sub
+
+Private Sub scrlMapKey_Change()
+ lblMapKey.caption = "Item: " & Trim$(Item(scrlMapKey.value).name)
+End Sub
+
+Private Sub scrlMapKey_Scroll()
+ scrlMapKey_Change
+End Sub
+
+Private Sub scrlMapWarp_Change()
+ lblMapWarp.caption = "Map: " & scrlMapWarp.value
+End Sub
+
+Private Sub scrlMapWarp_Scroll()
+ scrlMapWarp_Change
+End Sub
+
+Private Sub scrlMapWarpX_Change()
+ lblMapWarpX.caption = "X: " & scrlMapWarpX.value
+End Sub
+
+Private Sub scrlMapWarpX_Scroll()
+ scrlMapWarpX_Change
+End Sub
+
+Private Sub scrlMapWarpY_Change()
+ lblMapWarpY.caption = "Y: " & scrlMapWarpY.value
+End Sub
+
+Private Sub scrlMapWarpY_Scroll()
+ scrlMapWarpY_Change
+End Sub
+
+Private Sub scrlNpcDir_Change()
+
+ Select Case scrlNpcDir.value
+
+ Case DIR_DOWN
+ lblNpcDir = "Direction: Down"
+
+ Case DIR_UP
+ lblNpcDir = "Direction: Up"
+
+ Case DIR_LEFT
+ lblNpcDir = "Direction: Left"
+
+ Case DIR_RIGHT
+ lblNpcDir = "Direction: Right"
+ End Select
+
+End Sub
+
+Private Sub scrlNpcDir_Scroll()
+ scrlNpcDir_Change
+End Sub
+
+Private Sub scrlResource_Change()
+ lblResource.caption = "Resource: " & Resource(scrlResource.value).name
+End Sub
+
+Private Sub scrlResource_Scroll()
+ scrlResource_Change
+End Sub
+
+Private Sub scrlPictureX_Change()
+ Call MapEditorTileScroll
+End Sub
+
+Private Sub scrlPictureY_Change()
+ Call MapEditorTileScroll
+End Sub
+
+Private Sub scrlPictureX_Scroll()
+ scrlPictureY_Change
+End Sub
+
+Private Sub scrlPictureY_Scroll()
+ scrlPictureY_Change
+End Sub
+
+Private Sub scrlTileSet_Change()
+ fraTileSet.caption = "Tileset: " & scrlTileSet.value
+ frmEditor_Map.scrlPictureX.value = 0
+ frmEditor_Map.scrlPictureY.value = 0
+ frmEditor_Map.picBackSelect.left = 0
+ frmEditor_Map.picBackSelect.top = 0
+ GDIRenderTileset
+ frmEditor_Map.scrlPictureY.Max = (frmEditor_Map.picBackSelect.height \ PIC_Y) - (frmEditor_Map.picBack.height \ PIC_Y)
+ frmEditor_Map.scrlPictureX.Max = (frmEditor_Map.picBackSelect.width \ PIC_X) - (frmEditor_Map.picBack.width \ PIC_X)
+ MapEditorTileScroll
+End Sub
+
+Private Sub scrlTileSet_Scroll()
+ scrlTileSet_Change
+End Sub
+
+Private Sub cmdChat_Click()
+ MapEditorChatNpc = lstChat.ListIndex + 1
+ MapEditorChatDir = scrlChat.value
+ picAttributes.visible = False
+ fraChat.visible = False
+End Sub
+
+Private Sub optChat_Click()
+ Dim n As Long
+ If lstChat.ListCount <= 0 Then
+ lstChat.Clear
+ For n = 1 To MAX_MAP_NPCS
+ If map.MapData.Npc(n) > 0 Then
+ lstChat.AddItem n & ": " & Npc(map.MapData.Npc(n)).name
+ Else
+ lstChat.AddItem n & ": No Npc"
+ End If
+ Next n
+ scrlChat.value = 0
+ lstChat.ListIndex = 0
+ End If
+
+ ClearAttributeDialogue
+ picAttributes.visible = True
+ fraChat.visible = True
+End Sub
+
+Private Sub scrlChat_Change()
+ Dim sAppend As String
+
+ Select Case scrlChat.value
+
+ Case DIR_UP
+ sAppend = "Up"
+
+ Case DIR_DOWN
+ sAppend = "Down"
+
+ Case DIR_RIGHT
+ sAppend = "Right"
+
+ Case DIR_LEFT
+ sAppend = "Left"
+ End Select
+
+ lblChat.caption = "Direction Req: " & sAppend
+End Sub
diff --git a/client/src/frmEditor_Map.frx b/client/src/frmEditor_Map.frx
new file mode 100644
index 0000000..6cb39a6
Binary files /dev/null and b/client/src/frmEditor_Map.frx differ
diff --git a/client/src/frmEditor_NPC.frm b/client/src/frmEditor_NPC.frm
new file mode 100644
index 0000000..6669601
--- /dev/null
+++ b/client/src/frmEditor_NPC.frm
@@ -0,0 +1,818 @@
+VERSION 5.00
+Begin VB.Form frmEditor_NPC
+ BorderStyle = 1 'Fixed Single
+ Caption = "Npc Editor"
+ ClientHeight = 6390
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 9630
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmEditor_NPC.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 426
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 642
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmdCopy
+ Caption = "Copy"
+ Height = 375
+ Left = 6480
+ TabIndex = 61
+ Top = 5880
+ Width = 615
+ End
+ Begin VB.CommandButton cmdPaste
+ Caption = "Paste"
+ Height = 375
+ Left = 7200
+ TabIndex = 60
+ Top = 5880
+ Width = 615
+ End
+ Begin VB.Frame fraSpell
+ Caption = "Spell"
+ Height = 1455
+ Left = 3360
+ TabIndex = 55
+ Top = 4320
+ Width = 3015
+ Begin VB.HScrollBar scrlSpellNum
+ Height = 255
+ Left = 1200
+ Max = 255
+ TabIndex = 58
+ Top = 1080
+ Width = 1695
+ End
+ Begin VB.HScrollBar scrlSpell
+ Height = 255
+ Left = 120
+ Max = 10
+ Min = 1
+ TabIndex = 56
+ Top = 240
+ Value = 1
+ Width = 2775
+ End
+ Begin VB.Label lblSpellNum
+ AutoSize = -1 'True
+ Caption = "Num: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 59
+ Top = 1080
+ Width = 555
+ End
+ Begin VB.Label lblSpellName
+ Caption = "Spell: None"
+ Height = 255
+ Left = 120
+ TabIndex = 57
+ Top = 720
+ Width = 2775
+ End
+ Begin VB.Line Line2
+ BorderColor = &H80000000&
+ X1 = 120
+ X2 = 2880
+ Y1 = 600
+ Y2 = 600
+ End
+ End
+ Begin VB.Frame Frame4
+ Caption = "Info"
+ Height = 4095
+ Left = 3360
+ TabIndex = 35
+ Top = 120
+ Width = 3015
+ Begin VB.TextBox txtSpawnSecs
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 1080
+ TabIndex = 45
+ Text = "0"
+ Top = 3600
+ Width = 1815
+ End
+ Begin VB.HScrollBar scrlConv
+ Height = 255
+ Left = 120
+ TabIndex = 44
+ Top = 3240
+ Width = 2775
+ End
+ Begin VB.ComboBox cmbSound
+ Height = 300
+ Left = 1200
+ Style = 2 'Dropdown List
+ TabIndex = 43
+ Top = 2040
+ Width = 1695
+ End
+ Begin VB.HScrollBar scrlAnimation
+ Height = 255
+ Left = 120
+ TabIndex = 42
+ Top = 2640
+ Width = 2775
+ End
+ Begin VB.PictureBox picSprite
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 480
+ Left = 2400
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 41
+ Top = 960
+ Width = 480
+ End
+ Begin VB.HScrollBar scrlSprite
+ Height = 255
+ Left = 1200
+ Max = 255
+ TabIndex = 40
+ Top = 960
+ Width = 1095
+ End
+ Begin VB.TextBox txtName
+ Height = 270
+ Left = 840
+ TabIndex = 39
+ Top = 240
+ Width = 2055
+ End
+ Begin VB.ComboBox cmbBehaviour
+ Height = 300
+ ItemData = "frmEditor_NPC.frx":3332
+ Left = 1200
+ List = "frmEditor_NPC.frx":3345
+ Style = 2 'Dropdown List
+ TabIndex = 38
+ Top = 1680
+ Width = 1695
+ End
+ Begin VB.HScrollBar scrlRange
+ Height = 255
+ Left = 1200
+ Max = 255
+ TabIndex = 37
+ Top = 1320
+ Width = 1095
+ End
+ Begin VB.TextBox txtAttackSay
+ Height = 255
+ Left = 840
+ TabIndex = 36
+ Top = 600
+ Width = 2055
+ End
+ Begin VB.Label Label16
+ AutoSize = -1 'True
+ Caption = "Spawn Rate:"
+ Height = 180
+ Left = 120
+ TabIndex = 54
+ Top = 3600
+ UseMnemonic = 0 'False
+ Width = 930
+ End
+ Begin VB.Label lblConv
+ Caption = "Conv: None"
+ Height = 255
+ Left = 120
+ TabIndex = 53
+ Top = 3000
+ Width = 1695
+ End
+ Begin VB.Label Label1
+ Caption = "Sound:"
+ Height = 255
+ Left = 120
+ TabIndex = 52
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.Label lblAnimation
+ Caption = "Anim: None"
+ Height = 255
+ Left = 120
+ TabIndex = 51
+ Top = 2400
+ Width = 2775
+ End
+ Begin VB.Label lblSprite
+ AutoSize = -1 'True
+ Caption = "Sprite: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 50
+ Top = 960
+ Width = 660
+ End
+ Begin VB.Label lblName
+ AutoSize = -1 'True
+ Caption = "Name:"
+ Height = 180
+ Left = 120
+ TabIndex = 49
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Behaviour:"
+ Height = 180
+ Left = 120
+ TabIndex = 48
+ Top = 1680
+ UseMnemonic = 0 'False
+ Width = 810
+ End
+ Begin VB.Label lblRange
+ AutoSize = -1 'True
+ Caption = "Range: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 47
+ Top = 1320
+ UseMnemonic = 0 'False
+ Width = 675
+ End
+ Begin VB.Label lblSay
+ AutoSize = -1 'True
+ Caption = "Say:"
+ Height = 180
+ Left = 120
+ TabIndex = 46
+ Top = 600
+ UseMnemonic = 0 'False
+ Width = 345
+ End
+ End
+ Begin VB.Frame Fra7
+ Caption = "Vitals"
+ Height = 1815
+ Left = 6480
+ TabIndex = 26
+ Top = 3960
+ Width = 3015
+ Begin VB.TextBox txtLevel
+ Height = 285
+ Left = 960
+ TabIndex = 30
+ Top = 1320
+ Width = 1935
+ End
+ Begin VB.TextBox txtDamage
+ Height = 285
+ Left = 960
+ TabIndex = 29
+ Top = 600
+ Width = 1935
+ End
+ Begin VB.TextBox txtHP
+ Height = 285
+ Left = 960
+ TabIndex = 28
+ Top = 240
+ Width = 1935
+ End
+ Begin VB.TextBox txtEXP
+ Height = 285
+ Left = 960
+ TabIndex = 27
+ Top = 960
+ Width = 1935
+ End
+ Begin VB.Label Label5
+ AutoSize = -1 'True
+ Caption = "Damage:"
+ Height = 180
+ Left = 120
+ TabIndex = 34
+ Top = 600
+ Width = 675
+ End
+ Begin VB.Label Label4
+ AutoSize = -1 'True
+ Caption = "Level:"
+ Height = 180
+ Left = 120
+ TabIndex = 33
+ Top = 1320
+ Width = 705
+ End
+ Begin VB.Label Label15
+ AutoSize = -1 'True
+ Caption = "Exp:"
+ Height = 180
+ Left = 120
+ TabIndex = 32
+ Top = 960
+ Width = 585
+ End
+ Begin VB.Label Label13
+ AutoSize = -1 'True
+ Caption = "Health:"
+ Height = 180
+ Left = 120
+ TabIndex = 31
+ Top = 240
+ Width = 555
+ End
+ End
+ Begin VB.Frame Frame2
+ Caption = "Stats"
+ Height = 1455
+ Left = 6480
+ TabIndex = 15
+ Top = 120
+ Width = 3015
+ Begin VB.HScrollBar scrlStat
+ Height = 255
+ Index = 5
+ Left = 1080
+ Max = 255
+ TabIndex = 20
+ Top = 840
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStat
+ Height = 255
+ Index = 4
+ Left = 120
+ Max = 255
+ TabIndex = 19
+ Top = 840
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStat
+ Height = 255
+ Index = 3
+ Left = 2040
+ Max = 255
+ TabIndex = 18
+ Top = 240
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStat
+ Height = 255
+ Index = 2
+ Left = 1080
+ Max = 255
+ TabIndex = 17
+ Top = 240
+ Width = 855
+ End
+ Begin VB.HScrollBar scrlStat
+ Height = 255
+ Index = 1
+ Left = 120
+ Max = 255
+ TabIndex = 16
+ Top = 240
+ Width = 855
+ End
+ Begin VB.Label lblStat
+ AutoSize = -1 'True
+ Caption = "Will: 0"
+ Height = 180
+ Index = 5
+ Left = 1080
+ TabIndex = 25
+ Top = 1080
+ Width = 480
+ End
+ Begin VB.Label lblStat
+ AutoSize = -1 'True
+ Caption = "Agi: 0"
+ Height = 180
+ Index = 4
+ Left = 120
+ TabIndex = 24
+ Top = 1080
+ Width = 465
+ End
+ Begin VB.Label lblStat
+ AutoSize = -1 'True
+ Caption = "Int: 0"
+ Height = 180
+ Index = 3
+ Left = 2040
+ TabIndex = 23
+ Top = 480
+ Width = 435
+ End
+ Begin VB.Label lblStat
+ AutoSize = -1 'True
+ Caption = "End: 0"
+ Height = 180
+ Index = 2
+ Left = 1080
+ TabIndex = 22
+ Top = 480
+ Width = 495
+ End
+ Begin VB.Label lblStat
+ AutoSize = -1 'True
+ Caption = "Str: 0"
+ Height = 180
+ Index = 1
+ Left = 120
+ TabIndex = 21
+ Top = 480
+ Width = 435
+ End
+ End
+ Begin VB.Frame fraDrop
+ Caption = "Drop"
+ Height = 2175
+ Left = 6480
+ TabIndex = 6
+ Top = 1680
+ Width = 3015
+ Begin VB.TextBox txtChance
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 960
+ TabIndex = 10
+ Text = "0"
+ Top = 720
+ Width = 1935
+ End
+ Begin VB.HScrollBar scrlNum
+ Height = 255
+ Left = 1200
+ Max = 255
+ TabIndex = 9
+ Top = 1440
+ Width = 1695
+ End
+ Begin VB.HScrollBar scrlValue
+ Height = 255
+ Left = 1200
+ Max = 255
+ TabIndex = 8
+ Top = 1800
+ Width = 1695
+ End
+ Begin VB.HScrollBar scrlDrop
+ Height = 255
+ Left = 120
+ Min = 1
+ TabIndex = 7
+ Top = 240
+ Value = 1
+ Width = 2775
+ End
+ Begin VB.Label Label3
+ AutoSize = -1 'True
+ Caption = "Chance:"
+ Height = 180
+ Left = 120
+ TabIndex = 14
+ Top = 720
+ UseMnemonic = 0 'False
+ Width = 630
+ End
+ Begin VB.Label lblNum
+ AutoSize = -1 'True
+ Caption = "Num: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 13
+ Top = 1440
+ Width = 555
+ End
+ Begin VB.Label lblItemName
+ AutoSize = -1 'True
+ Caption = "Item: None"
+ Height = 180
+ Left = 120
+ TabIndex = 12
+ Top = 1080
+ Width = 2775
+ End
+ Begin VB.Label lblValue
+ AutoSize = -1 'True
+ Caption = "Value: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 11
+ Top = 1800
+ UseMnemonic = 0 'False
+ Width = 645
+ End
+ Begin VB.Line Line1
+ BorderColor = &H80000000&
+ X1 = 120
+ X2 = 2880
+ Y1 = 600
+ Y2 = 600
+ End
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 3360
+ TabIndex = 5
+ Top = 5880
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 7920
+ TabIndex = 4
+ Top = 5880
+ Width = 1575
+ End
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 4920
+ TabIndex = 3
+ Top = 5880
+ Width = 1455
+ End
+ Begin VB.Frame Frame3
+ Caption = "NPC List"
+ Height = 5655
+ Left = 120
+ TabIndex = 1
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ Height = 5280
+ Left = 120
+ TabIndex = 2
+ Top = 240
+ Width = 2895
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Enabled = 0 'False
+ Height = 375
+ Left = 240
+ TabIndex = 0
+ Top = 5880
+ Width = 2895
+ End
+End
+Attribute VB_Name = "frmEditor_NPC"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Private DropIndex As Long
+Private SpellIndex As Long
+
+Private Sub cmbBehaviour_Click()
+ Npc(EditorIndex).Behaviour = cmbBehaviour.ListIndex
+End Sub
+
+Private Sub cmdCopy_Click()
+ NpcEditorCopy
+End Sub
+
+Private Sub cmdDelete_Click()
+ Dim tmpIndex As Long
+ ClearNPC EditorIndex
+ tmpIndex = lstIndex.ListIndex
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Npc(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+ NpcEditorInit
+End Sub
+
+Private Sub cmdPaste_Click()
+ NpcEditorPaste
+End Sub
+
+Private Sub Form_Load()
+ scrlSprite.Max = Count_Char
+ scrlAnimation.Max = MAX_ANIMATIONS
+ scrlConv.Max = MAX_CONVS
+End Sub
+
+Private Sub scrlConv_Change()
+
+ If scrlConv.value > 0 Then
+ lblConv.caption = "Conv: " & Trim$(Conv(scrlConv.value).name)
+ Else
+ lblConv.caption = "Conv: None"
+ End If
+
+ Npc(EditorIndex).Conv = scrlConv.value
+End Sub
+
+Private Sub cmdSave_Click()
+ Call NpcEditorOk
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call NpcEditorCancel
+End Sub
+
+Private Sub lstIndex_Click()
+ NpcEditorInit
+End Sub
+
+Private Sub scrlAnimation_Change()
+ Dim sString As String
+
+ If scrlAnimation.value = 0 Then sString = "None" Else sString = Trim$(Animation(scrlAnimation.value).name)
+ lblAnimation.caption = "Anim: " & sString
+ Npc(EditorIndex).Animation = scrlAnimation.value
+End Sub
+
+Private Sub scrlDrop_Change()
+ DropIndex = scrlDrop.value
+ fraDrop.caption = "Drop - " & DropIndex
+ txtChance.text = Npc(EditorIndex).DropChance(DropIndex)
+ scrlNum.value = Npc(EditorIndex).DropItem(DropIndex)
+ scrlValue.value = Npc(EditorIndex).DropItemValue(DropIndex)
+End Sub
+
+Private Sub scrlSpell_Change()
+ SpellIndex = scrlSpell.value
+ fraSpell.caption = "Spell - " & SpellIndex
+ scrlSpellNum.value = Npc(EditorIndex).Spell(SpellIndex)
+End Sub
+
+Private Sub scrlSpellNum_Change()
+ lblSpellNum.caption = "Num: " & scrlSpellNum.value
+
+ If scrlSpellNum.value > 0 Then
+ lblSpellName.caption = "Spell: " & Trim$(Spell(scrlSpellNum.value).name)
+ Else
+ lblSpellName.caption = "Spell: None"
+ End If
+
+ Npc(EditorIndex).Spell(SpellIndex) = scrlSpellNum.value
+End Sub
+
+Private Sub scrlSprite_Change()
+ lblSprite.caption = "Sprite: " & scrlSprite.value
+ Npc(EditorIndex).sprite = scrlSprite.value
+End Sub
+
+Private Sub scrlRange_Change()
+ lblRange.caption = "Range: " & scrlRange.value
+ Npc(EditorIndex).Range = scrlRange.value
+End Sub
+
+Private Sub scrlNum_Change()
+ lblNum.caption = "Num: " & scrlNum.value
+
+ If scrlNum.value > 0 Then
+ lblItemName.caption = "Item: " & Trim$(Item(scrlNum.value).name)
+ End If
+
+ Npc(EditorIndex).DropItem(DropIndex) = scrlNum.value
+End Sub
+
+Private Sub scrlStat_Change(index As Integer)
+ Dim prefix As String
+
+ Select Case index
+
+ Case 1
+ prefix = "Str: "
+
+ Case 2
+ prefix = "End: "
+
+ Case 3
+ prefix = "Int: "
+
+ Case 4
+ prefix = "Agi: "
+
+ Case 5
+ prefix = "Will: "
+ End Select
+
+ lblStat(index).caption = prefix & scrlStat(index).value
+ Npc(EditorIndex).Stat(index) = scrlStat(index).value
+End Sub
+
+Private Sub scrlValue_Change()
+ lblValue.caption = "Value: " & scrlValue.value
+ Npc(EditorIndex).DropItemValue(DropIndex) = scrlValue.value
+End Sub
+
+Private Sub txtAttackSay_Change()
+ Npc(EditorIndex).AttackSay = txtAttackSay.text
+End Sub
+
+Private Sub txtChance_Validate(Cancel As Boolean)
+
+ On Error GoTo chanceErr
+
+ If DropIndex = 0 Then Exit Sub
+ If Not IsNumeric(txtChance.text) And Not Right$(txtChance.text, 1) = "%" And Not InStr(1, txtChance.text, "/") > 0 And Not InStr(1, txtChance.text, ".") Then
+ txtChance.text = "0"
+ Npc(EditorIndex).DropChance(DropIndex) = 0
+ Exit Sub
+ End If
+
+ If Right$(txtChance.text, 1) = "%" Then
+ txtChance.text = left$(txtChance.text, Len(txtChance.text) - 1) / 100
+ ElseIf InStr(1, txtChance.text, "/") > 0 Then
+ Dim i() As String
+ i = Split(txtChance.text, "/")
+ txtChance.text = Int(i(0) / i(1) * 1000) / 1000
+ End If
+
+ If txtChance.text > 1 Or txtChance.text < 0 Then
+ Err.Description = "Value must be between 0 and 1!"
+ GoTo chanceErr
+ End If
+
+ Npc(EditorIndex).DropChance(DropIndex) = txtChance.text
+ Exit Sub
+chanceErr:
+ txtChance.text = "0"
+ Npc(EditorIndex).DropChance(DropIndex) = 0
+End Sub
+
+Private Sub txtDamage_Change()
+
+ If Not Len(txtDamage.text) > 0 Then Exit Sub
+ If IsNumeric(txtDamage.text) Then Npc(EditorIndex).Damage = Val(txtDamage.text)
+End Sub
+
+Private Sub txtEXP_Change()
+
+ If Not Len(txtEXP.text) > 0 Then Exit Sub
+ If IsNumeric(txtEXP.text) Then Npc(EditorIndex).EXP = Val(txtEXP.text)
+End Sub
+
+Private Sub txtHP_Change()
+
+ If Not Len(txtHP.text) > 0 Then Exit Sub
+ If IsNumeric(txtHP.text) Then Npc(EditorIndex).HP = Val(txtHP.text)
+End Sub
+
+Private Sub txtLevel_Change()
+
+ If Not Len(txtLevel.text) > 0 Then Exit Sub
+ If IsNumeric(txtLevel.text) Then Npc(EditorIndex).Level = Val(txtLevel.text)
+End Sub
+
+Public Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Npc(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Npc(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
+
+Private Sub txtSpawnSecs_Change()
+
+ If Not Len(txtSpawnSecs.text) > 0 Then Exit Sub
+ Npc(EditorIndex).SpawnSecs = Val(txtSpawnSecs.text)
+End Sub
+
+Private Sub cmbSound_Click()
+
+ If cmbSound.ListIndex >= 0 Then
+ Npc(EditorIndex).sound = cmbSound.list(cmbSound.ListIndex)
+ Else
+ Npc(EditorIndex).sound = "None."
+ End If
+
+End Sub
diff --git a/client/src/frmEditor_NPC.frx b/client/src/frmEditor_NPC.frx
new file mode 100644
index 0000000..cb2e91f
Binary files /dev/null and b/client/src/frmEditor_NPC.frx differ
diff --git a/client/src/frmEditor_Resource.frm b/client/src/frmEditor_Resource.frm
new file mode 100644
index 0000000..d380562
--- /dev/null
+++ b/client/src/frmEditor_Resource.frm
@@ -0,0 +1,465 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Resource
+ BorderStyle = 1 'Fixed Single
+ Caption = "Resource Editor"
+ ClientHeight = 8295
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 8535
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmEditor_Resource.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 553
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 569
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 5160
+ TabIndex = 28
+ Top = 7800
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 6840
+ TabIndex = 27
+ Top = 7800
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 3480
+ TabIndex = 26
+ Top = 7800
+ Width = 1455
+ End
+ Begin VB.Frame Frame1
+ Caption = "Resource Properties"
+ Height = 7575
+ Left = 3360
+ TabIndex = 3
+ Top = 120
+ Width = 5055
+ Begin VB.ComboBox cmbSound
+ Height = 300
+ Left = 960
+ Style = 2 'Dropdown List
+ TabIndex = 32
+ Top = 7080
+ Width = 3975
+ End
+ Begin VB.HScrollBar scrlAnimation
+ Height = 255
+ Left = 120
+ Max = 6000
+ TabIndex = 29
+ Top = 6720
+ Width = 4815
+ End
+ Begin VB.HScrollBar scrlExhaustedPic
+ Height = 255
+ Left = 2640
+ TabIndex = 24
+ Top = 1920
+ Width = 2295
+ End
+ Begin VB.PictureBox picExhaustedPic
+ AutoRedraw = -1 'True
+ AutoSize = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 1680
+ Left = 2640
+ ScaleHeight = 112
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 152
+ TabIndex = 23
+ Top = 2280
+ Width = 2280
+ End
+ Begin VB.TextBox txtName
+ Height = 285
+ Left = 960
+ TabIndex = 13
+ Top = 240
+ Width = 3975
+ End
+ Begin VB.ComboBox cmbType
+ Height = 300
+ ItemData = "frmEditor_Resource.frx":3332
+ Left = 960
+ List = "frmEditor_Resource.frx":3342
+ Style = 2 'Dropdown List
+ TabIndex = 12
+ Top = 1320
+ Width = 3975
+ End
+ Begin VB.HScrollBar scrlNormalPic
+ Height = 255
+ Left = 120
+ TabIndex = 11
+ Top = 1920
+ Width = 2295
+ End
+ Begin VB.HScrollBar scrlReward
+ Height = 255
+ Left = 120
+ TabIndex = 10
+ Top = 4320
+ Width = 4815
+ End
+ Begin VB.HScrollBar scrlTool
+ Height = 255
+ Left = 120
+ Max = 3
+ TabIndex = 9
+ Top = 4920
+ Width = 4815
+ End
+ Begin VB.HScrollBar scrlHealth
+ Height = 255
+ Left = 120
+ Max = 255
+ TabIndex = 8
+ Top = 5520
+ Width = 4815
+ End
+ Begin VB.PictureBox picNormalPic
+ AutoRedraw = -1 'True
+ AutoSize = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 1680
+ Left = 120
+ ScaleHeight = 112
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 152
+ TabIndex = 7
+ Top = 2280
+ Width = 2280
+ End
+ Begin VB.HScrollBar scrlRespawn
+ Height = 255
+ Left = 120
+ Max = 6000
+ TabIndex = 6
+ Top = 6120
+ Width = 4815
+ End
+ Begin VB.TextBox txtMessage
+ Height = 285
+ Left = 960
+ TabIndex = 5
+ Top = 600
+ Width = 3975
+ End
+ Begin VB.TextBox txtMessage2
+ Height = 285
+ Left = 960
+ TabIndex = 4
+ Top = 960
+ Width = 3975
+ End
+ Begin VB.Label Label5
+ Caption = "Sound:"
+ Height = 255
+ Left = 120
+ TabIndex = 31
+ Top = 7080
+ Width = 1455
+ End
+ Begin VB.Label lblAnim
+ AutoSize = -1 'True
+ Caption = "Animation: None"
+ Height = 180
+ Left = 120
+ TabIndex = 30
+ Top = 6480
+ Width = 1260
+ End
+ Begin VB.Label lblExhaustedPic
+ AutoSize = -1 'True
+ Caption = "Exhausted Image: 0"
+ Height = 180
+ Left = 2640
+ TabIndex = 25
+ Top = 1680
+ Width = 1530
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Name:"
+ Height = 180
+ Left = 120
+ TabIndex = 22
+ Top = 240
+ Width = 495
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Type:"
+ Height = 180
+ Left = 120
+ TabIndex = 21
+ Top = 1320
+ Width = 435
+ End
+ Begin VB.Label lblNormalPic
+ AutoSize = -1 'True
+ Caption = "Normal Image: 0"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 195
+ Left = 120
+ TabIndex = 20
+ Top = 1680
+ Width = 1470
+ End
+ Begin VB.Label lblReward
+ AutoSize = -1 'True
+ Caption = "Item Reward: None"
+ Height = 180
+ Left = 120
+ TabIndex = 19
+ Top = 4080
+ Width = 1440
+ End
+ Begin VB.Label lblTool
+ AutoSize = -1 'True
+ Caption = "Tool Required: None"
+ Height = 180
+ Left = 120
+ TabIndex = 18
+ Top = 4680
+ Width = 1530
+ End
+ Begin VB.Label lblHealth
+ AutoSize = -1 'True
+ Caption = "Health: 0"
+ Height = 180
+ Left = 120
+ TabIndex = 17
+ Top = 5280
+ Width = 705
+ End
+ Begin VB.Label lblRespawn
+ AutoSize = -1 'True
+ Caption = "Respawn Time (Seconds): 0"
+ Height = 180
+ Left = 120
+ TabIndex = 16
+ Top = 5880
+ Width = 2100
+ End
+ Begin VB.Label Label3
+ AutoSize = -1 'True
+ Caption = "Success:"
+ Height = 180
+ Left = 120
+ TabIndex = 15
+ Top = 600
+ Width = 705
+ End
+ Begin VB.Label Label4
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "Empty:"
+ Height = 180
+ Left = 120
+ TabIndex = 14
+ Top = 960
+ Width = 540
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Enabled = 0 'False
+ Height = 375
+ Left = 240
+ TabIndex = 2
+ Top = 7800
+ Width = 2895
+ End
+ Begin VB.Frame Frame3
+ Caption = "Resource List"
+ Height = 7575
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ Height = 7260
+ Left = 120
+ TabIndex = 1
+ Top = 240
+ Width = 2895
+ End
+ End
+End
+Attribute VB_Name = "frmEditor_Resource"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmbType_Click()
+ Resource(EditorIndex).ResourceType = cmbType.ListIndex
+End Sub
+
+Private Sub cmdDelete_Click()
+ Dim tmpIndex As Long
+ ClearResource EditorIndex
+ tmpIndex = lstIndex.ListIndex
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Resource(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+ ResourceEditorInit
+End Sub
+
+Private Sub cmdSave_Click()
+ Call ResourceEditorOk
+End Sub
+
+Private Sub Form_Load()
+ scrlReward.Max = MAX_ITEMS
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call ResourceEditorCancel
+End Sub
+
+Private Sub lstIndex_Click()
+ ResourceEditorInit
+End Sub
+
+Private Sub scrlAnimation_Change()
+ Dim sString As String
+
+ If scrlAnimation.value = 0 Then sString = "None" Else sString = Trim$(Animation(scrlAnimation.value).name)
+ lblAnim.caption = "Animation: " & sString
+ Resource(EditorIndex).Animation = scrlAnimation.value
+End Sub
+
+Private Sub scrlExhaustedPic_Change()
+ lblExhaustedPic.caption = "Exhausted Image: " & scrlExhaustedPic.value
+ Resource(EditorIndex).ExhaustedImage = scrlExhaustedPic.value
+End Sub
+
+Private Sub scrlHealth_Change()
+ lblHealth.caption = "Health: " & scrlHealth.value
+ Resource(EditorIndex).health = scrlHealth.value
+End Sub
+
+Private Sub scrlNormalPic_Change()
+ lblNormalPic.caption = "Normal Image: " & scrlNormalPic.value
+ Resource(EditorIndex).ResourceImage = scrlNormalPic.value
+End Sub
+
+Private Sub scrlRespawn_Change()
+ lblRespawn.caption = "Respawn Time (Seconds): " & scrlRespawn.value
+ Resource(EditorIndex).RespawnTime = scrlRespawn.value
+End Sub
+
+Private Sub scrlReward_Change()
+
+ If scrlReward.value > 0 Then
+ lblReward.caption = "Item Reward: " & Trim$(Item(scrlReward.value).name)
+ Else
+ lblReward.caption = "Item Reward: None"
+ End If
+
+ Resource(EditorIndex).ItemReward = scrlReward.value
+End Sub
+
+Private Sub scrlTool_Change()
+ Dim name As String
+
+ Select Case scrlTool.value
+
+ Case 0
+ name = "None"
+
+ Case 1
+ name = "Hatchet"
+
+ Case 2
+ name = "Rod"
+
+ Case 3
+ name = "Pickaxe"
+ End Select
+
+ lblTool.caption = "Tool Required: " & name
+ Resource(EditorIndex).ToolRequired = scrlTool.value
+End Sub
+
+Private Sub txtMessage_Change()
+ Resource(EditorIndex).SuccessMessage = Trim$(txtMessage.text)
+End Sub
+
+Private Sub txtMessage2_Change()
+ Resource(EditorIndex).EmptyMessage = Trim$(txtMessage2.text)
+End Sub
+
+Private Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Resource(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Resource(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
+
+Private Sub cmbSound_Click()
+
+ If cmbSound.ListIndex >= 0 Then
+ Resource(EditorIndex).sound = cmbSound.List(cmbSound.ListIndex)
+ Else
+ Resource(EditorIndex).sound = "None."
+ End If
+
+End Sub
diff --git a/client/src/frmEditor_Resource.frx b/client/src/frmEditor_Resource.frx
new file mode 100644
index 0000000..d762af6
Binary files /dev/null and b/client/src/frmEditor_Resource.frx differ
diff --git a/client/src/frmEditor_Shop.frm b/client/src/frmEditor_Shop.frm
new file mode 100644
index 0000000..8248fca
--- /dev/null
+++ b/client/src/frmEditor_Shop.frm
@@ -0,0 +1,336 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Shop
+ BorderStyle = 1 'Fixed Single
+ Caption = "Shop Editor"
+ ClientHeight = 9075
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 8775
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmEditor_Shop.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 605
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 585
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 5280
+ TabIndex = 20
+ Top = 8520
+ Width = 1455
+ End
+ Begin VB.Frame Frame1
+ Caption = "Shop Properties"
+ Height = 8295
+ Left = 3360
+ TabIndex = 5
+ Top = 120
+ Width = 5295
+ Begin VB.CommandButton cmdCopy
+ Caption = "Cut"
+ Height = 255
+ Left = 120
+ TabIndex = 23
+ Top = 7560
+ Width = 2415
+ End
+ Begin VB.CommandButton cmdPaste
+ Caption = "Paste"
+ Height = 255
+ Left = 2760
+ TabIndex = 22
+ Top = 7560
+ Width = 2415
+ End
+ Begin VB.CommandButton cmdDeleteTrade
+ Caption = "Delete"
+ Height = 255
+ Left = 2760
+ TabIndex = 21
+ Top = 7920
+ Width = 2415
+ End
+ Begin VB.HScrollBar scrlBuy
+ Height = 255
+ Left = 120
+ Max = 1000
+ Min = 1
+ TabIndex = 19
+ Top = 840
+ Value = 100
+ Width = 5055
+ End
+ Begin VB.TextBox txtName
+ Height = 285
+ Left = 720
+ TabIndex = 12
+ Top = 240
+ Width = 4455
+ End
+ Begin VB.ListBox lstTradeItem
+ Height = 5460
+ ItemData = "frmEditor_Shop.frx":3332
+ Left = 120
+ List = "frmEditor_Shop.frx":334E
+ TabIndex = 11
+ Top = 2040
+ Width = 5055
+ End
+ Begin VB.ComboBox cmbItem
+ Height = 300
+ Left = 720
+ Style = 2 'Dropdown List
+ TabIndex = 10
+ Top = 1320
+ Width = 3135
+ End
+ Begin VB.TextBox txtItemValue
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 4560
+ TabIndex = 9
+ Text = "1"
+ Top = 1320
+ Width = 615
+ End
+ Begin VB.ComboBox cmbCostItem
+ Height = 300
+ Left = 720
+ Style = 2 'Dropdown List
+ TabIndex = 8
+ Top = 1680
+ Width = 3135
+ End
+ Begin VB.TextBox txtCostValue
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 4560
+ TabIndex = 7
+ Text = "1"
+ Top = 1680
+ Width = 615
+ End
+ Begin VB.CommandButton cmdUpdate
+ Caption = "Update"
+ Height = 255
+ Left = 120
+ TabIndex = 6
+ Top = 7920
+ Width = 2415
+ End
+ Begin VB.Label lblBuy
+ AutoSize = -1 'True
+ Caption = "Buy Rate: 100%"
+ Height = 180
+ Left = 120
+ TabIndex = 18
+ Top = 600
+ Width = 1260
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Name:"
+ Height = 180
+ Left = 120
+ TabIndex = 17
+ Top = 240
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ Begin VB.Label Label3
+ AutoSize = -1 'True
+ Caption = "Item:"
+ Height = 180
+ Left = 120
+ TabIndex = 16
+ Top = 1320
+ Width = 420
+ End
+ Begin VB.Label Label4
+ AutoSize = -1 'True
+ Caption = "Value:"
+ Height = 180
+ Left = 3960
+ TabIndex = 15
+ Top = 1320
+ Width = 495
+ End
+ Begin VB.Label Label5
+ AutoSize = -1 'True
+ Caption = "Price:"
+ Height = 180
+ Left = 120
+ TabIndex = 14
+ Top = 1680
+ Width = 450
+ End
+ Begin VB.Label Label6
+ AutoSize = -1 'True
+ Caption = "Value:"
+ Height = 180
+ Left = 3960
+ TabIndex = 13
+ Top = 1680
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ End
+ Begin VB.Frame Frame3
+ Caption = "Shop List"
+ Height = 8295
+ Left = 120
+ TabIndex = 3
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ Height = 7980
+ Left = 120
+ TabIndex = 4
+ Top = 240
+ Width = 2895
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Enabled = 0 'False
+ Height = 375
+ Left = 240
+ TabIndex = 2
+ Top = 8520
+ Width = 2895
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 3480
+ TabIndex = 0
+ Top = 8520
+ Width = 1575
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 6960
+ TabIndex = 1
+ Top = 8520
+ Width = 1575
+ End
+End
+Attribute VB_Name = "frmEditor_Shop"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private tmpTrade As TradeItemRec
+
+Private Sub cmdCopy_Click()
+Dim index As Long
+
+ index = lstTradeItem.ListIndex + 1
+ tmpTrade.Item = Shop(EditorIndex).TradeItem(index).Item
+ tmpTrade.ItemValue = Shop(EditorIndex).TradeItem(index).ItemValue
+ tmpTrade.CostItem = Shop(EditorIndex).TradeItem(index).CostItem
+ tmpTrade.CostValue = Shop(EditorIndex).TradeItem(index).CostValue
+
+ cmdDeleteTrade_Click
+End Sub
+
+Private Sub cmdPaste_Click()
+Dim index As Long, tmpPos As Long
+ tmpPos = lstTradeItem.ListIndex
+
+ index = lstTradeItem.ListIndex + 1
+ Shop(EditorIndex).TradeItem(index).Item = tmpTrade.Item
+ Shop(EditorIndex).TradeItem(index).ItemValue = tmpTrade.ItemValue
+ Shop(EditorIndex).TradeItem(index).CostItem = tmpTrade.CostItem
+ Shop(EditorIndex).TradeItem(index).CostValue = tmpTrade.CostValue
+
+ UpdateShopTrade tmpPos
+End Sub
+
+Private Sub cmdSave_Click()
+
+ If LenB(Trim$(txtName)) = 0 Then
+ Call MsgBox("Name required.")
+ Else
+ Call ShopEditorOk
+ End If
+
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call ShopEditorCancel
+End Sub
+
+Private Sub cmdUpdate_Click()
+ Dim index As Long
+ Dim tmpPos As Long
+ tmpPos = lstTradeItem.ListIndex
+ index = lstTradeItem.ListIndex + 1
+
+ If index = 0 Then Exit Sub
+
+ With Shop(EditorIndex).TradeItem(index)
+ .Item = cmbItem.ListIndex
+ .ItemValue = Val(txtItemValue.text)
+ .CostItem = cmbCostItem.ListIndex
+ .CostValue = Val(txtCostValue.text)
+ End With
+
+ UpdateShopTrade tmpPos
+End Sub
+
+Private Sub cmdDeleteTrade_Click()
+ Dim index As Long
+ Dim tmpPos As Long
+ tmpPos = lstTradeItem.ListIndex
+ index = lstTradeItem.ListIndex + 1
+
+ If index = 0 Then Exit Sub
+
+ With Shop(EditorIndex).TradeItem(index)
+ .Item = 0
+ .ItemValue = 0
+ .CostItem = 0
+ .CostValue = 0
+ End With
+
+ UpdateShopTrade tmpPos
+End Sub
+
+Private Sub lstIndex_Click()
+ ShopEditorInit
+End Sub
+
+Private Sub scrlBuy_Change()
+ lblBuy.caption = "Buy Rate: " & scrlBuy.value & "%"
+ Shop(EditorIndex).BuyRate = scrlBuy.value
+End Sub
+
+Private Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Shop(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Shop(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
diff --git a/client/src/frmEditor_Shop.frx b/client/src/frmEditor_Shop.frx
new file mode 100644
index 0000000..dc2d806
Binary files /dev/null and b/client/src/frmEditor_Shop.frx differ
diff --git a/client/src/frmEditor_Spell.frm b/client/src/frmEditor_Spell.frm
new file mode 100644
index 0000000..f2ce5d5
--- /dev/null
+++ b/client/src/frmEditor_Spell.frm
@@ -0,0 +1,814 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Spell
+ BorderStyle = 1 'Fixed Single
+ Caption = "Spell Editor"
+ ClientHeight = 8055
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 10335
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 537
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 689
+ StartUpPosition = 2 'CenterScreen
+ Begin VB.CommandButton cmdCopy
+ Caption = "Copy"
+ Height = 375
+ Left = 6480
+ TabIndex = 64
+ Top = 7560
+ Width = 975
+ End
+ Begin VB.CommandButton cmdPaste
+ Caption = "Paste"
+ Height = 375
+ Left = 7560
+ TabIndex = 63
+ Top = 7560
+ Width = 975
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 375
+ Left = 3360
+ TabIndex = 6
+ Top = 7560
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 8640
+ TabIndex = 5
+ Top = 7560
+ Width = 1575
+ End
+ Begin VB.CommandButton cmdDelete
+ Caption = "Delete"
+ Height = 375
+ Left = 4920
+ TabIndex = 4
+ Top = 7560
+ Width = 1455
+ End
+ Begin VB.Frame Frame1
+ Caption = "Spell Properties"
+ Height = 7335
+ Left = 3360
+ TabIndex = 3
+ Top = 120
+ Width = 6855
+ Begin VB.HScrollBar scrlUses
+ Height = 255
+ LargeChange = 10
+ Left = 5280
+ TabIndex = 62
+ Top = 6960
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlNext
+ Height = 255
+ Left = 5280
+ TabIndex = 60
+ Top = 6600
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlIndex
+ Height = 255
+ Left = 5280
+ TabIndex = 58
+ Top = 6240
+ Width = 1455
+ End
+ Begin VB.ComboBox cmbSound
+ Height = 300
+ Left = 120
+ Style = 2 'Dropdown List
+ TabIndex = 56
+ Top = 6840
+ Width = 1215
+ End
+ Begin VB.TextBox txtDesc
+ Height = 975
+ Left = 1440
+ MaxLength = 255
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 54
+ Top = 6240
+ Width = 975
+ End
+ Begin VB.Frame Frame6
+ Caption = "Data"
+ Height = 5895
+ Left = 3480
+ TabIndex = 14
+ Top = 240
+ Width = 3255
+ Begin VB.HScrollBar scrlStun
+ Height = 255
+ Left = 120
+ TabIndex = 51
+ Top = 5520
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlAnim
+ Height = 255
+ Left = 120
+ TabIndex = 49
+ Top = 4920
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlAnimCast
+ Height = 255
+ Left = 120
+ TabIndex = 47
+ Top = 4320
+ Width = 2895
+ End
+ Begin VB.CheckBox chkAOE
+ Caption = "Area of Effect spell?"
+ Height = 255
+ Left = 120
+ TabIndex = 43
+ Top = 3240
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlAOE
+ Height = 255
+ Left = 120
+ TabIndex = 42
+ Top = 3720
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlRange
+ Height = 255
+ Left = 120
+ TabIndex = 40
+ Top = 2880
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlInterval
+ Height = 255
+ Left = 1680
+ Max = 60
+ TabIndex = 38
+ Top = 2280
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlDuration
+ Height = 255
+ Left = 120
+ Max = 60
+ TabIndex = 36
+ Top = 2280
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlVital
+ Height = 255
+ LargeChange = 10
+ Left = 120
+ Max = 1000
+ TabIndex = 34
+ Top = 1680
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlDir
+ Height = 255
+ Left = 1680
+ TabIndex = 22
+ Top = 480
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlY
+ Height = 255
+ Left = 1680
+ TabIndex = 20
+ Top = 1080
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlX
+ Height = 255
+ Left = 120
+ TabIndex = 18
+ Top = 1080
+ Width = 1455
+ End
+ Begin VB.HScrollBar scrlMap
+ Height = 255
+ Left = 120
+ Max = 100
+ TabIndex = 16
+ Top = 480
+ Width = 1455
+ End
+ Begin VB.Label lblStun
+ Caption = "Stun Duration: None"
+ Height = 255
+ Left = 120
+ TabIndex = 52
+ Top = 5280
+ Width = 2895
+ End
+ Begin VB.Label lblAnim
+ Caption = "Animation: None"
+ Height = 255
+ Left = 120
+ TabIndex = 48
+ Top = 4680
+ Width = 2895
+ End
+ Begin VB.Label lblAnimCast
+ Caption = "Cast Anim: None"
+ Height = 255
+ Left = 120
+ TabIndex = 46
+ Top = 4080
+ Width = 2895
+ End
+ Begin VB.Label lblAOE
+ Caption = "AoE: Self-cast"
+ Height = 255
+ Left = 120
+ TabIndex = 41
+ Top = 3480
+ Width = 3015
+ End
+ Begin VB.Label lblRange
+ Caption = "Range: Self-cast"
+ Height = 255
+ Left = 120
+ TabIndex = 39
+ Top = 2640
+ Width = 3015
+ End
+ Begin VB.Label lblInterval
+ Caption = "Interval: 0s"
+ Height = 255
+ Left = 1680
+ TabIndex = 37
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.Label lblDuration
+ Caption = "Duration: 0s"
+ Height = 255
+ Left = 120
+ TabIndex = 35
+ Top = 2040
+ Width = 1455
+ End
+ Begin VB.Label lblVital
+ Caption = "Vital: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 33
+ Top = 1440
+ Width = 3015
+ End
+ Begin VB.Label lblDir
+ Caption = "Dir: Down"
+ Height = 255
+ Left = 1680
+ TabIndex = 21
+ Top = 240
+ Width = 1455
+ End
+ Begin VB.Label lblY
+ Caption = "Y: 0"
+ Height = 255
+ Left = 1680
+ TabIndex = 19
+ Top = 840
+ Width = 1455
+ End
+ Begin VB.Label lblX
+ Caption = "X: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 17
+ Top = 840
+ Width = 1455
+ End
+ Begin VB.Label lblMap
+ Caption = "Map: 0"
+ Height = 255
+ Left = 120
+ TabIndex = 15
+ Top = 240
+ Width = 1455
+ End
+ End
+ Begin VB.Frame Frame2
+ Caption = "Basic Information"
+ Height = 5895
+ Left = 120
+ TabIndex = 7
+ Top = 240
+ Width = 3255
+ Begin VB.PictureBox picSprite
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 480
+ Left = 2640
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 50
+ Top = 5160
+ Width = 480
+ End
+ Begin VB.HScrollBar scrlIcon
+ Height = 255
+ Left = 120
+ TabIndex = 45
+ Top = 5400
+ Width = 2415
+ End
+ Begin VB.HScrollBar scrlCool
+ Height = 255
+ Left = 120
+ Max = 60
+ TabIndex = 32
+ Top = 4680
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlCast
+ Height = 255
+ Left = 120
+ Max = 60
+ TabIndex = 30
+ Top = 4080
+ Width = 3015
+ End
+ Begin VB.ComboBox cmbClass
+ Height = 300
+ Left = 120
+ Style = 2 'Dropdown List
+ TabIndex = 28
+ Top = 3480
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlAccess
+ Height = 255
+ Left = 120
+ Max = 5
+ TabIndex = 26
+ Top = 2880
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlLevel
+ Height = 255
+ Left = 120
+ Max = 100
+ TabIndex = 24
+ Top = 2280
+ Width = 3015
+ End
+ Begin VB.HScrollBar scrlMP
+ Height = 255
+ Left = 120
+ TabIndex = 13
+ Top = 1680
+ Width = 3015
+ End
+ Begin VB.ComboBox cmbType
+ Height = 300
+ ItemData = "frmEditor_Spell.frx":0000
+ Left = 120
+ List = "frmEditor_Spell.frx":0013
+ Style = 2 'Dropdown List
+ TabIndex = 11
+ Top = 1080
+ Width = 3015
+ End
+ Begin VB.TextBox txtName
+ Height = 270
+ Left = 120
+ TabIndex = 9
+ Top = 480
+ Width = 3015
+ End
+ Begin VB.Label lblIcon
+ Caption = "Icon: None"
+ Height = 255
+ Left = 120
+ TabIndex = 44
+ Top = 5160
+ Width = 3015
+ End
+ Begin VB.Label lblCool
+ Caption = "Cooldown Time: 0s"
+ Height = 255
+ Left = 120
+ TabIndex = 31
+ Top = 4440
+ Width = 2535
+ End
+ Begin VB.Label lblCast
+ Caption = "Casting Time: 0s"
+ Height = 255
+ Left = 120
+ TabIndex = 29
+ Top = 3840
+ Width = 1695
+ End
+ Begin VB.Label Label5
+ Caption = "Class Required:"
+ Height = 255
+ Left = 120
+ TabIndex = 27
+ Top = 3240
+ Width = 1815
+ End
+ Begin VB.Label lblAccess
+ Caption = "Access Required: None"
+ Height = 255
+ Left = 120
+ TabIndex = 25
+ Top = 2640
+ Width = 1815
+ End
+ Begin VB.Label lblLevel
+ Caption = "Level Required: None"
+ Height = 255
+ Left = 120
+ TabIndex = 23
+ Top = 2040
+ Width = 1815
+ End
+ Begin VB.Label lblMP
+ Caption = "MP Cost: None"
+ Height = 255
+ Left = 120
+ TabIndex = 12
+ Top = 1440
+ Width = 1815
+ End
+ Begin VB.Label Label2
+ Caption = "Type:"
+ Height = 255
+ Left = 120
+ TabIndex = 10
+ Top = 840
+ Width = 1815
+ End
+ Begin VB.Label Label1
+ AutoSize = -1 'True
+ Caption = "Name:"
+ Height = 180
+ Left = 120
+ TabIndex = 8
+ Top = 240
+ Width = 495
+ End
+ End
+ Begin VB.Label lblUses
+ Caption = "Uses: 0"
+ Height = 255
+ Left = 2520
+ TabIndex = 61
+ Top = 6960
+ Width = 2655
+ End
+ Begin VB.Label lblNext
+ Caption = "Next: None"
+ Height = 255
+ Left = 2520
+ TabIndex = 59
+ Top = 6600
+ Width = 2655
+ End
+ Begin VB.Label lblIndex
+ Caption = "Unique Index: 0"
+ Height = 255
+ Left = 2520
+ TabIndex = 57
+ Top = 6240
+ Width = 2655
+ End
+ Begin VB.Label Label4
+ Caption = "Sound:"
+ Height = 255
+ Left = 120
+ TabIndex = 55
+ Top = 6600
+ Width = 1215
+ End
+ Begin VB.Label Label3
+ Caption = "Description:"
+ Height = 255
+ Left = 120
+ TabIndex = 53
+ Top = 6240
+ Width = 1215
+ End
+ End
+ Begin VB.Frame Frame3
+ Caption = "Spell List"
+ Height = 7335
+ Left = 120
+ TabIndex = 1
+ Top = 120
+ Width = 3135
+ Begin VB.ListBox lstIndex
+ Height = 6900
+ Left = 120
+ TabIndex = 2
+ Top = 240
+ Width = 2895
+ End
+ End
+ Begin VB.CommandButton cmdArray
+ Caption = "Change Array Size"
+ Enabled = 0 'False
+ Height = 375
+ Left = 240
+ TabIndex = 0
+ Top = 7560
+ Width = 2895
+ End
+End
+Attribute VB_Name = "frmEditor_Spell"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub chkAOE_Click()
+
+ If chkAOE.value = 0 Then
+ Spell(EditorIndex).IsAoE = False
+ Else
+ Spell(EditorIndex).IsAoE = True
+ End If
+
+End Sub
+
+Private Sub cmbClass_Click()
+ Spell(EditorIndex).ClassReq = cmbClass.ListIndex
+End Sub
+
+Private Sub cmbType_Click()
+ Spell(EditorIndex).Type = cmbType.ListIndex
+End Sub
+
+Private Sub cmdCopy_Click()
+ SpellEditorCopy
+End Sub
+
+Private Sub cmdDelete_Click()
+ Dim tmpIndex As Long
+ ClearSpell EditorIndex
+ tmpIndex = lstIndex.ListIndex
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Spell(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+ SpellEditorInit
+End Sub
+
+Private Sub cmdPaste_Click()
+ SpellEditorPaste
+End Sub
+
+Private Sub cmdSave_Click()
+ SpellEditorOk
+End Sub
+
+Private Sub lstIndex_Click()
+ SpellEditorInit
+End Sub
+
+Private Sub cmdCancel_Click()
+ SpellEditorCancel
+End Sub
+
+Private Sub scrlAccess_Change()
+
+ If scrlAccess.value > 0 Then
+ lblAccess.caption = "Access Required: " & scrlAccess.value
+ Else
+ lblAccess.caption = "Access Required: None"
+ End If
+
+ Spell(EditorIndex).AccessReq = scrlAccess.value
+End Sub
+
+Private Sub scrlAnim_Change()
+
+ If scrlAnim.value > 0 Then
+ lblAnim.caption = "Animation: " & Trim$(Animation(scrlAnim.value).name)
+ Else
+ lblAnim.caption = "Animation: None"
+ End If
+
+ Spell(EditorIndex).SpellAnim = scrlAnim.value
+End Sub
+
+Private Sub scrlAnimCast_Change()
+
+ If scrlAnimCast.value > 0 Then
+ lblAnimCast.caption = "Cast Anim: " & Trim$(Animation(scrlAnimCast.value).name)
+ Else
+ lblAnimCast.caption = "Cast Anim: None"
+ End If
+
+ Spell(EditorIndex).CastAnim = scrlAnimCast.value
+End Sub
+
+Private Sub scrlAOE_Change()
+
+ If scrlAOE.value > 0 Then
+ lblAOE.caption = "AoE: " & scrlAOE.value & " tiles."
+ Else
+ lblAOE.caption = "AoE: Self-cast"
+ End If
+
+ Spell(EditorIndex).AoE = scrlAOE.value
+End Sub
+
+Private Sub scrlCast_Change()
+ lblCast.caption = "Casting Time: " & scrlCast.value & "s"
+ Spell(EditorIndex).CastTime = scrlCast.value
+End Sub
+
+Private Sub scrlCool_Change()
+ lblCool.caption = "Cooldown Time: " & scrlCool.value & "s"
+ Spell(EditorIndex).CDTime = scrlCool.value
+End Sub
+
+Private Sub scrlDir_Change()
+ Dim sDir As String
+
+ Select Case scrlDir.value
+
+ Case DIR_UP
+ sDir = "Up"
+
+ Case DIR_DOWN
+ sDir = "Down"
+
+ Case DIR_RIGHT
+ sDir = "Right"
+
+ Case DIR_LEFT
+ sDir = "Left"
+ End Select
+
+ lblDir.caption = "Dir: " & sDir
+ Spell(EditorIndex).dir = scrlDir.value
+End Sub
+
+Private Sub scrlDuration_Change()
+ lblDuration.caption = "Duration: " & scrlDuration.value & "s"
+ Spell(EditorIndex).Duration = scrlDuration.value
+End Sub
+
+Private Sub scrlIcon_Change()
+
+ If scrlIcon.value > 0 Then
+ lblIcon.caption = "Icon: " & scrlIcon.value
+ Else
+ lblIcon.caption = "Icon: None"
+ End If
+
+ Spell(EditorIndex).icon = scrlIcon.value
+End Sub
+
+Private Sub scrlIndex_Change()
+ lblIndex.caption = "Unique Index: " & scrlIndex.value
+ Spell(EditorIndex).UniqueIndex = scrlIndex.value
+End Sub
+
+Private Sub scrlInterval_Change()
+ lblInterval.caption = "Interval: " & scrlInterval.value & "s"
+ Spell(EditorIndex).Interval = scrlInterval.value
+End Sub
+
+Private Sub scrlLevel_Change()
+
+ If scrlLevel.value > 0 Then
+ lblLevel.caption = "Level Required: " & scrlLevel.value
+ Else
+ lblLevel.caption = "Level Required: None"
+ End If
+
+ Spell(EditorIndex).LevelReq = scrlLevel.value
+End Sub
+
+Private Sub scrlMap_Change()
+ lblMap.caption = "Map: " & scrlMap.value
+ Spell(EditorIndex).map = scrlMap.value
+End Sub
+
+Private Sub scrlMP_Change()
+
+ If scrlMP.value > 0 Then
+ lblMP.caption = "MP Cost: " & scrlMP.value
+ Else
+ lblMP.caption = "MP Cost: None"
+ End If
+
+ Spell(EditorIndex).MPCost = scrlMP.value
+End Sub
+
+Private Sub scrlNext_Change()
+
+ If scrlNext.value > 0 Then
+ lblNext.caption = "Next: " & scrlNext.value & " - " & Trim$(Spell(scrlNext.value).name)
+ Else
+ lblNext.caption = "Next: None"
+ End If
+
+ Spell(EditorIndex).NextRank = scrlNext.value
+End Sub
+
+Private Sub scrlRange_Change()
+
+ If scrlRange.value > 0 Then
+ lblRange.caption = "Range: " & scrlRange.value & " tiles."
+ Else
+ lblRange.caption = "Range: Self-cast"
+ End If
+
+ Spell(EditorIndex).Range = scrlRange.value
+End Sub
+
+Private Sub scrlStun_Change()
+
+ If scrlStun.value > 0 Then
+ lblStun.caption = "Stun Duration: " & scrlStun.value & "s"
+ Else
+ lblStun.caption = "Stun Duration: None"
+ End If
+
+ Spell(EditorIndex).StunDuration = scrlStun.value
+End Sub
+
+Private Sub scrlUses_Change()
+ lblUses.caption = "Uses: " & scrlUses.value
+ Spell(EditorIndex).NextUses = scrlUses.value
+End Sub
+
+Private Sub scrlVital_Change()
+ lblVital.caption = "Vital: " & scrlVital.value
+ Spell(EditorIndex).Vital = scrlVital.value
+End Sub
+
+Private Sub scrlX_Change()
+ lblX.caption = "X: " & scrlX.value
+ Spell(EditorIndex).x = scrlX.value
+End Sub
+
+Private Sub scrlY_Change()
+ lblY.caption = "Y: " & scrlY.value
+ Spell(EditorIndex).y = scrlY.value
+End Sub
+
+Private Sub txtDesc_Change()
+ Spell(EditorIndex).Desc = txtDesc.text
+End Sub
+
+Public Sub txtName_Validate(Cancel As Boolean)
+ Dim tmpIndex As Long
+
+ If EditorIndex = 0 Then Exit Sub
+ tmpIndex = lstIndex.ListIndex
+ Spell(EditorIndex).name = Trim$(txtName.text)
+ lstIndex.RemoveItem EditorIndex - 1
+ lstIndex.AddItem EditorIndex & ": " & Spell(EditorIndex).name, EditorIndex - 1
+ lstIndex.ListIndex = tmpIndex
+End Sub
+
+Private Sub cmbSound_Click()
+
+ If cmbSound.ListIndex >= 0 Then
+ Spell(EditorIndex).sound = cmbSound.list(cmbSound.ListIndex)
+ Else
+ Spell(EditorIndex).sound = "None."
+ End If
+
+End Sub
diff --git a/client/src/frmEditor_Spell.frx b/client/src/frmEditor_Spell.frx
new file mode 100644
index 0000000..30db731
Binary files /dev/null and b/client/src/frmEditor_Spell.frx differ
diff --git a/client/src/frmEditor_Spell_OLD.frm b/client/src/frmEditor_Spell_OLD.frm
new file mode 100644
index 0000000..3a076ed
--- /dev/null
+++ b/client/src/frmEditor_Spell_OLD.frm
@@ -0,0 +1,405 @@
+VERSION 5.00
+Begin VB.Form frmEditor_Spell
+ BorderStyle = 1 'Fixed Single
+ Caption = "Spell Editor"
+ ClientHeight = 6435
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 5055
+ ControlBox = 0 'False
+ DrawMode = 14 'Copy Pen
+ BeginProperty Font
+ Name = "Tahoma"
+ Size = 9.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmEditor_Spell.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 429
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 337
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmdBack
+ Caption = "Back to Index"
+ Height = 255
+ Left = 1800
+ TabIndex = 32
+ Top = 6000
+ Width = 1455
+ End
+ Begin VB.Frame FraData
+ Caption = "Data"
+ Height = 1215
+ Left = 120
+ TabIndex = 25
+ Top = 1320
+ Width = 4815
+ Begin VB.HScrollBar scrlMPReq
+ Height = 255
+ Left = 720
+ Max = 1000
+ TabIndex = 29
+ Top = 720
+ Width = 3255
+ End
+ Begin VB.HScrollBar scrlLevelReq
+ Height = 255
+ Left = 720
+ Max = 255
+ Min = 1
+ TabIndex = 26
+ Top = 360
+ Value = 1
+ Width = 3255
+ End
+ Begin VB.Label lblMPReq
+ Alignment = 1 'Right Justify
+ Caption = "0"
+ Height = 375
+ Left = 4200
+ TabIndex = 31
+ Top = 720
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ Begin VB.Label lblMP
+ Caption = "MP"
+ Height = 375
+ Left = 120
+ TabIndex = 30
+ Top = 720
+ UseMnemonic = 0 'False
+ Width = 735
+ End
+ Begin VB.Label lblLevel
+ Caption = "Level"
+ Height = 375
+ Left = 120
+ TabIndex = 28
+ Top = 360
+ UseMnemonic = 0 'False
+ Width = 735
+ End
+ Begin VB.Label lblLevelReq
+ Alignment = 1 'Right Justify
+ Caption = "1"
+ Height = 375
+ Left = 4200
+ TabIndex = 27
+ Top = 360
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ End
+ Begin VB.Frame FraPic
+ Caption = "Spell Animation"
+ Height = 1095
+ Left = 120
+ TabIndex = 17
+ Top = 2640
+ Width = 4815
+ Begin VB.HScrollBar scrlFrame
+ Height = 255
+ Left = 960
+ Max = 255
+ TabIndex = 22
+ Top = 720
+ Value = 1
+ Width = 2655
+ End
+ Begin VB.HScrollBar scrlPic
+ Height = 255
+ Left = 960
+ Max = 255
+ TabIndex = 19
+ Top = 360
+ Value = 1
+ Width = 2655
+ End
+ Begin VB.PictureBox picPic
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "MS Sans Serif"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 480
+ Left = 4200
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 18
+ Top = 360
+ Width = 480
+ End
+ Begin VB.Label lblFrame
+ Caption = "Frame"
+ Height = 255
+ Left = 120
+ TabIndex = 24
+ Top = 720
+ Width = 855
+ End
+ Begin VB.Label lblFrameNum
+ Alignment = 1 'Right Justify
+ Caption = "0"
+ Height = 255
+ Left = 3600
+ TabIndex = 23
+ Top = 720
+ Width = 495
+ End
+ Begin VB.Label lblSpell
+ Caption = "Spell"
+ Height = 255
+ Left = 120
+ TabIndex = 21
+ Top = 360
+ Width = 855
+ End
+ Begin VB.Label lblSpellNum
+ Alignment = 1 'Right Justify
+ Caption = "0"
+ Height = 255
+ Left = 3600
+ TabIndex = 20
+ Top = 360
+ Width = 495
+ End
+ End
+ Begin VB.ComboBox cmbClassReq
+ Height = 360
+ ItemData = "frmEditor_Spell.frx":3332
+ Left = 120
+ List = "frmEditor_Spell.frx":3334
+ Style = 2 'Dropdown List
+ TabIndex = 16
+ Top = 720
+ Width = 4815
+ End
+ Begin VB.Frame fraGiveItem
+ Caption = "Give Item"
+ Height = 1455
+ Left = 120
+ TabIndex = 9
+ Top = 4440
+ Visible = 0 'False
+ Width = 4815
+ Begin VB.HScrollBar scrlItemValue
+ Height = 255
+ Left = 1320
+ TabIndex = 14
+ Top = 840
+ Width = 2895
+ End
+ Begin VB.HScrollBar scrlItemNum
+ Height = 255
+ Left = 1320
+ Max = 255
+ Min = 1
+ TabIndex = 10
+ Top = 360
+ Value = 1
+ Width = 2895
+ End
+ Begin VB.Label lblItemValue
+ Alignment = 1 'Right Justify
+ Caption = "0"
+ Height = 375
+ Left = 4200
+ TabIndex = 15
+ Top = 840
+ UseMnemonic = 0 'False
+ Width = 495
+ End
+ Begin VB.Label Label5
+ Caption = "Value"
+ Height = 375
+ Left = 120
+ TabIndex = 13
+ Top = 840
+ UseMnemonic = 0 'False
+ Width = 1095
+ End
+ Begin VB.Label lblItemNum
+ Alignment = 1 'Right Justify
+ Caption = "1"
+ Height = 375
+ Left = 4200
+ TabIndex = 12
+ Top = 360
+ Width = 495
+ End
+ Begin VB.Label Label2
+ Caption = "Item"
+ Height = 375
+ Left = 120
+ TabIndex = 11
+ Top = 360
+ Width = 1095
+ End
+ End
+ Begin VB.CommandButton cmdSave
+ Caption = "Save"
+ Height = 255
+ Left = 120
+ TabIndex = 8
+ Top = 6000
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 255
+ Left = 3480
+ TabIndex = 7
+ Top = 6000
+ Width = 1455
+ End
+ Begin VB.ComboBox cmbType
+ Height = 360
+ ItemData = "frmEditor_Spell.frx":3336
+ Left = 120
+ List = "frmEditor_Spell.frx":334F
+ Style = 2 'Dropdown List
+ TabIndex = 6
+ Top = 3960
+ Width = 4815
+ End
+ Begin VB.Frame fraVitals
+ Caption = "Vitals Data"
+ Height = 1455
+ Left = 120
+ TabIndex = 2
+ Top = 4440
+ Visible = 0 'False
+ Width = 4815
+ Begin VB.HScrollBar scrlVitalMod
+ Height = 255
+ Left = 1320
+ Max = 255
+ TabIndex = 3
+ Top = 360
+ Value = 1
+ Width = 2895
+ End
+ Begin VB.Label Label4
+ Caption = "Vital Mod"
+ Height = 375
+ Left = 120
+ TabIndex = 5
+ Top = 360
+ UseMnemonic = 0 'False
+ Width = 1095
+ End
+ Begin VB.Label lblVitalMod
+ Alignment = 1 'Right Justify
+ Caption = "1"
+ Height = 375
+ Left = 4200
+ TabIndex = 4
+ Top = 360
+ Width = 495
+ End
+ End
+ Begin VB.TextBox txtName
+ Height = 390
+ Left = 960
+ TabIndex = 1
+ Top = 120
+ Width = 3975
+ End
+ Begin VB.Label Label1
+ Caption = "Name"
+ Height = 375
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ UseMnemonic = 0 'False
+ Width = 735
+ End
+End
+Attribute VB_Name = "frmEditor_Spell"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Form_Load()
+ scrlLevelReq.Max = MAX_LEVELS
+End Sub
+
+Private Sub cmdSave_Click()
+
+ If LenB(Trim$(txtName)) = 0 Then
+ Call MsgBox("Name required.")
+ Else
+ Call SpellEditorOk
+ End If
+
+End Sub
+
+Private Sub cmdBack_Click()
+ Unload Me
+ frmIndex.Show
+End Sub
+
+Private Sub cmdCancel_Click()
+ Call SpellEditorCancel
+End Sub
+
+Private Sub cmbType_Click()
+
+ If cmbType.ListIndex <> SPELL_TYPE_GIVEITEM Then
+ fraVitals.Visible = True
+ fraGiveItem.Visible = False
+ Else
+ fraVitals.Visible = False
+ fraGiveItem.Visible = True
+ End If
+
+End Sub
+
+Private Sub scrlFrame_Change()
+ lblFrameNum.Caption = scrlFrame.Value
+End Sub
+
+Private Sub scrlItemNum_Change()
+ fraGiveItem.Caption = "Give Item " & Trim$(Item(scrlItemNum.Value).Name)
+ lblItemNum.Caption = CStr(scrlItemNum.Value)
+End Sub
+
+Private Sub scrlItemValue_Change()
+ lblItemValue.Caption = CStr(scrlItemValue.Value)
+End Sub
+
+Private Sub scrlLevelReq_Change()
+ lblLevelReq.Caption = CStr(scrlLevelReq.Value)
+End Sub
+
+Private Sub scrlMPReq_Change()
+ lblMPReq.Caption = CStr(scrlMPReq.Value)
+End Sub
+
+Private Sub scrlPic_Change()
+ lblSpellNum = CStr(scrlPic.Value)
+ frmEditor_Spell.scrlFrame.Value = 0
+End Sub
+
+Private Sub scrlVitalMod_Change()
+ lblVitalMod.Caption = CStr(scrlVitalMod.Value)
+End Sub
diff --git a/client/src/frmEditor_Spell_OLD.frx b/client/src/frmEditor_Spell_OLD.frx
new file mode 100644
index 0000000..1ce0718
Binary files /dev/null and b/client/src/frmEditor_Spell_OLD.frx differ
diff --git a/client/src/frmIndex.frm b/client/src/frmIndex.frm
new file mode 100644
index 0000000..2ce0d90
--- /dev/null
+++ b/client/src/frmIndex.frm
@@ -0,0 +1,116 @@
+VERSION 5.00
+Begin VB.Form frmIndex
+ BorderStyle = 1 'Fixed Single
+ Caption = "Index"
+ ClientHeight = 4215
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 5295
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Tahoma"
+ Size = 9.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmIndex.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 281
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 353
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.CommandButton cmddelete
+ Caption = "Delete"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 1920
+ TabIndex = 2
+ Top = 3720
+ Width = 1575
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 3720
+ TabIndex = 3
+ Top = 3720
+ Width = 1455
+ End
+ Begin VB.CommandButton cmdOk
+ Caption = "Ok"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 375
+ Left = 120
+ TabIndex = 1
+ Top = 3720
+ Width = 1575
+ End
+ Begin VB.ListBox lstIndex
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 3375
+ ItemData = "frmIndex.frx":3332
+ Left = 120
+ List = "frmIndex.frx":3334
+ TabIndex = 0
+ Top = 120
+ Width = 5055
+ End
+End
+Attribute VB_Name = "frmIndex"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmdOk_Click()
+ Dim Buffer As clsBuffer
+ EditorIndex = lstIndex.ListIndex + 1
+ frmIndex.Hide
+End Sub
+
+Private Sub cmdCancel_Click()
+ Editor = 0
+ Unload frmIndex
+End Sub
+
diff --git a/client/src/frmIndex.frx b/client/src/frmIndex.frx
new file mode 100644
index 0000000..1661882
Binary files /dev/null and b/client/src/frmIndex.frx differ
diff --git a/client/src/frmMain.frm b/client/src/frmMain.frm
new file mode 100644
index 0000000..1fcdd7a
--- /dev/null
+++ b/client/src/frmMain.frm
@@ -0,0 +1,134 @@
+VERSION 5.00
+Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
+Begin VB.Form frmMain
+ BackColor = &H00FFFFFF&
+ BorderStyle = 1 'Fixed Single
+ Caption = "Crystalshire"
+ ClientHeight = 10800
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 19200
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmMain.frx":0000
+ KeyPreview = -1 'True
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 720
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 1280
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin MSWinsockLib.Winsock Socket
+ Left = 120
+ Top = 120
+ _ExtentX = 741
+ _ExtentY = 741
+ _Version = 393216
+ End
+ Begin VB.PictureBox picIntro
+ Appearance = 0 'Flat
+ AutoRedraw = -1 'True
+ BackColor = &H00FFFFFF&
+ BorderStyle = 0 'None
+ Enabled = 0 'False
+ FillColor = &H000000FF&
+ ForeColor = &H80000008&
+ Height = 480
+ Left = 0
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 0
+ Top = 0
+ Visible = 0 'False
+ Width = 480
+ End
+End
+Attribute VB_Name = "frmMain"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+' Form
+Private Sub Form_Unload(Cancel As Integer)
+ DestroyGame
+End Sub
+
+Private Sub Form_KeyPress(KeyAscii As Integer)
+ Call HandleKeyPresses(KeyAscii)
+End Sub
+
+Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
+ ' handles screenshot mode
+ If KeyCode = vbKeyF11 Then
+ If GetPlayerAccess(MyIndex) > 0 Then
+ screenshotMode = Not screenshotMode
+ End If
+ End If
+
+ ' handles form
+ If KeyCode = vbKeyInsert Then
+ If frmMain.BorderStyle = 0 Then
+ frmMain.BorderStyle = 1
+ Else
+ frmMain.BorderStyle = 0
+ End If
+ frmMain.caption = frmMain.caption
+ End If
+
+ ' handles delete events
+ If KeyCode = vbKeyDelete Then
+ If InMapEditor Then DeleteEvent selTileX, selTileY
+ End If
+
+ ' handles copy + pasting events
+ If KeyCode = vbKeyC Then
+ If ControlDown Then
+ If InMapEditor Then
+ CopyEvent_Map selTileX, selTileY
+ End If
+ End If
+ End If
+ If KeyCode = vbKeyV Then
+ If ControlDown Then
+ If InMapEditor Then
+ PasteEvent_Map selTileX, selTileY
+ End If
+ End If
+ End If
+End Sub
+
+Private Sub Form_DblClick()
+ HandleGuiMouse entStates.DblClick
+
+ ' Handle events
+ If currMouseX >= 0 And currMouseX <= frmMain.ScaleWidth Then
+ If currMouseY >= 0 And currMouseY <= frmMain.ScaleHeight Then
+ If InMapEditor Then
+ If frmEditor_Map.optEvents.value Then
+ AddEvent CurX, CurY
+ End If
+ End If
+ End If
+ End If
+End Sub
+
+' Winsock event
+Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
+
+ If IsConnected Then
+ Call IncomingData(bytesTotal)
+ End If
+
+End Sub
diff --git a/client/src/frmMain.frx b/client/src/frmMain.frx
new file mode 100644
index 0000000..740c070
Binary files /dev/null and b/client/src/frmMain.frx differ
diff --git a/client/src/frmMapProperties.frm b/client/src/frmMapProperties.frm
new file mode 100644
index 0000000..d270722
--- /dev/null
+++ b/client/src/frmMapProperties.frm
@@ -0,0 +1,652 @@
+VERSION 5.00
+Begin VB.Form frmEditor_MapProperties
+ BorderStyle = 1 'Fixed Single
+ Caption = "Map Properties"
+ ClientHeight = 8190
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 6615
+ ControlBox = 0 'False
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 546
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 441
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.Frame Frame6
+ Caption = "Weather"
+ Height = 1695
+ Left = 120
+ TabIndex = 50
+ Top = 5880
+ Width = 2055
+ Begin VB.HScrollBar HScroll8
+ Height = 255
+ Left = 120
+ TabIndex = 56
+ Top = 1200
+ Width = 1815
+ End
+ Begin VB.OptionButton Option4
+ Caption = "Snow"
+ Height = 255
+ Left = 1080
+ TabIndex = 54
+ Top = 480
+ Width = 855
+ End
+ Begin VB.OptionButton Option3
+ Caption = "Storm"
+ Height = 255
+ Left = 120
+ TabIndex = 53
+ Top = 480
+ Width = 855
+ End
+ Begin VB.OptionButton Option2
+ Caption = "Rain"
+ Height = 255
+ Left = 1080
+ TabIndex = 52
+ Top = 240
+ Width = 855
+ End
+ Begin VB.OptionButton Option1
+ Caption = "None"
+ Height = 255
+ Left = 120
+ TabIndex = 51
+ Top = 240
+ Value = -1 'True
+ Width = 855
+ End
+ Begin VB.Line Line2
+ BorderColor = &H00C0C0C0&
+ X1 = 120
+ X2 = 1920
+ Y1 = 840
+ Y2 = 840
+ End
+ Begin VB.Label Label15
+ Caption = "Power: 1"
+ Height = 255
+ Left = 120
+ TabIndex = 55
+ Top = 960
+ Width = 1815
+ End
+ End
+ Begin VB.Frame Frame4
+ Caption = "Boss"
+ Height = 975
+ Left = 120
+ TabIndex = 32
+ Top = 4800
+ Width = 2055
+ Begin VB.HScrollBar scrlBoss
+ Height = 255
+ Left = 120
+ TabIndex = 34
+ Top = 480
+ Width = 1815
+ End
+ Begin VB.Label lblBoss
+ Caption = "Boss: None"
+ Height = 255
+ Left = 120
+ TabIndex = 33
+ Top = 240
+ Width = 1815
+ End
+ End
+ Begin VB.Frame Frame5
+ Caption = "Effects"
+ Height = 2775
+ Left = 2280
+ TabIndex = 35
+ Top = 4800
+ Width = 4215
+ Begin VB.HScrollBar HScroll7
+ Height = 255
+ Left = 120
+ TabIndex = 49
+ Top = 2400
+ Width = 1095
+ End
+ Begin VB.HScrollBar HScroll6
+ Height = 255
+ Left = 3000
+ TabIndex = 47
+ Top = 1800
+ Width = 1095
+ End
+ Begin VB.HScrollBar HScroll5
+ Height = 255
+ Left = 1560
+ TabIndex = 45
+ Top = 1800
+ Width = 1095
+ End
+ Begin VB.HScrollBar HScroll4
+ Height = 255
+ Left = 120
+ TabIndex = 43
+ Top = 1800
+ Width = 1095
+ End
+ Begin VB.HScrollBar HScroll3
+ Height = 255
+ Left = 120
+ TabIndex = 41
+ Top = 1080
+ Width = 1815
+ End
+ Begin VB.HScrollBar HScroll2
+ Height = 255
+ Left = 2160
+ TabIndex = 39
+ Top = 480
+ Width = 1935
+ End
+ Begin VB.HScrollBar HScroll1
+ Height = 255
+ Left = 120
+ TabIndex = 37
+ Top = 480
+ Width = 1815
+ End
+ Begin VB.Label Label14
+ Caption = "Grey: 255"
+ Height = 255
+ Left = 120
+ TabIndex = 48
+ Top = 2160
+ Width = 1095
+ End
+ Begin VB.Label Label13
+ Caption = "Blue: -255"
+ Height = 255
+ Left = 3000
+ TabIndex = 46
+ Top = 1560
+ Width = 1095
+ End
+ Begin VB.Label Label12
+ Caption = "Green: -255"
+ Height = 255
+ Left = 1560
+ TabIndex = 44
+ Top = 1560
+ Width = 1095
+ End
+ Begin VB.Label Label10
+ Caption = "Red: -255"
+ Height = 255
+ Left = 120
+ TabIndex = 42
+ Top = 1560
+ Width = 975
+ End
+ Begin VB.Line Line1
+ BorderColor = &H00C0C0C0&
+ X1 = 120
+ X2 = 4080
+ Y1 = 1440
+ Y2 = 1440
+ End
+ Begin VB.Label Label5
+ Caption = "Blending: Normal"
+ Height = 255
+ Left = 120
+ TabIndex = 40
+ Top = 840
+ Width = 1815
+ End
+ Begin VB.Label Label4
+ Caption = "Opacity: 100%"
+ Height = 255
+ Left = 2160
+ TabIndex = 38
+ Top = 240
+ Width = 1575
+ End
+ Begin VB.Label Label3
+ Caption = "Fog: None"
+ Height = 255
+ Left = 120
+ TabIndex = 36
+ Top = 240
+ Width = 3135
+ End
+ End
+ Begin VB.Frame Frame3
+ Caption = "Music"
+ Height = 3255
+ Left = 4440
+ TabIndex = 27
+ Top = 1440
+ Width = 2055
+ Begin VB.CommandButton cmdPlay
+ Caption = "Play"
+ Height = 255
+ Left = 120
+ TabIndex = 31
+ Top = 2640
+ Width = 1815
+ End
+ Begin VB.CommandButton cmdStop
+ Caption = "Stop"
+ Height = 255
+ Left = 120
+ TabIndex = 30
+ Top = 2880
+ Width = 1815
+ End
+ Begin VB.ListBox lstMusic
+ Height = 2205
+ Left = 120
+ TabIndex = 28
+ Top = 240
+ Width = 1815
+ End
+ End
+ Begin VB.Frame frmMaxSizes
+ Caption = "Max Sizes"
+ Height = 975
+ Left = 120
+ TabIndex = 22
+ Top = 3720
+ Width = 2055
+ Begin VB.TextBox txtMaxX
+ Height = 285
+ Left = 1080
+ TabIndex = 24
+ Text = "0"
+ Top = 240
+ Width = 735
+ End
+ Begin VB.TextBox txtMaxY
+ Height = 285
+ Left = 1080
+ TabIndex = 23
+ Text = "0"
+ Top = 600
+ Width = 735
+ End
+ Begin VB.Label Label11
+ AutoSize = -1 'True
+ Caption = "Max X:"
+ Height = 195
+ Left = 120
+ TabIndex = 26
+ Top = 270
+ Width = 600
+ End
+ Begin VB.Label Label2
+ AutoSize = -1 'True
+ Caption = "Max Y:"
+ Height = 195
+ Left = 120
+ TabIndex = 25
+ Top = 630
+ Width = 585
+ End
+ End
+ Begin VB.Frame Frame2
+ Caption = "Map Links"
+ Height = 1455
+ Left = 120
+ TabIndex = 16
+ Top = 480
+ Width = 2055
+ Begin VB.TextBox txtUp
+ Alignment = 1 'Right Justify
+ Appearance = 0 'Flat
+ Height = 300
+ Left = 720
+ TabIndex = 20
+ Text = "0"
+ Top = 600
+ Width = 615
+ End
+ Begin VB.TextBox txtDown
+ Alignment = 1 'Right Justify
+ Appearance = 0 'Flat
+ Height = 300
+ Left = 720
+ TabIndex = 19
+ Text = "0"
+ Top = 1080
+ Width = 615
+ End
+ Begin VB.TextBox txtRight
+ Alignment = 1 'Right Justify
+ Appearance = 0 'Flat
+ Height = 300
+ Left = 1320
+ TabIndex = 18
+ Text = "0"
+ Top = 840
+ Width = 615
+ End
+ Begin VB.TextBox txtLeft
+ Alignment = 1 'Right Justify
+ Appearance = 0 'Flat
+ Height = 300
+ Left = 120
+ TabIndex = 17
+ Text = "0"
+ Top = 840
+ Width = 615
+ End
+ Begin VB.Label lblMap
+ BackStyle = 0 'Transparent
+ Caption = "Current map: 0"
+ BeginProperty Font
+ Name = "Tahoma"
+ Size = 9.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 255
+ Left = 240
+ TabIndex = 21
+ Top = 240
+ Width = 2415
+ End
+ End
+ Begin VB.Frame fraMapSettings
+ Caption = "Map Settings"
+ Height = 855
+ Left = 2280
+ TabIndex = 13
+ Top = 480
+ Width = 4215
+ Begin VB.ComboBox cmbMoral
+ Height = 315
+ ItemData = "frmMapProperties.frx":0000
+ Left = 960
+ List = "frmMapProperties.frx":000D
+ Style = 2 'Dropdown List
+ TabIndex = 14
+ Top = 360
+ Width = 3135
+ End
+ Begin VB.Label Label6
+ AutoSize = -1 'True
+ Caption = "Moral:"
+ Height = 195
+ Left = 120
+ TabIndex = 15
+ Top = 360
+ Width = 540
+ End
+ End
+ Begin VB.Frame Frame1
+ Caption = "Boot Settings"
+ Height = 1575
+ Left = 120
+ TabIndex = 6
+ Top = 2040
+ Width = 2055
+ Begin VB.TextBox txtBootMap
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 1080
+ TabIndex = 9
+ Text = "0"
+ Top = 360
+ Width = 735
+ End
+ Begin VB.TextBox txtBootX
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 1080
+ TabIndex = 8
+ Text = "0"
+ Top = 720
+ Width = 735
+ End
+ Begin VB.TextBox txtBootY
+ Alignment = 1 'Right Justify
+ Height = 285
+ Left = 1080
+ TabIndex = 7
+ Text = "0"
+ Top = 1080
+ Width = 735
+ End
+ Begin VB.Label Label7
+ AutoSize = -1 'True
+ Caption = "Boot Map:"
+ Height = 195
+ Left = 120
+ TabIndex = 12
+ Top = 360
+ Width = 870
+ End
+ Begin VB.Label Label8
+ AutoSize = -1 'True
+ Caption = "Boot X:"
+ Height = 195
+ Left = 120
+ TabIndex = 11
+ Top = 720
+ Width = 645
+ End
+ Begin VB.Label Label9
+ AutoSize = -1 'True
+ Caption = "Boot Y:"
+ Height = 195
+ Left = 120
+ TabIndex = 10
+ Top = 1080
+ Width = 630
+ End
+ End
+ Begin VB.Frame fraNPCs
+ Caption = "NPCs"
+ Height = 3255
+ Left = 2280
+ TabIndex = 4
+ Top = 1440
+ Width = 2055
+ Begin VB.ListBox lstNpcs
+ Height = 2400
+ Left = 120
+ TabIndex = 29
+ Top = 240
+ Width = 1815
+ End
+ Begin VB.ComboBox cmbNpc
+ Height = 315
+ Left = 120
+ Style = 2 'Dropdown List
+ TabIndex = 5
+ Top = 2760
+ Width = 1815
+ End
+ End
+ Begin VB.CommandButton cmdCancel
+ Caption = "Cancel"
+ Height = 375
+ Left = 1200
+ TabIndex = 3
+ Top = 7680
+ Width = 975
+ End
+ Begin VB.CommandButton cmdOk
+ Caption = "Ok"
+ Height = 375
+ Left = 120
+ TabIndex = 2
+ Top = 7680
+ Width = 975
+ End
+ Begin VB.TextBox txtName
+ Height = 285
+ Left = 840
+ TabIndex = 1
+ Top = 120
+ Width = 5655
+ End
+ Begin VB.Label Label1
+ Caption = "Name:"
+ Height = 375
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ UseMnemonic = 0 'False
+ Width = 735
+ End
+End
+Attribute VB_Name = "frmEditor_MapProperties"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmdPlay_Click()
+ Stop_Music
+ Play_Music lstMusic.list(lstMusic.ListIndex)
+End Sub
+
+Private Sub cmdStop_Click()
+ Stop_Music
+End Sub
+
+Private Sub cmdOk_Click()
+ Dim x As Long, x2 As Long
+ Dim y As Long, y2 As Long
+ Dim tempArr() As TileRec
+
+ If Not IsNumeric(txtMaxX.text) Then txtMaxX.text = map.MapData.MaxX
+ If Val(txtMaxX.text) < 1 Then txtMaxX.text = 1
+ If Val(txtMaxX.text) > MAX_BYTE Then txtMaxX.text = MAX_BYTE
+ If Not IsNumeric(txtMaxY.text) Then txtMaxY.text = map.MapData.MaxY
+ If Val(txtMaxY.text) < 1 Then txtMaxY.text = 1
+ If Val(txtMaxY.text) > MAX_BYTE Then txtMaxY.text = MAX_BYTE
+
+ With map.MapData
+ .name = Trim$(txtName.text)
+
+ If lstMusic.ListIndex >= 0 Then
+ .Music = lstMusic.list(lstMusic.ListIndex)
+ Else
+ .Music = vbNullString
+ End If
+
+ .Up = Val(txtUp.text)
+ .Down = Val(txtDown.text)
+ .left = Val(txtLeft.text)
+ .Right = Val(txtRight.text)
+ .Moral = cmbMoral.ListIndex
+ .BootMap = Val(txtBootMap.text)
+ .BootX = Val(txtBootX.text)
+ .BootY = Val(txtBootY.text)
+ .BossNpc = scrlBoss.value
+ ' set the data before changing it
+ tempArr = map.TileData.Tile
+ x2 = map.MapData.MaxX
+ y2 = map.MapData.MaxY
+ ' change the data
+ .MaxX = Val(txtMaxX.text)
+ .MaxY = Val(txtMaxY.text)
+
+ If x2 > .MaxX Then x2 = .MaxX
+ If y2 > .MaxY Then y2 = .MaxY
+ ' redim the map size
+ ReDim map.TileData.Tile(0 To .MaxX, 0 To .MaxY)
+
+ For x = 0 To x2
+ For y = 0 To y2
+ map.TileData.Tile(x, y) = tempArr(x, y)
+ Next
+ Next
+
+ End With
+
+ ' cache the shit
+ initAutotiles
+ Unload frmEditor_MapProperties
+ ClearTempTile
+End Sub
+
+Private Sub cmdCancel_Click()
+ Unload frmEditor_MapProperties
+End Sub
+
+Private Sub lstNpcs_Click()
+ Dim tmpString() As String
+ Dim npcNum As Long
+
+ ' exit out if needed
+ If Not cmbNpc.ListCount > 0 Then Exit Sub
+ If Not lstNpcs.ListCount > 0 Then Exit Sub
+ ' set the combo box properly
+ tmpString = Split(lstNpcs.list(lstNpcs.ListIndex))
+ npcNum = CLng(left$(tmpString(0), Len(tmpString(0)) - 1))
+ cmbNpc.ListIndex = map.MapData.Npc(npcNum)
+End Sub
+
+Private Sub cmbNpc_Click()
+ Dim tmpString() As String
+ Dim npcNum As Long
+ Dim x As Long, tmpIndex As Long
+
+ ' exit out if needed
+ If Not cmbNpc.ListCount > 0 Then Exit Sub
+ If Not lstNpcs.ListCount > 0 Then Exit Sub
+ ' set the combo box properly
+ tmpString = Split(cmbNpc.list(cmbNpc.ListIndex))
+
+ ' make sure it's not a clear
+ If Not cmbNpc.list(cmbNpc.ListIndex) = "No NPC" Then
+ npcNum = CLng(left$(tmpString(0), Len(tmpString(0)) - 1))
+ map.MapData.Npc(lstNpcs.ListIndex + 1) = npcNum
+ Else
+ map.MapData.Npc(lstNpcs.ListIndex + 1) = 0
+ End If
+
+ ' re-load the list
+ tmpIndex = lstNpcs.ListIndex
+ lstNpcs.Clear
+
+ For x = 1 To MAX_MAP_NPCS
+
+ If map.MapData.Npc(x) > 0 Then
+ lstNpcs.AddItem x & ": " & Trim$(Npc(map.MapData.Npc(x)).name)
+ Else
+ lstNpcs.AddItem x & ": No NPC"
+ End If
+
+ Next
+
+ lstNpcs.ListIndex = tmpIndex
+End Sub
+
+Private Sub scrlBoss_Change()
+
+ If scrlBoss.value > 0 Then
+ lblBoss.caption = "Boss Npc: " & Trim$(Npc(map.MapData.Npc(scrlBoss.value)).name)
+ Else
+ lblBoss.caption = "Boss Npc: None"
+ End If
+
+End Sub
diff --git a/client/src/frmMapProperties.frx b/client/src/frmMapProperties.frx
new file mode 100644
index 0000000..fadef07
Binary files /dev/null and b/client/src/frmMapProperties.frx differ
diff --git a/client/src/frmMenu.frm b/client/src/frmMenu.frm
new file mode 100644
index 0000000..231fc66
--- /dev/null
+++ b/client/src/frmMenu.frm
@@ -0,0 +1,840 @@
+VERSION 5.00
+Begin VB.Form frmMenu
+ BackColor = &H00E0E0E0&
+ BorderStyle = 1 'Fixed Single
+ ClientHeight = 5280
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 7725
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmMenu.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 352
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 515
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.PictureBox picCharacter
+ AutoSize = -1 'True
+ BackColor = &H00C0C0C0&
+ BorderStyle = 0 'None
+ Height = 3645
+ Left = 555
+ ScaleHeight = 243
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 442
+ TabIndex = 16
+ Top = 180
+ Visible = 0 'False
+ Width = 6630
+ Begin VB.PictureBox picSprite
+ AutoRedraw = -1 'True
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ Height = 720
+ Left = 4800
+ ScaleHeight = 48
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 32
+ TabIndex = 26
+ Top = 1680
+ Width = 480
+ End
+ Begin VB.ComboBox cmbClass
+ Appearance = 0 'Flat
+ BackColor = &H00FFFFFF&
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00000000&
+ Height = 330
+ Left = 2280
+ Style = 2 'Dropdown List
+ TabIndex = 20
+ Top = 1800
+ Width = 2175
+ End
+ Begin VB.OptionButton optMale
+ Appearance = 0 'Flat
+ BackColor = &H00000000&
+ Caption = "Male"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Left = 2280
+ TabIndex = 19
+ Top = 2295
+ Value = -1 'True
+ Width = 975
+ End
+ Begin VB.OptionButton optFemale
+ Appearance = 0 'Flat
+ BackColor = &H00000000&
+ Caption = "Female"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Left = 3360
+ TabIndex = 18
+ Top = 2280
+ Width = 1095
+ End
+ Begin VB.TextBox txtCName
+ Appearance = 0 'Flat
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 225
+ Left = 2280
+ MaxLength = 12
+ TabIndex = 21
+ Top = 1080
+ Width = 2775
+ End
+ Begin VB.Label lblSprite
+ Alignment = 2 'Center
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "[ Change Sprite ]"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 210
+ Left = 2280
+ TabIndex = 25
+ Top = 1440
+ Width = 2775
+ End
+ Begin VB.Label lblBlank
+ Alignment = 1 'Right Justify
+ BackStyle = 0 'Transparent
+ Caption = "Gender:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 5
+ Left = 1080
+ TabIndex = 24
+ Top = 2280
+ Width = 1095
+ End
+ Begin VB.Label lblBlank
+ Alignment = 1 'Right Justify
+ BackStyle = 0 'Transparent
+ Caption = "Class:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 4
+ Left = 1440
+ TabIndex = 23
+ Top = 1800
+ Width = 735
+ End
+ Begin VB.Label lblBlank
+ Alignment = 1 'Right Justify
+ BackStyle = 0 'Transparent
+ Caption = "Name:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 2
+ Left = 1440
+ TabIndex = 22
+ Top = 1080
+ Width = 735
+ End
+ Begin VB.Label lblCAccept
+ Alignment = 2 'Center
+ BackStyle = 0 'Transparent
+ Caption = "Accept"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Left = 2760
+ TabIndex = 17
+ Top = 2760
+ Width = 1215
+ End
+ End
+ Begin VB.PictureBox picRegister
+ AutoSize = -1 'True
+ BackColor = &H00C0C0C0&
+ BorderStyle = 0 'None
+ Height = 3645
+ Left = 555
+ ScaleHeight = 243
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 442
+ TabIndex = 7
+ Top = 180
+ Visible = 0 'False
+ Width = 6630
+ Begin VB.TextBox txtRPass2
+ Appearance = 0 'Flat
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 225
+ IMEMode = 3 'DISABLE
+ Left = 2520
+ MaxLength = 20
+ PasswordChar = "•"
+ TabIndex = 13
+ Top = 2040
+ Width = 2775
+ End
+ Begin VB.TextBox txtRPass
+ Appearance = 0 'Flat
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 225
+ IMEMode = 3 'DISABLE
+ Left = 2520
+ MaxLength = 20
+ PasswordChar = "•"
+ TabIndex = 10
+ Top = 1680
+ Width = 2775
+ End
+ Begin VB.TextBox txtRUser
+ Appearance = 0 'Flat
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 225
+ Left = 2520
+ MaxLength = 12
+ TabIndex = 8
+ Top = 1320
+ Width = 2775
+ End
+ Begin VB.Label lblBlank
+ BackStyle = 0 'Transparent
+ Caption = "Retype:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 11
+ Left = 1320
+ TabIndex = 14
+ Top = 2040
+ Width = 1215
+ End
+ Begin VB.Label txtRAccept
+ Alignment = 2 'Center
+ BackStyle = 0 'Transparent
+ Caption = "Accept"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Left = 2760
+ TabIndex = 12
+ Top = 2760
+ Width = 1215
+ End
+ Begin VB.Label lblBlank
+ BackStyle = 0 'Transparent
+ Caption = "Password:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 9
+ Left = 1320
+ TabIndex = 11
+ Top = 1680
+ Width = 1215
+ End
+ Begin VB.Label lblBlank
+ BackStyle = 0 'Transparent
+ Caption = "Username:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 8
+ Left = 1320
+ TabIndex = 9
+ Top = 1320
+ Width = 1215
+ End
+ End
+ Begin VB.PictureBox picLogin
+ AutoSize = -1 'True
+ BackColor = &H00C0C0C0&
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Tahoma"
+ Size = 9.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 3630
+ Left = 555
+ ScaleHeight = 242
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 442
+ TabIndex = 0
+ Top = 180
+ Visible = 0 'False
+ Width = 6630
+ Begin VB.CheckBox chkPass
+ Appearance = 0 'Flat
+ BackColor = &H00000000&
+ Caption = "Save Password?"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Left = 1320
+ TabIndex = 5
+ Top = 2160
+ Width = 1815
+ End
+ Begin VB.TextBox txtLPass
+ Appearance = 0 'Flat
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00000000&
+ Height = 225
+ IMEMode = 3 'DISABLE
+ Left = 2520
+ MaxLength = 20
+ PasswordChar = "•"
+ TabIndex = 3
+ Top = 1800
+ Width = 2775
+ End
+ Begin VB.TextBox txtLUser
+ Appearance = 0 'Flat
+ BorderStyle = 0 'None
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00000000&
+ Height = 225
+ Left = 2520
+ MaxLength = 12
+ TabIndex = 1
+ Top = 1440
+ Width = 2775
+ End
+ Begin VB.Label lblLAccept
+ Alignment = 2 'Center
+ BackStyle = 0 'Transparent
+ Caption = "Accept"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Left = 2760
+ TabIndex = 6
+ Top = 2760
+ Width = 1215
+ End
+ Begin VB.Label lblBlank
+ BackStyle = 0 'Transparent
+ Caption = "Password:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 3
+ Left = 1320
+ TabIndex = 4
+ Top = 1800
+ Width = 1215
+ End
+ Begin VB.Label lblBlank
+ BackStyle = 0 'Transparent
+ Caption = "Username:"
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 255
+ Index = 0
+ Left = 1320
+ TabIndex = 2
+ Top = 1440
+ Width = 1215
+ End
+ End
+ Begin VB.PictureBox picCredits
+ AutoSize = -1 'True
+ BackColor = &H00C0C0C0&
+ BorderStyle = 0 'None
+ Height = 3645
+ Left = 555
+ ScaleHeight = 3645
+ ScaleWidth = 6630
+ TabIndex = 15
+ Top = 180
+ Visible = 0 'False
+ Width = 6630
+ End
+ Begin VB.PictureBox picMain
+ AutoSize = -1 'True
+ BackColor = &H00C0C0C0&
+ BorderStyle = 0 'None
+ Height = 3645
+ Left = 555
+ ScaleHeight = 3645
+ ScaleWidth = 6630
+ TabIndex = 27
+ Top = 180
+ Width = 6630
+ Begin VB.Label lblNews
+ Alignment = 2 'Center
+ BackStyle = 0 'Transparent
+ Caption = "This is an example of the news. Not very exciting, I know, but it's better than nothing, amirite? "
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 1575
+ Left = 1680
+ TabIndex = 28
+ Top = 1200
+ Width = 3135
+ End
+ End
+ Begin VB.Image imgButton
+ Height = 435
+ Index = 4
+ Left = 5460
+ Top = 4305
+ Width = 1335
+ End
+ Begin VB.Image imgButton
+ Height = 435
+ Index = 3
+ Left = 3960
+ Top = 4305
+ Width = 1335
+ End
+ Begin VB.Image imgButton
+ Height = 435
+ Index = 2
+ Left = 2460
+ Top = 4305
+ Width = 1335
+ End
+ Begin VB.Image imgButton
+ Height = 435
+ Index = 1
+ Left = 960
+ Top = 4305
+ Width = 1335
+ End
+End
+Attribute VB_Name = "frmMenu"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub cmbClass_Click()
+ newCharClass = cmbClass.ListIndex
+ newCharSprite = 0
+End Sub
+
+Private Sub Form_Load()
+ Dim tmpTxt As String, tmpArray() As String, i As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' general menu stuff
+ Me.Caption = Options.Game_Name
+
+ ' load news
+ Open App.Path & "\data files\news.txt" For Input As #1
+ Line Input #1, tmpTxt
+ Close #1
+ ' split breaks
+ tmpArray() = Split(tmpTxt, "
")
+ lblNews.Caption = vbNullString
+ For i = 0 To UBound(tmpArray)
+ lblNews.Caption = lblNews.Caption & tmpArray(i) & vbNewLine
+ Next
+
+ ' Load the username + pass
+ txtLUser.Text = Trim$(Options.Username)
+ If Options.SavePass = 1 Then
+ txtLPass.Text = Trim$(Options.Password)
+ chkPass.value = Options.SavePass
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "Form_Load", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not EnteringGame Then DestroyGame
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "Form_Unload", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub imgButton_Click(Index As Integer)
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Select Case Index
+ Case 1
+ If Not picLogin.visible Then
+ ' destroy socket, change visiblity
+ DestroyTCP
+ picCredits.visible = False
+ picLogin.visible = True
+ picRegister.visible = False
+ picCharacter.visible = False
+ picMain.visible = False
+ End If
+ Case 2
+ If Not picRegister.visible Then
+ ' destroy socket, change visiblity
+ DestroyTCP
+ picCredits.visible = False
+ picLogin.visible = False
+ picRegister.visible = True
+ picCharacter.visible = False
+ picMain.visible = False
+ End If
+ Case 3
+ If Not picCredits.visible Then
+ ' destroy socket, change visiblity
+ DestroyTCP
+ picCredits.visible = True
+ picLogin.visible = False
+ picRegister.visible = False
+ picCharacter.visible = False
+ picMain.visible = False
+ End If
+ Case 4
+ Call DestroyGame
+ End Select
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "imgButton_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub lblLAccept_Click()
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If isLoginLegal(txtLUser.Text, txtLPass.Text) Then
+ Call MenuState(MENU_STATE_LOGIN)
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "lblLAccept_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+
+Private Sub lblSprite_Click()
+Dim spritecount As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If optMale.value Then
+ spritecount = UBound(Class(cmbClass.ListIndex + 1).MaleSprite)
+ Else
+ spritecount = UBound(Class(cmbClass.ListIndex + 1).FemaleSprite)
+ End If
+
+ If newCharSprite >= spritecount Then
+ newCharSprite = 0
+ Else
+ newCharSprite = newCharSprite + 1
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "lblSprite_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub optFemale_Click()
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ newCharClass = cmbClass.ListIndex
+ newCharSprite = 0
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "optFemale_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub optMale_Click()
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ newCharClass = cmbClass.ListIndex
+ newCharSprite = 0
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "optMale_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' Register
+Private Sub txtRAccept_Click()
+ Dim Name As String
+ Dim Password As String
+ Dim PasswordAgain As String
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Name = Trim$(txtRUser.Text)
+ Password = Trim$(txtRPass.Text)
+ PasswordAgain = Trim$(txtRPass2.Text)
+
+ If isLoginLegal(Name, Password) Then
+ If Password <> PasswordAgain Then
+ Call MsgBox("Passwords don't match.")
+ Exit Sub
+ End If
+
+ If Not isStringLegal(Name) Then
+ Exit Sub
+ End If
+
+ Call MenuState(MENU_STATE_NEWACCOUNT)
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "txtRAccept_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' New Char
+Private Sub lblCAccept_Click()
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Call MenuState(MENU_STATE_ADDCHAR)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "lblCAccept_Click", "frmMenu", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
diff --git a/client/src/frmMenu.frx b/client/src/frmMenu.frx
new file mode 100644
index 0000000..72e7565
Binary files /dev/null and b/client/src/frmMenu.frx differ
diff --git a/client/src/frmSendGetData.frm b/client/src/frmSendGetData.frm
new file mode 100644
index 0000000..d558bc6
--- /dev/null
+++ b/client/src/frmSendGetData.frm
@@ -0,0 +1,95 @@
+VERSION 5.00
+Begin VB.Form frmLoad
+ BackColor = &H00000000&
+ BorderStyle = 0 'None
+ ClientHeight = 480
+ ClientLeft = 0
+ ClientTop = -105
+ ClientWidth = 4200
+ Icon = "frmSendGetData.frx":0000
+ KeyPreview = -1 'True
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ ScaleHeight = 32
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 280
+ ShowInTaskbar = 0 'False
+ StartUpPosition = 2 'CenterScreen
+ Visible = 0 'False
+ Begin VB.Label lblStatus
+ Alignment = 2 'Center
+ BackStyle = 0 'Transparent
+ BeginProperty Font
+ Name = "Georgia"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 225
+ Left = 0
+ TabIndex = 0
+ Top = 120
+ Width = 4200
+ End
+End
+Attribute VB_Name = "frmLoad"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Form_Load()
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Me.Caption = Options.Game_Name & " (esc to cancel)"
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "Form_Load", "frmLoad", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub Form_KeyPress(KeyAscii As Integer)
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+
+ If KeyAscii = vbKeyEscape Then
+ Call DestroyTCP
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "Form_KeyPress", "frmLoad", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' When the form close button is pressed
+Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If UnloadMode = vbFormControlMenu Then
+ Cancel = True
+ Call DestroyTCP
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "Form_QueryUnload", "frmLoad", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
diff --git a/client/src/frmSendGetData.frx b/client/src/frmSendGetData.frx
new file mode 100644
index 0000000..72e7565
Binary files /dev/null and b/client/src/frmSendGetData.frx differ
diff --git a/client/src/modClientTCP.bas b/client/src/modClientTCP.bas
new file mode 100644
index 0000000..31f858e
--- /dev/null
+++ b/client/src/modClientTCP.bas
@@ -0,0 +1,1047 @@
+Attribute VB_Name = "modClientTCP"
+Option Explicit
+' ******************************************
+' ** Communcation to server, TCP **
+' ** Winsock Control (mswinsck.ocx) **
+' ** String packets (slow and big) **
+' ******************************************
+Private PlayerBuffer As clsBuffer
+
+Sub TcpInit(ByVal IP As String, ByVal Port As Long)
+ Set PlayerBuffer = Nothing
+ Set PlayerBuffer = New clsBuffer
+ ' connect
+ frmMain.Socket.Close
+ frmMain.Socket.RemoteHost = IP
+ frmMain.Socket.RemotePort = Port
+End Sub
+
+Sub DestroyTCP()
+ frmMain.Socket.Close
+End Sub
+
+Public Sub IncomingData(ByVal DataLength As Long)
+ Dim Buffer() As Byte
+ Dim pLength As Long
+ frmMain.Socket.GetData Buffer, vbUnicode, DataLength
+ PlayerBuffer.WriteBytes Buffer()
+
+ If PlayerBuffer.length >= 4 Then pLength = PlayerBuffer.ReadLong(False)
+
+ Do While pLength > 0 And pLength <= PlayerBuffer.length - 4
+
+ If pLength <= PlayerBuffer.length - 4 Then
+ PlayerBuffer.ReadLong
+ HandleData PlayerBuffer.ReadBytes(pLength)
+ End If
+
+ pLength = 0
+
+ If PlayerBuffer.length >= 4 Then pLength = PlayerBuffer.ReadLong(False)
+ Loop
+
+ PlayerBuffer.Trim
+
+ DoEvents
+End Sub
+
+Public Function ConnectToServer() As Boolean
+ Dim Wait As Long
+
+ ' Check to see if we are already connected, if so just exit
+ If IsConnected Then
+ ConnectToServer = True
+ Exit Function
+ End If
+
+ Wait = GetTickCount
+ frmMain.Socket.Close
+ frmMain.Socket.Connect
+ SetStatus "Connecting to server."
+
+ ' Wait until connected or 3 seconds have passed and report the server being down
+ Do While (Not IsConnected) And (GetTickCount <= Wait + 3000)
+ DoEvents
+ Loop
+
+ ConnectToServer = IsConnected
+ SetStatus vbNullString
+End Function
+
+Function IsConnected() As Boolean
+
+ If frmMain.Socket.state = sckConnected Then
+ IsConnected = True
+ End If
+
+End Function
+
+Function IsPlaying(ByVal index As Long) As Boolean
+
+ ' if the player doesn't exist, the name will equal 0
+ If LenB(GetPlayerName(index)) > 0 Then
+ IsPlaying = True
+ End If
+
+End Function
+
+Sub SendData(ByRef data() As Byte)
+ Dim Buffer As clsBuffer
+
+ If IsConnected Then
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong (UBound(data) - LBound(data)) + 1
+ Buffer.WriteBytes data()
+ frmMain.Socket.SendData Buffer.ToArray()
+ End If
+
+End Sub
+
+' *****************************
+' ** Outgoing Client Packets **
+' *****************************
+Public Sub SendNewAccount(ByVal name As String, ByVal password As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CNewAccount
+ Buffer.WriteString name
+ Buffer.WriteString password
+ Buffer.WriteLong CLIENT_MAJOR
+ Buffer.WriteLong CLIENT_MINOR
+ Buffer.WriteLong CLIENT_REVISION
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendLogin(ByVal name As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CLogin
+ Buffer.WriteString name
+ Buffer.WriteString loginToken
+ Buffer.WriteLong CLIENT_MAJOR
+ Buffer.WriteLong CLIENT_MINOR
+ Buffer.WriteLong CLIENT_REVISION
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendAuthLogin(ByVal name As String, ByVal password As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAuthLogin
+ Buffer.WriteString name
+ Buffer.WriteString password
+ Buffer.WriteLong CLIENT_MAJOR
+ Buffer.WriteLong CLIENT_MINOR
+ Buffer.WriteLong CLIENT_REVISION
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendAddChar(ByVal name As String, ByVal sex As Long, ByVal ClassNum As Long, ByVal sprite As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAddChar
+ Buffer.WriteString name
+ Buffer.WriteLong sex
+ Buffer.WriteLong ClassNum
+ Buffer.WriteLong sprite
+ Buffer.WriteLong CharNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendUseChar(ByVal CharSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CUseChar
+ Buffer.WriteLong CharSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendDelChar(ByVal CharSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CDelChar
+ Buffer.WriteLong CharSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SayMsg(ByVal text As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSayMsg
+ Buffer.WriteString text
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub BroadcastMsg(ByVal text As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CBroadcastMsg
+ Buffer.WriteString text
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub EmoteMsg(ByVal text As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CEmoteMsg
+ Buffer.WriteString text
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub PlayerMsg(ByVal text As String, ByVal MsgTo As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSayMsg
+ Buffer.WriteString MsgTo
+ Buffer.WriteString text
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendPlayerMove()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CPlayerMove
+ Buffer.WriteLong GetPlayerDir(MyIndex)
+ Buffer.WriteLong Player(MyIndex).Moving
+ Buffer.WriteLong Player(MyIndex).x
+ Buffer.WriteLong Player(MyIndex).y
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendPlayerDir()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CPlayerDir
+ Buffer.WriteLong GetPlayerDir(MyIndex)
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendPlayerRequestNewMap()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestNewMap
+ Buffer.WriteLong GetPlayerDir(MyIndex)
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendMap()
+ Dim x As Long
+ Dim y As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ CanMoveNow = False
+
+ Buffer.WriteLong CMapData
+
+ Buffer.WriteString Trim$(map.MapData.name)
+ Buffer.WriteString Trim$(map.MapData.Music)
+ Buffer.WriteByte map.MapData.Moral
+ Buffer.WriteLong map.MapData.Up
+ Buffer.WriteLong map.MapData.Down
+ Buffer.WriteLong map.MapData.left
+ Buffer.WriteLong map.MapData.Right
+ Buffer.WriteLong map.MapData.BootMap
+ Buffer.WriteByte map.MapData.BootX
+ Buffer.WriteByte map.MapData.BootY
+ Buffer.WriteByte map.MapData.MaxX
+ Buffer.WriteByte map.MapData.MaxY
+ Buffer.WriteLong map.MapData.BossNpc
+ For i = 1 To MAX_MAP_NPCS
+ Buffer.WriteLong map.MapData.Npc(i)
+ Next
+
+ Buffer.WriteLong map.TileData.EventCount
+ If map.TileData.EventCount > 0 Then
+ For i = 1 To map.TileData.EventCount
+ With map.TileData.Events(i)
+ Buffer.WriteString .name
+ Buffer.WriteLong .x
+ Buffer.WriteLong .y
+ Buffer.WriteLong .pageCount
+ End With
+ If map.TileData.Events(i).pageCount > 0 Then
+ For x = 1 To map.TileData.Events(i).pageCount
+ With map.TileData.Events(i).EventPage(x)
+ Buffer.WriteByte .chkPlayerVar
+ Buffer.WriteByte .chkSelfSwitch
+ Buffer.WriteByte .chkHasItem
+ Buffer.WriteLong .PlayerVarNum
+ Buffer.WriteLong .SelfSwitchNum
+ Buffer.WriteLong .HasItemNum
+ Buffer.WriteLong .PlayerVariable
+ Buffer.WriteByte .GraphicType
+ Buffer.WriteLong .Graphic
+ Buffer.WriteLong .GraphicX
+ Buffer.WriteLong .GraphicY
+ Buffer.WriteByte .MoveType
+ Buffer.WriteByte .MoveSpeed
+ Buffer.WriteByte .MoveFreq
+ Buffer.WriteByte .WalkAnim
+ Buffer.WriteByte .StepAnim
+ Buffer.WriteByte .DirFix
+ Buffer.WriteByte .WalkThrough
+ Buffer.WriteByte .Priority
+ Buffer.WriteByte .Trigger
+ Buffer.WriteLong .CommandCount
+ End With
+ If map.TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ For y = 1 To map.TileData.Events(i).EventPage(x).CommandCount
+ With map.TileData.Events(i).EventPage(x).Commands(y)
+ Buffer.WriteByte .Type
+ Buffer.WriteString .text
+ Buffer.WriteLong .Colour
+ Buffer.WriteByte .channel
+ Buffer.WriteByte .TargetType
+ Buffer.WriteLong .target
+ Buffer.WriteLong .x
+ Buffer.WriteLong .y
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ With map.TileData.Tile(x, y)
+ For i = 1 To MapLayer.Layer_Count - 1
+ Buffer.WriteLong .Layer(i).x
+ Buffer.WriteLong .Layer(i).y
+ Buffer.WriteLong .Layer(i).tileset
+ Buffer.WriteByte .Autotile(i)
+ Next
+ Buffer.WriteByte .Type
+ Buffer.WriteLong .Data1
+ Buffer.WriteLong .Data2
+ Buffer.WriteLong .Data3
+ Buffer.WriteLong .Data4
+ Buffer.WriteLong .Data5
+ Buffer.WriteByte .DirBlock
+ End With
+ Next
+ Next
+
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub WarpMeTo(ByVal name As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CWarpMeTo
+ Buffer.WriteString name
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub WarpToMe(ByVal name As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CWarpToMe
+ Buffer.WriteString name
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub WarpTo(ByVal mapNum As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CWarpTo
+ Buffer.WriteLong mapNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSetAccess(ByVal name As String, ByVal Access As Byte)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSetAccess
+ Buffer.WriteString name
+ Buffer.WriteLong Access
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSetSprite(ByVal SpriteNum As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSetSprite
+ Buffer.WriteLong SpriteNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendKick(ByVal name As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CKickPlayer
+ Buffer.WriteString name
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendBan(ByVal name As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CBanPlayer
+ Buffer.WriteString name
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendBanList()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CBanList
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditItem()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditItem
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveItem(ByVal itemNum As Long)
+ Dim Buffer As clsBuffer
+ Dim ItemSize As Long
+ Dim ItemData() As Byte
+ Set Buffer = New clsBuffer
+ ItemSize = LenB(Item(itemNum))
+ ReDim ItemData(ItemSize - 1)
+ CopyMemory ItemData(0), ByVal VarPtr(Item(itemNum)), ItemSize
+ Buffer.WriteLong CSaveItem
+ Buffer.WriteLong itemNum
+ Buffer.WriteBytes ItemData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditAnimation()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditAnimation
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveAnimation(ByVal Animationnum As Long)
+ Dim Buffer As clsBuffer
+ Dim AnimationSize As Long
+ Dim AnimationData() As Byte
+ Set Buffer = New clsBuffer
+ AnimationSize = LenB(Animation(Animationnum))
+ ReDim AnimationData(AnimationSize - 1)
+ CopyMemory AnimationData(0), ByVal VarPtr(Animation(Animationnum)), AnimationSize
+ Buffer.WriteLong CSaveAnimation
+ Buffer.WriteLong Animationnum
+ Buffer.WriteBytes AnimationData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditNpc()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditNpc
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveNpc(ByVal npcNum As Long)
+ Dim Buffer As clsBuffer
+ Dim NpcSize As Long
+ Dim NpcData() As Byte
+ Set Buffer = New clsBuffer
+ NpcSize = LenB(Npc(npcNum))
+ ReDim NpcData(NpcSize - 1)
+ CopyMemory NpcData(0), ByVal VarPtr(Npc(npcNum)), NpcSize
+ Buffer.WriteLong CSaveNpc
+ Buffer.WriteLong npcNum
+ Buffer.WriteBytes NpcData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditResource()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditResource
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveResource(ByVal ResourceNum As Long)
+ Dim Buffer As clsBuffer
+ Dim ResourceSize As Long
+ Dim ResourceData() As Byte
+ Set Buffer = New clsBuffer
+ ResourceSize = LenB(Resource(ResourceNum))
+ ReDim ResourceData(ResourceSize - 1)
+ CopyMemory ResourceData(0), ByVal VarPtr(Resource(ResourceNum)), ResourceSize
+ Buffer.WriteLong CSaveResource
+ Buffer.WriteLong ResourceNum
+ Buffer.WriteBytes ResourceData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendMapRespawn()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CMapRespawn
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendUseItem(ByVal invNum As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CUseItem
+ Buffer.WriteLong invNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendDropItem(ByVal invNum As Long, ByVal amount As Long)
+ Dim Buffer As clsBuffer
+
+ If InBank Or InShop Then Exit Sub
+
+ ' do basic checks
+ If invNum < 1 Or invNum > MAX_INV Then Exit Sub
+ If PlayerInv(invNum).num < 1 Or PlayerInv(invNum).num > MAX_ITEMS Then Exit Sub
+ If Item(GetPlayerInvItemNum(MyIndex, invNum)).Type = ITEM_TYPE_CURRENCY Then
+ If amount < 1 Or amount > PlayerInv(invNum).value Then Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CMapDropItem
+ Buffer.WriteLong invNum
+ Buffer.WriteLong amount
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendWhosOnline()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CWhosOnline
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendMOTDChange(ByVal MOTD As String)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSetMotd
+ Buffer.WriteString MOTD
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditShop()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditShop
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveShop(ByVal shopNum As Long)
+ Dim Buffer As clsBuffer
+ Dim ShopSize As Long
+ Dim ShopData() As Byte
+ Set Buffer = New clsBuffer
+ ShopSize = LenB(Shop(shopNum))
+ ReDim ShopData(ShopSize - 1)
+ CopyMemory ShopData(0), ByVal VarPtr(Shop(shopNum)), ShopSize
+ Buffer.WriteLong CSaveShop
+ Buffer.WriteLong shopNum
+ Buffer.WriteBytes ShopData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditSpell()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditSpell
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveSpell(ByVal spellnum As Long)
+ Dim Buffer As clsBuffer
+ Dim SpellSize As Long
+ Dim SpellData() As Byte
+ Set Buffer = New clsBuffer
+ SpellSize = LenB(Spell(spellnum))
+ ReDim SpellData(SpellSize - 1)
+ CopyMemory SpellData(0), ByVal VarPtr(Spell(spellnum)), SpellSize
+ Buffer.WriteLong CSaveSpell
+ Buffer.WriteLong spellnum
+ Buffer.WriteBytes SpellData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditMap()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditMap
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendBanDestroy()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CBanDestroy
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendChangeInvSlots(ByVal oldSlot As Long, ByVal newSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSwapInvSlots
+ Buffer.WriteLong oldSlot
+ Buffer.WriteLong newSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+ ' buffer it
+ PlayerSwitchInvSlots oldSlot, newSlot
+End Sub
+
+Sub SendChangeSpellSlots(ByVal oldSlot As Long, ByVal newSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSwapSpellSlots
+ Buffer.WriteLong oldSlot
+ Buffer.WriteLong newSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+ ' buffer it
+ PlayerSwitchSpellSlots oldSlot, newSlot
+End Sub
+
+Sub GetPing()
+ Dim Buffer As clsBuffer
+ PingStart = GetTickCount
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CCheckPing
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUnequip(ByVal eqNum As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CUnequip
+ Buffer.WriteLong eqNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestPlayerData()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestPlayerData
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestItems()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestItems
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestAnimations()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestAnimations
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestNPCS()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestNPCS
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestResources()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestResources
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestSpells()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestSpells
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestShops()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestShops
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendSpawnItem(ByVal tmpItem As Long, ByVal tmpAmount As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSpawnItem
+ Buffer.WriteLong tmpItem
+ Buffer.WriteLong tmpAmount
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTrainStat(ByVal statNum As Byte)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CUseStatPoint
+ Buffer.WriteByte statNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestLevelUp()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestLevelUp
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub BuyItem(ByVal shopSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CBuyItem
+ Buffer.WriteLong shopSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SellItem(ByVal invSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSellItem
+ Buffer.WriteLong invSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub DepositItem(ByVal invSlot As Long, ByVal amount As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CDepositItem
+ Buffer.WriteLong invSlot
+ Buffer.WriteLong amount
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub WithdrawItem(ByVal bankslot As Long, ByVal amount As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CWithdrawItem
+ Buffer.WriteLong bankslot
+ Buffer.WriteLong amount
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub CloseBank()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CCloseBank
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+ InBank = False
+End Sub
+
+Public Sub ChangeBankSlots(ByVal oldSlot As Long, ByVal newSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CChangeBankSlots
+ Buffer.WriteLong oldSlot
+ Buffer.WriteLong newSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub AdminWarp(ByVal x As Long, ByVal y As Long)
+ If x < 0 Or y < 0 Or x > map.MapData.MaxX Or y > map.MapData.MaxY Then Exit Sub
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAdminWarp
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub AcceptTrade()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAcceptTrade
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub DeclineTrade()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CDeclineTrade
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub TradeItem(ByVal invSlot As Long, ByVal amount As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CTradeItem
+ Buffer.WriteLong invSlot
+ Buffer.WriteLong amount
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub UntradeItem(ByVal invSlot As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CUntradeItem
+ Buffer.WriteLong invSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendHotbarChange(ByVal sType As Long, ByVal Slot As Long, ByVal hotbarNum As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CHotbarChange
+ Buffer.WriteLong sType
+ Buffer.WriteLong Slot
+ Buffer.WriteLong hotbarNum
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendHotbarUse(ByVal Slot As Long)
+ Dim Buffer As clsBuffer, x As Long
+
+ ' check if spell
+ If Hotbar(Slot).sType = 2 Then ' spell
+
+ For x = 1 To MAX_PLAYER_SPELLS
+
+ ' is the spell matching the hotbar?
+ If PlayerSpells(x).Spell = Hotbar(Slot).Slot Then
+ ' found it, cast it
+ CastSpell x
+ Exit Sub
+ End If
+
+ Next
+
+ ' can't find the spell, exit out
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CHotbarUse
+ Buffer.WriteLong Slot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendMapReport()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CMapReport
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub PlayerTarget(ByVal target As Long, ByVal TargetType As Long)
+ Dim Buffer As clsBuffer
+
+ If myTargetType = TargetType And myTarget = target Then
+ myTargetType = 0
+ myTarget = 0
+ Else
+ myTarget = target
+ myTargetType = TargetType
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CTarget
+ Buffer.WriteLong target
+ Buffer.WriteLong TargetType
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTradeRequest(playerIndex As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CTradeRequest
+ Buffer.WriteLong playerIndex
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendAcceptTradeRequest()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAcceptTradeRequest
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendDeclineTradeRequest()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CDeclineTradeRequest
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPartyLeave()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CPartyLeave
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPartyRequest(index As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CPartyRequest
+ Buffer.WriteLong index
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendAcceptParty()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAcceptParty
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendDeclineParty()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CDeclineParty
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendRequestEditConv()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestEditConv
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendSaveConv(ByVal Convnum As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Dim x As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CSaveConv
+ Buffer.WriteLong Convnum
+
+ With Conv(Convnum)
+ Buffer.WriteString .name
+ Buffer.WriteLong .chatCount
+
+ For i = 1 To .chatCount
+ Buffer.WriteString .Conv(i).Conv
+
+ For x = 1 To 4
+ Buffer.WriteString .Conv(i).rText(x)
+ Buffer.WriteLong .Conv(i).rTarget(x)
+ Next
+
+ Buffer.WriteLong .Conv(i).Event
+ Buffer.WriteLong .Conv(i).Data1
+ Buffer.WriteLong .Conv(i).Data2
+ Buffer.WriteLong .Conv(i).Data3
+ Next
+
+ End With
+
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendRequestConvs()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CRequestConvs
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Public Sub SendChatOption(ByVal index As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CChatOption
+ Buffer.WriteLong index
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendFinishTutorial()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CFinishTutorial
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendCloseShop()
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CCloseShop
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
diff --git a/client/src/modConstants.bas b/client/src/modConstants.bas
new file mode 100644
index 0000000..4acb1a2
--- /dev/null
+++ b/client/src/modConstants.bas
@@ -0,0 +1,278 @@
+Attribute VB_Name = "modConstants"
+Option Explicit
+' in development? [turn off music]
+Public Const inDevelopment As Boolean = True
+' Version constants
+Public Const CLIENT_MAJOR As Byte = 1
+Public Const CLIENT_MINOR As Byte = 8
+Public Const CLIENT_REVISION As Byte = 0
+' Connection details
+Public Const GAME_SERVER_IP As String = "127.0.0.1" ' "46.23.70.66"
+Public Const AUTH_SERVER_IP As String = "127.0.0.1" ' "46.23.70.66"
+Public Const GAME_SERVER_PORT As Long = 7001 ' the port used by the main game server
+Public Const AUTH_SERVER_PORT As Long = 7002 ' the port used for people to connect to auth server
+Public Const SERVER_AUTH_PORT As Long = 7003 ' the portal used for server to talk to auth server
+' Resolution count
+Public Const RES_COUNT As Long = 16
+' Music
+Public Const MenuMusic = "_menu.mid"
+' GUI
+Public Const ChatBubbleWidth As Long = 200
+Public Const CHAT_TIMER As Long = 20000
+' Inventory constants
+Public Const InvTop As Long = 28
+Public Const InvLeft As Long = 9
+Public Const InvOffsetY As Long = 6
+Public Const InvOffsetX As Long = 6
+Public Const InvColumns As Long = 5
+' Character consts
+Public Const EqTop As Long = 315
+Public Const EqLeft As Long = 11
+Public Const EqOffsetX As Long = 8
+Public Const EqColumns As Long = 4
+' Inventory constants
+Public Const SkillTop As Long = 28
+Public Const SkillLeft As Long = 9
+Public Const SkillOffsetY As Long = 6
+Public Const SkillOffsetX As Long = 6
+Public Const SkillColumns As Long = 5
+' Hotbar constants
+Public Const HotbarTop As Long = 0
+Public Const HotbarLeft As Long = 8
+Public Const HotbarOffsetX As Long = 41
+' Shop constants
+Public Const ShopTop As Long = 28
+Public Const ShopLeft As Long = 9
+Public Const ShopOffsetY As Long = 6
+Public Const ShopOffsetX As Long = 6
+Public Const ShopColumns As Long = 7
+' Trade
+Public Const TradeTop As Long = 0
+Public Const TradeLeft As Long = 0
+Public Const TradeOffsetY As Long = 6
+Public Const TradeOffsetX As Long = 6
+Public Const TradeColumns As Long = 5
+' API Declares
+Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
+Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByRef Msg() As Byte, ByVal wParam As Long, ByVal lParam As Long) As Long
+Public Declare Function GetForegroundWindow Lib "user32" () As Long
+' Animation
+Public Const AnimColumns As Long = 5
+' values
+Public Const MAX_BYTE As Byte = 255
+Public Const MAX_INTEGER As Integer = 32767
+Public Const MAX_LONG As Long = 2147483647
+' path constants
+Public Const SOUND_PATH As String = "\Data Files\sound\"
+Public Const MUSIC_PATH As String = "\Data Files\music\"
+' Map Path and variables
+Public Const MAP_PATH As String = "\Data Files\maps\"
+Public Const MAP_EXT As String = ".map"
+' Key constants
+Public Const VK_A As Long = &H41
+Public Const VK_D As Long = &H44
+Public Const VK_S As Long = &H53
+Public Const VK_W As Long = &H57
+Public Const VK_SHIFT As Long = &H10
+Public Const VK_RETURN As Long = &HD
+Public Const VK_CONTROL As Long = &H11
+Public Const VK_TAB As Long = &H9
+Public Const VK_LEFT As Long = &H25
+Public Const VK_UP As Long = &H26
+Public Const VK_RIGHT As Long = &H27
+Public Const VK_DOWN As Long = &H28
+' Menu states
+Public Const MENU_STATE_NEWACCOUNT As Byte = 0
+Public Const MENU_STATE_DELACCOUNT As Byte = 1
+Public Const MENU_STATE_LOGIN As Byte = 2
+Public Const MENU_STATE_GETCHARS As Byte = 3
+Public Const MENU_STATE_NEWCHAR As Byte = 4
+Public Const MENU_STATE_ADDCHAR As Byte = 5
+Public Const MENU_STATE_DELCHAR As Byte = 6
+Public Const MENU_STATE_USECHAR As Byte = 7
+Public Const MENU_STATE_INIT As Byte = 8
+' Speed moving vars
+Public Const WALK_SPEED As Byte = 2
+Public Const RUN_SPEED As Byte = 4
+' Tile size constants
+Public Const PIC_X As Long = 32
+Public Const PIC_Y As Long = 32
+' ********************************************************
+' * The values below must match with the server's values *
+' ********************************************************
+' General constants
+Public Const MAX_PLAYERS As Long = 200
+Public Const MAX_ITEMS As Long = 255
+Public Const MAX_NPCS As Long = 255
+Public Const MAX_ANIMATIONS As Long = 255
+Public Const MAX_INV As Long = 35
+Public Const MAX_MAP_ITEMS As Long = 255
+Public Const MAX_MAP_NPCS As Long = 30
+Public Const MAX_SHOPS As Long = 50
+Public Const MAX_PLAYER_SPELLS As Long = 35
+Public Const MAX_SPELLS As Long = 255
+Public Const MAX_TRADES As Long = 35
+Public Const MAX_RESOURCES As Long = 100
+Public Const MAX_LEVELS As Long = 25
+Public Const MAX_BANK As Long = 99
+Public Const MAX_HOTBAR As Long = 10
+Public Const MAX_PARTYS As Long = 35
+Public Const MAX_PARTY_MEMBERS As Long = 4
+Public Const MAX_CONVS As Byte = 255
+Public Const MAX_NPC_DROPS As Byte = 30
+Public Const MAX_NPC_SPELLS As Byte = 10
+Public Const MAX_CHARS As Byte = 3
+' Website
+Public Const GAME_NAME As String = "Crystalshire"
+Public Const GAME_WEBSITE As String = "http://www.crystalshire.com"
+' String constants
+Public Const NAME_LENGTH As Byte = 20
+' Sex constants
+Public Const SEX_MALE As Byte = 0
+Public Const SEX_FEMALE As Byte = 1
+' Map constants
+Public Const MAX_MAPS As Long = 100
+Public Const MAX_MAPX As Byte = 24
+Public Const MAX_MAPY As Byte = 18
+Public Const MAP_MORAL_NONE As Byte = 0
+Public Const MAP_MORAL_SAFE As Byte = 1
+Public Const MAP_MORAL_BOSS As Byte = 2
+' Tile consants
+Public Const TILE_TYPE_WALKABLE As Byte = 0
+Public Const TILE_TYPE_BLOCKED As Byte = 1
+Public Const TILE_TYPE_WARP As Byte = 2
+Public Const TILE_TYPE_ITEM As Byte = 3
+Public Const TILE_TYPE_NPCAVOID As Byte = 4
+Public Const TILE_TYPE_KEY As Byte = 5
+Public Const TILE_TYPE_KEYOPEN As Byte = 6
+Public Const TILE_TYPE_RESOURCE As Byte = 7
+Public Const TILE_TYPE_DOOR As Byte = 8
+Public Const TILE_TYPE_NPCSPAWN As Byte = 9
+Public Const TILE_TYPE_SHOP As Byte = 10
+Public Const TILE_TYPE_BANK As Byte = 11
+Public Const TILE_TYPE_HEAL As Byte = 12
+Public Const TILE_TYPE_TRAP As Byte = 13
+Public Const TILE_TYPE_SLIDE As Byte = 14
+Public Const TILE_TYPE_CHAT As Byte = 15
+Public Const TILE_TYPE_APPEAR As Byte = 16
+' Item constants
+Public Const ITEM_TYPE_NONE As Byte = 0
+Public Const ITEM_TYPE_WEAPON As Byte = 1
+Public Const ITEM_TYPE_ARMOR As Byte = 2
+Public Const ITEM_TYPE_HELMET As Byte = 3
+Public Const ITEM_TYPE_SHIELD As Byte = 4
+Public Const ITEM_TYPE_CONSUME As Byte = 5
+Public Const ITEM_TYPE_KEY As Byte = 6
+Public Const ITEM_TYPE_CURRENCY As Byte = 7
+Public Const ITEM_TYPE_SPELL As Byte = 8
+Public Const ITEM_TYPE_UNIQUE As Byte = 9
+Public Const ITEM_TYPE_FOOD As Byte = 10
+' Direction constants
+Public Const DIR_UP As Byte = 0
+Public Const DIR_DOWN As Byte = 1
+Public Const DIR_LEFT As Byte = 2
+Public Const DIR_RIGHT As Byte = 3
+' Constants for player movement: Tiles per Second
+Public Const MOVING_WALKING As Byte = 1
+Public Const MOVING_RUNNING As Byte = 2
+' Admin constants
+Public Const ADMIN_MONITOR As Byte = 1
+Public Const ADMIN_MAPPER As Byte = 2
+Public Const ADMIN_DEVELOPER As Byte = 3
+Public Const ADMIN_CREATOR As Byte = 4
+' NPC constants
+Public Const NPC_BEHAVIOUR_ATTACKONSIGHT As Byte = 0
+Public Const NPC_BEHAVIOUR_ATTACKWHENATTACKED As Byte = 1
+Public Const NPC_BEHAVIOUR_FRIENDLY As Byte = 2
+Public Const NPC_BEHAVIOUR_SHOPKEEPER As Byte = 3
+Public Const NPC_BEHAVIOUR_GUARD As Byte = 4
+' Spell constants
+Public Const SPELL_TYPE_DAMAGEHP As Byte = 0
+Public Const SPELL_TYPE_DAMAGEMP As Byte = 1
+Public Const SPELL_TYPE_HEALHP As Byte = 2
+Public Const SPELL_TYPE_HEALMP As Byte = 3
+Public Const SPELL_TYPE_WARP As Byte = 4
+' Game editor constants
+Public Const EDITOR_ITEM As Byte = 1
+Public Const EDITOR_NPC As Byte = 2
+Public Const EDITOR_SPELL As Byte = 3
+Public Const EDITOR_SHOP As Byte = 4
+Public Const EDITOR_RESOURCE As Byte = 5
+Public Const EDITOR_ANIMATION As Byte = 6
+Public Const EDITOR_CONV As Byte = 7
+' Target type constants
+Public Const TARGET_TYPE_NONE As Byte = 0
+Public Const TARGET_TYPE_PLAYER As Byte = 1
+Public Const TARGET_TYPE_NPC As Byte = 2
+Public Const TARGET_TYPE_EVENT As Byte = 3
+' Autotiles
+Public Const AUTO_INNER As Byte = 1
+Public Const AUTO_OUTER As Byte = 2
+Public Const AUTO_HORIZONTAL As Byte = 3
+Public Const AUTO_VERTICAL As Byte = 4
+Public Const AUTO_FILL As Byte = 5
+' Autotile types
+Public Const AUTOTILE_NONE As Byte = 0
+Public Const AUTOTILE_NORMAL As Byte = 1
+Public Const AUTOTILE_FAKE As Byte = 2
+Public Const AUTOTILE_ANIM As Byte = 3
+Public Const AUTOTILE_CLIFF As Byte = 4
+Public Const AUTOTILE_WATERFALL As Byte = 5
+' Rendering
+Public Const RENDER_STATE_NONE As Long = 0
+Public Const RENDER_STATE_NORMAL As Long = 1
+Public Const RENDER_STATE_AUTOTILE As Long = 2
+Public Const RENDER_STATE_APPEAR As Long = 3
+' Scrolling action message constants
+Public Const ACTIONMsgSTATIC As Long = 0
+Public Const ACTIONMsgSCROLL As Long = 1
+Public Const ACTIONMsgSCREEN As Long = 2
+' Texture paths
+Public Const Path_Anim As String = "\data files\graphics\animations\"
+Public Const Path_Char As String = "\data files\graphics\characters\"
+Public Const Path_Face As String = "\data files\graphics\faces\"
+Public Const Path_GUI As String = "\data files\graphics\gui\"
+Public Const Path_Design As String = "\data files\graphics\gui\designs\"
+Public Const Path_Gradient As String = "\data files\graphics\gui\gradients\"
+Public Const Path_Item As String = "\data files\graphics\items\"
+Public Const Path_Paperdoll As String = "\data files\graphics\paperdolls\"
+Public Const Path_Resource As String = "\data files\graphics\resources\"
+Public Const Path_Spellicon As String = "\data files\graphics\spellicons\"
+Public Const Path_Tileset As String = "\data files\graphics\tilesets\"
+Public Const Path_Font As String = "\data files\graphics\fonts\"
+Public Const Path_Graphics As String = "\data files\graphics\"
+Public Const Path_Surface As String = "\data files\graphics\surfaces\"
+Public Const Path_Fog As String = "\data files\graphics\fog\"
+' text color pointers
+Public Const Black As Byte = 0
+Public Const Blue As Byte = 1
+Public Const Green As Byte = 2
+Public Const Cyan As Byte = 3
+Public Const Red As Byte = 4
+Public Const Magenta As Byte = 5
+Public Const Brown As Byte = 6
+Public Const Grey As Byte = 7
+Public Const DarkGrey As Byte = 8
+Public Const BrightBlue As Byte = 9
+Public Const BrightGreen As Byte = 10
+Public Const BrightCyan As Byte = 11
+Public Const BrightRed As Byte = 12
+Public Const Pink As Byte = 13
+Public Const Yellow As Byte = 14
+Public Const White As Byte = 15
+Public Const DarkBrown As Byte = 16
+Public Const Gold As Byte = 17
+Public Const LightGreen As Byte = 18
+' pointers
+Public Const SayColor As Byte = White
+Public Const GlobalColor As Byte = BrightBlue
+Public Const BroadcastColor As Byte = White
+Public Const TellColor As Byte = BrightGreen
+Public Const EmoteColor As Byte = BrightCyan
+Public Const AdminColor As Byte = BrightCyan
+Public Const HelpColor As Byte = BrightBlue
+Public Const WhoColor As Byte = BrightBlue
+Public Const JoinLeftColor As Byte = DarkGrey
+Public Const NpcColor As Byte = Brown
+Public Const AlertColor As Byte = Red
+Public Const NewMapColor As Byte = BrightBlue
diff --git a/client/src/modDatabase.bas b/client/src/modDatabase.bas
new file mode 100644
index 0000000..c0c129e
--- /dev/null
+++ b/client/src/modDatabase.bas
@@ -0,0 +1,757 @@
+Attribute VB_Name = "modDatabase"
+Option Explicit
+' Text API
+Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpString As String, ByVal lpfilename As String) As Long
+Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpdefault As String, ByVal lpreturnedstring As String, ByVal nsize As Long, ByVal lpfilename As String) As Long
+
+Private crcTable(0 To 255) As Long
+
+Public Sub InitCRC32()
+Dim i As Long, n As Long, CRC As Long
+
+ For i = 0 To 255
+ CRC = i
+ For n = 0 To 7
+ If CRC And 1 Then
+ CRC = (((CRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor &HEDB88320
+ Else
+ CRC = ((CRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF
+ End If
+ Next
+ crcTable(i) = CRC
+ Next
+End Sub
+
+Public Function CRC32(ByRef data() As Byte) As Long
+Dim lCurPos As Long
+Dim lLen As Long
+
+ lLen = AryCount(data) - 1
+ CRC32 = &HFFFFFFFF
+
+ For lCurPos = 0 To lLen
+ CRC32 = (((CRC32 And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (crcTable((CRC32 And 255) Xor data(lCurPos)))
+ Next
+
+ CRC32 = CRC32 Xor &HFFFFFFFF
+End Function
+
+Public Sub ChkDir(ByVal tDir As String, ByVal tName As String)
+
+ If LCase$(dir$(tDir & tName, vbDirectory)) <> tName Then Call MkDir(tDir & tName)
+End Sub
+
+Public Function FileExist(ByVal filename As String) As Boolean
+
+ If LenB(dir$(filename)) > 0 Then
+ FileExist = True
+ End If
+
+End Function
+
+' gets a string from a text file
+Public Function GetVar(File As String, header As String, Var As String) As String
+ Dim sSpaces As String ' Max string length
+ Dim szReturn As String ' Return default value if not found
+ szReturn = vbNullString
+ sSpaces = Space$(5000)
+ Call GetPrivateProfileString$(header, Var, szReturn, sSpaces, Len(sSpaces), File)
+ GetVar = RTrim$(sSpaces)
+ GetVar = left$(GetVar, Len(GetVar) - 1)
+End Function
+
+' writes a variable to a text file
+Public Sub PutVar(File As String, header As String, Var As String, value As String)
+ Call WritePrivateProfileString$(header, Var, value, File)
+End Sub
+
+Public Sub SaveOptions()
+ Dim filename As String, i As Long
+
+ filename = App.path & "\Data Files\config_v2.ini"
+
+ Call PutVar(filename, "Options", "Username", Options.Username)
+ Call PutVar(filename, "Options", "Music", Str$(Options.Music))
+ Call PutVar(filename, "Options", "Sound", Str$(Options.sound))
+ Call PutVar(filename, "Options", "NoAuto", Str$(Options.NoAuto))
+ Call PutVar(filename, "Options", "Render", Str$(Options.Render))
+ Call PutVar(filename, "Options", "SaveUser", Str$(Options.SaveUser))
+ Call PutVar(filename, "Options", "Resolution", Str$(Options.Resolution))
+ Call PutVar(filename, "Options", "Fullscreen", Str$(Options.Fullscreen))
+ For i = 0 To ChatChannel.Channel_Count - 1
+ Call PutVar(filename, "Options", "Channel" & i, Str$(Options.channelState(i)))
+ Next
+End Sub
+
+Public Sub LoadOptions()
+ Dim filename As String, i As Long
+
+ On Error GoTo errorhandler
+
+ filename = App.path & "\Data Files\config_v2.ini"
+
+ If Not FileExist(filename) Then
+ GoTo errorhandler
+ Else
+ Options.Username = GetVar(filename, "Options", "Username")
+ Options.Music = GetVar(filename, "Options", "Music")
+ Options.sound = Val(GetVar(filename, "Options", "Sound"))
+ Options.NoAuto = Val(GetVar(filename, "Options", "NoAuto"))
+ Options.Render = Val(GetVar(filename, "Options", "Render"))
+ Options.SaveUser = Val(GetVar(filename, "Options", "SaveUser"))
+ Options.Resolution = Val(GetVar(filename, "Options", "Resolution"))
+ Options.Fullscreen = Val(GetVar(filename, "Options", "Fullscreen"))
+ For i = 0 To ChatChannel.Channel_Count - 1
+ Options.channelState(i) = Val(GetVar(filename, "Options", "Channel" & i))
+ Next
+ End If
+
+ Exit Sub
+errorhandler:
+ Options.Music = 1
+ Options.sound = 1
+ Options.NoAuto = 0
+ Options.Username = vbNullString
+ Options.Fullscreen = 0
+ Options.Render = 0
+ Options.SaveUser = 0
+ For i = 0 To ChatChannel.Channel_Count - 1
+ Options.channelState(i) = 1
+ Next
+ SaveOptions
+ Exit Sub
+End Sub
+
+Public Sub SaveMap(ByVal mapNum As Long)
+ Dim filename As String, f As Long, x As Long, y As Long, i As Long
+
+ ' save map data
+ filename = App.path & MAP_PATH & mapNum & "_.dat"
+
+ ' if it exists then kill the ini
+ If FileExist(filename) Then Kill filename
+
+ ' General
+ With map.MapData
+ PutVar filename, "General", "Name", .name
+ PutVar filename, "General", "Music", .Music
+ PutVar filename, "General", "Moral", Val(.Moral)
+ PutVar filename, "General", "Up", Val(.Up)
+ PutVar filename, "General", "Down", Val(.Down)
+ PutVar filename, "General", "Left", Val(.left)
+ PutVar filename, "General", "Right", Val(.Right)
+ PutVar filename, "General", "BootMap", Val(.BootMap)
+ PutVar filename, "General", "BootX", Val(.BootX)
+ PutVar filename, "General", "BootY", Val(.BootY)
+ PutVar filename, "General", "MaxX", Val(.MaxX)
+ PutVar filename, "General", "MaxY", Val(.MaxY)
+ PutVar filename, "General", "BossNpc", Val(.BossNpc)
+ For i = 1 To MAX_MAP_NPCS
+ PutVar filename, "General", "Npc" & i, Val(.Npc(i))
+ Next
+ End With
+
+ ' Events
+ PutVar filename, "Events", "EventCount", Val(map.TileData.EventCount)
+
+ If map.TileData.EventCount > 0 Then
+ For i = 1 To map.TileData.EventCount
+ With map.TileData.Events(i)
+ PutVar filename, "Event" & i, "Name", .name
+ PutVar filename, "Event" & i, "x", Val(.x)
+ PutVar filename, "Event" & i, "y", Val(.y)
+ PutVar filename, "Event" & i, "PageCount", Val(.pageCount)
+ End With
+ If map.TileData.Events(i).pageCount > 0 Then
+ For x = 1 To map.TileData.Events(i).pageCount
+ With map.TileData.Events(i).EventPage(x)
+ PutVar filename, "Event" & i & "Page" & x, "chkPlayerVar", Val(.chkPlayerVar)
+ PutVar filename, "Event" & i & "Page" & x, "chkSelfSwitch", Val(.chkSelfSwitch)
+ PutVar filename, "Event" & i & "Page" & x, "chkHasItem", Val(.chkHasItem)
+ PutVar filename, "Event" & i & "Page" & x, "PlayerVarNum", Val(.PlayerVarNum)
+ PutVar filename, "Event" & i & "Page" & x, "SelfSwitchNum", Val(.SelfSwitchNum)
+ PutVar filename, "Event" & i & "Page" & x, "HasItemNum", Val(.HasItemNum)
+ PutVar filename, "Event" & i & "Page" & x, "PlayerVariable", Val(.PlayerVariable)
+ PutVar filename, "Event" & i & "Page" & x, "GraphicType", Val(.GraphicType)
+ PutVar filename, "Event" & i & "Page" & x, "Graphic", Val(.Graphic)
+ PutVar filename, "Event" & i & "Page" & x, "GraphicX", Val(.GraphicX)
+ PutVar filename, "Event" & i & "Page" & x, "GraphicY", Val(.GraphicY)
+ PutVar filename, "Event" & i & "Page" & x, "MoveType", Val(.MoveType)
+ PutVar filename, "Event" & i & "Page" & x, "MoveSpeed", Val(.MoveSpeed)
+ PutVar filename, "Event" & i & "Page" & x, "MoveFreq", Val(.MoveFreq)
+ PutVar filename, "Event" & i & "Page" & x, "WalkAnim", Val(.WalkAnim)
+ PutVar filename, "Event" & i & "Page" & x, "StepAnim", Val(.StepAnim)
+ PutVar filename, "Event" & i & "Page" & x, "DirFix", Val(.DirFix)
+ PutVar filename, "Event" & i & "Page" & x, "WalkThrough", Val(.WalkThrough)
+ PutVar filename, "Event" & i & "Page" & x, "Priority", Val(.Priority)
+ PutVar filename, "Event" & i & "Page" & x, "Trigger", Val(.Trigger)
+ PutVar filename, "Event" & i & "Page" & x, "CommandCount", Val(.CommandCount)
+ End With
+ If map.TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ For y = 1 To map.TileData.Events(i).EventPage(x).CommandCount
+ With map.TileData.Events(i).EventPage(x).Commands(y)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Type", Val(.Type)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Text", .text
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Colour", Val(.colour)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Channel", Val(.channel)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "TargetType", Val(.TargetType)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Target", Val(.target)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "x", Val(.x)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "y", Val(.y)
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ ' dump tile data
+ filename = App.path & MAP_PATH & mapNum & ".dat"
+
+ ' if it exists then kill the ini
+ If FileExist(filename) Then Kill filename
+
+ f = FreeFile
+ With map
+ Open filename For Binary As #f
+ For x = 0 To .MapData.MaxX
+ For y = 0 To .MapData.MaxY
+ Put #f, , .TileData.Tile(x, y).Type
+ Put #f, , .TileData.Tile(x, y).Data1
+ Put #f, , .TileData.Tile(x, y).Data2
+ Put #f, , .TileData.Tile(x, y).Data3
+ Put #f, , .TileData.Tile(x, y).Data4
+ Put #f, , .TileData.Tile(x, y).Data5
+ Put #f, , .TileData.Tile(x, y).Autotile
+ Put #f, , .TileData.Tile(x, y).DirBlock
+ For i = 1 To MapLayer.Layer_Count - 1
+ Put #f, , .TileData.Tile(x, y).Layer(i).Tileset
+ Put #f, , .TileData.Tile(x, y).Layer(i).x
+ Put #f, , .TileData.Tile(x, y).Layer(i).y
+ Next
+ Next
+ Next
+ Close #f
+ End With
+
+ Close #f
+End Sub
+
+Sub GetMapCRC32(mapNum As Long)
+Dim data() As Byte, filename As String, f As Long
+ ' map data
+ filename = App.path & MAP_PATH & mapNum & "_.dat"
+ If FileExist(filename) Then
+ f = FreeFile
+ Open filename For Binary As #f
+ data = Space$(LOF(f))
+ Get #f, , data
+ Close #f
+ MapCRC32(mapNum).MapDataCRC = CRC32(data)
+ Else
+ MapCRC32(mapNum).MapDataCRC = 0
+ End If
+ ' clear
+ Erase data
+ ' tile data
+ filename = App.path & MAP_PATH & mapNum & ".dat"
+ If FileExist(filename) Then
+ f = FreeFile
+ Open filename For Binary As #f
+ data = Space$(LOF(f))
+ Get #f, , data
+ Close #f
+ MapCRC32(mapNum).MapTileCRC = CRC32(data)
+ Else
+ MapCRC32(mapNum).MapTileCRC = 0
+ End If
+End Sub
+
+Public Sub LoadMap(ByVal mapNum As Long)
+ Dim filename As String, i As Long, f As Long, x As Long, y As Long
+
+ ' load map data
+ filename = App.path & MAP_PATH & mapNum & "_.dat"
+
+ ' General
+ With map.MapData
+ .name = GetVar(filename, "General", "Name")
+ .Music = GetVar(filename, "General", "Music")
+ .Moral = Val(GetVar(filename, "General", "Moral"))
+ .Up = Val(GetVar(filename, "General", "Up"))
+ .Down = Val(GetVar(filename, "General", "Down"))
+ .left = Val(GetVar(filename, "General", "Left"))
+ .Right = Val(GetVar(filename, "General", "Right"))
+ .BootMap = Val(GetVar(filename, "General", "BootMap"))
+ .BootX = Val(GetVar(filename, "General", "BootX"))
+ .BootY = Val(GetVar(filename, "General", "BootY"))
+ .MaxX = Val(GetVar(filename, "General", "MaxX"))
+ .MaxY = Val(GetVar(filename, "General", "MaxY"))
+ .BossNpc = Val(GetVar(filename, "General", "BossNpc"))
+ For i = 1 To MAX_MAP_NPCS
+ .Npc(i) = Val(GetVar(filename, "General", "Npc" & i))
+ Next
+ End With
+
+ ' Events
+ map.TileData.EventCount = Val(GetVar(filename, "Events", "EventCount"))
+
+ If map.TileData.EventCount > 0 Then
+ ReDim Preserve map.TileData.Events(1 To map.TileData.EventCount)
+ For i = 1 To map.TileData.EventCount
+ With map.TileData.Events(i)
+ .name = GetVar(filename, "Event" & i, "Name")
+ .x = Val(GetVar(filename, "Event" & i, "x"))
+ .y = Val(GetVar(filename, "Event" & i, "y"))
+ .pageCount = Val(GetVar(filename, "Event" & i, "PageCount"))
+ End With
+ If map.TileData.Events(i).pageCount > 0 Then
+ ReDim Preserve map.TileData.Events(i).EventPage(1 To map.TileData.Events(i).pageCount)
+ For x = 1 To map.TileData.Events(i).pageCount
+ With map.TileData.Events(i).EventPage(x)
+ .chkPlayerVar = Val(GetVar(filename, "Event" & i & "Page" & x, "chkPlayerVar"))
+ .chkSelfSwitch = Val(GetVar(filename, "Event" & i & "Page" & x, "chkSelfSwitch"))
+ .chkHasItem = Val(GetVar(filename, "Event" & i & "Page" & x, "chkHasItem"))
+ .PlayerVarNum = Val(GetVar(filename, "Event" & i & "Page" & x, "PlayerVarNum"))
+ .SelfSwitchNum = Val(GetVar(filename, "Event" & i & "Page" & x, "SelfSwitchNum"))
+ .HasItemNum = Val(GetVar(filename, "Event" & i & "Page" & x, "HasItemNum"))
+ .PlayerVariable = Val(GetVar(filename, "Event" & i & "Page" & x, "PlayerVariable"))
+ .GraphicType = Val(GetVar(filename, "Event" & i & "Page" & x, "GraphicType"))
+ .Graphic = Val(GetVar(filename, "Event" & i & "Page" & x, "Graphic"))
+ .GraphicX = Val(GetVar(filename, "Event" & i & "Page" & x, "GraphicX"))
+ .GraphicY = Val(GetVar(filename, "Event" & i & "Page" & x, "GraphicY"))
+ .MoveType = Val(GetVar(filename, "Event" & i & "Page" & x, "MoveType"))
+ .MoveSpeed = Val(GetVar(filename, "Event" & i & "Page" & x, "MoveSpeed"))
+ .MoveFreq = Val(GetVar(filename, "Event" & i & "Page" & x, "MoveFreq"))
+ .WalkAnim = Val(GetVar(filename, "Event" & i & "Page" & x, "WalkAnim"))
+ .StepAnim = Val(GetVar(filename, "Event" & i & "Page" & x, "StepAnim"))
+ .DirFix = Val(GetVar(filename, "Event" & i & "Page" & x, "DirFix"))
+ .WalkThrough = Val(GetVar(filename, "Event" & i & "Page" & x, "WalkThrough"))
+ .Priority = Val(GetVar(filename, "Event" & i & "Page" & x, "Priority"))
+ .Trigger = Val(GetVar(filename, "Event" & i & "Page" & x, "Trigger"))
+ .CommandCount = Val(GetVar(filename, "Event" & i & "Page" & x, "CommandCount"))
+ End With
+ If map.TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ ReDim Preserve map.TileData.Events(i).EventPage(x).Commands(1 To map.TileData.Events(i).EventPage(x).CommandCount)
+ For y = 1 To map.TileData.Events(i).EventPage(x).CommandCount
+ With map.TileData.Events(i).EventPage(x).Commands(y)
+ .Type = GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Type")
+ .text = GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Text")
+ .colour = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Colour"))
+ .channel = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Channel"))
+ .TargetType = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "TargetType"))
+ .target = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Target"))
+ .x = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "x"))
+ .y = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "y"))
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ ' dump tile data
+ filename = App.path & MAP_PATH & mapNum & ".dat"
+ f = FreeFile
+
+ ReDim map.TileData.Tile(0 To map.MapData.MaxX, 0 To map.MapData.MaxY) As TileRec
+
+ With map
+ Open filename For Binary As #f
+ For x = 0 To .MapData.MaxX
+ For y = 0 To .MapData.MaxY
+ Get #f, , .TileData.Tile(x, y).Type
+ Get #f, , .TileData.Tile(x, y).Data1
+ Get #f, , .TileData.Tile(x, y).Data2
+ Get #f, , .TileData.Tile(x, y).Data3
+ Get #f, , .TileData.Tile(x, y).Data4
+ Get #f, , .TileData.Tile(x, y).Data5
+ Get #f, , .TileData.Tile(x, y).Autotile
+ Get #f, , .TileData.Tile(x, y).DirBlock
+ For i = 1 To MapLayer.Layer_Count - 1
+ Get #f, , .TileData.Tile(x, y).Layer(i).Tileset
+ Get #f, , .TileData.Tile(x, y).Layer(i).x
+ Get #f, , .TileData.Tile(x, y).Layer(i).y
+ Next
+ Next
+ Next
+ Close #f
+ End With
+
+ ClearTempTile
+End Sub
+
+Sub ClearPlayer(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Player(index)), LenB(Player(index)))
+ Player(index).name = vbNullString
+End Sub
+
+Sub ClearItem(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Item(index)), LenB(Item(index)))
+ Item(index).name = vbNullString
+ Item(index).Desc = vbNullString
+ Item(index).sound = "None."
+End Sub
+
+Sub ClearItems()
+ Dim i As Long
+
+ For i = 1 To MAX_ITEMS
+ Call ClearItem(i)
+ Next
+
+End Sub
+
+Sub ClearAnimInstance(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(AnimInstance(index)), LenB(AnimInstance(index)))
+End Sub
+
+Sub ClearAnimation(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Animation(index)), LenB(Animation(index)))
+ Animation(index).name = vbNullString
+ Animation(index).sound = "None."
+End Sub
+
+Sub ClearAnimations()
+ Dim i As Long
+
+ For i = 1 To MAX_ANIMATIONS
+ Call ClearAnimation(i)
+ Next
+
+End Sub
+
+Sub ClearNPC(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Npc(index)), LenB(Npc(index)))
+ Npc(index).name = vbNullString
+ Npc(index).sound = "None."
+End Sub
+
+Sub ClearNpcs()
+ Dim i As Long
+
+ For i = 1 To MAX_NPCS
+ Call ClearNPC(i)
+ Next
+
+End Sub
+
+Sub ClearSpell(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Spell(index)), LenB(Spell(index)))
+ Spell(index).name = vbNullString
+ Spell(index).Desc = vbNullString
+ Spell(index).sound = "None."
+End Sub
+
+Sub ClearSpells()
+ Dim i As Long
+
+ For i = 1 To MAX_SPELLS
+ Call ClearSpell(i)
+ Next
+
+End Sub
+
+Sub ClearShop(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Shop(index)), LenB(Shop(index)))
+ Shop(index).name = vbNullString
+End Sub
+
+Sub ClearShops()
+ Dim i As Long
+
+ For i = 1 To MAX_SHOPS
+ Call ClearShop(i)
+ Next
+
+End Sub
+
+Sub ClearResource(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Resource(index)), LenB(Resource(index)))
+ Resource(index).name = vbNullString
+ Resource(index).SuccessMessage = vbNullString
+ Resource(index).EmptyMessage = vbNullString
+ Resource(index).sound = "None."
+End Sub
+
+Sub ClearResources()
+ Dim i As Long
+
+ For i = 1 To MAX_RESOURCES
+ Call ClearResource(i)
+ Next
+
+End Sub
+
+Sub ClearMapItem(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(MapItem(index)), LenB(MapItem(index)))
+End Sub
+
+Sub ClearMap()
+ Call ZeroMemory(ByVal VarPtr(map), LenB(map))
+ map.MapData.name = vbNullString
+ map.MapData.MaxX = MAX_MAPX
+ map.MapData.MaxY = MAX_MAPY
+ ReDim map.TileData.Tile(0 To map.MapData.MaxX, 0 To map.MapData.MaxY)
+ initAutotiles
+End Sub
+
+Sub ClearMapItems()
+ Dim i As Long
+
+ For i = 1 To MAX_MAP_ITEMS
+ Call ClearMapItem(i)
+ Next
+
+End Sub
+
+Sub ClearMapNpc(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(MapNpc(index)), LenB(MapNpc(index)))
+End Sub
+
+Sub ClearMapNpcs()
+ Dim i As Long
+
+ For i = 1 To MAX_MAP_NPCS
+ Call ClearMapNpc(i)
+ Next
+
+End Sub
+
+' **********************
+' ** Player functions **
+' **********************
+Function GetPlayerName(ByVal index As Long) As String
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerName = Trim$(Player(index).name)
+End Function
+
+Sub SetPlayerName(ByVal index As Long, ByVal name As String)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).name = name
+End Sub
+
+Function GetPlayerClass(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerClass = Player(index).Class
+End Function
+
+Sub SetPlayerClass(ByVal index As Long, ByVal ClassNum As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).Class = ClassNum
+End Sub
+
+Function GetPlayerSprite(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerSprite = Player(index).sprite
+End Function
+
+Sub SetPlayerSprite(ByVal index As Long, ByVal sprite As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).sprite = sprite
+End Sub
+
+Function GetPlayerLevel(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerLevel = Player(index).Level
+End Function
+
+Sub SetPlayerLevel(ByVal index As Long, ByVal Level As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).Level = Level
+End Sub
+
+Function GetPlayerExp(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerExp = Player(index).EXP
+End Function
+
+Sub SetPlayerExp(ByVal index As Long, ByVal EXP As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).EXP = EXP
+End Sub
+
+Function GetPlayerAccess(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerAccess = Player(index).Access
+End Function
+
+Sub SetPlayerAccess(ByVal index As Long, ByVal Access As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).Access = Access
+End Sub
+
+Function GetPlayerPK(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerPK = Player(index).PK
+End Function
+
+Sub SetPlayerPK(ByVal index As Long, ByVal PK As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).PK = PK
+End Sub
+
+Function GetPlayerVital(ByVal index As Long, ByVal Vital As Vitals) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerVital = Player(index).Vital(Vital)
+End Function
+
+Sub SetPlayerVital(ByVal index As Long, ByVal Vital As Vitals, ByVal value As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).Vital(Vital) = value
+
+ If GetPlayerVital(index, Vital) > GetPlayerMaxVital(index, Vital) Then
+ Player(index).Vital(Vital) = GetPlayerMaxVital(index, Vital)
+ End If
+
+End Sub
+
+Function GetPlayerMaxVital(ByVal index As Long, ByVal Vital As Vitals) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerMaxVital = Player(index).MaxVital(Vital)
+End Function
+
+Function GetPlayerStat(ByVal index As Long, Stat As Stats) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerStat = Player(index).Stat(Stat)
+End Function
+
+Sub SetPlayerStat(ByVal index As Long, Stat As Stats, ByVal value As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ If value <= 0 Then value = 1
+ If value > MAX_BYTE Then value = MAX_BYTE
+ Player(index).Stat(Stat) = value
+End Sub
+
+Function GetPlayerPOINTS(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerPOINTS = Player(index).POINTS
+End Function
+
+Sub SetPlayerPOINTS(ByVal index As Long, ByVal POINTS As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).POINTS = POINTS
+End Sub
+
+Function GetPlayerMap(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Or index <= 0 Then Exit Function
+ GetPlayerMap = Player(index).map
+End Function
+
+Sub SetPlayerMap(ByVal index As Long, ByVal mapNum As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).map = mapNum
+End Sub
+
+Function GetPlayerX(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerX = Player(index).x
+End Function
+
+Sub SetPlayerX(ByVal index As Long, ByVal x As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).x = x
+End Sub
+
+Function GetPlayerY(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerY = Player(index).y
+End Function
+
+Sub SetPlayerY(ByVal index As Long, ByVal y As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).y = y
+End Sub
+
+Function GetPlayerDir(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerDir = Player(index).dir
+End Function
+
+Sub SetPlayerDir(ByVal index As Long, ByVal dir As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ Player(index).dir = dir
+End Sub
+
+Function GetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ If invSlot = 0 Then Exit Function
+ GetPlayerInvItemNum = PlayerInv(invSlot).num
+End Function
+
+Sub SetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long, ByVal itemNum As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ PlayerInv(invSlot).num = itemNum
+End Sub
+
+Function GetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerInvItemValue = PlayerInv(invSlot).value
+End Function
+
+Sub SetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long, ByVal ItemValue As Long)
+
+ If index > MAX_PLAYERS Then Exit Sub
+ PlayerInv(invSlot).value = ItemValue
+End Sub
+
+Function GetPlayerEquipment(ByVal index As Long, ByVal EquipmentSlot As Equipment) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerEquipment = Player(index).Equipment(EquipmentSlot)
+End Function
+
+Sub SetPlayerEquipment(ByVal index As Long, ByVal invNum As Long, ByVal EquipmentSlot As Equipment)
+
+ If index < 1 Or index > MAX_PLAYERS Then Exit Sub
+ Player(index).Equipment(EquipmentSlot) = invNum
+End Sub
+
+Sub ClearConv(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Conv(index)), LenB(Conv(index)))
+ Conv(index).name = vbNullString
+ ReDim Conv(index).Conv(1)
+End Sub
+
+Sub ClearConvs()
+ Dim i As Long
+
+ For i = 1 To MAX_CONVS
+ Call ClearConv(i)
+ Next
+
+End Sub
diff --git a/client/src/modDirectDraw7.bas b/client/src/modDirectDraw7.bas
new file mode 100644
index 0000000..fede699
--- /dev/null
+++ b/client/src/modDirectDraw7.bas
@@ -0,0 +1,3481 @@
+Attribute VB_Name = "modDirectDraw7"
+Option Explicit
+' **********************
+' ** Renders graphics **
+' **********************
+' DirectDraw7 Object
+Public DD As DirectDraw7
+' Clipper object
+Public DD_Clip As DirectDrawClipper
+
+' primary surface
+Public DDS_Primary As DirectDrawSurface7
+Public DDSD_Primary As DDSURFACEDESC2
+
+' back buffer
+Public DDS_BackBuffer As DirectDrawSurface7
+Public DDSD_BackBuffer As DDSURFACEDESC2
+
+' Used for pre-rendering
+Public DDS_Map As DirectDrawSurface7
+Public DDSD_Map As DDSURFACEDESC2
+
+' gfx buffers
+Public DDS_Item() As DirectDrawSurface7 ' arrays
+Public DDS_Character() As DirectDrawSurface7
+Public DDS_Paperdoll() As DirectDrawSurface7
+Public DDS_Tileset() As DirectDrawSurface7
+Public DDS_Resource() As DirectDrawSurface7
+Public DDS_Animation() As DirectDrawSurface7
+Public DDS_SpellIcon() As DirectDrawSurface7
+Public DDS_Face() As DirectDrawSurface7
+Public DDS_Door As DirectDrawSurface7 ' singes
+Public DDS_Blood As DirectDrawSurface7
+Public DDS_Misc As DirectDrawSurface7
+Public DDS_Direction As DirectDrawSurface7
+Public DDS_Target As DirectDrawSurface7
+Public DDS_Bars As DirectDrawSurface7
+
+' descriptions
+Public DDSD_Temp As DDSURFACEDESC2 ' arrays
+Public DDSD_Item() As DDSURFACEDESC2
+Public DDSD_Character() As DDSURFACEDESC2
+Public DDSD_Paperdoll() As DDSURFACEDESC2
+Public DDSD_Tileset() As DDSURFACEDESC2
+Public DDSD_Resource() As DDSURFACEDESC2
+Public DDSD_Animation() As DDSURFACEDESC2
+Public DDSD_SpellIcon() As DDSURFACEDESC2
+Public DDSD_Face() As DDSURFACEDESC2
+Public DDSD_Door As DDSURFACEDESC2 ' singles
+Public DDSD_Blood As DDSURFACEDESC2
+Public DDSD_Misc As DDSURFACEDESC2
+Public DDSD_Direction As DDSURFACEDESC2
+Public DDSD_Target As DDSURFACEDESC2
+Public DDSD_Bars As DDSURFACEDESC2
+
+' timers
+Public Const SurfaceTimerMax As Long = 10000
+Public CharacterTimer() As Long
+Public PaperdollTimer() As Long
+Public ItemTimer() As Long
+Public ResourceTimer() As Long
+Public AnimationTimer() As Long
+Public SpellIconTimer() As Long
+Public FaceTimer() As Long
+
+' Number of graphic files
+Public NumTileSets As Long
+Public NumCharacters As Long
+Public NumPaperdolls As Long
+Public NumItems As Long
+Public NumResources As Long
+Public NumAnimations As Long
+Public NumSpellIcons As Long
+Public NumFaces As Long
+
+' ********************
+' ** Initialization **
+' ********************
+Public Function InitDirectDraw() As Boolean
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' Clear DD7
+ Call DestroyDirectDraw
+
+ ' Init Direct Draw
+ Set DD = DX7.DirectDrawCreate(vbNullString)
+
+ ' Windowed
+ DD.SetCooperativeLevel frmMain.hWnd, DDSCL_NORMAL
+
+ ' Init type and set the primary surface
+ With DDSD_Primary
+ .lFlags = DDSD_CAPS
+ .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
+ .lBackBufferCount = 1
+ End With
+ Set DDS_Primary = DD.CreateSurface(DDSD_Primary)
+
+ ' Create the clipper
+ Set DD_Clip = DD.CreateClipper(0)
+
+ ' Associate the picture hwnd with the clipper
+ DD_Clip.SetHWnd frmMain.picScreen.hWnd
+
+ ' Have the blits to the screen clipped to the picture box
+ DDS_Primary.SetClipper DD_Clip
+
+ ' Initialise the surfaces
+ InitSurfaces
+
+ ' We're done
+ InitDirectDraw = True
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "InitDirectDraw", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Private Sub InitSurfaces()
+Dim rec As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' DirectDraw Surface memory management setting
+ DDSD_Temp.lFlags = DDSD_CAPS
+ DDSD_Temp.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+
+ ' clear out everything for re-init
+ Set DDS_BackBuffer = Nothing
+
+ ' Initialize back buffer
+ With DDSD_BackBuffer
+ .lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
+ .ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps
+ .lWidth = (MAX_MAPX + 3) * PIC_X
+ .lHeight = (MAX_MAPY + 3) * PIC_Y
+ End With
+ Set DDS_BackBuffer = DD.CreateSurface(DDSD_BackBuffer)
+
+ ' load persistent surfaces
+ If FileExist(App.Path & "\data files\graphics\door.bmp", True) Then Call InitDDSurf("door", DDSD_Door, DDS_Door)
+ If FileExist(App.Path & "\data files\graphics\direction.bmp", True) Then Call InitDDSurf("direction", DDSD_Direction, DDS_Direction)
+ If FileExist(App.Path & "\data files\graphics\target.bmp", True) Then Call InitDDSurf("target", DDSD_Target, DDS_Target)
+ If FileExist(App.Path & "\data files\graphics\misc.bmp", True) Then Call InitDDSurf("misc", DDSD_Misc, DDS_Misc)
+ If FileExist(App.Path & "\data files\graphics\blood.bmp", True) Then Call InitDDSurf("blood", DDSD_Blood, DDS_Blood)
+ If FileExist(App.Path & "\data files\graphics\bars.bmp", True) Then Call InitDDSurf("bars", DDSD_Bars, DDS_Bars)
+
+ ' count the blood sprites
+ BloodCount = DDSD_Blood.lWidth / 32
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "InitSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' This sub gets the mask color from the surface loaded from a bitmap image
+Public Sub SetMaskColorFromPixel(ByRef TheSurface As DirectDrawSurface7, ByVal x As Long, ByVal y As Long)
+Dim TmpR As RECT
+Dim TmpDDSD As DDSURFACEDESC2
+Dim TmpColorKey As DDCOLORKEY
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ With TmpR
+ .Left = x
+ .top = y
+ .Right = x
+ .Bottom = y
+ End With
+
+ TheSurface.Lock TmpR, TmpDDSD, DDLOCK_WAIT Or DDLOCK_READONLY, 0
+
+ With TmpColorKey
+ .Low = TheSurface.GetLockedPixel(x, y)
+ .High = .Low
+ End With
+
+ TheSurface.SetColorKey DDCKEY_SRCBLT, TmpColorKey
+ TheSurface.Unlock TmpR
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "SetMaskColorFromPixel", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' Initializing a surface, using a bitmap
+Public Sub InitDDSurf(fileName As String, ByRef SurfDesc As DDSURFACEDESC2, ByRef Surf As DirectDrawSurface7)
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' Set path
+ fileName = App.Path & GFX_PATH & fileName & GFX_EXT
+
+ ' Destroy surface if it exist
+ If Not Surf Is Nothing Then
+ Set Surf = Nothing
+ Call ZeroMemory(ByVal VarPtr(SurfDesc), LenB(SurfDesc))
+ End If
+
+ ' set flags
+ SurfDesc.lFlags = DDSD_CAPS
+ SurfDesc.ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps
+
+ ' init object
+ Set Surf = DD.CreateSurfaceFromFile(fileName, SurfDesc)
+
+ ' Set mask
+ Call SetMaskColorFromPixel(Surf, 0, 0)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "InitDDSurf", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Function CheckSurfaces() As Boolean
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' Check if we need to restore surfaces
+ If Not DD.TestCooperativeLevel = DD_OK Then
+ CheckSurfaces = False
+ Else
+ CheckSurfaces = True
+ End If
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "CheckSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Private Function NeedToRestoreSurfaces() As Boolean
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not DD.TestCooperativeLevel = DD_OK Then
+ NeedToRestoreSurfaces = True
+ End If
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "NeedToRestoreSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Public Sub ReInitDD()
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Call InitDirectDraw
+
+ LoadTilesets
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "ReInitDD", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub DestroyDirectDraw()
+Dim i As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' Unload DirectDraw
+ Set DDS_Misc = Nothing
+
+ For i = 1 To NumTileSets
+ Set DDS_Tileset(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Tileset(i)), LenB(DDSD_Tileset(i))
+ Next
+
+ For i = 1 To NumItems
+ Set DDS_Item(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Item(i)), LenB(DDSD_Item(i))
+ Next
+
+ For i = 1 To NumCharacters
+ Set DDS_Character(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Character(i)), LenB(DDSD_Character(i))
+ Next
+
+ For i = 1 To NumPaperdolls
+ Set DDS_Paperdoll(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Paperdoll(i)), LenB(DDSD_Paperdoll(i))
+ Next
+
+ For i = 1 To NumResources
+ Set DDS_Resource(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Resource(i)), LenB(DDSD_Resource(i))
+ Next
+
+ For i = 1 To NumAnimations
+ Set DDS_Animation(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Animation(i)), LenB(DDSD_Animation(i))
+ Next
+
+ For i = 1 To NumSpellIcons
+ Set DDS_SpellIcon(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_SpellIcon(i)), LenB(DDSD_SpellIcon(i))
+ Next
+
+ For i = 1 To NumFaces
+ Set DDS_Face(i) = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i))
+ Next
+
+ Set DDS_Blood = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Blood), LenB(DDSD_Blood)
+
+ Set DDS_Door = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Door), LenB(DDSD_Door)
+
+ Set DDS_Direction = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Direction), LenB(DDSD_Direction)
+
+ Set DDS_Target = Nothing
+ ZeroMemory ByVal VarPtr(DDSD_Target), LenB(DDSD_Target)
+
+ Set DDS_BackBuffer = Nothing
+ Set DDS_Primary = Nothing
+ Set DD_Clip = Nothing
+ Set DD = Nothing
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "DestroyDirectDraw", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' **************
+' ** Blitting **
+' **************
+Public Sub Engine_BltFast(ByVal dx As Long, ByVal dy As Long, ByRef ddS As DirectDrawSurface7, srcRECT As RECT, trans As CONST_DDBLTFASTFLAGS)
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+
+ If Not ddS Is Nothing Then
+ Call DDS_BackBuffer.BltFast(dx, dy, ddS, srcRECT, trans)
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "Engine_BltFast", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Function Engine_BltToDC(ByRef Surface As DirectDrawSurface7, sRECT As DxVBLib.RECT, dRECT As DxVBLib.RECT, ByRef picBox As VB.PictureBox, Optional Clear As Boolean = True) As Boolean
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Clear Then
+ picBox.Cls
+ End If
+
+ Call Surface.BltToDC(picBox.hDC, sRECT, dRECT)
+ picBox.Refresh
+ Engine_BltToDC = True
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "Engine_BltToDC", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Public Sub BltDirection(ByVal x As Long, ByVal y As Long)
+Dim rec As DxVBLib.RECT
+Dim i As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' render grid
+ rec.top = 24
+ rec.Left = 0
+ rec.Right = rec.Left + 32
+ rec.Bottom = rec.top + 32
+ Call Engine_BltFast(ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), DDS_Direction, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' render dir blobs
+ For i = 1 To 4
+ rec.Left = (i - 1) * 8
+ rec.Right = rec.Left + 8
+ ' find out whether render blocked or not
+ If Not isDirBlocked(Map.Tile(x, y).DirBlock, CByte(i)) Then
+ rec.top = 8
+ Else
+ rec.top = 16
+ End If
+ rec.Bottom = rec.top + 8
+ 'render!
+ Call Engine_BltFast(ConvertMapX(x * PIC_X) + DirArrowX(i), ConvertMapY(y * PIC_Y) + DirArrowY(i), DDS_Direction, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltDirection", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltTarget(ByVal x As Long, ByVal y As Long)
+Dim sRECT As DxVBLib.RECT
+Dim width As Long, height As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If DDS_Target Is Nothing Then Exit Sub
+
+ width = DDSD_Target.lWidth / 2
+ height = DDSD_Target.lHeight
+
+ With sRECT
+ .top = 0
+ .Bottom = height
+ .Left = 0
+ .Right = width
+ End With
+
+ x = x - ((width - 32) / 2)
+ y = y - (height / 2)
+
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+
+ ' clipping
+ If y < 0 Then
+ With sRECT
+ .top = .top - y
+ End With
+ y = 0
+ End If
+
+ If x < 0 Then
+ With sRECT
+ .Left = .Left - x
+ End With
+ x = 0
+ End If
+
+ If y + height > DDSD_BackBuffer.lHeight Then
+ sRECT.Bottom = sRECT.Bottom - (y + height - DDSD_BackBuffer.lHeight)
+ End If
+
+ If x + width > DDSD_BackBuffer.lWidth Then
+ sRECT.Right = sRECT.Right - (x + width - DDSD_BackBuffer.lWidth)
+ End If
+ ' /clipping
+
+ Call Engine_BltFast(x, y, DDS_Target, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltTarget", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltHover(ByVal tType As Long, ByVal target As Long, ByVal x As Long, ByVal y As Long)
+Dim sRECT As DxVBLib.RECT
+Dim width As Long, height As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If DDS_Target Is Nothing Then Exit Sub
+
+ width = DDSD_Target.lWidth / 2
+ height = DDSD_Target.lHeight
+
+ With sRECT
+ .top = 0
+ .Bottom = height
+ .Left = width
+ .Right = .Left + width
+ End With
+
+ x = x - ((width - 32) / 2)
+ y = y - (height / 2)
+
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+
+ ' clipping
+ If y < 0 Then
+ With sRECT
+ .top = .top - y
+ End With
+ y = 0
+ End If
+
+ If x < 0 Then
+ With sRECT
+ .Left = .Left - x
+ End With
+ x = 0
+ End If
+
+ If y + height > DDSD_BackBuffer.lHeight Then
+ sRECT.Bottom = sRECT.Bottom - (y + height - DDSD_BackBuffer.lHeight)
+ End If
+
+ If x + width > DDSD_BackBuffer.lWidth Then
+ sRECT.Right = sRECT.Right - (x + width - DDSD_BackBuffer.lWidth)
+ End If
+ ' /clipping
+
+ Call Engine_BltFast(x, y, DDS_Target, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltHover", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltMapTile(ByVal x As Long, ByVal y As Long)
+Dim rec As DxVBLib.RECT
+Dim i As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ With Map.Tile(x, y)
+ For i = MapLayer.Ground To MapLayer.Mask2
+ ' skip tile?
+ If (.Layer(i).Tileset > 0 And .Layer(i).Tileset <= NumTileSets) And (.Layer(i).x > 0 Or .Layer(i).y > 0) Then
+ ' sort out rec
+ rec.top = .Layer(i).y * PIC_Y
+ rec.Bottom = rec.top + PIC_Y
+ rec.Left = .Layer(i).x * PIC_X
+ rec.Right = rec.Left + PIC_X
+ ' render
+ Call Engine_BltFast(ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), DDS_Tileset(.Layer(i).Tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+ End If
+ Next
+ End With
+
+ ' Error handler
+ Exit Sub
+
+errorhandler:
+ HandleError "BltMapTile", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltMapFringeTile(ByVal x As Long, ByVal y As Long)
+Dim rec As DxVBLib.RECT
+Dim i As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ With Map.Tile(x, y)
+ For i = MapLayer.Fringe To MapLayer.Fringe2
+ ' skip tile if tileset isn't set
+ If (.Layer(i).Tileset > 0 And .Layer(i).Tileset <= NumTileSets) And (.Layer(i).x > 0 Or .Layer(i).y > 0) Then
+ ' sort out rec
+ rec.top = .Layer(i).y * PIC_Y
+ rec.Bottom = rec.top + PIC_Y
+ rec.Left = .Layer(i).x * PIC_X
+ rec.Right = rec.Left + PIC_X
+ ' render
+ Call Engine_BltFast(ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), DDS_Tileset(.Layer(i).Tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+ End If
+ Next
+ End With
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltMapFringeTile", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltDoor(ByVal x As Long, ByVal y As Long)
+Dim rec As DxVBLib.RECT
+Dim x2 As Long, y2 As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' sort out animation
+ With TempTile(x, y)
+ If .DoorAnimate = 1 Then ' opening
+ If .DoorTimer + 100 < GetTickCount Then
+ If .DoorFrame < 4 Then
+ .DoorFrame = .DoorFrame + 1
+ Else
+ .DoorAnimate = 2 ' set to closing
+ End If
+ .DoorTimer = GetTickCount
+ End If
+ ElseIf .DoorAnimate = 2 Then ' closing
+ If .DoorTimer + 100 < GetTickCount Then
+ If .DoorFrame > 1 Then
+ .DoorFrame = .DoorFrame - 1
+ Else
+ .DoorAnimate = 0 ' end animation
+ End If
+ .DoorTimer = GetTickCount
+ End If
+ End If
+
+ If .DoorFrame = 0 Then .DoorFrame = 1
+ End With
+
+ With rec
+ .top = 0
+ .Bottom = DDSD_Door.lHeight
+ .Left = ((TempTile(x, y).DoorFrame - 1) * (DDSD_Door.lWidth / 4))
+ .Right = .Left + (DDSD_Door.lWidth / 4)
+ End With
+
+ x2 = (x * PIC_X)
+ y2 = (y * PIC_Y) - (DDSD_Door.lHeight / 2) + 4
+ Call DDS_BackBuffer.BltFast(ConvertMapX(x2), ConvertMapY(y2), DDS_Door, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltDoor", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltBlood(ByVal Index As Long)
+Dim rec As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ With Blood(Index)
+ ' check if we should be seeing it
+ If .Timer + 20000 < GetTickCount Then Exit Sub
+
+ rec.top = 0
+ rec.Bottom = PIC_Y
+ rec.Left = (.Sprite - 1) * PIC_X
+ rec.Right = rec.Left + PIC_X
+
+ Engine_BltFast ConvertMapX(.x * PIC_X), ConvertMapY(.y * PIC_Y), DDS_Blood, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End With
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltBlood", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltAnimation(ByVal Index As Long, ByVal Layer As Long)
+Dim Sprite As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+Dim i As Long
+Dim width As Long, height As Long
+Dim looptime As Long
+Dim FrameCount As Long
+Dim x As Long, y As Long
+Dim lockindex As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If AnimInstance(Index).Animation = 0 Then
+ ClearAnimInstance Index
+ Exit Sub
+ End If
+
+ Sprite = Animation(AnimInstance(Index).Animation).Sprite(Layer)
+
+ If Sprite < 1 Or Sprite > NumAnimations Then Exit Sub
+
+ FrameCount = Animation(AnimInstance(Index).Animation).Frames(Layer)
+
+ AnimationTimer(Sprite) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Animation(Sprite) Is Nothing Then
+ Call InitDDSurf("animations\" & Sprite, DDSD_Animation(Sprite), DDS_Animation(Sprite))
+ End If
+
+ ' total width divided by frame count
+ width = DDSD_Animation(Sprite).lWidth / FrameCount
+ height = DDSD_Animation(Sprite).lHeight
+
+ sRECT.top = 0
+ sRECT.Bottom = height
+ sRECT.Left = (AnimInstance(Index).FrameIndex(Layer) - 1) * width
+ sRECT.Right = sRECT.Left + width
+
+ ' change x or y if locked
+ If AnimInstance(Index).LockType > TARGET_TYPE_NONE Then ' if <> none
+ ' is a player
+ If AnimInstance(Index).LockType = TARGET_TYPE_PLAYER Then
+ ' quick save the index
+ lockindex = AnimInstance(Index).lockindex
+ ' check if is ingame
+ If IsPlaying(lockindex) Then
+ ' check if on same map
+ If GetPlayerMap(lockindex) = GetPlayerMap(MyIndex) Then
+ ' is on map, is playing, set x & y
+ x = (GetPlayerX(lockindex) * PIC_X) + 16 - (width / 2) + Player(lockindex).XOffset
+ y = (GetPlayerY(lockindex) * PIC_Y) + 16 - (height / 2) + Player(lockindex).YOffset
+ End If
+ End If
+ ElseIf AnimInstance(Index).LockType = TARGET_TYPE_NPC Then
+ ' quick save the index
+ lockindex = AnimInstance(Index).lockindex
+ ' check if NPC exists
+ If MapNpc(lockindex).num > 0 Then
+ ' check if alive
+ If MapNpc(lockindex).Vital(Vitals.HP) > 0 Then
+ ' exists, is alive, set x & y
+ x = (MapNpc(lockindex).x * PIC_X) + 16 - (width / 2) + MapNpc(lockindex).XOffset
+ y = (MapNpc(lockindex).y * PIC_Y) + 16 - (height / 2) + MapNpc(lockindex).YOffset
+ Else
+ ' npc not alive anymore, kill the animation
+ ClearAnimInstance Index
+ Exit Sub
+ End If
+ Else
+ ' npc not alive anymore, kill the animation
+ ClearAnimInstance Index
+ Exit Sub
+ End If
+ End If
+ Else
+ ' no lock, default x + y
+ x = (AnimInstance(Index).x * 32) + 16 - (width / 2)
+ y = (AnimInstance(Index).y * 32) + 16 - (height / 2)
+ End If
+
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+
+ ' Clip to screen
+ If y < 0 Then
+
+ With sRECT
+ .top = .top - y
+ End With
+
+ y = 0
+ End If
+
+ If x < 0 Then
+
+ With sRECT
+ .Left = .Left - x
+ End With
+
+ x = 0
+ End If
+
+ If y + height > DDSD_BackBuffer.lHeight Then
+ sRECT.Bottom = sRECT.Bottom - (y + height - DDSD_BackBuffer.lHeight)
+ End If
+
+ If x + width > DDSD_BackBuffer.lWidth Then
+ sRECT.Right = sRECT.Right - (x + width - DDSD_BackBuffer.lWidth)
+ End If
+
+ Call Engine_BltFast(x, y, DDS_Animation(Sprite), sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltAnimation", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltItem(ByVal itemnum As Long)
+Dim PicNum As Long
+Dim rec As DxVBLib.RECT
+Dim MaxFrames As Byte
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' if it's not us then don't render
+ If MapItem(itemnum).playerName <> vbNullString Then
+ If MapItem(itemnum).playerName <> Trim$(GetPlayerName(MyIndex)) Then Exit Sub
+ End If
+
+ ' get the picture
+ PicNum = Item(MapItem(itemnum).num).Pic
+
+ If PicNum < 1 Or PicNum > NumItems Then Exit Sub
+ ItemTimer(PicNum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(PicNum) Is Nothing Then
+ Call InitDDSurf("items\" & PicNum, DDSD_Item(PicNum), DDS_Item(PicNum))
+ End If
+
+ If DDSD_Item(PicNum).lWidth > 64 Then ' has more than 1 frame
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = (MapItem(itemnum).Frame * 32)
+ .Right = .Left + 32
+ End With
+ Else
+ With rec
+ .top = 0
+ .Bottom = PIC_Y
+ .Left = 0
+ .Right = PIC_X
+ End With
+ End If
+
+ Call Engine_BltFast(ConvertMapX(MapItem(itemnum).x * PIC_X), ConvertMapY(MapItem(itemnum).y * PIC_Y), DDS_Item(PicNum), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltItem", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub ScreenshotMap()
+Dim x As Long, y As Long, i As Long, rec As RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' clear the surface
+ Set DDS_Map = Nothing
+
+ ' Initialize it
+ With DDSD_Map
+ .lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
+ .ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps
+ .lWidth = (Map.MaxX + 1) * 32
+ .lHeight = (Map.MaxY + 1) * 32
+ End With
+ Set DDS_Map = DD.CreateSurface(DDSD_Map)
+
+ ' render the tiles
+ For x = 0 To Map.MaxX
+ For y = 0 To Map.MaxY
+ With Map.Tile(x, y)
+ For i = MapLayer.Ground To MapLayer.Mask2
+ ' skip tile?
+ If (.Layer(i).Tileset > 0 And .Layer(i).Tileset <= NumTileSets) And (.Layer(i).x > 0 Or .Layer(i).y > 0) Then
+ ' sort out rec
+ rec.top = .Layer(i).y * PIC_Y
+ rec.Bottom = rec.top + PIC_Y
+ rec.Left = .Layer(i).x * PIC_X
+ rec.Right = rec.Left + PIC_X
+ ' render
+ DDS_Map.BltFast x * PIC_X, y * PIC_Y, DDS_Tileset(.Layer(i).Tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End If
+ Next
+ End With
+ Next
+ Next
+
+ ' render the resources
+ For y = 0 To Map.MaxY
+ If NumResources > 0 Then
+ If Resources_Init Then
+ If Resource_Index > 0 Then
+ For i = 1 To Resource_Index
+ If MapResource(i).y = y Then
+ Call BltMapResource(i, True)
+ End If
+ Next
+ End If
+ End If
+ End If
+ Next
+
+ ' render the tiles
+ For x = 0 To Map.MaxX
+ For y = 0 To Map.MaxY
+ With Map.Tile(x, y)
+ For i = MapLayer.Fringe To MapLayer.Fringe2
+ ' skip tile?
+ If (.Layer(i).Tileset > 0 And .Layer(i).Tileset <= NumTileSets) And (.Layer(i).x > 0 Or .Layer(i).y > 0) Then
+ ' sort out rec
+ rec.top = .Layer(i).y * PIC_Y
+ rec.Bottom = rec.top + PIC_Y
+ rec.Left = .Layer(i).x * PIC_X
+ rec.Right = rec.Left + PIC_X
+ ' render
+ DDS_Map.BltFast x * PIC_X, y * PIC_Y, DDS_Tileset(.Layer(i).Tileset), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End If
+ Next
+ End With
+ Next
+ Next
+
+ ' dump and save
+ frmMain.picSSMap.width = DDSD_Map.lWidth
+ frmMain.picSSMap.height = DDSD_Map.lHeight
+ rec.top = 0
+ rec.Left = 0
+ rec.Bottom = DDSD_Map.lHeight
+ rec.Right = DDSD_Map.lWidth
+ Engine_BltToDC DDS_Map, rec, rec, frmMain.picSSMap
+ SavePicture frmMain.picSSMap.Image, App.Path & "\map" & GetPlayerMap(MyIndex) & ".jpg"
+
+ ' let them know we did it
+ AddText "Screenshot of map #" & GetPlayerMap(MyIndex) & " saved.", BrightGreen
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "ScreenshotMap", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltMapResource(ByVal Resource_num As Long, Optional ByVal screenShot As Boolean = False)
+Dim Resource_master As Long
+Dim Resource_state As Long
+Dim Resource_sprite As Long
+Dim rec As DxVBLib.RECT
+Dim x As Long, y As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' make sure it's not out of map
+ If MapResource(Resource_num).x > Map.MaxX Then Exit Sub
+ If MapResource(Resource_num).y > Map.MaxY Then Exit Sub
+
+ ' Get the Resource type
+ Resource_master = Map.Tile(MapResource(Resource_num).x, MapResource(Resource_num).y).Data1
+
+ If Resource_master = 0 Then Exit Sub
+
+ If Resource(Resource_master).ResourceImage = 0 Then Exit Sub
+ ' Get the Resource state
+ Resource_state = MapResource(Resource_num).ResourceState
+
+ If Resource_state = 0 Then ' normal
+ Resource_sprite = Resource(Resource_master).ResourceImage
+ ElseIf Resource_state = 1 Then ' used
+ Resource_sprite = Resource(Resource_master).ExhaustedImage
+ End If
+
+ ' cut down everything if we're editing
+ If InMapEditor Then
+ Resource_sprite = Resource(Resource_master).ExhaustedImage
+ End If
+
+ ' Load early
+ If DDS_Resource(Resource_sprite) Is Nothing Then
+ Call InitDDSurf("Resources\" & Resource_sprite, DDSD_Resource(Resource_sprite), DDS_Resource(Resource_sprite))
+ End If
+
+ ' src rect
+ With rec
+ .top = 0
+ .Bottom = DDSD_Resource(Resource_sprite).lHeight
+ .Left = 0
+ .Right = DDSD_Resource(Resource_sprite).lWidth
+ End With
+
+ ' Set base x + y, then the offset due to size
+ x = (MapResource(Resource_num).x * PIC_X) - (DDSD_Resource(Resource_sprite).lWidth / 2) + 16
+ y = (MapResource(Resource_num).y * PIC_Y) - DDSD_Resource(Resource_sprite).lHeight + 32
+
+ ' render it
+ If Not screenShot Then
+ Call BltResource(Resource_sprite, x, y, rec)
+ Else
+ Call ScreenshotResource(Resource_sprite, x, y, rec)
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltMapResource", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub BltResource(ByVal Resource As Long, ByVal dx As Long, dy As Long, rec As DxVBLib.RECT)
+Dim x As Long
+Dim y As Long
+Dim width As Long
+Dim height As Long
+Dim destRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Resource < 1 Or Resource > NumResources Then Exit Sub
+
+ ResourceTimer(Resource) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Resource(Resource) Is Nothing Then
+ Call InitDDSurf("Resources\" & Resource, DDSD_Resource(Resource), DDS_Resource(Resource))
+ End If
+
+ x = ConvertMapX(dx)
+ y = ConvertMapY(dy)
+
+ width = (rec.Right - rec.Left)
+ height = (rec.Bottom - rec.top)
+
+ If y < 0 Then
+ With rec
+ .top = .top - y
+ End With
+ y = 0
+ End If
+
+ If x < 0 Then
+ With rec
+ .Left = .Left - x
+ End With
+ x = 0
+ End If
+
+ If y + height > DDSD_BackBuffer.lHeight Then
+ rec.Bottom = rec.Bottom - (y + height - DDSD_BackBuffer.lHeight)
+ End If
+
+ If x + width > DDSD_BackBuffer.lWidth Then
+ rec.Right = rec.Right - (x + width - DDSD_BackBuffer.lWidth)
+ End If
+
+ ' End clipping
+ Call Engine_BltFast(x, y, DDS_Resource(Resource), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltResource", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub ScreenshotResource(ByVal Resource As Long, ByVal x As Long, y As Long, rec As DxVBLib.RECT)
+Dim width As Long
+Dim height As Long
+Dim destRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Resource < 1 Or Resource > NumResources Then Exit Sub
+
+ ResourceTimer(Resource) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Resource(Resource) Is Nothing Then
+ Call InitDDSurf("Resources\" & Resource, DDSD_Resource(Resource), DDS_Resource(Resource))
+ End If
+
+ width = (rec.Right - rec.Left)
+ height = (rec.Bottom - rec.top)
+
+ If y < 0 Then
+ With rec
+ .top = .top - y
+ End With
+ y = 0
+ End If
+
+ If x < 0 Then
+ With rec
+ .Left = .Left - x
+ End With
+ x = 0
+ End If
+
+ If y + height > DDSD_Map.lHeight Then
+ rec.Bottom = rec.Bottom - (y + height - DDSD_Map.lHeight)
+ End If
+
+ If x + width > DDSD_Map.lWidth Then
+ rec.Right = rec.Right - (x + width - DDSD_Map.lWidth)
+ End If
+
+ ' End clipping
+ 'Call Engine_BltFast(x, y, DDS_Resource(Resource), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+ DDS_Map.BltFast x, y, DDS_Resource(Resource), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "ScreenshotResource", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub BltBars()
+Dim tmpY As Long, tmpX As Long
+Dim sWidth As Long, sHeight As Long
+Dim sRECT As RECT
+Dim barWidth As Long
+Dim i As Long, npcNum As Long, partyIndex As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' dynamic bar calculations
+ sWidth = DDSD_Bars.lWidth
+ sHeight = DDSD_Bars.lHeight / 4
+
+ ' render health bars
+ For i = 1 To MAX_MAP_NPCS
+ npcNum = MapNpc(i).num
+ ' exists?
+ If npcNum > 0 Then
+ ' alive?
+ If MapNpc(i).Vital(Vitals.HP) > 0 And MapNpc(i).Vital(Vitals.HP) < Npc(npcNum).HP Then
+ ' lock to npc
+ tmpX = MapNpc(i).x * PIC_X + MapNpc(i).XOffset + 16 - (sWidth / 2)
+ tmpY = MapNpc(i).y * PIC_Y + MapNpc(i).YOffset + 35
+
+ ' calculate the width to fill
+ barWidth = ((MapNpc(i).Vital(Vitals.HP) / sWidth) / (Npc(npcNum).HP / sWidth)) * sWidth
+
+ ' draw bar background
+ With sRECT
+ .top = sHeight * 1 ' HP bar background
+ .Left = 0
+ .Right = .Left + sWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+
+ ' draw the bar proper
+ With sRECT
+ .top = 0 ' HP bar
+ .Left = 0
+ .Right = .Left + barWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End If
+ End If
+ Next
+
+ ' check for casting time bar
+ If SpellBuffer > 0 Then
+ If Spell(PlayerSpells(SpellBuffer)).CastTime > 0 Then
+ ' lock to player
+ tmpX = GetPlayerX(MyIndex) * PIC_X + Player(MyIndex).XOffset + 16 - (sWidth / 2)
+ tmpY = GetPlayerY(MyIndex) * PIC_Y + Player(MyIndex).YOffset + 35 + sHeight + 1
+
+ ' calculate the width to fill
+ barWidth = (GetTickCount - SpellBufferTimer) / ((Spell(PlayerSpells(SpellBuffer)).CastTime * 1000)) * sWidth
+
+ ' draw bar background
+ With sRECT
+ .top = sHeight * 3 ' cooldown bar background
+ .Left = 0
+ .Right = sWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+
+ ' draw the bar proper
+ With sRECT
+ .top = sHeight * 2 ' cooldown bar
+ .Left = 0
+ .Right = barWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End If
+ End If
+
+ ' draw own health bar
+ If GetPlayerVital(MyIndex, Vitals.HP) > 0 And GetPlayerVital(MyIndex, Vitals.HP) < GetPlayerMaxVital(MyIndex, Vitals.HP) Then
+ ' lock to Player
+ tmpX = GetPlayerX(MyIndex) * PIC_X + Player(MyIndex).XOffset + 16 - (sWidth / 2)
+ tmpY = GetPlayerY(MyIndex) * PIC_X + Player(MyIndex).YOffset + 35
+
+ ' calculate the width to fill
+ barWidth = ((GetPlayerVital(MyIndex, Vitals.HP) / sWidth) / (GetPlayerMaxVital(MyIndex, Vitals.HP) / sWidth)) * sWidth
+
+ ' draw bar background
+ With sRECT
+ .top = sHeight * 1 ' HP bar background
+ .Left = 0
+ .Right = .Left + sWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+
+ ' draw the bar proper
+ With sRECT
+ .top = 0 ' HP bar
+ .Left = 0
+ .Right = .Left + barWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End If
+
+ ' draw party health bars
+ If Party.Leader > 0 Then
+ For i = 1 To MAX_PARTY_MEMBERS
+ partyIndex = Party.Member(i)
+ If (partyIndex > 0) And (partyIndex <> MyIndex) And (GetPlayerMap(partyIndex) = GetPlayerMap(MyIndex)) Then
+ ' player exists
+ If GetPlayerVital(partyIndex, Vitals.HP) > 0 And GetPlayerVital(partyIndex, Vitals.HP) < GetPlayerMaxVital(partyIndex, Vitals.HP) Then
+ ' lock to Player
+ tmpX = GetPlayerX(partyIndex) * PIC_X + Player(partyIndex).XOffset + 16 - (sWidth / 2)
+ tmpY = GetPlayerY(partyIndex) * PIC_X + Player(partyIndex).YOffset + 35
+
+ ' calculate the width to fill
+ barWidth = ((GetPlayerVital(partyIndex, Vitals.HP) / sWidth) / (GetPlayerMaxVital(partyIndex, Vitals.HP) / sWidth)) * sWidth
+
+ ' draw bar background
+ With sRECT
+ .top = sHeight * 1 ' HP bar background
+ .Left = 0
+ .Right = .Left + sWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+
+ ' draw the bar proper
+ With sRECT
+ .top = 0 ' HP bar
+ .Left = 0
+ .Right = .Left + barWidth
+ .Bottom = .top + sHeight
+ End With
+ Engine_BltFast ConvertMapX(tmpX), ConvertMapY(tmpY), DDS_Bars, sRECT, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+ End If
+ End If
+ Next
+ End If
+
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltBars", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltHotbar()
+Dim sRECT As RECT, dRECT As RECT, i As Long, num As String, n As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ frmMain.picHotbar.Cls
+ For i = 1 To MAX_HOTBAR
+ With dRECT
+ .top = HotbarTop
+ .Left = HotbarLeft + ((HotbarOffsetX + 32) * (((i - 1) Mod MAX_HOTBAR)))
+ .Bottom = .top + 32
+ .Right = .Left + 32
+ End With
+
+ With sRECT
+ .top = 0
+ .Left = 32
+ .Bottom = 32
+ .Right = 64
+ End With
+
+ Select Case Hotbar(i).sType
+ Case 1 ' inventory
+ If Len(Item(Hotbar(i).Slot).Name) > 0 Then
+ If Item(Hotbar(i).Slot).Pic > 0 Then
+ If DDS_Item(Item(Hotbar(i).Slot).Pic) Is Nothing Then
+ Call InitDDSurf("Items\" & Item(Hotbar(i).Slot).Pic, DDSD_Item(Item(Hotbar(i).Slot).Pic), DDS_Item(Item(Hotbar(i).Slot).Pic))
+ End If
+ Engine_BltToDC DDS_Item(Item(Hotbar(i).Slot).Pic), sRECT, dRECT, frmMain.picHotbar, False
+ End If
+ End If
+ Case 2 ' spell
+ With sRECT
+ .top = 0
+ .Left = 0
+ .Bottom = 32
+ .Right = 32
+ End With
+ If Len(Spell(Hotbar(i).Slot).Name) > 0 Then
+ If Spell(Hotbar(i).Slot).Icon > 0 Then
+ If DDS_SpellIcon(Spell(Hotbar(i).Slot).Icon) Is Nothing Then
+ Call InitDDSurf("Spellicons\" & Spell(Hotbar(i).Slot).Icon, DDSD_SpellIcon(Spell(Hotbar(i).Slot).Icon), DDS_SpellIcon(Spell(Hotbar(i).Slot).Icon))
+ End If
+ ' check for cooldown
+ For n = 1 To MAX_PLAYER_SPELLS
+ If PlayerSpells(n) = Hotbar(i).Slot Then
+ ' has spell
+ If Not SpellCD(i) = 0 Then
+ sRECT.Left = 32
+ sRECT.Right = 64
+ End If
+ End If
+ Next
+ Engine_BltToDC DDS_SpellIcon(Spell(Hotbar(i).Slot).Icon), sRECT, dRECT, frmMain.picHotbar, False
+ End If
+ End If
+ End Select
+
+ ' render the letters
+ num = "F" & Str(i)
+ DrawText frmMain.picHotbar.hDC, dRECT.Left + 2, dRECT.top + 16, num, QBColor(White)
+ Next
+ frmMain.picHotbar.Refresh
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltHotbar", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltPlayer(ByVal Index As Long)
+Dim Anim As Byte, i As Long, x As Long, y As Long
+Dim Sprite As Long, spritetop As Long
+Dim rec As DxVBLib.RECT
+Dim attackspeed As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Sprite = GetPlayerSprite(Index)
+
+ If Sprite < 1 Or Sprite > NumCharacters Then Exit Sub
+
+ CharacterTimer(Sprite) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Character(Sprite) Is Nothing Then
+ Call InitDDSurf("characters\" & Sprite, DDSD_Character(Sprite), DDS_Character(Sprite))
+ End If
+
+ ' speed from weapon
+ If GetPlayerEquipment(Index, Weapon) > 0 Then
+ attackspeed = Item(GetPlayerEquipment(Index, Weapon)).Speed
+ Else
+ attackspeed = 1000
+ End If
+
+ ' Reset frame
+ If Player(Index).Step = 3 Then
+ Anim = 0
+ ElseIf Player(Index).Step = 1 Then
+ Anim = 2
+ End If
+
+ ' Check for attacking animation
+ If Player(Index).AttackTimer + (attackspeed / 2) > GetTickCount Then
+ If Player(Index).Attacking = 1 Then
+ Anim = 3
+ End If
+ Else
+ ' If not attacking, walk normally
+ Select Case GetPlayerDir(Index)
+ Case DIR_UP
+ If (Player(Index).YOffset > 8) Then Anim = Player(Index).Step
+ Case DIR_DOWN
+ If (Player(Index).YOffset < -8) Then Anim = Player(Index).Step
+ Case DIR_LEFT
+ If (Player(Index).XOffset > 8) Then Anim = Player(Index).Step
+ Case DIR_RIGHT
+ If (Player(Index).XOffset < -8) Then Anim = Player(Index).Step
+ End Select
+ End If
+
+ ' Check to see if we want to stop making him attack
+ With Player(Index)
+ If .AttackTimer + attackspeed < GetTickCount Then
+ .Attacking = 0
+ .AttackTimer = 0
+ End If
+ End With
+
+ ' Set the left
+ Select Case GetPlayerDir(Index)
+ Case DIR_UP
+ spritetop = 3
+ Case DIR_RIGHT
+ spritetop = 2
+ Case DIR_DOWN
+ spritetop = 0
+ Case DIR_LEFT
+ spritetop = 1
+ End Select
+
+ With rec
+ .top = spritetop * (DDSD_Character(Sprite).lHeight / 4)
+ .Bottom = .top + (DDSD_Character(Sprite).lHeight / 4)
+ .Left = Anim * (DDSD_Character(Sprite).lWidth / 4)
+ .Right = .Left + (DDSD_Character(Sprite).lWidth / 4)
+ End With
+
+ ' Calculate the X
+ x = GetPlayerX(Index) * PIC_X + Player(Index).XOffset - ((DDSD_Character(Sprite).lWidth / 4 - 32) / 2)
+
+ ' Is the player's height more than 32..?
+ If (DDSD_Character(Sprite).lHeight) > 32 Then
+ ' Create a 32 pixel offset for larger sprites
+ y = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset - ((DDSD_Character(Sprite).lHeight / 4) - 32)
+ Else
+ ' Proceed as normal
+ y = GetPlayerY(Index) * PIC_Y + Player(Index).YOffset
+ End If
+
+ ' render the actual sprite
+ Call BltSprite(Sprite, x, y, rec)
+
+ ' check for paperdolling
+ For i = 1 To UBound(PaperdollOrder)
+ If GetPlayerEquipment(Index, PaperdollOrder(i)) > 0 Then
+ If Item(GetPlayerEquipment(Index, PaperdollOrder(i))).Paperdoll > 0 Then
+ Call BltPaperdoll(x, y, Item(GetPlayerEquipment(Index, PaperdollOrder(i))).Paperdoll, Anim, spritetop)
+ End If
+ End If
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltPlayer", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltNpc(ByVal MapNpcNum As Long)
+Dim Anim As Byte, i As Long, x As Long, y As Long, Sprite As Long, spritetop As Long
+Dim rec As DxVBLib.RECT
+Dim attackspeed As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If MapNpc(MapNpcNum).num = 0 Then Exit Sub ' no npc set
+
+ Sprite = Npc(MapNpc(MapNpcNum).num).Sprite
+
+ If Sprite < 1 Or Sprite > NumCharacters Then Exit Sub
+
+ CharacterTimer(Sprite) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Character(Sprite) Is Nothing Then
+ Call InitDDSurf("characters\" & Sprite, DDSD_Character(Sprite), DDS_Character(Sprite))
+ End If
+
+ attackspeed = 1000
+
+ ' Reset frame
+ Anim = 0
+ ' Check for attacking animation
+ If MapNpc(MapNpcNum).AttackTimer + (attackspeed / 2) > GetTickCount Then
+ If MapNpc(MapNpcNum).Attacking = 1 Then
+ Anim = 3
+ End If
+ Else
+ ' If not attacking, walk normally
+ Select Case MapNpc(MapNpcNum).Dir
+ Case DIR_UP
+ If (MapNpc(MapNpcNum).YOffset > 8) Then Anim = MapNpc(MapNpcNum).Step
+ Case DIR_DOWN
+ If (MapNpc(MapNpcNum).YOffset < -8) Then Anim = MapNpc(MapNpcNum).Step
+ Case DIR_LEFT
+ If (MapNpc(MapNpcNum).XOffset > 8) Then Anim = MapNpc(MapNpcNum).Step
+ Case DIR_RIGHT
+ If (MapNpc(MapNpcNum).XOffset < -8) Then Anim = MapNpc(MapNpcNum).Step
+ End Select
+ End If
+
+ ' Check to see if we want to stop making him attack
+ With MapNpc(MapNpcNum)
+ If .AttackTimer + attackspeed < GetTickCount Then
+ .Attacking = 0
+ .AttackTimer = 0
+ End If
+ End With
+
+ ' Set the left
+ Select Case MapNpc(MapNpcNum).Dir
+ Case DIR_UP
+ spritetop = 3
+ Case DIR_RIGHT
+ spritetop = 2
+ Case DIR_DOWN
+ spritetop = 0
+ Case DIR_LEFT
+ spritetop = 1
+ End Select
+
+ With rec
+ .top = (DDSD_Character(Sprite).lHeight / 4) * spritetop
+ .Bottom = .top + DDSD_Character(Sprite).lHeight / 4
+ .Left = Anim * (DDSD_Character(Sprite).lWidth / 4)
+ .Right = .Left + (DDSD_Character(Sprite).lWidth / 4)
+ End With
+
+ ' Calculate the X
+ x = MapNpc(MapNpcNum).x * PIC_X + MapNpc(MapNpcNum).XOffset - ((DDSD_Character(Sprite).lWidth / 4 - 32) / 2)
+
+ ' Is the player's height more than 32..?
+ If (DDSD_Character(Sprite).lHeight / 4) > 32 Then
+ ' Create a 32 pixel offset for larger sprites
+ y = MapNpc(MapNpcNum).y * PIC_Y + MapNpc(MapNpcNum).YOffset - ((DDSD_Character(Sprite).lHeight / 4) - 32)
+ Else
+ ' Proceed as normal
+ y = MapNpc(MapNpcNum).y * PIC_Y + MapNpc(MapNpcNum).YOffset
+ End If
+
+ Call BltSprite(Sprite, x, y, rec)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltNpc", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltPaperdoll(ByVal x2 As Long, ByVal y2 As Long, ByVal Sprite As Long, ByVal Anim As Long, ByVal spritetop As Long)
+Dim rec As DxVBLib.RECT
+Dim x As Long, y As Long
+Dim width As Long, height As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Sprite < 1 Or Sprite > NumPaperdolls Then Exit Sub
+
+ If DDS_Paperdoll(Sprite) Is Nothing Then
+ Call InitDDSurf("Paperdolls\" & Sprite, DDSD_Paperdoll(Sprite), DDS_Paperdoll(Sprite))
+ End If
+
+ With rec
+ .top = spritetop * (DDSD_Paperdoll(Sprite).lHeight / 4)
+ .Bottom = .top + (DDSD_Paperdoll(Sprite).lHeight / 4)
+ .Left = Anim * (DDSD_Paperdoll(Sprite).lWidth / 4)
+ .Right = .Left + (DDSD_Paperdoll(Sprite).lWidth / 4)
+ End With
+
+ ' clipping
+ x = ConvertMapX(x2)
+ y = ConvertMapY(y2)
+ width = (rec.Right - rec.Left)
+ height = (rec.Bottom - rec.top)
+
+ ' Clip to screen
+ If y < 0 Then
+ With rec
+ .top = .top - y
+ End With
+ y = 0
+ End If
+
+ If x < 0 Then
+ With rec
+ .Left = .Left - x
+ End With
+ x = 0
+ End If
+
+ If y + height > DDSD_BackBuffer.lHeight Then
+ rec.Bottom = rec.Bottom - (y + height - DDSD_BackBuffer.lHeight)
+ End If
+
+ If x + width > DDSD_BackBuffer.lWidth Then
+ rec.Right = rec.Right - (x + width - DDSD_BackBuffer.lWidth)
+ End If
+ ' /clipping
+
+ Call Engine_BltFast(x, y, DDS_Paperdoll(Sprite), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltPaperdoll", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Private Sub BltSprite(ByVal Sprite As Long, ByVal x2 As Long, y2 As Long, rec As DxVBLib.RECT)
+Dim x As Long
+Dim y As Long
+Dim width As Long
+Dim height As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Sprite < 1 Or Sprite > NumCharacters Then Exit Sub
+ x = ConvertMapX(x2)
+ y = ConvertMapY(y2)
+ width = (rec.Right - rec.Left)
+ height = (rec.Bottom - rec.top)
+
+ ' clipping
+ If y < 0 Then
+ With rec
+ .top = .top - y
+ End With
+ y = 0
+ End If
+
+ If x < 0 Then
+ With rec
+ .Left = .Left - x
+ End With
+ x = 0
+ End If
+
+ If y + height > DDSD_BackBuffer.lHeight Then
+ rec.Bottom = rec.Bottom - (y + height - DDSD_BackBuffer.lHeight)
+ End If
+
+ If x + width > DDSD_BackBuffer.lWidth Then
+ rec.Right = rec.Right - (x + width - DDSD_BackBuffer.lWidth)
+ End If
+ ' /clipping
+
+ Call Engine_BltFast(x, y, DDS_Character(Sprite), rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltSprite", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltAnimatedInvItems()
+Dim i As Long
+Dim itemnum As Long, itempic As Long
+Dim x As Long, y As Long
+Dim MaxFrames As Byte
+Dim Amount As Long
+Dim rec As RECT, rec_pos As RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not InGame Then Exit Sub
+
+ ' check for map animation changes#
+ For i = 1 To MAX_MAP_ITEMS
+
+ If MapItem(i).num > 0 Then
+ itempic = Item(MapItem(i).num).Pic
+
+ If itempic < 1 Or itempic > NumItems Then Exit Sub
+ MaxFrames = (DDSD_Item(itempic).lWidth / 2) / 32 ' Work out how many frames there are. /2 because of inventory icons as well as ingame
+
+ If MapItem(i).Frame < MaxFrames - 1 Then
+ MapItem(i).Frame = MapItem(i).Frame + 1
+ Else
+ MapItem(i).Frame = 1
+ End If
+ End If
+
+ Next
+
+ For i = 1 To MAX_INV
+ itemnum = GetPlayerInvItemNum(MyIndex, i)
+
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+
+ If itempic > 0 And itempic <= NumItems Then
+ If DDSD_Item(itempic).lWidth > 64 Then
+ MaxFrames = (DDSD_Item(itempic).lWidth / 2) / 32 ' Work out how many frames there are. /2 because of inventory icons as well as ingame
+
+ If InvItemFrame(i) < MaxFrames - 1 Then
+ InvItemFrame(i) = InvItemFrame(i) + 1
+ Else
+ InvItemFrame(i) = 1
+ End If
+
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = (DDSD_Item(itempic).lWidth / 2) + (InvItemFrame(i) * 32) ' middle to get the start of inv gfx, then +32 for each frame
+ .Right = .Left + 32
+ End With
+
+ With rec_pos
+ .top = InvTop + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ .Bottom = .top + PIC_Y
+ .Left = InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ ' We'll now re-blt the item, and place the currency value over it again :P
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picInventory, False
+
+ ' If item is a stack - draw the amount you have
+ If GetPlayerInvItemValue(MyIndex, i) > 1 Then
+ y = rec_pos.top + 22
+ x = rec_pos.Left - 4
+ Amount = CStr(GetPlayerInvItemValue(MyIndex, i))
+ ' Draw currency but with k, m, b etc. using a convertion function
+ DrawText frmMain.picInventory.hDC, x, y, ConvertCurrency(Amount), QBColor(Yellow)
+
+ ' Check if it's gold, and update the label
+ If GetPlayerInvItemNum(MyIndex, i) = 1 Then '1 = gold :P
+ frmMain.lblGold.Caption = Format$(Amount, "#,###,###,###") & "g"
+ End If
+ End If
+ End If
+ End If
+ End If
+
+ Next
+
+ frmMain.picInventory.Refresh
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltAnimatedInvItems", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltFace()
+Dim rec As RECT, rec_pos As RECT, faceNum As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If NumFaces = 0 Then Exit Sub
+
+ frmMain.picFace.Cls
+
+ faceNum = GetPlayerSprite(MyIndex)
+
+ If faceNum <= 0 Or faceNum > NumFaces Then Exit Sub
+
+ With rec
+ .top = 0
+ .Bottom = 100
+ .Left = 0
+ .Right = 100
+ End With
+
+ With rec_pos
+ .top = 0
+ .Bottom = 100
+ .Left = 0
+ .Right = 100
+ End With
+
+ ' Load face if not loaded, and reset timer
+ FaceTimer(faceNum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Face(faceNum) Is Nothing Then
+ Call InitDDSurf("Faces\" & faceNum, DDSD_Face(faceNum), DDS_Face(faceNum))
+ End If
+
+ Engine_BltToDC DDS_Face(faceNum), rec, rec_pos, frmMain.picFace, False
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltFace", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltEquipment()
+Dim i As Long, itemnum As Long, itempic As Long
+Dim rec As RECT, rec_pos As RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If NumItems = 0 Then Exit Sub
+
+ frmMain.picCharacter.Cls
+
+ For i = 1 To Equipment.Equipment_Count - 1
+ itemnum = GetPlayerEquipment(MyIndex, i)
+
+ If itemnum > 0 Then
+ itempic = Item(itemnum).Pic
+
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = 32
+ .Right = 64
+ End With
+
+ With rec_pos
+ .top = EqTop
+ .Bottom = .top + PIC_Y
+ .Left = EqLeft + ((EqOffsetX + 32) * (((i - 1) Mod EqColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picCharacter, False
+ End If
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltEquipment", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltInventory()
+Dim i As Long, x As Long, y As Long, itemnum As Long, itempic As Long
+Dim Amount As Long
+Dim rec As RECT, rec_pos As RECT
+Dim colour As Long
+Dim tmpItem As Long, amountModifier As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not InGame Then Exit Sub
+
+ ' reset gold label
+ frmMain.lblGold.Caption = "0g"
+
+ frmMain.picInventory.Cls
+
+ For i = 1 To MAX_INV
+ itemnum = GetPlayerInvItemNum(MyIndex, i)
+
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+
+ amountModifier = 0
+ ' exit out if we're offering item in a trade.
+ If InTrade > 0 Then
+ For x = 1 To MAX_INV
+ tmpItem = GetPlayerInvItemNum(MyIndex, TradeYourOffer(x).num)
+ If TradeYourOffer(x).num = i Then
+ ' check if currency
+ If Not Item(tmpItem).Type = ITEM_TYPE_CURRENCY Then
+ ' normal item, exit out
+ GoTo NextLoop
+ Else
+ ' if amount = all currency, remove from inventory
+ If TradeYourOffer(x).Value = GetPlayerInvItemValue(MyIndex, i) Then
+ GoTo NextLoop
+ Else
+ ' not all, change modifier to show change in currency count
+ amountModifier = TradeYourOffer(x).Value
+ End If
+ End If
+ End If
+ Next
+ End If
+
+ If itempic > 0 And itempic <= NumItems Then
+ If DDSD_Item(itempic).lWidth <= 64 Then ' more than 1 frame is handled by anim sub
+
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = 32
+ .Right = 64
+ End With
+
+ With rec_pos
+ .top = InvTop + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ .Bottom = .top + PIC_Y
+ .Left = InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picInventory, False
+
+ ' If item is a stack - draw the amount you have
+ If GetPlayerInvItemValue(MyIndex, i) > 1 Then
+ y = rec_pos.top + 22
+ x = rec_pos.Left - 4
+
+ Amount = GetPlayerInvItemValue(MyIndex, i) - amountModifier
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If Amount < 1000000 Then
+ colour = QBColor(White)
+ ElseIf Amount > 1000000 And Amount < 10000000 Then
+ colour = QBColor(Yellow)
+ ElseIf Amount > 10000000 Then
+ colour = QBColor(BrightGreen)
+ End If
+
+ DrawText frmMain.picInventory.hDC, x, y, Format$(ConvertCurrency(Str(Amount)), "#,###,###,###"), colour
+
+ ' Check if it's gold, and update the label
+ If GetPlayerInvItemNum(MyIndex, i) = 1 Then '1 = gold :P
+ frmMain.lblGold.Caption = Format$(Amount, "#,###,###,###") & "g"
+ End If
+ End If
+ End If
+ End If
+ End If
+NextLoop:
+ Next
+
+ frmMain.picInventory.Refresh
+ 'update animated items
+ BltAnimatedInvItems
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltInventory", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltTrade()
+Dim i As Long, x As Long, y As Long, itemnum As Long, itempic As Long
+Dim Amount As Long
+Dim rec As RECT, rec_pos As RECT
+Dim colour As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not InGame Then Exit Sub
+ frmMain.picYourTrade.Cls
+ frmMain.picTheirTrade.Cls
+
+ For i = 1 To MAX_INV
+ ' blt your own offer
+ itemnum = GetPlayerInvItemNum(MyIndex, TradeYourOffer(i).num)
+
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+
+ If itempic > 0 And itempic <= NumItems Then
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = 32
+ .Right = 64
+ End With
+
+ With rec_pos
+ .top = InvTop - 24 + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ .Bottom = .top + PIC_Y
+ .Left = InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picYourTrade, False
+
+ ' If item is a stack - draw the amount you have
+ If TradeYourOffer(i).Value > 1 Then
+ y = rec_pos.top + 22
+ x = rec_pos.Left - 4
+
+ Amount = TradeYourOffer(i).Value
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If Amount < 1000000 Then
+ colour = QBColor(White)
+ ElseIf Amount > 1000000 And Amount < 10000000 Then
+ colour = QBColor(Yellow)
+ ElseIf Amount > 10000000 Then
+ colour = QBColor(BrightGreen)
+ End If
+
+ DrawText frmMain.picYourTrade.hDC, x, y, ConvertCurrency(Str(Amount)), colour
+ End If
+ End If
+ End If
+
+ ' blt their offer
+ itemnum = TradeTheirOffer(i).num
+
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+
+ If itempic > 0 And itempic <= NumItems Then
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = 32
+ .Right = 64
+ End With
+
+ With rec_pos
+ .top = InvTop - 24 + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ .Bottom = .top + PIC_Y
+ .Left = InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picTheirTrade, False
+
+ ' If item is a stack - draw the amount you have
+ If TradeTheirOffer(i).Value > 1 Then
+ y = rec_pos.top + 22
+ x = rec_pos.Left - 4
+
+ Amount = TradeTheirOffer(i).Value
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If Amount < 1000000 Then
+ colour = QBColor(White)
+ ElseIf Amount > 1000000 And Amount < 10000000 Then
+ colour = QBColor(Yellow)
+ ElseIf Amount > 10000000 Then
+ colour = QBColor(BrightGreen)
+ End If
+
+ DrawText frmMain.picTheirTrade.hDC, x, y, ConvertCurrency(Str(Amount)), colour
+ End If
+ End If
+ End If
+ Next
+
+ frmMain.picYourTrade.Refresh
+ frmMain.picTheirTrade.Refresh
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltTrade", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltPlayerSpells()
+Dim i As Long, x As Long, y As Long, spellnum As Long, spellicon As Long
+Dim Amount As String
+Dim rec As RECT, rec_pos As RECT
+Dim colour As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not InGame Then Exit Sub
+ frmMain.picSpells.Cls
+
+ For i = 1 To MAX_PLAYER_SPELLS
+ spellnum = PlayerSpells(i)
+
+ If spellnum > 0 And spellnum <= MAX_SPELLS Then
+ spellicon = Spell(spellnum).Icon
+
+ If spellicon > 0 And spellicon <= NumSpellIcons Then
+
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = 0
+ .Right = 32
+ End With
+
+ If Not SpellCD(i) = 0 Then
+ rec.Left = 32
+ rec.Right = 64
+ End If
+
+ With rec_pos
+ .top = SpellTop + ((SpellOffsetY + 32) * ((i - 1) \ SpellColumns))
+ .Bottom = .top + PIC_Y
+ .Left = SpellLeft + ((SpellOffsetX + 32) * (((i - 1) Mod SpellColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load spellicon if not loaded, and reset timer
+ SpellIconTimer(spellicon) = GetTickCount + SurfaceTimerMax
+
+ If DDS_SpellIcon(spellicon) Is Nothing Then
+ Call InitDDSurf("SpellIcons\" & spellicon, DDSD_SpellIcon(spellicon), DDS_SpellIcon(spellicon))
+ End If
+
+ Engine_BltToDC DDS_SpellIcon(spellicon), rec, rec_pos, frmMain.picSpells, False
+ End If
+ End If
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltPlayerSpells", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltShop()
+Dim i As Long, x As Long, y As Long, itemnum As Long, itempic As Long
+Dim Amount As String
+Dim rec As RECT, rec_pos As RECT
+Dim colour As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If Not InGame Then Exit Sub
+
+ frmMain.picShopItems.Cls
+
+ For i = 1 To MAX_TRADES
+ itemnum = Shop(InShop).TradeItem(i).Item 'GetPlayerInvItemNum(MyIndex, i)
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+ If itempic > 0 And itempic <= NumItems Then
+
+ With rec
+ .top = 0
+ .Bottom = 32
+ .Left = 32
+ .Right = 64
+ End With
+
+ With rec_pos
+ .top = ShopTop + ((ShopOffsetY + 32) * ((i - 1) \ ShopColumns))
+ .Bottom = .top + PIC_Y
+ .Left = ShopLeft + ((ShopOffsetX + 32) * (((i - 1) Mod ShopColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picShopItems, False
+
+ ' If item is a stack - draw the amount you have
+ If Shop(InShop).TradeItem(i).ItemValue > 1 Then
+ y = rec_pos.top + 22
+ x = rec_pos.Left - 4
+ Amount = CStr(Shop(InShop).TradeItem(i).ItemValue)
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If CLng(Amount) < 1000000 Then
+ colour = QBColor(White)
+ ElseIf CLng(Amount) > 1000000 And CLng(Amount) < 10000000 Then
+ colour = QBColor(Yellow)
+ ElseIf CLng(Amount) > 10000000 Then
+ colour = QBColor(BrightGreen)
+ End If
+
+ DrawText frmMain.picShopItems.hDC, x, y, ConvertCurrency(Amount), colour
+ End If
+ End If
+ End If
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltShop", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltInventoryItem(ByVal x As Long, ByVal y As Long)
+Dim rec As RECT, rec_pos As RECT
+Dim itemnum As Long, itempic As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ itemnum = GetPlayerInvItemNum(MyIndex, DragInvSlotNum)
+
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+
+ If itempic = 0 Then Exit Sub
+
+ With rec
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = DDSD_Item(itempic).lWidth / 2
+ .Right = .Left + PIC_X
+ End With
+
+ With rec_pos
+ .top = 2
+ .Bottom = .top + PIC_Y
+ .Left = 2
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picTempInv, False
+
+ With frmMain.picTempInv
+ .top = y
+ .Left = x
+ .Visible = True
+ .ZOrder (0)
+ End With
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltInventoryItem", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltDraggedSpell(ByVal x As Long, ByVal y As Long)
+Dim rec As RECT, rec_pos As RECT
+Dim spellnum As Long, spellpic As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ spellnum = PlayerSpells(DragSpell)
+
+ If spellnum > 0 And spellnum <= MAX_SPELLS Then
+ spellpic = Spell(spellnum).Icon
+
+ If spellpic = 0 Then Exit Sub
+
+ With rec
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = 0
+ .Right = .Left + PIC_X
+ End With
+
+ With rec_pos
+ .top = 2
+ .Bottom = .top + PIC_Y
+ .Left = 2
+ .Right = .Left + PIC_X
+ End With
+
+ ' Load item if not loaded, and reset timer
+ SpellIconTimer(spellpic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_SpellIcon(spellpic) Is Nothing Then
+ Call InitDDSurf("Spellicons\" & spellpic, DDSD_SpellIcon(spellpic), DDS_SpellIcon(spellpic))
+ End If
+
+ Engine_BltToDC DDS_SpellIcon(spellpic), rec, rec_pos, frmMain.picTempSpell, False
+
+ With frmMain.picTempSpell
+ .top = y
+ .Left = x
+ .Visible = True
+ .ZOrder (0)
+ End With
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltInventoryItem", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltItemDesc(ByVal itemnum As Long)
+Dim rec As RECT, rec_pos As RECT
+Dim itempic As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ frmMain.picItemDescPic.Cls
+
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+ itempic = Item(itemnum).Pic
+
+ If itempic = 0 Then Exit Sub
+
+ ' Load item if not loaded, and reset timer
+ ItemTimer(itempic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itempic) Is Nothing Then
+ Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
+ End If
+
+ With rec
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = DDSD_Item(itempic).lWidth / 2
+ .Right = .Left + PIC_X
+ End With
+
+ With rec_pos
+ .top = 0
+ .Bottom = 64
+ .Left = 0
+ .Right = 64
+ End With
+ Engine_BltToDC DDS_Item(itempic), rec, rec_pos, frmMain.picItemDescPic, False
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltItemDesc", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltSpellDesc(ByVal spellnum As Long)
+Dim rec As RECT, rec_pos As RECT
+Dim spellpic As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ frmMain.picSpellDescPic.Cls
+
+ If spellnum > 0 And spellnum <= MAX_SPELLS Then
+ spellpic = Spell(spellnum).Icon
+
+ If spellpic <= 0 Or spellpic > NumSpellIcons Then Exit Sub
+
+ ' Load item if not loaded, and reset timer
+ SpellIconTimer(spellpic) = GetTickCount + SurfaceTimerMax
+
+ If DDS_SpellIcon(spellpic) Is Nothing Then
+ Call InitDDSurf("SpellIcons\" & spellpic, DDSD_SpellIcon(spellpic), DDS_SpellIcon(spellpic))
+ End If
+
+ With rec
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = 0
+ .Right = .Left + PIC_X
+ End With
+
+ With rec_pos
+ .top = 0
+ .Bottom = 64
+ .Left = 0
+ .Right = 64
+ End With
+ Engine_BltToDC DDS_SpellIcon(spellpic), rec, rec_pos, frmMain.picSpellDescPic, False
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltSpellDesc", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+' ******************
+' ** Game Editors **
+' ******************
+Public Sub EditorMap_BltTileset()
+Dim height As Long
+Dim width As Long
+Dim Tileset As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' find tileset number
+ Tileset = frmEditor_Map.scrlTileSet.Value
+
+ ' exit out if doesn't exist
+ If Tileset < 0 Or Tileset > NumTileSets Then Exit Sub
+
+ ' make sure it's loaded
+ If DDS_Tileset(Tileset) Is Nothing Then
+ Call InitDDSurf("tilesets\" & Tileset, DDSD_Tileset(Tileset), DDS_Tileset(Tileset))
+ End If
+
+ height = DDSD_Tileset(Tileset).lHeight
+ width = DDSD_Tileset(Tileset).lWidth
+
+ dRECT.top = 0
+ dRECT.Bottom = height
+ dRECT.Left = 0
+ dRECT.Right = width
+
+ frmEditor_Map.picBackSelect.height = height
+ frmEditor_Map.picBackSelect.width = width
+
+ Call Engine_BltToDC(DDS_Tileset(Tileset), sRECT, dRECT, frmEditor_Map.picBackSelect)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorMap_BltTileset", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltTileOutline()
+Dim rec As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If frmEditor_Map.optBlock.Value Then Exit Sub
+
+ With rec
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = 0
+ .Right = .Left + PIC_X
+ End With
+
+ Call Engine_BltFast(ConvertMapX(CurX * PIC_X), ConvertMapY(CurY * PIC_Y), DDS_Misc, rec, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltTileOutline", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub NewCharacterBltSprite()
+Dim Sprite As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+Dim width As Long, height As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If frmMenu.cmbClass.ListIndex = -1 Then Exit Sub
+
+ If frmMenu.optMale.Value = True Then
+ Sprite = Class(frmMenu.cmbClass.ListIndex + 1).MaleSprite(newCharSprite)
+ Else
+ Sprite = Class(frmMenu.cmbClass.ListIndex + 1).FemaleSprite(newCharSprite)
+ End If
+
+ If Sprite < 1 Or Sprite > NumCharacters Then
+ frmMenu.picSprite.Cls
+ Exit Sub
+ End If
+
+ CharacterTimer(Sprite) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Character(Sprite) Is Nothing Then
+ Call InitDDSurf("Characters\" & Sprite, DDSD_Character(Sprite), DDS_Character(Sprite))
+ End If
+
+ width = DDSD_Character(Sprite).lWidth / 4
+ height = DDSD_Character(Sprite).lHeight / 4
+
+ frmMenu.picSprite.width = width
+ frmMenu.picSprite.height = height
+
+ sRECT.top = 0
+ sRECT.Bottom = sRECT.top + height
+ sRECT.Left = 0
+ sRECT.Right = sRECT.Left + width
+
+ dRECT.top = 0
+ dRECT.Bottom = height
+ dRECT.Left = 0
+ dRECT.Right = width
+
+ Call Engine_BltToDC(DDS_Character(Sprite), sRECT, dRECT, frmMenu.picSprite)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "NewCharacterBltSprite", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorMap_BltMapItem()
+Dim itemnum As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ itemnum = Item(frmEditor_Map.scrlMapItem.Value).Pic
+
+ If itemnum < 1 Or itemnum > NumItems Then
+ frmEditor_Map.picMapItem.Cls
+ Exit Sub
+ End If
+
+ ItemTimer(itemnum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itemnum) Is Nothing Then
+ Call InitDDSurf("Items\" & itemnum, DDSD_Item(itemnum), DDS_Item(itemnum))
+ End If
+
+ sRECT.top = 0
+ sRECT.Bottom = PIC_Y
+ sRECT.Left = 0
+ sRECT.Right = PIC_X
+ dRECT.top = 0
+ dRECT.Bottom = PIC_Y
+ dRECT.Left = 0
+ dRECT.Right = PIC_X
+ Call Engine_BltToDC(DDS_Item(itemnum), sRECT, dRECT, frmEditor_Map.picMapItem)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorMap_BltMapItem", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorMap_BltKey()
+Dim itemnum As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ itemnum = Item(frmEditor_Map.scrlMapKey.Value).Pic
+
+ If itemnum < 1 Or itemnum > NumItems Then
+ frmEditor_Map.picMapKey.Cls
+ Exit Sub
+ End If
+
+ ItemTimer(itemnum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itemnum) Is Nothing Then
+ Call InitDDSurf("Items\" & itemnum, DDSD_Item(itemnum), DDS_Item(itemnum))
+ End If
+
+ sRECT.top = 0
+ sRECT.Bottom = PIC_Y
+ sRECT.Left = 0
+ sRECT.Right = PIC_X
+ dRECT.top = 0
+ dRECT.Bottom = PIC_Y
+ dRECT.Left = 0
+ dRECT.Right = PIC_X
+ Call Engine_BltToDC(DDS_Item(itemnum), sRECT, dRECT, frmEditor_Map.picMapKey)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorMap_BltKey", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorItem_BltItem()
+Dim itemnum As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ itemnum = frmEditor_Item.scrlPic.Value
+
+ If itemnum < 1 Or itemnum > NumItems Then
+ frmEditor_Item.picItem.Cls
+ Exit Sub
+ End If
+
+ ItemTimer(itemnum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Item(itemnum) Is Nothing Then
+ Call InitDDSurf("Items\" & itemnum, DDSD_Item(itemnum), DDS_Item(itemnum))
+ End If
+
+ ' rect for source
+ sRECT.top = 0
+ sRECT.Bottom = PIC_Y
+ sRECT.Left = 0
+ sRECT.Right = PIC_X
+
+ ' same for destination as source
+ dRECT = sRECT
+ Call Engine_BltToDC(DDS_Item(itemnum), sRECT, dRECT, frmEditor_Item.picItem)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorItem_BltItem", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorItem_BltPaperdoll()
+Dim Sprite As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ frmEditor_Item.picPaperdoll.Cls
+
+ Sprite = frmEditor_Item.scrlPaperdoll.Value
+
+ If Sprite < 1 Or Sprite > NumPaperdolls Then
+ frmEditor_Item.picPaperdoll.Cls
+ Exit Sub
+ End If
+
+ PaperdollTimer(Sprite) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Paperdoll(Sprite) Is Nothing Then
+ Call InitDDSurf("paperdolls\" & Sprite, DDSD_Paperdoll(Sprite), DDS_Paperdoll(Sprite))
+ End If
+
+ ' rect for source
+ sRECT.top = 0
+ sRECT.Bottom = DDSD_Paperdoll(Sprite).lHeight
+ sRECT.Left = 0
+ sRECT.Right = DDSD_Paperdoll(Sprite).lWidth
+ ' same for destination as source
+ dRECT = sRECT
+
+ Call Engine_BltToDC(DDS_Paperdoll(Sprite), sRECT, dRECT, frmEditor_Item.picPaperdoll)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorItem_BltPaperdoll", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorSpell_BltIcon()
+Dim iconnum As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ iconnum = frmEditor_Spell.scrlIcon.Value
+
+ If iconnum < 1 Or iconnum > NumSpellIcons Then
+ frmEditor_Spell.picSprite.Cls
+ Exit Sub
+ End If
+
+ SpellIconTimer(iconnum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_SpellIcon(iconnum) Is Nothing Then
+ Call InitDDSurf("SpellIcons\" & iconnum, DDSD_SpellIcon(iconnum), DDS_SpellIcon(iconnum))
+ End If
+
+ sRECT.top = 0
+ sRECT.Bottom = PIC_Y
+ sRECT.Left = 0
+ sRECT.Right = PIC_X
+ dRECT.top = 0
+ dRECT.Bottom = PIC_Y
+ dRECT.Left = 0
+ dRECT.Right = PIC_X
+
+ Call Engine_BltToDC(DDS_SpellIcon(iconnum), sRECT, dRECT, frmEditor_Spell.picSprite)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorSpell_BltIcon", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorAnim_BltAnim()
+Dim Animationnum As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+Dim i As Long
+Dim width As Long, height As Long
+Dim looptime As Long
+Dim FrameCount As Long
+Dim ShouldRender As Boolean
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ For i = 0 To 1
+ Animationnum = frmEditor_Animation.scrlSprite(i).Value
+
+ If Animationnum < 1 Or Animationnum > NumAnimations Then
+ frmEditor_Animation.picSprite(i).Cls
+ Else
+ looptime = frmEditor_Animation.scrlLoopTime(i)
+ FrameCount = frmEditor_Animation.scrlFrameCount(i)
+
+ ShouldRender = False
+
+ ' check if we need to render new frame
+ If AnimEditorTimer(i) + looptime <= GetTickCount Then
+ ' check if out of range
+ If AnimEditorFrame(i) >= FrameCount Then
+ AnimEditorFrame(i) = 1
+ Else
+ AnimEditorFrame(i) = AnimEditorFrame(i) + 1
+ End If
+ AnimEditorTimer(i) = GetTickCount
+ ShouldRender = True
+ End If
+
+ If ShouldRender Then
+ frmEditor_Animation.picSprite(i).Cls
+
+ AnimationTimer(Animationnum) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Animation(Animationnum) Is Nothing Then
+ Call InitDDSurf("animations\" & Animationnum, DDSD_Animation(Animationnum), DDS_Animation(Animationnum))
+ End If
+
+ If frmEditor_Animation.scrlFrameCount(i).Value > 0 Then
+ ' total width divided by frame count
+ width = DDSD_Animation(Animationnum).lWidth / frmEditor_Animation.scrlFrameCount(i).Value
+ height = DDSD_Animation(Animationnum).lHeight
+
+ sRECT.top = 0
+ sRECT.Bottom = height
+ sRECT.Left = (AnimEditorFrame(i) - 1) * width
+ sRECT.Right = sRECT.Left + width
+
+ dRECT.top = 0
+ dRECT.Bottom = height
+ dRECT.Left = 0
+ dRECT.Right = width
+
+ Call Engine_BltToDC(DDS_Animation(Animationnum), sRECT, dRECT, frmEditor_Animation.picSprite(i))
+ End If
+ End If
+ End If
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorAnim_BltAnim", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorNpc_BltSprite()
+Dim Sprite As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ Sprite = frmEditor_NPC.scrlSprite.Value
+
+ If Sprite < 1 Or Sprite > NumCharacters Then
+ frmEditor_NPC.picSprite.Cls
+ Exit Sub
+ End If
+
+ CharacterTimer(Sprite) = GetTickCount + SurfaceTimerMax
+
+ If DDS_Character(Sprite) Is Nothing Then
+ Call InitDDSurf("characters\" & Sprite, DDSD_Character(Sprite), DDS_Character(Sprite))
+ End If
+
+ sRECT.top = 0
+ sRECT.Bottom = SIZE_Y
+ sRECT.Left = PIC_X * 3 ' facing down
+ sRECT.Right = sRECT.Left + SIZE_X
+ dRECT.top = 0
+ dRECT.Bottom = SIZE_Y
+ dRECT.Left = 0
+ dRECT.Right = SIZE_X
+ Call Engine_BltToDC(DDS_Character(Sprite), sRECT, dRECT, frmEditor_NPC.picSprite)
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorNpc_BltSprite", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub EditorResource_BltSprite()
+Dim Sprite As Long
+Dim sRECT As DxVBLib.RECT
+Dim dRECT As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' normal sprite
+ Sprite = frmEditor_Resource.scrlNormalPic.Value
+
+ If Sprite < 1 Or Sprite > NumResources Then
+ frmEditor_Resource.picNormalPic.Cls
+ Else
+ ResourceTimer(Sprite) = GetTickCount + SurfaceTimerMax
+ If DDS_Resource(Sprite) Is Nothing Then
+ Call InitDDSurf("Resources\" & Sprite, DDSD_Resource(Sprite), DDS_Resource(Sprite))
+ End If
+ sRECT.top = 0
+ sRECT.Bottom = DDSD_Resource(Sprite).lHeight
+ sRECT.Left = 0
+ sRECT.Right = DDSD_Resource(Sprite).lWidth
+ dRECT.top = 0
+ dRECT.Bottom = DDSD_Resource(Sprite).lHeight
+ dRECT.Left = 0
+ dRECT.Right = DDSD_Resource(Sprite).lWidth
+ Call Engine_BltToDC(DDS_Resource(Sprite), sRECT, dRECT, frmEditor_Resource.picNormalPic)
+ End If
+
+ ' exhausted sprite
+ Sprite = frmEditor_Resource.scrlExhaustedPic.Value
+
+ If Sprite < 1 Or Sprite > NumResources Then
+ frmEditor_Resource.picExhaustedPic.Cls
+ Else
+ ResourceTimer(Sprite) = GetTickCount + SurfaceTimerMax
+ If DDS_Resource(Sprite) Is Nothing Then
+ Call InitDDSurf("Resources\" & Sprite, DDSD_Resource(Sprite), DDS_Resource(Sprite))
+ End If
+ sRECT.top = 0
+ sRECT.Bottom = DDSD_Resource(Sprite).lHeight
+ sRECT.Left = 0
+ sRECT.Right = DDSD_Resource(Sprite).lWidth
+ dRECT.top = 0
+ dRECT.Bottom = DDSD_Resource(Sprite).lHeight
+ dRECT.Left = 0
+ dRECT.Right = DDSD_Resource(Sprite).lWidth
+ Call Engine_BltToDC(DDS_Resource(Sprite), sRECT, dRECT, frmEditor_Resource.picExhaustedPic)
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "EditorResource_BltSprite", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub Render_Graphics()
+Dim x As Long
+Dim y As Long
+Dim i As Long
+Dim rec As DxVBLib.RECT
+Dim rec_pos As DxVBLib.RECT
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ' check if automation is screwed
+ If Not CheckSurfaces Then
+ ' exit out and let them know we need to re-init
+ ReInitSurfaces = True
+ Exit Sub
+ Else
+ ' if we need to fix the surfaces then do so
+ If ReInitSurfaces Then
+ ReInitSurfaces = False
+ ReInitDD
+ End If
+ End If
+
+ ' don't render
+ If frmMain.WindowState = vbMinimized Then Exit Sub
+ If GettingMap Then Exit Sub
+
+ ' update the viewpoint
+ UpdateCamera
+
+ ' update animation editor
+ If Editor = EDITOR_ANIMATION Then
+ EditorAnim_BltAnim
+ End If
+
+ ' fill it with black
+ DDS_BackBuffer.BltColorFill rec_pos, 0
+
+ ' blit lower tiles
+ If NumTileSets > 0 Then
+ For x = TileView.Left To TileView.Right
+ For y = TileView.top To TileView.Bottom
+ If IsValidMapPoint(x, y) Then
+ Call BltMapTile(x, y)
+ End If
+ Next
+ Next
+ End If
+
+ ' render the decals
+ For i = 1 To MAX_BYTE
+ Call BltBlood(i)
+ Next
+
+ ' Blit out the items
+ If NumItems > 0 Then
+ For i = 1 To MAX_MAP_ITEMS
+ If MapItem(i).num > 0 Then
+ Call BltItem(i)
+ End If
+ Next
+ End If
+
+ ' 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
+
+ ' Y-based render. Renders Players, Npcs and Resources based on Y-axis.
+ For y = 0 To Map.MaxY
+ If NumCharacters > 0 Then
+ ' Players
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ If Player(i).y = y Then
+ Call BltPlayer(i)
+ End If
+ End If
+ Next
+
+ ' Npcs
+ For i = 1 To Npc_HighIndex
+ If MapNpc(i).y = y Then
+ Call BltNpc(i)
+ End If
+ Next
+ End If
+
+ ' Resources
+ If NumResources > 0 Then
+ If Resources_Init Then
+ If Resource_Index > 0 Then
+ For i = 1 To Resource_Index
+ If MapResource(i).y = y Then
+ Call BltMapResource(i)
+ End If
+ Next
+ End If
+ End If
+ End If
+ Next
+
+ ' animations
+ If NumAnimations > 0 Then
+ For i = 1 To MAX_BYTE
+ If AnimInstance(i).Used(1) Then
+ BltAnimation i, 1
+ End If
+ Next
+ End If
+
+ ' blit out upper tiles
+ If NumTileSets > 0 Then
+ For x = TileView.Left To TileView.Right
+ For y = TileView.top To TileView.Bottom
+ If IsValidMapPoint(x, y) Then
+ Call BltMapFringeTile(x, y)
+ End If
+ Next
+ Next
+ End If
+
+ ' blit out a square at mouse cursor
+ If InMapEditor Then
+ If frmEditor_Map.optBlock.Value = True Then
+ For x = TileView.Left To TileView.Right
+ For y = TileView.top To TileView.Bottom
+ If IsValidMapPoint(x, y) Then
+ Call BltDirection(x, y)
+ End If
+ Next
+ Next
+ End If
+ Call BltTileOutline
+ End If
+
+ ' Render the bars
+ BltBars
+
+ ' Blt the target icon
+ If myTarget > 0 Then
+ If myTargetType = TARGET_TYPE_PLAYER Then
+ BltTarget (Player(myTarget).x * 32) + Player(myTarget).XOffset, (Player(myTarget).y * 32) + Player(myTarget).YOffset
+ ElseIf myTargetType = TARGET_TYPE_NPC Then
+ BltTarget (MapNpc(myTarget).x * 32) + MapNpc(myTarget).XOffset, (MapNpc(myTarget).y * 32) + MapNpc(myTarget).YOffset
+ End If
+ End If
+
+ ' blt the hover icon
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If Player(i).Map = Player(MyIndex).Map Then
+ If CurX = Player(i).x And CurY = Player(i).y Then
+ If myTargetType = TARGET_TYPE_PLAYER And myTarget = i Then
+ ' dont render lol
+ Else
+ BltHover TARGET_TYPE_PLAYER, i, (Player(i).x * 32) + Player(i).XOffset, (Player(i).y * 32) + Player(i).YOffset
+ End If
+ End If
+ End If
+ End If
+ Next
+ For i = 1 To Npc_HighIndex
+ If MapNpc(i).num > 0 Then
+ If CurX = MapNpc(i).x And CurY = MapNpc(i).y Then
+ If myTargetType = TARGET_TYPE_NPC And myTarget = i Then
+ ' dont render lol
+ Else
+ BltHover TARGET_TYPE_NPC, i, (MapNpc(i).x * 32) + MapNpc(i).XOffset, (MapNpc(i).y * 32) + MapNpc(i).YOffset
+ End If
+ End If
+ End If
+ Next
+
+ ' Lock the backbuffer so we can draw text and names
+ TexthDC = DDS_BackBuffer.GetDC
+
+ ' draw FPS
+ If BFPS Then
+ Call DrawText(TexthDC, Camera.Right - (Len("FPS: " & GameFPS) * 8), Camera.top + 1, Trim$("FPS: " & GameFPS), QBColor(Yellow))
+ End If
+
+ ' draw cursor, player X and Y locations
+ If BLoc Then
+ Call DrawText(TexthDC, Camera.Left, Camera.top + 1, Trim$("cur x: " & CurX & " y: " & CurY), QBColor(Yellow))
+ Call DrawText(TexthDC, Camera.Left, Camera.top + 15, Trim$("loc x: " & GetPlayerX(MyIndex) & " y: " & GetPlayerY(MyIndex)), QBColor(Yellow))
+ Call DrawText(TexthDC, Camera.Left, Camera.top + 27, Trim$(" (map #" & GetPlayerMap(MyIndex) & ")"), QBColor(Yellow))
+ End If
+
+ ' draw player names
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ Call DrawPlayerName(i)
+ End If
+ Next
+
+ ' draw npc names
+ For i = 1 To Npc_HighIndex
+ If MapNpc(i).num > 0 Then
+ Call DrawNpcName(i)
+ End If
+ Next
+
+ For i = 1 To Action_HighIndex
+ Call BltActionMsg(i)
+ Next i
+
+ ' Blit out map attributes
+ If InMapEditor Then
+ Call BltMapAttributes
+ End If
+
+ ' Draw map name
+ Call DrawText(TexthDC, DrawMapNameX, DrawMapNameY, Map.Name, DrawMapNameColor)
+
+ ' Release DC
+ DDS_BackBuffer.ReleaseDC TexthDC
+
+ ' Get rec
+ With rec
+ .top = Camera.top
+ .Bottom = .top + ScreenY
+ .Left = Camera.Left
+ .Right = .Left + ScreenX
+ End With
+
+ ' rec_pos
+ With rec_pos
+ .Bottom = ((MAX_MAPY + 1) * PIC_Y)
+ .Right = ((MAX_MAPX + 1) * PIC_X)
+ End With
+
+ ' Flip and render
+ DX7.GetWindowRect frmMain.picScreen.hWnd, rec_pos
+ DDS_Primary.Blt rec_pos, DDS_BackBuffer, rec, DDBLT_WAIT
+
+ ' Error handler
+ Exit Sub
+
+errorhandler:
+ HandleError "Render_Graphics", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub UpdateCamera()
+Dim offsetX As Long
+Dim offsetY As Long
+Dim StartX As Long
+Dim StartY As Long
+Dim EndX As Long
+Dim EndY As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ offsetX = Player(MyIndex).XOffset + PIC_X
+ offsetY = Player(MyIndex).YOffset + PIC_Y
+
+ StartX = GetPlayerX(MyIndex) - StartXValue
+ StartY = GetPlayerY(MyIndex) - StartYValue
+ If StartX < 0 Then
+ offsetX = 0
+ If StartX = -1 Then
+ If Player(MyIndex).XOffset > 0 Then
+ offsetX = Player(MyIndex).XOffset
+ End If
+ End If
+ StartX = 0
+ End If
+ If StartY < 0 Then
+ offsetY = 0
+ If StartY = -1 Then
+ If Player(MyIndex).YOffset > 0 Then
+ offsetY = Player(MyIndex).YOffset
+ End If
+ End If
+ StartY = 0
+ End If
+
+ EndX = StartX + EndXValue
+ EndY = StartY + EndYValue
+ If EndX > Map.MaxX Then
+ offsetX = 32
+ If EndX = Map.MaxX + 1 Then
+ If Player(MyIndex).XOffset < 0 Then
+ offsetX = Player(MyIndex).XOffset + PIC_X
+ End If
+ End If
+ EndX = Map.MaxX
+ StartX = EndX - MAX_MAPX - 1
+ End If
+ If EndY > Map.MaxY Then
+ offsetY = 32
+ If EndY = Map.MaxY + 1 Then
+ If Player(MyIndex).YOffset < 0 Then
+ offsetY = Player(MyIndex).YOffset + PIC_Y
+ End If
+ End If
+ EndY = Map.MaxY
+ StartY = EndY - MAX_MAPY - 1
+ End If
+
+ With TileView
+ .top = StartY
+ .Bottom = EndY
+ .Left = StartX
+ .Right = EndX
+ End With
+
+ With Camera
+ .top = offsetY
+ .Bottom = .top + ScreenY
+ .Left = offsetX
+ .Right = .Left + ScreenX
+ End With
+
+ UpdateDrawMapName
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "UpdateCamera", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Function ConvertMapX(ByVal x As Long) As Long
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ConvertMapX = x - (TileView.Left * PIC_X)
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "ConvertMapX", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Public Function ConvertMapY(ByVal y As Long) As Long
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ConvertMapY = y - (TileView.top * PIC_Y)
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "ConvertMapY", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Public Function InViewPort(ByVal x As Long, ByVal y As Long) As Boolean
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ InViewPort = False
+
+ If x < TileView.Left Then Exit Function
+ If y < TileView.top Then Exit Function
+ If x > TileView.Right Then Exit Function
+ If y > TileView.Bottom Then Exit Function
+ InViewPort = True
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "InViewPort", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Public Function IsValidMapPoint(ByVal x As Long, ByVal y As Long) As Boolean
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ IsValidMapPoint = False
+
+ If x < 0 Then Exit Function
+ If y < 0 Then Exit Function
+ If x > Map.MaxX Then Exit Function
+ If y > Map.MaxY Then Exit Function
+ IsValidMapPoint = True
+
+ ' Error handler
+ Exit Function
+errorhandler:
+ HandleError "IsValidMapPoint", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Function
+End Function
+
+Public Sub LoadTilesets()
+Dim x As Long
+Dim y As Long
+Dim i As Long
+Dim tilesetInUse() As Boolean
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ ReDim tilesetInUse(0 To NumTileSets)
+
+ For x = 0 To Map.MaxX
+ For y = 0 To Map.MaxY
+ For i = 1 To MapLayer.Layer_Count - 1
+ ' check exists
+ If Map.Tile(x, y).Layer(i).Tileset > 0 And Map.Tile(x, y).Layer(i).Tileset <= NumTileSets Then
+ tilesetInUse(Map.Tile(x, y).Layer(i).Tileset) = True
+ End If
+ Next
+ Next
+ Next
+
+ For i = 1 To NumTileSets
+ If tilesetInUse(i) Then
+ ' load tileset
+ If DDS_Tileset(i) Is Nothing Then
+ Call InitDDSurf("tilesets\" & i, DDSD_Tileset(i), DDS_Tileset(i))
+ End If
+ Else
+ ' unload tileset
+ Call ZeroMemory(ByVal VarPtr(DDSD_Tileset(i)), LenB(DDSD_Tileset(i)))
+ Set DDS_Tileset(i) = Nothing
+ End If
+ Next
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "LoadTilesets", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Sub BltBank()
+Dim i As Long, x As Long, y As Long, itemnum As Long
+Dim Amount As String
+Dim sRECT As RECT, dRECT As RECT
+Dim Sprite As Long, colour As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ If frmMain.picBank.Visible = True Then
+ frmMain.picBank.Cls
+
+ For i = 1 To MAX_BANK
+ itemnum = GetBankItemNum(i)
+ If itemnum > 0 And itemnum <= MAX_ITEMS Then
+
+ Sprite = Item(itemnum).Pic
+
+ If Sprite <= 0 Or Sprite > NumItems Then Exit Sub
+
+ If DDS_Item(Sprite) Is Nothing Then
+ Call InitDDSurf("Items\" & Sprite, DDSD_Item(Sprite), DDS_Item(Sprite))
+ End If
+
+ With sRECT
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = DDSD_Item(Sprite).lWidth / 2
+ .Right = .Left + PIC_X
+ End With
+
+ With dRECT
+ .top = BankTop + ((BankOffsetY + 32) * ((i - 1) \ BankColumns))
+ .Bottom = .top + PIC_Y
+ .Left = BankLeft + ((BankOffsetX + 32) * (((i - 1) Mod BankColumns)))
+ .Right = .Left + PIC_X
+ End With
+
+ Engine_BltToDC DDS_Item(Sprite), sRECT, dRECT, frmMain.picBank, False
+
+ ' If item is a stack - draw the amount you have
+ If GetBankItemValue(i) > 1 Then
+ y = dRECT.top + 22
+ x = dRECT.Left - 4
+
+ Amount = CStr(GetBankItemValue(i))
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If CLng(Amount) < 1000000 Then
+ colour = QBColor(White)
+ ElseIf CLng(Amount) > 1000000 And CLng(Amount) < 10000000 Then
+ colour = QBColor(Yellow)
+ ElseIf CLng(Amount) > 10000000 Then
+ colour = QBColor(BrightGreen)
+ End If
+ DrawText frmMain.picBank.hDC, x, y, ConvertCurrency(Amount), colour
+ End If
+ End If
+ Next
+
+ frmMain.picBank.Refresh
+ End If
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltBank", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
+
+Public Sub BltBankItem(ByVal x As Long, ByVal y As Long)
+Dim sRECT As RECT, dRECT As RECT
+Dim itemnum As Long
+Dim Sprite As Long
+
+ ' If debug mode, handle error then exit out
+ If Options.Debug = 1 Then On Error GoTo errorhandler
+
+ itemnum = GetBankItemNum(DragBankSlotNum)
+ Sprite = Item(GetBankItemNum(DragBankSlotNum)).Pic
+
+ If DDS_Item(Sprite) Is Nothing Then
+ Call InitDDSurf("Items\" & Sprite, DDSD_Item(Sprite), DDS_Item(Sprite))
+ End If
+
+ If itemnum > 0 Then
+ If itemnum <= MAX_ITEMS Then
+ With sRECT
+ .top = 0
+ .Bottom = .top + PIC_Y
+ .Left = DDSD_Item(Sprite).lWidth / 2
+ .Right = .Left + PIC_X
+ End With
+ End If
+ End If
+
+ With dRECT
+ .top = 2
+ .Bottom = .top + PIC_Y
+ .Left = 2
+ .Right = .Left + PIC_X
+ End With
+
+ Engine_BltToDC DDS_Item(Sprite), sRECT, dRECT, frmMain.picTempBank
+
+ With frmMain.picTempBank
+ .top = y
+ .Left = x
+ .Visible = True
+ .ZOrder (0)
+ End With
+
+ ' Error handler
+ Exit Sub
+errorhandler:
+ HandleError "BltBankItem", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext
+ Err.Clear
+ Exit Sub
+End Sub
diff --git a/client/src/modDirectMusic.bas b/client/src/modDirectMusic.bas
new file mode 100644
index 0000000..59e41b0
--- /dev/null
+++ b/client/src/modDirectMusic.bas
@@ -0,0 +1,39 @@
+Attribute VB_Name = "modMusic"
+Option Explicit
+
+Public bInit_Music As Boolean
+
+Public Function Init_Music() As Boolean
+ On Error GoTo errorhandler
+
+ ' exit out early if we have the system turned off
+ If Options.Music = 0 Then Exit Function
+
+ ' exit out early if we've already loaded
+ If bInit_Music Then Exit Function
+
+ ' init music engine
+ If Not FSOUND_Init(44100, 32, 0) Then GoTo errorhandler
+
+ ' return positive
+ Init_Music = True
+ bInit_Music = True
+ Exit Function
+
+errorhandler:
+ Init_Music = False
+ bInit_Music = False
+End Function
+
+Public Sub Destroy_Music()
+ ' destroy music engine
+ FSOUND_Close
+End Sub
+
+Public Sub Play_Music(ByVal song As String)
+ If Not bInit_Music Then Exit Sub
+End Sub
+
+Public Sub Stop_Music()
+ If Not bInit_Music Then Exit Sub
+End Sub
diff --git a/client/src/modDirectSound.bas b/client/src/modDirectSound.bas
new file mode 100644
index 0000000..046617b
--- /dev/null
+++ b/client/src/modDirectSound.bas
@@ -0,0 +1,43 @@
+Attribute VB_Name = "modSound"
+Option Explicit
+
+' Hardcoded sound effects
+Public Const Sound_ButtonHover As String = "Cursor1.wav"
+Public Const Sound_ButtonClick As String = "Decision1.wav"
+
+Public bInit_Sound As Boolean
+Public lastButtonSound As Long
+Public lastNpcChatsound As Long
+
+Public Function Init_Sound() As Boolean
+ On Error GoTo errorhandler
+
+ ' exit out early if we have the system turned off
+ If Options.sound = 0 Then Exit Function
+
+ ' exit out early if we've already loaded
+ If bInit_Sound Then Exit Function
+
+ ' init sound engine
+
+ ' return positive
+ Init_Sound = True
+ bInit_Sound = True
+ Exit Function
+
+errorhandler:
+ Init_Sound = False
+ bInit_Sound = False
+End Function
+
+Public Sub Destroy_Sound()
+ If Not bInit_Sound Then Exit Sub
+End Sub
+
+Public Sub Play_Sound(ByVal sound As String)
+ If Not bInit_Sound Then Exit Sub
+End Sub
+
+Public Sub Stop_Sound()
+ If Not bInit_Sound Then Exit Sub
+End Sub
diff --git a/client/src/modDirectX8.bas b/client/src/modDirectX8.bas
new file mode 100644
index 0000000..30f54a3
--- /dev/null
+++ b/client/src/modDirectX8.bas
@@ -0,0 +1,2312 @@
+Attribute VB_Name = "modDirectX8"
+Option Explicit
+
+' Texture wrapper
+Public Tex_Anim() As Long, Tex_Char() As Long, Tex_Face() As Long, Tex_Item() As Long, Tex_Paperdoll() As Long, Tex_Resource() As Long
+Public Tex_Spellicon() As Long, Tex_Tileset() As Long, Tex_Fog() As Long, Tex_GUI() As Long, Tex_Design() As Long, Tex_Gradient() As Long, Tex_Surface() As Long
+Public Tex_Bars As Long, Tex_Blood As Long, Tex_Direction As Long, Tex_Misc As Long, Tex_Target As Long, Tex_Shadow As Long
+Public Tex_Fader As Long, Tex_Blank As Long, Tex_Event As Long
+
+' Texture count
+Public Count_Anim As Long, Count_Char As Long, Count_Face As Long, Count_GUI As Long, Count_Design As Long, Count_Gradient As Long
+Public Count_Item As Long, Count_Paperdoll As Long, Count_Resource As Long, Count_Spellicon As Long, Count_Tileset As Long, Count_Fog As Long, Count_Surface As Long
+
+' Variables
+Public DX8 As DirectX8
+Public D3D As Direct3D8
+Public D3DX As D3DX8
+Public D3DDevice As Direct3DDevice8
+Public DXVB As Direct3DVertexBuffer8
+Public D3DWindow As D3DPRESENT_PARAMETERS
+Public mhWnd As Long
+Public BackBuffer As Direct3DSurface8
+
+Public Const FVF As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE 'Or D3DFVF_SPECULAR
+
+Public Type TextureStruct
+ Texture As Direct3DTexture8
+ data() As Byte
+ w As Long
+ h As Long
+End Type
+
+Public Type TextureDataStruct
+ data() As Byte
+End Type
+
+Public Type Vertex
+ x As Single
+ y As Single
+ z As Single
+ RHW As Single
+ Colour As Long
+ tu As Single
+ tv As Single
+End Type
+
+Public mClip As RECT
+Public Box(0 To 3) As Vertex
+Public mTexture() As TextureStruct
+Public mTextures As Long
+Public CurrentTexture As Long
+
+Public ScreenWidth As Long, ScreenHeight As Long
+Public TileWidth As Long, TileHeight As Long
+Public ScreenX As Long, ScreenY As Long
+Public curResolution As Byte, isFullscreen As Boolean
+
+Public Sub InitDX8(ByVal hWnd As Long)
+Dim DispMode As D3DDISPLAYMODE, width As Long, height As Long
+
+ mhWnd = hWnd
+
+ Set DX8 = New DirectX8
+ Set D3D = DX8.Direct3DCreate
+ Set D3DX = New D3DX8
+
+ ' set size
+ GetResolutionSize curResolution, width, height
+ ScreenWidth = width
+ ScreenHeight = height
+ TileWidth = (width / 32) - 1
+ TileHeight = (height / 32) - 1
+ ScreenX = (TileWidth) * PIC_X
+ ScreenY = (TileHeight) * PIC_Y
+
+ ' set up window
+ Call D3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, DispMode)
+ DispMode.Format = D3DFMT_A8R8G8B8
+
+ If Options.Fullscreen = 0 Then
+ isFullscreen = False
+ D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY
+ D3DWindow.hDeviceWindow = hWnd
+ D3DWindow.BackBufferFormat = DispMode.Format
+ D3DWindow.Windowed = 1
+ Else
+ isFullscreen = True
+ D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY
+ D3DWindow.BackBufferCount = 1
+ D3DWindow.BackBufferFormat = DispMode.Format
+ D3DWindow.BackBufferWidth = ScreenWidth
+ D3DWindow.BackBufferHeight = ScreenHeight
+ End If
+
+ Select Case Options.Render
+ Case 1 ' hardware
+ If LoadDirectX(D3DCREATE_HARDWARE_VERTEXPROCESSING, hWnd) <> 0 Then
+ Options.Fullscreen = 0
+ Options.Resolution = 0
+ Options.Render = 0
+ SaveOptions
+ Call MsgBox("Could not initialize DirectX with hardware vertex processing.", vbCritical)
+ Call DestroyGame
+ End If
+ Case 2 ' mixed
+ If LoadDirectX(D3DCREATE_MIXED_VERTEXPROCESSING, hWnd) <> 0 Then
+ Options.Fullscreen = 0
+ Options.Resolution = 0
+ Options.Render = 0
+ SaveOptions
+ Call MsgBox("Could not initialize DirectX with mixed vertex processing.", vbCritical)
+ Call DestroyGame
+ End If
+ Case 3 ' software
+ If LoadDirectX(D3DCREATE_SOFTWARE_VERTEXPROCESSING, hWnd) <> 0 Then
+ Options.Fullscreen = 0
+ Options.Resolution = 0
+ Options.Render = 0
+ SaveOptions
+ Call MsgBox("Could not initialize DirectX with software vertex processing.", vbCritical)
+ Call DestroyGame
+ End If
+ Case Else ' auto
+ If LoadDirectX(D3DCREATE_HARDWARE_VERTEXPROCESSING, hWnd) <> 0 Then
+ If LoadDirectX(D3DCREATE_MIXED_VERTEXPROCESSING, hWnd) <> 0 Then
+ If LoadDirectX(D3DCREATE_SOFTWARE_VERTEXPROCESSING, hWnd) <> 0 Then
+ Options.Fullscreen = 0
+ Options.Resolution = 0
+ Options.Render = 0
+ SaveOptions
+ Call MsgBox("Could not initialize DirectX. DX8VB.dll may not be registered.", vbCritical)
+ Call DestroyGame
+ End If
+ End If
+ End If
+ End Select
+
+ ' Render states
+ Call D3DDevice.SetVertexShader(FVF)
+ Call D3DDevice.SetRenderState(D3DRS_CULLMODE, D3DCULL_NONE)
+ Call D3DDevice.SetRenderState(D3DRS_LIGHTING, False)
+ Call D3DDevice.SetRenderState(D3DRS_ALPHABLENDENABLE, True)
+ Call D3DDevice.SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA)
+ Call D3DDevice.SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA)
+ Call D3DDevice.SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_MODULATE)
+ Call D3DDevice.SetTextureStageState(0, D3DTSS_ALPHAARG2, D3DTA_CURRENT)
+ Call D3DDevice.SetTextureStageState(0, D3DTSS_ALPHAARG1, 2)
+ Call D3DDevice.SetStreamSource(0, DXVB, Len(Box(0)))
+End Sub
+
+Public Function LoadDirectX(ByVal BehaviourFlags As CONST_D3DCREATEFLAGS, ByVal hWnd As Long)
+On Error GoTo ErrorInit
+
+ Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, hWnd, BehaviourFlags, D3DWindow)
+ Exit Function
+
+ErrorInit:
+ LoadDirectX = 1
+End Function
+
+Sub DestroyDX8()
+Dim i As Long
+ 'For i = 1 To mTextures
+ ' mTexture(i).data
+ 'Next
+ If Not DX8 Is Nothing Then Set DX8 = Nothing
+ If Not D3D Is Nothing Then Set D3D = Nothing
+ If Not D3DX Is Nothing Then Set D3DX = Nothing
+ If Not D3DDevice Is Nothing Then Set D3DDevice = Nothing
+End Sub
+
+Public Sub LoadTextures()
+Dim i As Long
+ ' Arrays
+ Tex_Tileset = LoadTextureFiles(Count_Tileset, App.path & Path_Tileset)
+ Tex_Anim = LoadTextureFiles(Count_Anim, App.path & Path_Anim)
+ Tex_Char = LoadTextureFiles(Count_Char, App.path & Path_Char)
+ Tex_Face = LoadTextureFiles(Count_Face, App.path & Path_Face)
+ Tex_Item = LoadTextureFiles(Count_Item, App.path & Path_Item)
+ Tex_Paperdoll = LoadTextureFiles(Count_Paperdoll, App.path & Path_Paperdoll)
+ Tex_Resource = LoadTextureFiles(Count_Resource, App.path & Path_Resource)
+ Tex_Spellicon = LoadTextureFiles(Count_Spellicon, App.path & Path_Spellicon)
+ Tex_GUI = LoadTextureFiles(Count_GUI, App.path & Path_GUI)
+ Tex_Design = LoadTextureFiles(Count_Design, App.path & Path_Design)
+ Tex_Gradient = LoadTextureFiles(Count_Gradient, App.path & Path_Gradient)
+ Tex_Surface = LoadTextureFiles(Count_Surface, App.path & Path_Surface)
+ ' Singles
+ Tex_Bars = LoadTextureFile(App.path & Path_Graphics & "bars.png")
+ Tex_Blood = LoadTextureFile(App.path & Path_Graphics & "blood.png")
+ Tex_Direction = LoadTextureFile(App.path & Path_Graphics & "direction.png")
+ Tex_Misc = LoadTextureFile(App.path & Path_Graphics & "misc.png")
+ Tex_Target = LoadTextureFile(App.path & Path_Graphics & "target.png")
+ Tex_Shadow = LoadTextureFile(App.path & Path_Graphics & "shadow.png")
+ Tex_Fader = LoadTextureFile(App.path & Path_Graphics & "fader.png")
+ Tex_Blank = LoadTextureFile(App.path & Path_Graphics & "blank.png")
+ Tex_Event = LoadTextureFile(App.path & Path_Graphics & "event.png")
+End Sub
+
+Public Function LoadTextureFiles(ByRef Counter As Long, ByVal path As String) As Long()
+Dim Texture() As Long
+Dim i As Long
+
+ Counter = 1
+
+ Do While dir$(path & Counter + 1 & ".png") <> vbNullString
+ Counter = Counter + 1
+ Loop
+
+ ReDim Texture(0 To Counter)
+
+ For i = 1 To Counter
+ Texture(i) = LoadTextureFile(path & i & ".png")
+ DoEvents
+ Next
+
+ LoadTextureFiles = Texture
+End Function
+
+Public Function LoadTextureFile(ByVal path As String, Optional ByVal DontReuse As Boolean) As Long
+Dim data() As Byte
+Dim f As Long
+
+ If dir$(path) = vbNullString Then
+ Call MsgBox("""" & path & """ could not be found.")
+ End
+ End If
+
+ f = FreeFile
+ Open path For Binary As #f
+ ReDim data(0 To LOF(f) - 1)
+ Get #f, , data
+ Close #f
+
+ LoadTextureFile = LoadTexture(data, DontReuse)
+End Function
+
+Public Function LoadTexture(ByRef data() As Byte, Optional ByVal DontReuse As Boolean) As Long
+Dim i As Long
+
+ If AryCount(data) = 0 Then
+ Exit Function
+ End If
+
+ mTextures = mTextures + 1
+ LoadTexture = mTextures
+ ReDim Preserve mTexture(1 To mTextures) As TextureStruct
+ mTexture(mTextures).w = ByteToInt(data(18), data(19))
+ mTexture(mTextures).h = ByteToInt(data(22), data(23))
+ mTexture(mTextures).data = data
+ Set mTexture(mTextures).Texture = D3DX.CreateTextureFromFileInMemoryEx(D3DDevice, data(0), AryCount(data), mTexture(mTextures).w, mTexture(mTextures).h, D3DX_DEFAULT, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_POINT, 0, ByVal 0, ByVal 0)
+End Function
+
+Public Sub CheckGFX()
+ If D3DDevice.TestCooperativeLevel <> D3D_OK Then
+ Do While D3DDevice.TestCooperativeLevel = D3DERR_DEVICELOST
+ DoEvents
+ Loop
+ Call ResetGFX
+ End If
+End Sub
+
+Public Sub ResetGFX()
+Dim Temp() As TextureDataStruct
+Dim i As Long, n As Long
+
+ n = mTextures
+ ReDim Temp(1 To n)
+ For i = 1 To n
+ Set mTexture(i).Texture = Nothing
+ Temp(i).data = mTexture(i).data
+ Next
+
+ Erase mTexture
+ mTextures = 0
+
+ Call D3DDevice.Reset(D3DWindow)
+ Call D3DDevice.SetVertexShader(FVF)
+ Call D3DDevice.SetRenderState(D3DRS_CULLMODE, D3DCULL_NONE)
+ Call D3DDevice.SetRenderState(D3DRS_LIGHTING, False)
+ Call D3DDevice.SetRenderState(D3DRS_ALPHABLENDENABLE, True)
+ Call D3DDevice.SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCALPHA)
+ Call D3DDevice.SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA)
+ Call D3DDevice.SetTextureStageState(0, D3DTSS_ALPHAOP, D3DTOP_MODULATE)
+ Call D3DDevice.SetTextureStageState(0, D3DTSS_ALPHAARG2, D3DTA_CURRENT)
+ Call D3DDevice.SetTextureStageState(0, D3DTSS_ALPHAARG1, 2)
+
+ For i = 1 To n
+ Call LoadTexture(Temp(i).data)
+ Next
+End Sub
+
+Public Sub SetTexture(ByVal textureNum As Long)
+ If textureNum > 0 Then
+ Call D3DDevice.SetTexture(0, mTexture(textureNum).Texture)
+ CurrentTexture = textureNum
+ Else
+ Call D3DDevice.SetTexture(0, Nothing)
+ CurrentTexture = 0
+ End If
+End Sub
+
+Public Sub RenderTexture(Texture As Long, ByVal x As Long, ByVal y As Long, ByVal sX As Single, ByVal sY As Single, ByVal w As Long, ByVal h As Long, ByVal sW As Single, ByVal sH As Single, Optional ByVal Colour As Long = -1, Optional ByVal offset As Boolean = False)
+ SetTexture Texture
+ RenderGeom x, y, sX, sY, w, h, sW, sH, Colour, offset
+End Sub
+
+Public Sub RenderGeom(ByVal x As Long, ByVal y As Long, ByVal sX As Single, ByVal sY As Single, ByVal w As Long, ByVal h As Long, ByVal sW As Single, ByVal sH As Single, Optional ByVal Colour As Long = -1, Optional ByVal offset As Boolean = False)
+Dim i As Long
+
+ If CurrentTexture = 0 Then Exit Sub
+ If w = 0 Then Exit Sub
+ If h = 0 Then Exit Sub
+ If sW = 0 Then Exit Sub
+ If sH = 0 Then Exit Sub
+
+ If mClip.Right <> 0 Then
+ If mClip.top <> 0 Then
+ If mClip.left > x Then
+ sX = sX + (mClip.left - x) / (w / sW)
+ sW = sW - (mClip.left - x) / (w / sW)
+ w = w - (mClip.left - x)
+ x = mClip.left
+ End If
+
+ If mClip.top > y Then
+ sY = sY + (mClip.top - y) / (h / sH)
+ sH = sH - (mClip.top - y) / (h / sH)
+ h = h - (mClip.top - y)
+ y = mClip.top
+ End If
+
+ If mClip.Right < x + w Then
+ sW = sW - (x + w - mClip.Right) / (w / sW)
+ w = -x + mClip.Right
+ End If
+
+ If mClip.bottom < y + h Then
+ sH = sH - (y + h - mClip.bottom) / (h / sH)
+ h = -y + mClip.bottom
+ End If
+
+ If w <= 0 Then Exit Sub
+ If h <= 0 Then Exit Sub
+ If sW <= 0 Then Exit Sub
+ If sH <= 0 Then Exit Sub
+ End If
+ End If
+
+ Call GeomCalc(Box, CurrentTexture, x, y, w, h, sX, sY, sW, sH, Colour)
+ Call D3DDevice.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, Box(0), Len(Box(0)))
+End Sub
+
+Public Sub GeomCalc(ByRef Geom() As Vertex, ByVal textureNum As Long, ByVal x As Single, ByVal y As Single, ByVal w As Integer, ByVal h As Integer, ByVal sX As Single, ByVal sY As Single, ByVal sW As Single, ByVal sH As Single, ByVal Colour As Long)
+ sW = (sW + sX) / mTexture(textureNum).w + 0.000003
+ sH = (sH + sY) / mTexture(textureNum).h + 0.000003
+ sX = sX / mTexture(textureNum).w + 0.000003
+ sY = sY / mTexture(textureNum).h + 0.000003
+ Geom(0) = MakeVertex(x, y, 0, 1, Colour, 1, sX, sY)
+ Geom(1) = MakeVertex(x + w, y, 0, 1, Colour, 0, sW, sY)
+ Geom(2) = MakeVertex(x, y + h, 0, 1, Colour, 0, sX, sH)
+ Geom(3) = MakeVertex(x + w, y + h, 0, 1, Colour, 0, sW, sH)
+End Sub
+
+Private Sub GeomSetBox(ByVal x As Single, ByVal y As Single, ByVal w As Integer, ByVal h As Integer, ByVal Colour As Long)
+ Box(0) = MakeVertex(x, y, 0, 1, Colour, 0, 0, 0)
+ Box(1) = MakeVertex(x + w, y, 0, 1, Colour, 0, 0, 0)
+ Box(2) = MakeVertex(x, y + h, 0, 1, Colour, 0, 0, 0)
+ Box(3) = MakeVertex(x + w, y + h, 0, 1, Colour, 0, 0, 0)
+End Sub
+
+Private Function MakeVertex(x As Single, y As Single, z As Single, RHW As Single, Colour As Long, Specular As Long, tu As Single, tv As Single) As Vertex
+ MakeVertex.x = x
+ MakeVertex.y = y
+ MakeVertex.z = z
+ MakeVertex.RHW = RHW
+ MakeVertex.Colour = Colour
+ 'MakeVertex.Specular = Specular
+ MakeVertex.tu = tu
+ MakeVertex.tv = tv
+End Function
+
+' GDI rendering
+Public Sub GDIRenderAnimation()
+ Dim i As Long, Animationnum As Long, ShouldRender As Boolean, width As Long, height As Long, looptime As Long, FrameCount As Long
+ Dim sX As Long, sY As Long, sRECT As RECT
+ sRECT.top = 0
+ sRECT.bottom = 192
+ sRECT.left = 0
+ sRECT.Right = 192
+
+ For i = 0 To 1
+ Animationnum = frmEditor_Animation.scrlSprite(i).value
+
+ If Animationnum <= 0 Or Animationnum > Count_Anim Then
+ ' don't render lol
+ Else
+ looptime = frmEditor_Animation.scrlLoopTime(i)
+
+ FrameCount = frmEditor_Animation.scrlFrameCount(i)
+ ShouldRender = False
+
+ ' check if we need to render new frame
+ If AnimEditorTimer(i) + looptime <= GetTickCount Then
+
+ ' check if out of range
+ If AnimEditorFrame(i) >= FrameCount Then
+ AnimEditorFrame(i) = 1
+ Else
+ AnimEditorFrame(i) = AnimEditorFrame(i) + 1
+ End If
+
+ AnimEditorTimer(i) = GetTickCount
+ ShouldRender = True
+ End If
+
+ If ShouldRender Then
+ If frmEditor_Animation.scrlFrameCount(i).value > 0 Then
+ ' total width divided by frame count
+ width = 192
+ height = 192
+ sY = (height * ((AnimEditorFrame(i) - 1) \ AnimColumns))
+ sX = (width * (((AnimEditorFrame(i) - 1) Mod AnimColumns)))
+ ' Start Rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0)
+ Call D3DDevice.BeginScene
+ 'EngineRenderRectangle Tex_Anim(Animationnum), 0, 0, sX, sY, width, height, width, height
+ RenderTexture Tex_Anim(Animationnum), 0, 0, sX, sY, width, height, width, height
+ ' Finish Rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, frmEditor_Animation.picSprite(i).hWnd, ByVal 0)
+ End If
+ End If
+ End If
+
+ Next
+
+End Sub
+
+Public Sub GDIRenderChar(ByRef picBox As PictureBox, ByVal sprite As Long)
+ Dim height As Long, width As Long, sRECT As RECT
+
+ ' exit out if doesn't exist
+ If sprite <= 0 Or sprite > Count_Char Then Exit Sub
+ height = 32
+ width = 32
+ sRECT.top = 0
+ sRECT.bottom = sRECT.top + height
+ sRECT.left = 0
+ sRECT.Right = sRECT.left + width
+ ' Start Rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0)
+ Call D3DDevice.BeginScene
+ RenderTexture Tex_Char(sprite), 0, 0, 0, 0, width, height, width, height
+ ' Finish Rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, picBox.hWnd, ByVal 0)
+End Sub
+
+Public Sub GDIRenderFace(ByRef picBox As PictureBox, ByVal sprite As Long)
+ Dim height As Long, width As Long, sRECT As RECT
+
+ ' exit out if doesn't exist
+ If sprite <= 0 Or sprite > Count_Face Then Exit Sub
+ height = mTexture(Tex_Face(sprite)).h
+ width = mTexture(Tex_Face(sprite)).w
+
+ If height = 0 Or width = 0 Then
+ height = 1
+ width = 1
+ End If
+
+ sRECT.top = 0
+ sRECT.bottom = sRECT.top + height
+ sRECT.left = 0
+ sRECT.Right = sRECT.left + width
+ ' Start Rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0)
+ Call D3DDevice.BeginScene
+ 'EngineRenderRectangle Tex_Face(sprite), 0, 0, 0, 0, width, height, width, height, width, height
+ RenderTexture Tex_Face(sprite), 0, 0, 0, 0, width, height, width, height
+ ' Finish Rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, picBox.hWnd, ByVal 0)
+End Sub
+
+Sub GDIRenderEventGraphic()
+ Dim height As Long, width As Long, GraphicType As Long, graphicNum As Long, sX As Long, sY As Long, texNum As Long
+ Dim sRECT As RECT, Graphic As Long
+
+ If Not frmEditor_Events.visible Then Exit Sub
+ If curPageNum = 0 Then Exit Sub
+
+ GraphicType = tmpEvent.EventPage(curPageNum).GraphicType
+ Graphic = tmpEvent.EventPage(curPageNum).Graphic
+ sX = tmpEvent.EventPage(curPageNum).GraphicX
+ sY = tmpEvent.EventPage(curPageNum).GraphicY
+
+ If GraphicType = 0 Then Exit Sub
+ If Graphic = 0 Then Exit Sub
+
+ height = 32
+ width = 32
+
+ Select Case GraphicType
+ Case 0 ' nothing
+ texNum = 0
+ Case 1 ' Character
+ If Graphic <= Count_Char Then texNum = Tex_Char(Graphic) Else texNum = 0
+ Case 2 ' Tileset
+ If Graphic <= Count_Tileset Then texNum = Tex_Tileset(Graphic) Else texNum = 0
+ End Select
+
+ If texNum = 0 Then
+ frmEditor_Events.picGraphic.Cls
+ Exit Sub
+ End If
+
+ sRECT.top = 0
+ sRECT.bottom = sRECT.top + frmEditor_Events.picGraphic.ScaleHeight
+ sRECT.left = 0
+ sRECT.Right = sRECT.left + frmEditor_Events.picGraphic.ScaleWidth
+
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, DX8Colour(White, 255), 1#, 0)
+ Call D3DDevice.BeginScene
+
+ RenderTexture texNum, (frmEditor_Events.picGraphic.ScaleWidth / 2) - 16, (frmEditor_Events.picGraphic.ScaleHeight / 2) - 16, sX * 32, sY * 32, width, height, width, height
+
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, frmEditor_Events.picGraphic.hWnd, ByVal 0)
+End Sub
+
+Sub GDIRenderEventGraphicSel()
+ Dim height As Long, width As Long, GraphicType As Long, graphicNum As Long, sX As Long, sY As Long, texNum As Long
+ Dim sRECT As RECT, Graphic As Long
+
+ If Not frmEditor_Events.visible Then Exit Sub
+ If Not frmEditor_Events.fraGraphic.visible Then Exit Sub
+ If curPageNum = 0 Then Exit Sub
+
+ GraphicType = tmpEvent.EventPage(curPageNum).GraphicType
+ Graphic = tmpEvent.EventPage(curPageNum).Graphic
+
+ If GraphicType = 0 Then Exit Sub
+ If Graphic = 0 Then Exit Sub
+
+ Select Case GraphicType
+ Case 0 ' nothing
+ texNum = 0
+ Case 1 ' Character
+ If Graphic <= Count_Char Then texNum = Tex_Char(Graphic) Else texNum = 0
+ Case 2 ' Tileset
+ If Graphic <= Count_Tileset Then texNum = Tex_Tileset(Graphic) Else texNum = 0
+ End Select
+
+ If texNum = 0 Then
+ frmEditor_Events.picGraphicSel.Cls
+ Exit Sub
+ End If
+
+ width = mTexture(texNum).w
+ height = mTexture(texNum).h
+
+ sRECT.top = 0
+ sRECT.bottom = sRECT.top + frmEditor_Events.picGraphicSel.ScaleHeight
+ sRECT.left = 0
+ sRECT.Right = sRECT.left + frmEditor_Events.picGraphicSel.ScaleWidth
+
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, DX8Colour(White, 255), 1#, 0)
+ Call D3DDevice.BeginScene
+
+ RenderTexture texNum, 0, 0, 0, 0, width, height, width, height
+ RenderDesign DesignTypes.desTileBox, GraphicSelX * 32, GraphicSelY * 32, 32, 32
+
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, frmEditor_Events.picGraphicSel.hWnd, ByVal 0)
+End Sub
+
+Public Sub GDIRenderTileset()
+ Dim height As Long, width As Long, tileSet As Byte, sRECT As RECT
+ ' find tileset number
+ tileSet = frmEditor_Map.scrlTileSet.value
+
+ ' exit out if doesn't exist
+ If tileSet <= 0 Or tileSet > Count_Tileset Then Exit Sub
+ height = mTexture(Tex_Tileset(tileSet)).h
+ width = mTexture(Tex_Tileset(tileSet)).w
+
+ If height = 0 Or width = 0 Then
+ height = 1
+ width = 1
+ End If
+
+ frmEditor_Map.picBackSelect.width = width
+ frmEditor_Map.picBackSelect.height = height
+ sRECT.top = 0
+ sRECT.bottom = height
+ sRECT.left = 0
+ sRECT.Right = width
+
+ ' change selected shape for autotiles
+ If frmEditor_Map.scrlAutotile.value > 0 Then
+
+ Select Case frmEditor_Map.scrlAutotile.value
+
+ Case 1 ' autotile
+ shpSelectedWidth = 64
+ shpSelectedHeight = 96
+
+ Case 2 ' fake autotile
+ shpSelectedWidth = 32
+ shpSelectedHeight = 32
+
+ Case 3 ' animated
+ shpSelectedWidth = 192
+ shpSelectedHeight = 96
+
+ Case 4 ' cliff
+ shpSelectedWidth = 64
+ shpSelectedHeight = 64
+
+ Case 5 ' waterfall
+ shpSelectedWidth = 64
+ shpSelectedHeight = 96
+ End Select
+
+ End If
+
+ ' Start Rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, DX8Colour(White, 255), 1#, 0)
+ Call D3DDevice.BeginScene
+
+ 'EngineRenderRectangle Tex_Tileset(Tileset), 0, 0, 0, 0, width, height, width, height, width, height
+ If Tex_Tileset(tileSet) <= 0 Then Exit Sub
+ RenderTexture Tex_Tileset(tileSet), 0, 0, 0, 0, width, height, width, height
+ ' draw selection boxes
+ RenderDesign DesignTypes.desTileBox, shpSelectedLeft, shpSelectedTop, shpSelectedWidth, shpSelectedHeight
+ ' Finish Rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, frmEditor_Map.picBackSelect.hWnd, ByVal 0)
+End Sub
+
+Public Sub GDIRenderItem(ByRef picBox As PictureBox, ByVal sprite As Long)
+ Dim height As Long, width As Long, sRECT As RECT
+
+ ' exit out if doesn't exist
+ If sprite <= 0 Or sprite > Count_Item Then Exit Sub
+ height = mTexture(Tex_Item(sprite)).h
+ width = mTexture(Tex_Item(sprite)).w
+ sRECT.top = 0
+ sRECT.bottom = 32
+ sRECT.left = 0
+ sRECT.Right = 32
+ ' Start Rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0)
+ Call D3DDevice.BeginScene
+ 'EngineRenderRectangle Tex_Item(sprite), 0, 0, 0, 0, 32, 32, 32, 32, 32, 32
+ RenderTexture Tex_Item(sprite), 0, 0, 0, 0, 32, 32, 32, 32
+ ' Finish Rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, picBox.hWnd, ByVal 0)
+End Sub
+
+Public Sub GDIRenderSpell(ByRef picBox As PictureBox, ByVal sprite As Long)
+ Dim height As Long, width As Long, sRECT As RECT
+
+ ' exit out if doesn't exist
+ If sprite <= 0 Or sprite > Count_Spellicon Then Exit Sub
+ height = mTexture(Tex_Spellicon(sprite)).h
+ width = mTexture(Tex_Spellicon(sprite)).w
+
+ If height = 0 Or width = 0 Then
+ height = 1
+ width = 1
+ End If
+
+ sRECT.top = 0
+ sRECT.bottom = height
+ sRECT.left = 0
+ sRECT.Right = width
+ ' Start Rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, 0, 1#, 0)
+ Call D3DDevice.BeginScene
+ 'EngineRenderRectangle Tex_Spellicon(sprite), 0, 0, 0, 0, 32, 32, 32, 32, 32, 32
+ RenderTexture Tex_Spellicon(sprite), 0, 0, 0, 0, 32, 32, 32, 32
+ ' Finish Rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(sRECT, ByVal 0, picBox.hWnd, ByVal 0)
+End Sub
+
+' Directional blocking
+Public Sub DrawDirection(ByVal x As Long, ByVal y As Long)
+ Dim i As Long, top As Long, left As Long
+ ' render grid
+ top = 24
+ left = 0
+ 'EngineRenderRectangle Tex_Direction, ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), left, top, 32, 32, 32, 32, 32, 32
+ RenderTexture Tex_Direction, ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), left, top, 32, 32, 32, 32
+
+ ' render dir blobs
+ For i = 1 To 4
+ left = (i - 1) * 8
+
+ ' find out whether render blocked or not
+ If Not isDirBlocked(map.TileData.Tile(x, y).DirBlock, CByte(i)) Then
+ top = 8
+ Else
+ top = 16
+ End If
+
+ 'render!
+ 'EngineRenderRectangle Tex_Direction, ConvertMapX(x * PIC_X) + DirArrowX(i), ConvertMapY(y * PIC_Y) + DirArrowY(i), left, top, 8, 8, 8, 8, 8, 8
+ RenderTexture Tex_Direction, ConvertMapX(x * PIC_X) + DirArrowX(i), ConvertMapY(y * PIC_Y) + DirArrowY(i), left, top, 8, 8, 8, 8
+ Next
+
+End Sub
+
+Public Sub DrawFade()
+ RenderTexture Tex_Blank, 0, 0, 0, 0, ScreenWidth, ScreenHeight, 32, 32, DX8Colour(White, fadeAlpha)
+End Sub
+
+Public Sub DrawFog()
+ Dim fogNum As Long, Colour As Long, x As Long, y As Long, renderState As Long
+ fogNum = 3
+
+ If fogNum <= 0 Or fogNum > Count_Fog Then Exit Sub
+ Colour = D3DColorARGB(64, 255, 255, 255)
+ renderState = 0
+ Exit Sub
+
+ ' render state
+ Select Case renderState
+
+ Case 1 ' Additive
+ D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
+ D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
+
+ Case 2 ' Subtractive
+ D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_SUBTRACT
+ D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ZERO
+ D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCCOLOR
+ End Select
+
+ For x = 0 To 4
+ For y = 0 To 3
+ 'RenderTexture Tex_Fog(fogNum), (x * 256) + fogOffsetX, (y * 256) + fogOffsetY, 0, 0, 256, 256, 256, 256, colour
+ RenderTexture Tex_Fog(fogNum), (x * 256), (y * 256), 0, 0, 256, 256, 256, 256, Colour
+ Next
+ Next
+
+ ' reset render state
+ If renderState > 0 Then
+ D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
+ D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
+ D3DDevice.SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
+ End If
+
+End Sub
+
+Public Sub DrawAutoTile(ByVal layernum As Long, ByVal destX As Long, ByVal destY As Long, ByVal quarterNum As Long, ByVal x As Long, ByVal y As Long)
+ Dim yOffset As Long, xOffset As Long
+
+ ' calculate the offset
+ Select Case map.TileData.Tile(x, y).Autotile(layernum)
+
+ Case AUTOTILE_WATERFALL
+ yOffset = (waterfallFrame - 1) * 32
+
+ Case AUTOTILE_ANIM
+ xOffset = autoTileFrame * 64
+
+ Case AUTOTILE_CLIFF
+ yOffset = -32
+ End Select
+
+ ' Draw the quarter
+ RenderTexture Tex_Tileset(map.TileData.Tile(x, y).Layer(layernum).tileSet), destX, destY, Autotile(x, y).Layer(layernum).srcX(quarterNum) + xOffset, Autotile(x, y).Layer(layernum).srcY(quarterNum) + yOffset, 16, 16, 16, 16
+End Sub
+
+Sub DrawTileSelection()
+ If frmEditor_Map.optEvents.value Then
+ RenderDesign DesignTypes.desTileBox, ConvertMapX(selTileX * PIC_X), ConvertMapY(selTileY * PIC_Y), 32, 32
+ Else
+ If frmEditor_Map.scrlAutotile > 0 Then
+ RenderDesign DesignTypes.desTileBox, ConvertMapX(CurX * PIC_X), ConvertMapY(CurY * PIC_Y), 32, 32
+ Else
+ RenderDesign DesignTypes.desTileBox, ConvertMapX(CurX * PIC_X), ConvertMapY(CurY * PIC_Y), shpSelectedWidth, shpSelectedHeight
+ End If
+ End If
+End Sub
+
+' Rendering Procedures
+Public Sub DrawMapTile(ByVal x As Long, ByVal y As Long)
+Dim i As Long, tileSet As Long, sX As Long, sY As Long
+
+ With map.TileData.Tile(x, y)
+ ' draw the map
+ For i = MapLayer.Ground To MapLayer.Mask2
+ ' skip tile if tileset isn't set
+ If Autotile(x, y).Layer(i).renderState = RENDER_STATE_NORMAL Then
+ ' Draw normally
+ RenderTexture Tex_Tileset(.Layer(i).tileSet), ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), .Layer(i).x * 32, .Layer(i).y * 32, 32, 32, 32, 32
+ ElseIf Autotile(x, y).Layer(i).renderState = RENDER_STATE_AUTOTILE Then
+ ' Draw autotiles
+ DrawAutoTile i, ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), 1, x, y
+ DrawAutoTile i, ConvertMapX((x * PIC_X) + 16), ConvertMapY(y * PIC_Y), 2, x, y
+ DrawAutoTile i, ConvertMapX(x * PIC_X), ConvertMapY((y * PIC_Y) + 16), 3, x, y
+ DrawAutoTile i, ConvertMapX((x * PIC_X) + 16), ConvertMapY((y * PIC_Y) + 16), 4, x, y
+ ElseIf Autotile(x, y).Layer(i).renderState = RENDER_STATE_APPEAR Then
+ ' check if it's fading
+ If TempTile(x, y).fadeAlpha(i) > 0 Then
+ ' render it
+ tileSet = map.TileData.Tile(x, y).Layer(i).tileSet
+ sX = map.TileData.Tile(x, y).Layer(i).x
+ sY = map.TileData.Tile(x, y).Layer(i).y
+ RenderTexture Tex_Tileset(tileSet), ConvertMapX(x * 32), ConvertMapY(y * 32), sX * 32, sY * 32, 32, 32, 32, 32, DX8Colour(White, TempTile(x, y).fadeAlpha(i))
+ End If
+ End If
+ Next
+ End With
+End Sub
+
+Public Sub DrawMapFringeTile(ByVal x As Long, ByVal y As Long)
+ Dim i As Long
+
+ With map.TileData.Tile(x, y)
+ ' draw the map
+ For i = MapLayer.Fringe To MapLayer.Fringe2
+
+ ' skip tile if tileset isn't set
+ If Autotile(x, y).Layer(i).renderState = RENDER_STATE_NORMAL Then
+ ' Draw normally
+ RenderTexture Tex_Tileset(.Layer(i).tileSet), ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), .Layer(i).x * 32, .Layer(i).y * 32, 32, 32, 32, 32
+ ElseIf Autotile(x, y).Layer(i).renderState = RENDER_STATE_AUTOTILE Then
+ ' Draw autotiles
+ DrawAutoTile i, ConvertMapX(x * PIC_X), ConvertMapY(y * PIC_Y), 1, x, y
+ DrawAutoTile i, ConvertMapX((x * PIC_X) + 16), ConvertMapY(y * PIC_Y), 2, x, y
+ DrawAutoTile i, ConvertMapX(x * PIC_X), ConvertMapY((y * PIC_Y) + 16), 3, x, y
+ DrawAutoTile i, ConvertMapX((x * PIC_X) + 16), ConvertMapY((y * PIC_Y) + 16), 4, x, y
+ End If
+ Next
+ End With
+End Sub
+
+Public Sub DrawHotbar()
+ Dim xO As Long, yO As Long, width As Long, height As Long, i As Long, t As Long, sS As String
+
+ xO = Windows(GetWindowIndex("winHotbar")).Window.left
+ yO = Windows(GetWindowIndex("winHotbar")).Window.top
+
+ ' render start + end wood
+ RenderTexture Tex_GUI(31), xO - 1, yO + 3, 0, 0, 11, 26, 11, 26
+ RenderTexture Tex_GUI(31), xO + 407, yO + 3, 0, 0, 11, 26, 11, 26
+
+ For i = 1 To MAX_HOTBAR
+ xO = Windows(GetWindowIndex("winHotbar")).Window.left + HotbarLeft + ((i - 1) * HotbarOffsetX)
+ yO = Windows(GetWindowIndex("winHotbar")).Window.top + HotbarTop
+ width = 36
+ height = 36
+ ' don't render last one
+ If i <> 10 Then
+ ' render wood
+ RenderTexture Tex_GUI(32), xO + 30, yO + 3, 0, 0, 13, 26, 13, 26
+ End If
+ ' render box
+ RenderTexture Tex_GUI(30), xO - 2, yO - 2, 0, 0, width, height, width, height
+ ' render icon
+ If Not (DragBox.Origin = origin_Hotbar And DragBox.Slot = i) Then
+ Select Case Hotbar(i).sType
+ Case 1 ' inventory
+ If Len(Item(Hotbar(i).Slot).name) > 0 And Item(Hotbar(i).Slot).Pic > 0 Then
+ RenderTexture Tex_Item(Item(Hotbar(i).Slot).Pic), xO, yO, 0, 0, 32, 32, 32, 32
+ End If
+ Case 2 ' spell
+ If Len(Spell(Hotbar(i).Slot).name) > 0 And Spell(Hotbar(i).Slot).icon > 0 Then
+ RenderTexture Tex_Spellicon(Spell(Hotbar(i).Slot).icon), xO, yO, 0, 0, 32, 32, 32, 32
+ For t = 1 To MAX_PLAYER_SPELLS
+ If PlayerSpells(t).Spell > 0 Then
+ If PlayerSpells(t).Spell = Hotbar(i).Slot And SpellCD(t) > 0 Then
+ RenderTexture Tex_Spellicon(Spell(Hotbar(i).Slot).icon), xO, yO, 0, 0, 32, 32, 32, 32, D3DColorARGB(255, 100, 100, 100)
+ End If
+ End If
+ Next
+ End If
+ End Select
+ End If
+ ' draw the numbers
+ sS = Str(i)
+ If i = 10 Then sS = "0"
+ RenderText font(Fonts.rockwellDec_15), sS, xO + 4, yO + 19, White
+ Next
+End Sub
+
+Public Sub RenderAppearTileFade()
+Dim x As Long, y As Long, tileSet As Long, sX As Long, sY As Long, layernum As Long
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ For layernum = MapLayer.Ground To MapLayer.Mask
+ ' check if it's fading
+ If TempTile(x, y).fadeAlpha(layernum) > 0 Then
+ ' render it
+ tileSet = map.TileData.Tile(x, y).Layer(layernum).tileSet
+ sX = map.TileData.Tile(x, y).Layer(layernum).x
+ sY = map.TileData.Tile(x, y).Layer(layernum).y
+ RenderTexture Tex_Tileset(tileSet), ConvertMapX(x * 32), ConvertMapY(y * 32), sX * 32, sY * 32, 32, 32, 32, 32, DX8Colour(White, TempTile(x, y).fadeAlpha(layernum))
+ End If
+ Next
+ Next
+ Next
+End Sub
+
+Public Sub DrawCharacter()
+ Dim xO As Long, yO As Long, width As Long, height As Long, i As Long, sprite As Long, itemNum As Long, itemPic As Long
+
+ xO = Windows(GetWindowIndex("winCharacter")).Window.left
+ yO = Windows(GetWindowIndex("winCharacter")).Window.top
+
+ ' Render bottom
+ RenderTexture Tex_GUI(37), xO + 4, yO + 314, 0, 0, 40, 38, 40, 38
+ RenderTexture Tex_GUI(37), xO + 44, yO + 314, 0, 0, 40, 38, 40, 38
+ RenderTexture Tex_GUI(37), xO + 84, yO + 314, 0, 0, 40, 38, 40, 38
+ RenderTexture Tex_GUI(37), xO + 124, yO + 314, 0, 0, 46, 38, 46, 38
+
+ ' render top wood
+ RenderTexture Tex_GUI(1), xO + 4, yO + 23, 100, 100, 166, 291, 166, 291
+
+ ' loop through equipment
+ For i = 1 To Equipment.Equipment_Count - 1
+ itemNum = GetPlayerEquipment(MyIndex, i)
+
+ ' get the item sprite
+ If itemNum > 0 Then
+ itemPic = Tex_Item(Item(itemNum).Pic)
+ Else
+ ' no item equiped - use blank image
+ itemPic = Tex_GUI(37 + i)
+ End If
+
+ yO = Windows(GetWindowIndex("winCharacter")).Window.top + EqTop
+ xO = Windows(GetWindowIndex("winCharacter")).Window.left + EqLeft + ((EqOffsetX + 32) * (((i - 1) Mod EqColumns)))
+
+ RenderTexture itemPic, xO, yO, 0, 0, 32, 32, 32, 32
+ Next
+End Sub
+
+Public Sub DrawSkills()
+ Dim xO As Long, yO As Long, width As Long, height As Long, i As Long, y As Long, spellnum As Long, spellPic As Long, x As Long, top As Long, left As Long
+
+ xO = Windows(GetWindowIndex("winSkills")).Window.left
+ yO = Windows(GetWindowIndex("winSkills")).Window.top
+
+ width = Windows(GetWindowIndex("winSkills")).Window.width
+ height = Windows(GetWindowIndex("winSkills")).Window.height
+
+ ' render green
+ RenderTexture Tex_GUI(34), xO + 4, yO + 23, 0, 0, width - 8, height - 27, 4, 4
+
+ width = 76
+ height = 76
+
+ y = yO + 23
+ ' render grid - row
+ For i = 1 To 4
+ If i = 4 Then height = 42
+ RenderTexture Tex_GUI(35), xO + 4, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 80, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 156, y, 0, 0, 42, height, 42, height
+ y = y + 76
+ Next
+
+ ' actually draw the icons
+ For i = 1 To MAX_PLAYER_SPELLS
+ spellnum = PlayerSpells(i).Spell
+ If spellnum > 0 And spellnum <= MAX_SPELLS Then
+ ' not dragging?
+ If Not (DragBox.Origin = origin_Spells And DragBox.Slot = i) Then
+ spellPic = Spell(spellnum).icon
+
+ If spellPic > 0 And spellPic <= Count_Spellicon Then
+ top = yO + InvTop + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ left = xO + InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+
+ RenderTexture Tex_Spellicon(spellPic), left, top, 0, 0, 32, 32, 32, 32
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Public Sub RenderMapName()
+Dim zonetype As String, Colour As Long
+
+ If map.MapData.Moral = 0 Then
+ zonetype = "PK Zone"
+ Colour = Red
+ ElseIf map.MapData.Moral = 1 Then
+ zonetype = "Safe Zone"
+ Colour = White
+ ElseIf map.MapData.Moral = 2 Then
+ zonetype = "Boss Chamber"
+ Colour = Grey
+ End If
+
+ RenderText font(Fonts.rockwellDec_10), Trim$(map.MapData.name) & " - " & zonetype, ScreenWidth - 15 - TextWidth(font(Fonts.rockwellDec_10), Trim$(map.MapData.name) & " - " & zonetype), 45, Colour, 255
+End Sub
+
+Public Sub DrawShopBackground()
+ Dim xO As Long, yO As Long, width As Long, height As Long, i As Long, y As Long
+
+ xO = Windows(GetWindowIndex("winShop")).Window.left
+ yO = Windows(GetWindowIndex("winShop")).Window.top
+ width = Windows(GetWindowIndex("winShop")).Window.width
+ height = Windows(GetWindowIndex("winShop")).Window.height
+
+ ' render green
+ RenderTexture Tex_GUI(34), xO + 4, yO + 23, 0, 0, width - 8, height - 27, 4, 4
+
+ width = 76
+ height = 76
+
+ y = yO + 23
+ ' render grid - row
+ For i = 1 To 3
+ If i = 3 Then height = 42
+ RenderTexture Tex_GUI(35), xO + 4, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 80, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 156, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 232, y, 0, 0, 42, height, 42, height
+ y = y + 76
+ Next
+ ' render bottom wood
+ RenderTexture Tex_GUI(1), xO + 4, y - 34, 0, 0, 270, 72, 270, 72
+End Sub
+
+Public Sub DrawShop()
+Dim xO As Long, yO As Long, itemPic As Long, itemNum As Long, amount As Long, i As Long, top As Long, left As Long, y As Long, x As Long, Colour As Long
+
+ If InShop = 0 Then Exit Sub
+
+ xO = Windows(GetWindowIndex("winShop")).Window.left
+ yO = Windows(GetWindowIndex("winShop")).Window.top
+
+ If Not shopIsSelling Then
+ ' render the shop items
+ For i = 1 To MAX_TRADES
+ itemNum = Shop(InShop).TradeItem(i).Item
+
+ ' draw early
+ top = yO + ShopTop + ((ShopOffsetY + 32) * ((i - 1) \ ShopColumns))
+ left = xO + ShopLeft + ((ShopOffsetX + 32) * (((i - 1) Mod ShopColumns)))
+ ' draw selected square
+ If shopSelectedSlot = i Then RenderTexture Tex_GUI(61), left, top, 0, 0, 32, 32, 32, 32
+
+ If itemNum > 0 And itemNum <= MAX_ITEMS Then
+ itemPic = Item(itemNum).Pic
+ If itemPic > 0 And itemPic <= Count_Item Then
+ ' draw item
+ RenderTexture Tex_Item(itemPic), left, top, 0, 0, 32, 32, 32, 32
+ End If
+ End If
+ Next
+ Else
+ ' render the shop items
+ For i = 1 To MAX_TRADES
+ itemNum = GetPlayerInvItemNum(MyIndex, i)
+
+ ' draw early
+ top = yO + ShopTop + ((ShopOffsetY + 32) * ((i - 1) \ ShopColumns))
+ left = xO + ShopLeft + ((ShopOffsetX + 32) * (((i - 1) Mod ShopColumns)))
+ ' draw selected square
+ If shopSelectedSlot = i Then RenderTexture Tex_GUI(61), left, top, 0, 0, 32, 32, 32, 32
+
+ If itemNum > 0 And itemNum <= MAX_ITEMS Then
+ itemPic = Item(itemNum).Pic
+ If itemPic > 0 And itemPic <= Count_Item Then
+
+ ' draw item
+ RenderTexture Tex_Item(itemPic), left, top, 0, 0, 32, 32, 32, 32
+
+ ' If item is a stack - draw the amount you have
+ If GetPlayerInvItemValue(MyIndex, i) > 1 Then
+ y = top + 21
+ x = left + 1
+ amount = CStr(GetPlayerInvItemValue(MyIndex, i))
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If CLng(amount) < 1000000 Then
+ Colour = White
+ ElseIf CLng(amount) > 1000000 And CLng(amount) < 10000000 Then
+ Colour = Yellow
+ ElseIf CLng(amount) > 10000000 Then
+ Colour = BrightGreen
+ End If
+
+ RenderText font(Fonts.verdana_12), ConvertCurrency(amount), x, y, Colour
+ End If
+ End If
+ End If
+ Next
+ End If
+End Sub
+
+Sub DrawTrade()
+ Dim xO As Long, yO As Long, width As Long, height As Long, i As Long, y As Long, x As Long
+
+ xO = Windows(GetWindowIndex("winTrade")).Window.left
+ yO = Windows(GetWindowIndex("winTrade")).Window.top
+ width = Windows(GetWindowIndex("winTrade")).Window.width
+ height = Windows(GetWindowIndex("winTrade")).Window.height
+
+ ' render green
+ RenderTexture Tex_GUI(34), xO + 4, yO + 23, 0, 0, width - 8, height - 27, 4, 4
+
+ ' top wood
+ RenderTexture Tex_GUI(1), xO + 4, yO + 23, 100, 100, width - 8, 18, width - 8, 18
+ ' left wood
+ RenderTexture Tex_GUI(1), xO + 4, yO + 41, 350, 0, 5, height - 45, 5, height - 45
+ ' right wood
+ RenderTexture Tex_GUI(1), xO + width - 9, yO + 41, 350, 0, 5, height - 45, 5, height - 45
+ ' centre wood
+ RenderTexture Tex_GUI(1), xO + 203, yO + 41, 350, 0, 6, height - 45, 6, height - 45
+ ' bottom wood
+ RenderTexture Tex_GUI(1), xO + 4, yO + 307, 100, 100, width - 8, 75, width - 8, 75
+
+ ' left
+ width = 76
+ height = 76
+ y = yO + 41
+ For i = 1 To 4
+ If i = 4 Then height = 38
+ RenderTexture Tex_GUI(35), xO + 4 + 5, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 80 + 5, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 156 + 5, y, 0, 0, 42, height, 42, height
+ y = y + 76
+ Next
+
+ ' right
+ width = 76
+ height = 76
+ y = yO + 41
+ For i = 1 To 4
+ If i = 4 Then height = 38
+ RenderTexture Tex_GUI(35), xO + 4 + 205, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 80 + 205, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 156 + 205, y, 0, 0, 42, height, 42, height
+ y = y + 76
+ Next
+End Sub
+
+Sub DrawYourTrade()
+Dim i As Long, itemNum As Long, itemPic As Long, top As Long, left As Long, Colour As Long, amount As String, x As Long, y As Long
+Dim xO As Long, yO As Long
+
+ xO = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picYour")).left
+ yO = Windows(GetWindowIndex("winTrade")).Window.top + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picYour")).top
+
+ ' your items
+ For i = 1 To MAX_INV
+ itemNum = GetPlayerInvItemNum(MyIndex, TradeYourOffer(i).num)
+ If itemNum > 0 And itemNum <= MAX_ITEMS Then
+ itemPic = Item(itemNum).Pic
+ If itemPic > 0 And itemPic <= Count_Item Then
+ top = yO + TradeTop + ((TradeOffsetY + 32) * ((i - 1) \ TradeColumns))
+ left = xO + TradeLeft + ((TradeOffsetX + 32) * (((i - 1) Mod TradeColumns)))
+
+ ' draw icon
+ RenderTexture Tex_Item(itemPic), left, top, 0, 0, 32, 32, 32, 32
+
+ ' If item is a stack - draw the amount you have
+ If TradeYourOffer(i).value > 1 Then
+ y = top + 21
+ x = left + 1
+ amount = CStr(TradeYourOffer(i).value)
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If CLng(amount) < 1000000 Then
+ Colour = White
+ ElseIf CLng(amount) > 1000000 And CLng(amount) < 10000000 Then
+ Colour = Yellow
+ ElseIf CLng(amount) > 10000000 Then
+ Colour = BrightGreen
+ End If
+
+ RenderText font(Fonts.verdana_12), ConvertCurrency(amount), x, y, Colour
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Sub DrawTheirTrade()
+Dim i As Long, itemNum As Long, itemPic As Long, top As Long, left As Long, Colour As Long, amount As String, x As Long, y As Long
+Dim xO As Long, yO As Long
+
+ xO = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picTheir")).left
+ yO = Windows(GetWindowIndex("winTrade")).Window.top + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picTheir")).top
+
+ ' their items
+ For i = 1 To MAX_INV
+ itemNum = TradeTheirOffer(i).num
+ If itemNum > 0 And itemNum <= MAX_ITEMS Then
+ itemPic = Item(itemNum).Pic
+ If itemPic > 0 And itemPic <= Count_Item Then
+ top = yO + TradeTop + ((TradeOffsetY + 32) * ((i - 1) \ TradeColumns))
+ left = xO + TradeLeft + ((TradeOffsetX + 32) * (((i - 1) Mod TradeColumns)))
+
+ ' draw icon
+ RenderTexture Tex_Item(itemPic), left, top, 0, 0, 32, 32, 32, 32
+
+ ' If item is a stack - draw the amount you have
+ If TradeTheirOffer(i).value > 1 Then
+ y = top + 21
+ x = left + 1
+ amount = CStr(TradeTheirOffer(i).value)
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If CLng(amount) < 1000000 Then
+ Colour = White
+ ElseIf CLng(amount) > 1000000 And CLng(amount) < 10000000 Then
+ Colour = Yellow
+ ElseIf CLng(amount) > 10000000 Then
+ Colour = BrightGreen
+ End If
+
+ RenderText font(Fonts.verdana_12), ConvertCurrency(amount), x, y, Colour
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Public Sub DrawInventory()
+ Dim xO As Long, yO As Long, width As Long, height As Long, i As Long, y As Long, itemNum As Long, itemPic As Long, x As Long, top As Long, left As Long, amount As String
+ Dim Colour As Long, skipItem As Boolean, amountModifier As Long, tmpItem As Long
+
+ xO = Windows(GetWindowIndex("winInventory")).Window.left
+ yO = Windows(GetWindowIndex("winInventory")).Window.top
+ width = Windows(GetWindowIndex("winInventory")).Window.width
+ height = Windows(GetWindowIndex("winInventory")).Window.height
+
+ ' render green
+ RenderTexture Tex_GUI(34), xO + 4, yO + 23, 0, 0, width - 8, height - 27, 4, 4
+
+ width = 76
+ height = 76
+
+ y = yO + 23
+ ' render grid - row
+ For i = 1 To 4
+ If i = 4 Then height = 38
+ RenderTexture Tex_GUI(35), xO + 4, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 80, y, 0, 0, width, height, width, height
+ RenderTexture Tex_GUI(35), xO + 156, y, 0, 0, 42, height, 42, height
+ y = y + 76
+ Next
+ ' render bottom wood
+ RenderTexture Tex_GUI(1), xO + 4, yO + 289, 100, 100, 194, 26, 194, 26
+
+ ' actually draw the icons
+ For i = 1 To MAX_INV
+ itemNum = GetPlayerInvItemNum(MyIndex, i)
+ If itemNum > 0 And itemNum <= MAX_ITEMS Then
+ ' not dragging?
+ If Not (DragBox.Origin = origin_Inventory And DragBox.Slot = i) Then
+ itemPic = Item(itemNum).Pic
+
+ ' exit out if we're offering item in a trade.
+ amountModifier = 0
+ If InTrade > 0 Then
+ For x = 1 To MAX_INV
+ tmpItem = GetPlayerInvItemNum(MyIndex, TradeYourOffer(x).num)
+ If TradeYourOffer(x).num = i Then
+ ' check if currency
+ If Not Item(tmpItem).Type = ITEM_TYPE_CURRENCY Then
+ ' normal item, exit out
+ skipItem = True
+ Else
+ ' if amount = all currency, remove from inventory
+ If TradeYourOffer(x).value = GetPlayerInvItemValue(MyIndex, i) Then
+ skipItem = True
+ Else
+ ' not all, change modifier to show change in currency count
+ amountModifier = TradeYourOffer(x).value
+ End If
+ End If
+ End If
+ Next
+ End If
+
+ If Not skipItem Then
+ If itemPic > 0 And itemPic <= Count_Item Then
+ top = yO + InvTop + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ left = xO + InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+
+ ' draw icon
+ RenderTexture Tex_Item(itemPic), left, top, 0, 0, 32, 32, 32, 32
+
+ ' If item is a stack - draw the amount you have
+ If GetPlayerInvItemValue(MyIndex, i) > 1 Then
+ y = top + 21
+ x = left + 1
+ amount = GetPlayerInvItemValue(MyIndex, i) - amountModifier
+
+ ' Draw currency but with k, m, b etc. using a convertion function
+ If CLng(amount) < 1000000 Then
+ Colour = White
+ ElseIf CLng(amount) > 1000000 And CLng(amount) < 10000000 Then
+ Colour = Yellow
+ ElseIf CLng(amount) > 10000000 Then
+ Colour = BrightGreen
+ End If
+
+ RenderText font(Fonts.verdana_12), ConvertCurrency(amount), x, y, Colour
+ End If
+ End If
+ End If
+ ' reset
+ skipItem = False
+ End If
+ End If
+ Next
+End Sub
+
+Public Sub DrawChatBubble(ByVal index As Long)
+ Dim theArray() As String, x As Long, y As Long, i As Long, MaxWidth As Long, x2 As Long, y2 As Long, Colour As Long, tmpNum As Long
+
+ With chatBubble(index)
+ ' exit out early
+ If .target = 0 Then Exit Sub
+ ' calculate position
+ Select Case .TargetType
+ Case TARGET_TYPE_PLAYER
+ ' it's a player
+ If Not GetPlayerMap(.target) = GetPlayerMap(MyIndex) Then Exit Sub
+ ' change the colour depending on access
+ Colour = DarkBrown
+ ' it's on our map - get co-ords
+ x = ConvertMapX((Player(.target).x * 32) + Player(.target).xOffset) + 16
+ y = ConvertMapY((Player(.target).y * 32) + Player(.target).yOffset) - 32
+ Case TARGET_TYPE_EVENT
+ Colour = .Colour
+ x = ConvertMapX(map.TileData.Events(.target).x * 32) + 16
+ y = ConvertMapY(map.TileData.Events(.target).y * 32) - 16
+ Case Else
+ Exit Sub
+ End Select
+
+ ' word wrap
+ WordWrap_Array .Msg, ChatBubbleWidth, theArray
+ ' find max width
+ tmpNum = UBound(theArray)
+
+ For i = 1 To tmpNum
+ If TextWidth(font(Fonts.georgiaDec_16), theArray(i)) > MaxWidth Then MaxWidth = TextWidth(font(Fonts.georgiaDec_16), theArray(i))
+ Next
+
+ ' calculate the new position
+ x2 = x - (MaxWidth \ 2)
+ y2 = y - (UBound(theArray) * 12)
+ ' render bubble - top left
+ RenderTexture Tex_GUI(33), x2 - 9, y2 - 5, 0, 0, 9, 5, 9, 5
+ ' top right
+ RenderTexture Tex_GUI(33), x2 + MaxWidth, y2 - 5, 119, 0, 9, 5, 9, 5
+ ' top
+ RenderTexture Tex_GUI(33), x2, y2 - 5, 9, 0, MaxWidth, 5, 5, 5
+ ' bottom left
+ RenderTexture Tex_GUI(33), x2 - 9, y, 0, 19, 9, 6, 9, 6
+ ' bottom right
+ RenderTexture Tex_GUI(33), x2 + MaxWidth, y, 119, 19, 9, 6, 9, 6
+ ' bottom - left half
+ RenderTexture Tex_GUI(33), x2, y, 9, 19, (MaxWidth \ 2) - 5, 6, 9, 6
+ ' bottom - right half
+ RenderTexture Tex_GUI(33), x2 + (MaxWidth \ 2) + 6, y, 9, 19, (MaxWidth \ 2) - 5, 6, 9, 6
+ ' left
+ RenderTexture Tex_GUI(33), x2 - 9, y2, 0, 6, 9, (UBound(theArray) * 12), 9, 1
+ ' right
+ RenderTexture Tex_GUI(33), x2 + MaxWidth, y2, 119, 6, 9, (UBound(theArray) * 12), 9, 1
+ ' center
+ RenderTexture Tex_GUI(33), x2, y2, 9, 5, MaxWidth, (UBound(theArray) * 12), 1, 1
+ ' little pointy bit
+ RenderTexture Tex_GUI(33), x - 5, y, 58, 19, 11, 11, 11, 11
+ ' render each line centralised
+ tmpNum = UBound(theArray)
+
+ For i = 1 To tmpNum
+ RenderText font(Fonts.georgia_16), theArray(i), x - (TextWidth(font(Fonts.georgiaDec_16), theArray(i)) / 2), y2, Colour
+ y2 = y2 + 12
+ Next
+
+ ' check if it's timed out - close it if so
+ If .timer + 5000 < GetTickCount Then
+ .active = False
+ End If
+ End With
+End Sub
+
+Public Function isConstAnimated(ByVal sprite As Long) As Boolean
+ isConstAnimated = False
+
+ Select Case sprite
+
+ Case 16, 21, 22, 26, 28
+ isConstAnimated = True
+ End Select
+
+End Function
+
+Public Function hasSpriteShadow(ByVal sprite As Long) As Boolean
+ hasSpriteShadow = True
+
+ Select Case sprite
+
+ Case 25, 26
+ hasSpriteShadow = False
+ End Select
+
+End Function
+
+Public Sub DrawPlayer(ByVal index As Long)
+ Dim Anim As Byte
+ Dim x As Long
+ Dim y As Long
+ Dim sprite As Long, spritetop As Long
+ Dim rec As GeomRec
+ Dim attackspeed As Long
+
+ ' pre-load sprite for calculations
+ sprite = GetPlayerSprite(index)
+
+ 'SetTexture Tex_Char(Sprite)
+ If sprite < 1 Or sprite > Count_Char Then Exit Sub
+
+ ' speed from weapon
+ If GetPlayerEquipment(index, Weapon) > 0 Then
+ attackspeed = Item(GetPlayerEquipment(index, Weapon)).speed
+ Else
+ attackspeed = 1000
+ End If
+
+ If Not isConstAnimated(GetPlayerSprite(index)) Then
+ ' Reset frame
+ Anim = 1
+
+ ' Check for attacking animation
+ If Player(index).AttackTimer + (attackspeed / 2) > GetTickCount Then
+ If Player(index).Attacking = 1 Then
+ Anim = 2
+ End If
+
+ Else
+
+ ' If not attacking, walk normally
+ Select Case GetPlayerDir(index)
+
+ Case DIR_UP
+
+ If (Player(index).yOffset > 8) Then Anim = Player(index).Step
+
+ Case DIR_DOWN
+
+ If (Player(index).yOffset < -8) Then Anim = Player(index).Step
+
+ Case DIR_LEFT
+
+ If (Player(index).xOffset > 8) Then Anim = Player(index).Step
+
+ Case DIR_RIGHT
+
+ If (Player(index).xOffset < -8) Then Anim = Player(index).Step
+ End Select
+
+ End If
+
+ Else
+
+ If Player(index).AnimTimer + 100 <= GetTickCount Then
+ Player(index).Anim = Player(index).Anim + 1
+
+ If Player(index).Anim >= 3 Then Player(index).Anim = 0
+ Player(index).AnimTimer = GetTickCount
+ End If
+
+ Anim = Player(index).Anim
+ End If
+
+ ' Check to see if we want to stop making him attack
+ With Player(index)
+
+ If .AttackTimer + attackspeed < GetTickCount Then
+ .Attacking = 0
+ .AttackTimer = 0
+ End If
+
+ End With
+
+ ' Set the left
+ Select Case GetPlayerDir(index)
+
+ Case DIR_UP
+ spritetop = 3
+
+ Case DIR_RIGHT
+ spritetop = 2
+
+ Case DIR_DOWN
+ spritetop = 0
+
+ Case DIR_LEFT
+ spritetop = 1
+ End Select
+
+ With rec
+ .top = spritetop * (mTexture(Tex_Char(sprite)).h / 4)
+ .height = (mTexture(Tex_Char(sprite)).h / 4)
+ .left = Anim * (mTexture(Tex_Char(sprite)).w / 4)
+ .width = (mTexture(Tex_Char(sprite)).w / 4)
+ End With
+
+ ' Calculate the X
+ x = GetPlayerX(index) * PIC_X + Player(index).xOffset - ((mTexture(Tex_Char(sprite)).w / 4 - 32) / 2)
+
+ ' Is the player's height more than 32..?
+ If (mTexture(Tex_Char(sprite)).h) > 32 Then
+ ' Create a 32 pixel offset for larger sprites
+ y = GetPlayerY(index) * PIC_Y + Player(index).yOffset - ((mTexture(Tex_Char(sprite)).h / 4) - 32) - 4
+ Else
+ ' Proceed as normal
+ y = GetPlayerY(index) * PIC_Y + Player(index).yOffset - 4
+ End If
+
+ RenderTexture Tex_Char(sprite), ConvertMapX(x), ConvertMapY(y), rec.left, rec.top, rec.width, rec.height, rec.width, rec.height
+End Sub
+
+Public Sub DrawNpc(ByVal MapNpcNum As Long)
+ Dim Anim As Byte
+ Dim x As Long
+ Dim y As Long
+ Dim sprite As Long, spritetop As Long
+ Dim rec As GeomRec
+ Dim attackspeed As Long
+
+ If MapNpc(MapNpcNum).num = 0 Then Exit Sub ' no npc set
+ ' pre-load texture for calculations
+ sprite = Npc(MapNpc(MapNpcNum).num).sprite
+
+ 'SetTexture Tex_Char(Sprite)
+ If sprite < 1 Or sprite > Count_Char Then Exit Sub
+ attackspeed = 1000
+
+ If Not isConstAnimated(Npc(MapNpc(MapNpcNum).num).sprite) Then
+ ' Reset frame
+ Anim = 1
+
+ ' Check for attacking animation
+ If MapNpc(MapNpcNum).AttackTimer + (attackspeed / 2) > GetTickCount Then
+ If MapNpc(MapNpcNum).Attacking = 1 Then
+ Anim = 2
+ End If
+
+ Else
+
+ ' If not attacking, walk normally
+ Select Case MapNpc(MapNpcNum).dir
+
+ Case DIR_UP
+
+ If (MapNpc(MapNpcNum).yOffset > 8) Then Anim = MapNpc(MapNpcNum).Step
+
+ Case DIR_DOWN
+
+ If (MapNpc(MapNpcNum).yOffset < -8) Then Anim = MapNpc(MapNpcNum).Step
+
+ Case DIR_LEFT
+
+ If (MapNpc(MapNpcNum).xOffset > 8) Then Anim = MapNpc(MapNpcNum).Step
+
+ Case DIR_RIGHT
+
+ If (MapNpc(MapNpcNum).xOffset < -8) Then Anim = MapNpc(MapNpcNum).Step
+ End Select
+
+ End If
+
+ Else
+
+ With MapNpc(MapNpcNum)
+
+ If .AnimTimer + 100 <= GetTickCount Then
+ .Anim = .Anim + 1
+
+ If .Anim >= 3 Then .Anim = 0
+ .AnimTimer = GetTickCount
+ End If
+
+ Anim = .Anim
+ End With
+
+ End If
+
+ ' Check to see if we want to stop making him attack
+ With MapNpc(MapNpcNum)
+
+ If .AttackTimer + attackspeed < GetTickCount Then
+ .Attacking = 0
+ .AttackTimer = 0
+ End If
+
+ End With
+
+ ' Set the left
+ Select Case MapNpc(MapNpcNum).dir
+
+ Case DIR_UP
+ spritetop = 3
+
+ Case DIR_RIGHT
+ spritetop = 2
+
+ Case DIR_DOWN
+ spritetop = 0
+
+ Case DIR_LEFT
+ spritetop = 1
+ End Select
+
+ With rec
+ .top = (mTexture(Tex_Char(sprite)).h / 4) * spritetop
+ .height = mTexture(Tex_Char(sprite)).h / 4
+ .left = Anim * (mTexture(Tex_Char(sprite)).w / 4)
+ .width = (mTexture(Tex_Char(sprite)).w / 4)
+ End With
+
+ ' Calculate the X
+ x = MapNpc(MapNpcNum).x * PIC_X + MapNpc(MapNpcNum).xOffset - ((mTexture(Tex_Char(sprite)).w / 4 - 32) / 2)
+
+ ' Is the player's height more than 32..?
+ If (mTexture(Tex_Char(sprite)).h / 4) > 32 Then
+ ' Create a 32 pixel offset for larger sprites
+ y = MapNpc(MapNpcNum).y * PIC_Y + MapNpc(MapNpcNum).yOffset - ((mTexture(Tex_Char(sprite)).h / 4) - 32) - 4
+ Else
+ ' Proceed as normal
+ y = MapNpc(MapNpcNum).y * PIC_Y + MapNpc(MapNpcNum).yOffset - 4
+ End If
+
+ RenderTexture Tex_Char(sprite), ConvertMapX(x), ConvertMapY(y), rec.left, rec.top, rec.width, rec.height, rec.width, rec.height
+End Sub
+
+Sub DrawEvent(eventNum As Long, pageNum As Long)
+Dim texNum As Long, x As Long, y As Long
+
+ ' render it
+ With map.TileData.Events(eventNum).EventPage(pageNum)
+ If .GraphicType > 0 Then
+ If .Graphic > 0 Then
+ Select Case .GraphicType
+ Case 1 ' character
+ If .Graphic < Count_Char Then
+ texNum = Tex_Char(.Graphic)
+ End If
+ Case 2 ' tileset
+ If .Graphic < Count_Tileset Then
+ texNum = Tex_Tileset(.Graphic)
+ End If
+ End Select
+ If texNum > 0 Then
+ x = ConvertMapX(map.TileData.Events(eventNum).x * 32)
+ y = ConvertMapY(map.TileData.Events(eventNum).y * 32)
+ RenderTexture texNum, x, y, .GraphicX * 32, .GraphicY * 32, 32, 32, 32, 32
+ End If
+ End If
+ End If
+ End With
+End Sub
+
+Sub DrawLowerEvents()
+Dim i As Long, x As Long
+
+ If map.TileData.EventCount = 0 Then Exit Sub
+ For i = 1 To map.TileData.EventCount
+ ' find the active page
+ If map.TileData.Events(i).pageCount > 0 Then
+ x = ActiveEventPage(i)
+ If x > 0 Then
+ ' make sure it's lower
+ If map.TileData.Events(i).EventPage(x).Priority <> 2 Then
+ ' render event
+ DrawEvent i, x
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Sub DrawUpperEvents()
+Dim i As Long, x As Long
+
+ If map.TileData.EventCount = 0 Then Exit Sub
+ For i = 1 To map.TileData.EventCount
+ ' find the active page
+ If map.TileData.Events(i).pageCount > 0 Then
+ x = ActiveEventPage(i)
+ If x > 0 Then
+ ' make sure it's lower
+ If map.TileData.Events(i).EventPage(x).Priority = 2 Then
+ ' render event
+ DrawEvent i, x
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Public Sub DrawShadow(ByVal sprite As Long, ByVal x As Long, ByVal y As Long)
+ If hasSpriteShadow(sprite) Then RenderTexture Tex_Shadow, ConvertMapX(x), ConvertMapY(y), 0, 0, 32, 32, 32, 32
+End Sub
+
+Public Sub DrawTarget(ByVal x As Long, ByVal y As Long)
+ Dim width As Long, height As Long
+ ' calculations
+ width = mTexture(Tex_Target).w / 2
+ height = mTexture(Tex_Target).h
+ x = x - ((width - 32) / 2)
+ y = y - (height / 2) + 16
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+ 'EngineRenderRectangle Tex_Target, x, y, 0, 0, width, height, width, height, width, height
+ RenderTexture Tex_Target, x, y, 0, 0, width, height, width, height
+End Sub
+
+Public Sub DrawTargetHover()
+ Dim i As Long, x As Long, y As Long, width As Long, height As Long
+
+ If diaIndex > 0 Then Exit Sub
+ width = mTexture(Tex_Target).w / 2
+ height = mTexture(Tex_Target).h
+
+ If width <= 0 Then width = 1
+ If height <= 0 Then height = 1
+
+ For i = 1 To MAX_PLAYERS
+
+ If IsPlaying(i) And GetPlayerMap(MyIndex) = GetPlayerMap(i) Then
+ x = (Player(i).x * 32) + Player(i).xOffset + 32
+ y = (Player(i).y * 32) + Player(i).yOffset + 32
+
+ If x >= GlobalX_Map And x <= GlobalX_Map + 32 Then
+ If y >= GlobalY_Map And y <= GlobalY_Map + 32 Then
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+ RenderTexture Tex_Target, x - 16 - (width / 2), y - 16 - (height / 2), width, 0, width, height, width, height
+ End If
+ End If
+ End If
+
+ Next
+
+ For i = 1 To MAX_MAP_NPCS
+
+ If MapNpc(i).num > 0 Then
+ x = (MapNpc(i).x * 32) + MapNpc(i).xOffset + 32
+ y = (MapNpc(i).y * 32) + MapNpc(i).yOffset + 32
+
+ If x >= GlobalX_Map And x <= GlobalX_Map + 32 Then
+ If y >= GlobalY_Map And y <= GlobalY_Map + 32 Then
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+ RenderTexture Tex_Target, x - 16 - (width / 2), y - 16 - (height / 2), width, 0, width, height, width, height
+ End If
+ End If
+ End If
+
+ Next
+
+End Sub
+
+Public Sub DrawResource(ByVal Resource_num As Long)
+ Dim Resource_master As Long
+ Dim Resource_state As Long
+ Dim Resource_sprite As Long
+ Dim rec As RECT
+ Dim x As Long, y As Long
+ Dim width As Long, height As Long
+ x = MapResource(Resource_num).x
+ y = MapResource(Resource_num).y
+
+ If x < 0 Or x > map.MapData.MaxX Then Exit Sub
+ If y < 0 Or y > map.MapData.MaxY Then Exit Sub
+ ' Get the Resource type
+ Resource_master = map.TileData.Tile(x, y).Data1
+
+ If Resource_master = 0 Then Exit Sub
+ If Resource(Resource_master).ResourceImage = 0 Then Exit Sub
+ ' Get the Resource state
+ Resource_state = MapResource(Resource_num).ResourceState
+
+ If Resource_state = 0 Then ' normal
+ Resource_sprite = Resource(Resource_master).ResourceImage
+ ElseIf Resource_state = 1 Then ' used
+ Resource_sprite = Resource(Resource_master).ExhaustedImage
+ End If
+
+ ' pre-load texture for calculations
+ 'SetTexture Tex_Resource(Resource_sprite)
+ ' src rect
+ With rec
+ .top = 0
+ .bottom = mTexture(Tex_Resource(Resource_sprite)).h
+ .left = 0
+ .Right = mTexture(Tex_Resource(Resource_sprite)).w
+ End With
+
+ ' Set base x + y, then the offset due to size
+ x = (MapResource(Resource_num).x * PIC_X) - (mTexture(Tex_Resource(Resource_sprite)).w / 2) + 16
+ y = (MapResource(Resource_num).y * PIC_Y) - mTexture(Tex_Resource(Resource_sprite)).h + 32
+ width = rec.Right - rec.left
+ height = rec.bottom - rec.top
+ 'EngineRenderRectangle Tex_Resource(Resource_sprite), ConvertMapX(x), ConvertMapY(y), 0, 0, width, height, width, height, width, height
+ RenderTexture Tex_Resource(Resource_sprite), ConvertMapX(x), ConvertMapY(y), 0, 0, width, height, width, height
+End Sub
+
+Public Sub DrawItem(ByVal itemNum As Long)
+ Dim PicNum As Integer, dontRender As Boolean, i As Long, tmpIndex As Long
+ PicNum = Item(MapItem(itemNum).num).Pic
+
+ If PicNum < 1 Or PicNum > Count_Item Then Exit Sub
+
+ ' if it's not us then don't render
+ If MapItem(itemNum).playerName <> vbNullString Then
+ If Trim$(MapItem(itemNum).playerName) <> Trim$(GetPlayerName(MyIndex)) Then
+
+ dontRender = True
+ End If
+
+ ' make sure it's not a party drop
+ If Party.Leader > 0 Then
+
+ For i = 1 To MAX_PARTY_MEMBERS
+ tmpIndex = Party.Member(i)
+
+ If tmpIndex > 0 Then
+ If Trim$(GetPlayerName(tmpIndex)) = Trim$(MapItem(itemNum).playerName) Then
+ If MapItem(itemNum).bound = 0 Then
+
+ dontRender = False
+ End If
+ End If
+ End If
+
+ Next
+
+ End If
+ End If
+
+ 'If Not dontRender Then EngineRenderRectangle Tex_Item(PicNum), ConvertMapX(MapItem(itemnum).x * PIC_X), ConvertMapY(MapItem(itemnum).y * PIC_Y), 0, 0, 32, 32, 32, 32, 32, 32
+ If Not dontRender Then
+ RenderTexture Tex_Item(PicNum), ConvertMapX(MapItem(itemNum).x * PIC_X), ConvertMapY(MapItem(itemNum).y * PIC_Y), 0, 0, 32, 32, 32, 32
+ End If
+
+End Sub
+
+Public Sub DrawBars()
+Dim left As Long, top As Long, width As Long, height As Long
+Dim tmpX As Long, tmpY As Long, barWidth As Long, i As Long, npcNum As Long
+Dim partyIndex As Long
+
+ ' dynamic bar calculations
+ width = mTexture(Tex_Bars).w
+ height = mTexture(Tex_Bars).h / 4
+
+ ' render npc health bars
+ For i = 1 To MAX_MAP_NPCS
+ npcNum = MapNpc(i).num
+ ' exists?
+ If npcNum > 0 Then
+ ' alive?
+ If MapNpc(i).Vital(Vitals.HP) > 0 And MapNpc(i).Vital(Vitals.HP) < Npc(npcNum).HP Then
+ ' lock to npc
+ tmpX = MapNpc(i).x * PIC_X + MapNpc(i).xOffset + 16 - (width / 2)
+ tmpY = MapNpc(i).y * PIC_Y + MapNpc(i).yOffset + 35
+
+ ' calculate the width to fill
+ If width > 0 Then BarWidth_NpcHP_Max(i) = ((MapNpc(i).Vital(Vitals.HP) / width) / (Npc(npcNum).HP / width)) * width
+
+ ' draw bar background
+ top = height * 1 ' HP bar background
+ left = 0
+ RenderTexture Tex_Bars, ConvertMapX(tmpX), ConvertMapY(tmpY), left, top, width, height, width, height
+
+ ' draw the bar proper
+ top = 0 ' HP bar
+ left = 0
+ RenderTexture Tex_Bars, ConvertMapX(tmpX), ConvertMapY(tmpY), left, top, BarWidth_NpcHP(i), height, BarWidth_NpcHP(i), height
+ End If
+ End If
+ Next
+
+ ' check for casting time bar
+ If SpellBuffer > 0 Then
+ If Spell(PlayerSpells(SpellBuffer).Spell).CastTime > 0 Then
+ ' lock to player
+ tmpX = GetPlayerX(MyIndex) * PIC_X + Player(MyIndex).xOffset + 16 - (width / 2)
+ tmpY = GetPlayerY(MyIndex) * PIC_Y + Player(MyIndex).yOffset + 35 + height + 1
+
+ ' calculate the width to fill
+ If width > 0 Then barWidth = (GetTickCount - SpellBufferTimer) / ((Spell(PlayerSpells(SpellBuffer).Spell).CastTime * 1000)) * width
+
+ ' draw bar background
+ top = height * 3 ' cooldown bar background
+ left = 0
+ RenderTexture Tex_Bars, ConvertMapX(tmpX), ConvertMapY(tmpY), left, top, width, height, width, height
+
+ ' draw the bar proper
+ top = height * 2 ' cooldown bar
+ left = 0
+ RenderTexture Tex_Bars, ConvertMapX(tmpX), ConvertMapY(tmpY), left, top, barWidth, height, barWidth, height
+ End If
+ End If
+
+ ' draw own health bar
+ If GetPlayerVital(MyIndex, Vitals.HP) > 0 And GetPlayerVital(MyIndex, Vitals.HP) < GetPlayerMaxVital(MyIndex, Vitals.HP) Then
+ ' lock to Player
+ tmpX = GetPlayerX(MyIndex) * PIC_X + Player(MyIndex).xOffset + 16 - (width / 2)
+ tmpY = GetPlayerY(MyIndex) * PIC_X + Player(MyIndex).yOffset + 35
+
+ ' calculate the width to fill
+ If width > 0 Then BarWidth_PlayerHP_Max(MyIndex) = ((GetPlayerVital(MyIndex, Vitals.HP) / width) / (GetPlayerMaxVital(MyIndex, Vitals.HP) / width)) * width
+
+ ' draw bar background
+ top = height * 1 ' HP bar background
+ left = 0
+ RenderTexture Tex_Bars, ConvertMapX(tmpX), ConvertMapY(tmpY), left, top, width, height, width, height
+
+ ' draw the bar proper
+ top = 0 ' HP bar
+ left = 0
+ RenderTexture Tex_Bars, ConvertMapX(tmpX), ConvertMapY(tmpY), left, top, BarWidth_PlayerHP(MyIndex), height, BarWidth_PlayerHP(MyIndex), height
+ End If
+End Sub
+
+Sub DrawMenuBG()
+ ' row 1
+ RenderTexture Tex_Surface(1), ScreenWidth - 512, ScreenHeight - 512, 0, 0, 512, 512, 512, 512
+ RenderTexture Tex_Surface(2), ScreenWidth - 1024, ScreenHeight - 512, 0, 0, 512, 512, 512, 512
+ RenderTexture Tex_Surface(3), ScreenWidth - 1536, ScreenHeight - 512, 0, 0, 512, 512, 512, 512
+ RenderTexture Tex_Surface(4), ScreenWidth - 2048, ScreenHeight - 512, 0, 0, 512, 512, 512, 512
+ ' row 2
+ RenderTexture Tex_Surface(5), ScreenWidth - 512, ScreenHeight - 1024, 0, 0, 512, 512, 512, 512
+ RenderTexture Tex_Surface(6), ScreenWidth - 1024, ScreenHeight - 1024, 0, 0, 512, 512, 512, 512
+ RenderTexture Tex_Surface(7), ScreenWidth - 1536, ScreenHeight - 1024, 0, 0, 512, 512, 512, 512
+ RenderTexture Tex_Surface(8), ScreenWidth - 2048, ScreenHeight - 1024, 0, 0, 512, 512, 512, 512
+ ' row 3
+ RenderTexture Tex_Surface(9), ScreenWidth - 512, ScreenHeight - 1088, 0, 0, 512, 64, 512, 64
+ RenderTexture Tex_Surface(10), ScreenWidth - 1024, ScreenHeight - 1088, 0, 0, 512, 64, 512, 64
+ RenderTexture Tex_Surface(11), ScreenWidth - 1536, ScreenHeight - 1088, 0, 0, 512, 64, 512, 64
+ RenderTexture Tex_Surface(12), ScreenWidth - 2048, ScreenHeight - 1088, 0, 0, 512, 64, 512, 64
+End Sub
+
+Public Sub DrawAnimation(ByVal index As Long, ByVal Layer As Long)
+ Dim sprite As Integer, sRECT As GeomRec, width As Long, height As Long, FrameCount As Long
+ Dim x As Long, y As Long, lockindex As Long
+
+ If AnimInstance(index).Animation = 0 Then
+ ClearAnimInstance index
+ Exit Sub
+ End If
+
+ sprite = Animation(AnimInstance(index).Animation).sprite(Layer)
+
+ If sprite < 1 Or sprite > Count_Anim Then Exit Sub
+ ' pre-load texture for calculations
+ 'SetTexture Tex_Anim(Sprite)
+ FrameCount = Animation(AnimInstance(index).Animation).Frames(Layer)
+ ' total width divided by frame count
+ width = 192 'mTexture(Tex_Anim(Sprite)).width / frameCount
+ height = 192 'mTexture(Tex_Anim(Sprite)).height
+
+ With sRECT
+ .top = (height * ((AnimInstance(index).FrameIndex(Layer) - 1) \ AnimColumns))
+ .height = height
+ .left = (width * (((AnimInstance(index).FrameIndex(Layer) - 1) Mod AnimColumns)))
+ .width = width
+ End With
+
+ ' change x or y if locked
+ If AnimInstance(index).LockType > TARGET_TYPE_NONE Then ' if <> none
+
+ ' is a player
+ If AnimInstance(index).LockType = TARGET_TYPE_PLAYER Then
+ ' quick save the index
+ lockindex = AnimInstance(index).lockindex
+
+ ' check if is ingame
+ If IsPlaying(lockindex) Then
+
+ ' check if on same map
+ If GetPlayerMap(lockindex) = GetPlayerMap(MyIndex) Then
+ ' is on map, is playing, set x & y
+ x = (GetPlayerX(lockindex) * PIC_X) + 16 - (width / 2) + Player(lockindex).xOffset
+ y = (GetPlayerY(lockindex) * PIC_Y) + 16 - (height / 2) + Player(lockindex).yOffset
+ End If
+ End If
+
+ ElseIf AnimInstance(index).LockType = TARGET_TYPE_NPC Then
+ ' quick save the index
+ lockindex = AnimInstance(index).lockindex
+
+ ' check if NPC exists
+ If MapNpc(lockindex).num > 0 Then
+
+ ' check if alive
+ If MapNpc(lockindex).Vital(Vitals.HP) > 0 Then
+ ' exists, is alive, set x & y
+ x = (MapNpc(lockindex).x * PIC_X) + 16 - (width / 2) + MapNpc(lockindex).xOffset
+ y = (MapNpc(lockindex).y * PIC_Y) + 16 - (height / 2) + MapNpc(lockindex).yOffset
+ Else
+ ' npc not alive anymore, kill the animation
+ ClearAnimInstance index
+ Exit Sub
+ End If
+
+ Else
+ ' npc not alive anymore, kill the animation
+ ClearAnimInstance index
+ Exit Sub
+ End If
+ End If
+
+ Else
+ ' no lock, default x + y
+ x = (AnimInstance(index).x * 32) + 16 - (width / 2)
+ y = (AnimInstance(index).y * 32) + 16 - (height / 2)
+ End If
+
+ x = ConvertMapX(x)
+ y = ConvertMapY(y)
+ 'EngineRenderRectangle Tex_Anim(sprite), x, y, sRECT.left, sRECT.top, sRECT.width, sRECT.height, sRECT.width, sRECT.height, sRECT.width, sRECT.height
+ RenderTexture Tex_Anim(sprite), x, y, sRECT.left, sRECT.top, sRECT.width, sRECT.height, sRECT.width, sRECT.height
+End Sub
+
+Public Sub DrawGDI()
+
+ If frmEditor_Animation.visible Then
+ GDIRenderAnimation
+ ElseIf frmEditor_Item.visible Then
+ GDIRenderItem frmEditor_Item.picItem, frmEditor_Item.scrlPic.value
+ ElseIf frmEditor_Map.visible Then
+ GDIRenderTileset
+ If frmEditor_Events.visible Then
+ GDIRenderEventGraphic
+ GDIRenderEventGraphicSel
+ End If
+ ElseIf frmEditor_NPC.visible Then
+ GDIRenderChar frmEditor_NPC.picSprite, frmEditor_NPC.scrlSprite.value
+ ElseIf frmEditor_Resource.visible Then
+ ' lol nothing
+ ElseIf frmEditor_Spell.visible Then
+ GDIRenderSpell frmEditor_Spell.picSprite, frmEditor_Spell.scrlIcon.value
+ End If
+
+End Sub
+
+' Main Loop
+Public Sub Render_Graphics()
+ Dim x As Long, y As Long, i As Long, bgColour As Long
+
+ ' fuck off if we're not doing anything
+ If GettingMap Then Exit Sub
+
+ ' update the camera
+ UpdateCamera
+
+ ' check graphics
+ CheckGFX
+
+ ' Start rendering
+ If Not InMapEditor Then
+ bgColour = 0
+ Else
+ bgColour = DX8Colour(Red, 255)
+ End If
+
+ ' Bg
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, bgColour, 1#, 0)
+ Call D3DDevice.BeginScene
+
+ ' render black if map
+ If InMapEditor Then
+ For x = TileView.left To TileView.Right
+ For y = TileView.top To TileView.bottom
+ If IsValidMapPoint(x, y) Then
+ RenderTexture Tex_Fader, ConvertMapX(x * 32), ConvertMapY(y * 32), 0, 0, 32, 32, 32, 32
+ End If
+ Next
+ Next
+ End If
+
+ ' Render appear tile fades
+ 'RenderAppearTileFade
+
+ ' render lower tiles
+ If Count_Tileset > 0 Then
+ For x = TileView.left To TileView.Right
+ For y = TileView.top To TileView.bottom
+ If IsValidMapPoint(x, y) Then
+ Call DrawMapTile(x, y)
+ End If
+ Next
+ Next
+ End If
+
+ ' render the items
+ If Count_Item > 0 Then
+ For i = 1 To MAX_MAP_ITEMS
+ If MapItem(i).num > 0 Then
+ Call DrawItem(i)
+ End If
+ Next
+ End If
+
+ ' draw animations
+ If Count_Anim > 0 Then
+ For i = 1 To MAX_BYTE
+ If AnimInstance(i).Used(0) Then
+ DrawAnimation i, 0
+ End If
+ Next
+ End If
+
+ ' draw events
+ DrawLowerEvents
+
+ ' Y-based render. Renders Players, Npcs and Resources based on Y-axis.
+ If Count_Char > 0 Then
+ ' shadows - Players
+ For i = 1 To MAX_PLAYERS
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ 'If Not Trim$(Player(i).name) = "Robin" Then
+ Call DrawShadow(Player(i).sprite, (Player(i).x * 32) + Player(i).xOffset, (Player(i).y * 32) + Player(i).yOffset)
+ 'End If
+ End If
+ Next
+
+ ' shadows - npcs
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(i).num > 0 Then
+ Call DrawShadow(Npc(MapNpc(i).num).sprite, (MapNpc(i).x * 32) + MapNpc(i).xOffset, (MapNpc(i).y * 32) + MapNpc(i).yOffset)
+ End If
+ Next
+
+ ' Players
+ For i = 1 To MAX_PLAYERS
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ Call DrawPlayer(i)
+ End If
+ Next
+
+ ' Npcs
+ For i = 1 To MAX_MAP_NPCS
+ Call DrawNpc(i)
+ Next
+ End If
+
+ ' Resources
+ If Count_Resource > 0 Then
+ If Resources_Init Then
+ If Resource_Index > 0 Then
+
+ For i = 1 To Resource_Index
+ Call DrawResource(i)
+ Next
+
+ End If
+ End If
+ End If
+
+ ' render out upper tiles
+ If Count_Tileset > 0 Then
+ For x = TileView.left To TileView.Right
+ For y = TileView.top To TileView.bottom
+ If IsValidMapPoint(x, y) Then
+ Call DrawMapFringeTile(x, y)
+ End If
+ Next
+ Next
+ End If
+
+ ' draw events
+ DrawUpperEvents
+
+ ' render fog
+ DrawFog
+
+ ' render animations
+ If Count_Anim > 0 Then
+ For i = 1 To MAX_BYTE
+ If AnimInstance(i).Used(1) Then
+ DrawAnimation i, 1
+ End If
+ Next
+ End If
+
+ ' render target
+ If myTarget > 0 Then
+ If myTargetType = TARGET_TYPE_PLAYER Then
+ DrawTarget (Player(myTarget).x * 32) + Player(myTarget).xOffset, (Player(myTarget).y * 32) + Player(myTarget).yOffset
+ ElseIf myTargetType = TARGET_TYPE_NPC Then
+ DrawTarget (MapNpc(myTarget).x * 32) + MapNpc(myTarget).xOffset, (MapNpc(myTarget).y * 32) + MapNpc(myTarget).yOffset
+ End If
+ End If
+
+ ' blt the hover icon
+ DrawTargetHover
+
+ ' draw the bars
+ DrawBars
+
+ ' draw attributes
+ If InMapEditor Then
+ DrawMapAttributes
+ DrawMapEvents
+ End If
+
+ ' draw player names
+ If Not screenshotMode Then
+ For i = 1 To MAX_PLAYERS
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ Call DrawPlayerName(i)
+ End If
+ Next
+ End If
+
+ ' draw npc names
+ If Not screenshotMode Then
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(i).num > 0 Then
+ Call DrawNpcName(i)
+ End If
+ Next
+ End If
+
+ ' draw action msg
+ For i = 1 To MAX_BYTE
+ DrawActionMsg i
+ Next
+
+ If InMapEditor Then
+ If frmEditor_Map.optBlock.value = True Then
+ For x = TileView.left To TileView.Right
+ For y = TileView.top To TileView.bottom
+ If IsValidMapPoint(x, y) Then
+ Call DrawDirection(x, y)
+ End If
+ Next
+ Next
+ End If
+ End If
+
+ ' draw the messages
+ For i = 1 To MAX_BYTE
+ If chatBubble(i).active Then
+ DrawChatBubble i
+ End If
+ Next
+
+ ' draw shadow
+ If Not screenshotMode Then
+ RenderTexture Tex_GUI(43), 0, 0, 0, 0, ScreenWidth, 64, 1, 64
+ RenderTexture Tex_GUI(42), 0, ScreenHeight - 64, 0, 0, ScreenWidth, 64, 1, 64
+ End If
+
+ ' Render entities
+ If Not InMapEditor And Not hideGUI And Not screenshotMode Then RenderEntities
+
+ ' render the tile selection
+ If InMapEditor Then DrawTileSelection
+
+ ' render FPS
+ If Not screenshotMode Then RenderText font(Fonts.rockwell_15), "FPS: " & GameFPS, 1, 1, White
+
+ ' draw loc
+ If BLoc Then
+ RenderText font(Fonts.georgiaDec_16), Trim$("cur x: " & CurX & " y: " & CurY), 260, 6, Yellow
+ RenderText font(Fonts.georgiaDec_16), Trim$("loc x: " & GetPlayerX(MyIndex) & " y: " & GetPlayerY(MyIndex)), 260, 22, Yellow
+ RenderText font(Fonts.georgiaDec_16), Trim$(" (map #" & GetPlayerMap(MyIndex) & ")"), 260, 38, Yellow
+ End If
+
+ ' draw map name
+ RenderMapName
+
+ ' End the rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(ByVal 0, ByVal 0, 0, ByVal 0)
+ ' GDI Rendering
+ DrawGDI
+End Sub
+
+Public Sub Render_Menu()
+ ' check graphics
+ CheckGFX
+ ' Start rendering
+ Call D3DDevice.Clear(0, ByVal 0, D3DCLEAR_TARGET, &HFFFFFF, 1#, 0)
+ Call D3DDevice.BeginScene
+ ' Render menu background
+ DrawMenuBG
+ ' Render entities
+ RenderEntities
+ ' render white fade
+ DrawFade
+ ' End the rendering
+ Call D3DDevice.EndScene
+ Call D3DDevice.Present(ByVal 0, ByVal 0, 0, ByVal 0)
+End Sub
diff --git a/client/src/modEnumerations.bas b/client/src/modEnumerations.bas
new file mode 100644
index 0000000..c4bfb7e
--- /dev/null
+++ b/client/src/modEnumerations.bas
@@ -0,0 +1,356 @@
+Attribute VB_Name = "modEnumerations"
+Option Explicit
+
+' The order of the packets must match with the server's packet enumeration
+' Packets sent by server to client
+Public Enum ServerPackets
+ SAlertMsg = 1
+ SLoginOk
+ SNewCharClasses
+ SClassesData
+ SInGame
+ SPlayerInv
+ SPlayerInvUpdate
+ SPlayerWornEq
+ SPlayerHp
+ SPlayerMp
+ SPlayerStats
+ SPlayerData
+ SPlayerMove
+ SNpcMove
+ SPlayerDir
+ SNpcDir
+ SPlayerXY
+ SPlayerXYMap
+ SAttack
+ SNpcAttack
+ SCheckForMap
+ SMapData
+ SMapItemData
+ SMapNpcData
+ SMapDone
+ SGlobalMsg
+ SAdminMsg
+ SPlayerMsg
+ SMapMsg
+ SSpawnItem
+ SItemEditor
+ SUpdateItem
+ SREditor
+ SSpawnNpc
+ SNpcDead
+ SNpcEditor
+ SUpdateNpc
+ SMapKey
+ SEditMap
+ SShopEditor
+ SUpdateShop
+ SSpellEditor
+ SUpdateSpell
+ SSpells
+ SLeft
+ SResourceCache
+ SResourceEditor
+ SUpdateResource
+ SSendPing
+ SDoorAnimation
+ SActionMsg
+ SPlayerEXP
+ SBlood
+ SAnimationEditor
+ SUpdateAnimation
+ SAnimation
+ SMapNpcVitals
+ SCooldown
+ SClearSpellBuffer
+ SSayMsg
+ SOpenShop
+ SResetShopAction
+ SStunned
+ SMapWornEq
+ SBank
+ STrade
+ SCloseTrade
+ STradeUpdate
+ STradeStatus
+ STarget
+ SHotbar
+ SHighIndex
+ SSound
+ STradeRequest
+ SPartyInvite
+ SPartyUpdate
+ SPartyVitals
+ SChatUpdate
+ SConvEditor
+ SUpdateConv
+ SStartTutorial
+ SChatBubble
+ SSetPlayerLoginToken
+ SPlayerChars
+ SCancelAnimation
+ SPlayerVariables
+ SEvent
+ ' Make sure SMsgCOUNT is below everything else
+ SMsgCOUNT
+End Enum
+
+' Packets sent by client to server
+Public Enum ClientPackets
+ CNewAccount = 1
+ CDelChar
+ CLogin
+ CAddChar
+ CUseChar
+ CSayMsg
+ CEmoteMsg
+ CBroadcastMsg
+ CPlayerMsg
+ CPlayerMove
+ CPlayerDir
+ CUseItem
+ CAttack
+ CUseStatPoint
+ CPlayerInfoRequest
+ CWarpMeTo
+ CWarpToMe
+ CWarpTo
+ CSetSprite
+ CGetStats
+ CRequestNewMap
+ CMapData
+ CNeedMap
+ CMapGetItem
+ CMapDropItem
+ CMapRespawn
+ CMapReport
+ CKickPlayer
+ CBanList
+ CBanDestroy
+ CBanPlayer
+ CRequestEditMap
+ CRequestEditItem
+ CSaveItem
+ CRequestEditNpc
+ CSaveNpc
+ CRequestEditShop
+ CSaveShop
+ CRequestEditSpell
+ CSaveSpell
+ CSetAccess
+ CWhosOnline
+ CSetMotd
+ CTarget
+ CSpells
+ CCast
+ CQuit
+ CSwapInvSlots
+ CRequestEditResource
+ CSaveResource
+ CCheckPing
+ CUnequip
+ CRequestPlayerData
+ CRequestItems
+ CRequestNPCS
+ CRequestResources
+ CSpawnItem
+ CRequestEditAnimation
+ CSaveAnimation
+ CRequestAnimations
+ CRequestSpells
+ CRequestShops
+ CRequestLevelUp
+ CForgetSpell
+ CCloseShop
+ CBuyItem
+ CSellItem
+ CChangeBankSlots
+ CDepositItem
+ CWithdrawItem
+ CCloseBank
+ CAdminWarp
+ CTradeRequest
+ CAcceptTrade
+ CDeclineTrade
+ CTradeItem
+ CUntradeItem
+ CHotbarChange
+ CHotbarUse
+ CSwapSpellSlots
+ CAcceptTradeRequest
+ CDeclineTradeRequest
+ CPartyRequest
+ CAcceptParty
+ CDeclineParty
+ CPartyLeave
+ CChatOption
+ CRequestEditConv
+ CSaveConv
+ CRequestConvs
+ CFinishTutorial
+ CAuthLogin
+ ' Make sure CMsgCOUNT is below everything else
+ CMsgCOUNT
+End Enum
+
+Public HandleDataSub(SMsgCOUNT) As Long
+
+' Stats used by Players, Npcs and Classes
+Public Enum Stats
+ Strength = 1
+ Endurance
+ Intelligence
+ Agility
+ Willpower
+ ' Make sure Stat_Count is below everything else
+ Stat_Count
+End Enum
+
+' Vitals used by Players, Npcs and Classes
+Public Enum Vitals
+ HP = 1
+ MP
+ ' Make sure Vital_Count is below everything else
+ Vital_Count
+End Enum
+
+' Equipment used by Players
+Public Enum Equipment
+ Weapon = 1
+ Armor
+ Helmet
+ Shield
+ ' Make sure Equipment_Count is below everything else
+ Equipment_Count
+End Enum
+
+' Layers in a map
+Public Enum MapLayer
+ Ground = 1
+ Mask
+ Mask2
+ Fringe
+ Fringe2
+ ' Make sure Layer_Count is below everything else
+ Layer_Count
+End Enum
+
+' Sound entities
+Public Enum SoundEntity
+ seAnimation = 1
+ seItem
+ seNpc
+ seResource
+ seSpell
+ ' Make sure SoundEntity_Count is below everything else
+ SoundEntity_Count
+End Enum
+
+' Menu
+Public Enum MenuCount
+ menuMain = 1
+ menuLogin
+ menuRegister
+ menuCredits
+ menuClass
+ menuNewChar
+ menuChars
+ menuMerge
+End Enum
+
+' Chat channels
+Public Enum ChatChannel
+ chGame = 0
+ chMap
+ chGlobal
+ chParty
+ chGuild
+ chPrivate
+ ' last
+ Channel_Count
+End Enum
+
+' dialogue
+Public Enum DialogueMsg
+ MsgCONNECTION = 1
+ MsgBANNED
+ MsgKICKED
+ MsgOUTDATED
+ MsgUSERLENGTH
+ MsgILLEGALNAME
+ MsgREBOOTING
+ MsgNAMETAKEN
+ MsgNAMELENGTH
+ MsgNAMEILLEGAL
+ MsgMYSQL
+ MsgWRONGPASS
+ MsgACTIVATED
+ MsgMERGE
+ MsgMAXCHARS
+ MsgMERGENAME
+ MsgDELCHAR
+End Enum
+
+Public Enum DialogueType
+ TypeName = 0
+ TypeTRADE
+ TypeFORGET
+ TypePARTY
+ TypeLOOTITEM
+ TypeALERT
+ TypeDELCHAR
+ TypeDROPITEM
+ TypeTRADEAMOUNT
+End Enum
+
+Public Enum DialogueStyle
+ StyleOKAY = 1
+ StyleYESNO
+ StyleINPUT
+End Enum
+
+' Event Types
+Public Enum EventType
+ ' Message
+ evAddText = 1
+ evShowText
+ evShowChatBubble
+ evShowChoices
+ evInputNumber
+ ' Game Progression
+ evPlayerVar
+ evEventSwitch
+ ' Flow Control
+ evIfElse
+ evExitProcess
+ ' Player
+ evChangeGold
+ evChangeItems
+ evChangeHP
+ evChangeMP
+ evChangeEXP
+ evChangeLevel
+ evChangeSkills
+ evChangeClass
+ evChangeSprite
+ evChangeSex
+ ' Movement
+ evWarpPlayer
+ evScrollMap
+ ' Character
+ evShowAnimation
+ evShowEmoticon
+ ' Screen Controls
+ evFadeout
+ evFadein
+ evTintScreen
+ evFlashScreen
+ evShakeScreen
+ ' Music and Sounds
+ evPlayBGM
+ evFadeoutBGM
+ evPlayBGS
+ evFadeoutBGS
+ evPlaySound
+ evStopSound
+End Enum
diff --git a/client/src/modEvents.bas b/client/src/modEvents.bas
new file mode 100644
index 0000000..c03ca30
--- /dev/null
+++ b/client/src/modEvents.bas
@@ -0,0 +1,317 @@
+Attribute VB_Name = "modEvents"
+Option Explicit
+
+Private Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
+Const LB_SETHORIZONTALEXTENT = &H194
+
+' temporary event
+Public cpEvent As EventRec
+
+Sub CopyEvent_Map(x As Long, y As Long)
+Dim count As Long, i As Long
+ count = map.TileData.EventCount
+ If count = 0 Then Exit Sub
+
+ For i = 1 To count
+ If map.TileData.Events(i).x = x And map.TileData.Events(i).y = y Then
+ ' copy it
+ CopyMemory ByVal VarPtr(cpEvent), ByVal VarPtr(map.TileData.Events(i)), LenB(map.TileData.Events(i))
+ ' exit
+ Exit Sub
+ End If
+ Next
+End Sub
+
+Sub PasteEvent_Map(x As Long, y As Long)
+Dim count As Long, i As Long, eventNum As Long
+ count = map.TileData.EventCount
+
+ If count > 0 Then
+ For i = 1 To count
+ If map.TileData.Events(i).x = x And map.TileData.Events(i).y = y Then
+ ' already an event - paste over it
+ eventNum = i
+ End If
+ Next
+ End If
+
+ ' couldn't find one - create one
+ If eventNum = 0 Then
+ ' increment count
+ AddEvent x, y, True
+ eventNum = count + 1
+ End If
+
+ ' copy it
+ CopyMemory ByVal VarPtr(map.TileData.Events(eventNum)), ByVal VarPtr(cpEvent), LenB(cpEvent)
+
+ ' set position
+ map.TileData.Events(eventNum).x = x
+ map.TileData.Events(eventNum).y = y
+End Sub
+
+Sub AddEvent(x As Long, y As Long, Optional ByVal cancelLoad As Boolean = False)
+Dim count As Long, pageCount As Long, i As Long
+ count = map.TileData.EventCount + 1
+ ' make sure there's not already an event
+ If count - 1 > 0 Then
+ For i = 1 To count - 1
+ If map.TileData.Events(i).x = x And map.TileData.Events(i).y = y Then
+ ' already an event - edit it
+ If Not cancelLoad Then EventEditorInit i
+ Exit Sub
+ End If
+ Next
+ End If
+ ' increment count
+ map.TileData.EventCount = count
+ ReDim Preserve map.TileData.Events(1 To count)
+ ' set the new event
+ map.TileData.Events(count).x = x
+ map.TileData.Events(count).y = y
+ ' give it a new page
+ pageCount = map.TileData.Events(count).pageCount + 1
+ map.TileData.Events(count).pageCount = pageCount
+ ReDim Preserve map.TileData.Events(count).EventPage(1 To pageCount)
+ ' load the editor
+ If Not cancelLoad Then EventEditorInit count
+End Sub
+
+Sub DeleteEvent(x As Long, y As Long)
+Dim count As Long, i As Long, lowIndex As Long
+ If Not InMapEditor Then Exit Sub
+
+ count = map.TileData.EventCount
+ For i = 1 To count
+ If map.TileData.Events(i).x = x And map.TileData.Events(i).y = y Then
+ ' delete it
+ ClearEvent i
+ lowIndex = i
+ Exit For
+ End If
+ Next
+
+ ' not found anything
+ If lowIndex = 0 Then Exit Sub
+
+ ' move everything down an index
+ For i = lowIndex To count - 1
+ CopyEvent i + 1, i
+ Next
+ ' delete the last index
+ ClearEvent count
+ ' set the new count
+ map.TileData.EventCount = count - 1
+End Sub
+
+Sub ClearEvent(eventNum As Long)
+ Call ZeroMemory(ByVal VarPtr(map.TileData.Events(eventNum)), LenB(map.TileData.Events(eventNum)))
+End Sub
+
+Sub CopyEvent(original As Long, newone As Long)
+ CopyMemory ByVal VarPtr(map.TileData.Events(newone)), ByVal VarPtr(map.TileData.Events(original)), LenB(map.TileData.Events(original))
+End Sub
+
+Sub EventEditorInit(eventNum As Long)
+Dim i As Long
+ EditorEvent = eventNum
+ ' copy the event data to the temp event
+ CopyMemory ByVal VarPtr(tmpEvent), ByVal VarPtr(map.TileData.Events(eventNum)), LenB(map.TileData.Events(eventNum))
+ ' populate form
+ With frmEditor_Events
+ ' set the tabs
+ .tabPages.Tabs.Clear
+ For i = 1 To tmpEvent.pageCount
+ .tabPages.Tabs.Add , , Str(i)
+ Next
+ ' items
+ .cmbHasItem.Clear
+ .cmbHasItem.AddItem "None"
+ For i = 1 To MAX_ITEMS
+ .cmbHasItem.AddItem i & ": " & Trim$(Item(i).name)
+ Next
+ ' variables
+ .cmbPlayerVar.Clear
+ .cmbPlayerVar.AddItem "None"
+ For i = 1 To MAX_BYTE
+ .cmbPlayerVar.AddItem i
+ Next
+ ' name
+ .txtName.text = tmpEvent.name
+ ' enable delete button
+ If tmpEvent.pageCount > 1 Then
+ .cmdDeletePage.enabled = True
+ Else
+ .cmdDeletePage.enabled = False
+ End If
+ .cmdPastePage.enabled = False
+ ' set the commands frame
+ .fraCommands.width = 417
+ .fraCommands.height = 497
+ ' set the dialogue frame
+ .fraDialogue.width = 417
+ .fraDialogue.height = 497
+ ' Load page 1 to start off with
+ curPageNum = 1
+ EventEditorLoadPage curPageNum
+ End With
+ ' show the editor
+ frmEditor_Events.Show
+End Sub
+
+Sub AddCommand(theType As EventType)
+Dim count As Long
+ ' update the array
+ With tmpEvent.EventPage(curPageNum)
+ count = .CommandCount + 1
+ ReDim Preserve .Commands(1 To count)
+ .CommandCount = count
+ ' set the shit
+ Select Case theType
+ Case EventType.evAddText
+ ' set the values
+ .Commands(count).Type = EventType.evAddText
+ .Commands(count).text = frmEditor_Events.txtAddText_Text.text
+ .Commands(count).colour = frmEditor_Events.scrlAddText_Colour.value
+ If frmEditor_Events.optAddText_Game.value Then
+ .Commands(count).channel = 0
+ ElseIf frmEditor_Events.optAddText_Map.value Then
+ .Commands(count).channel = 1
+ ElseIf frmEditor_Events.optAddText_Global.value Then
+ .Commands(count).channel = 2
+ End If
+ Case EventType.evShowChatBubble
+ .Commands(count).Type = EventType.evShowChatBubble
+ .Commands(count).text = frmEditor_Events.txtChatBubble.text
+ .Commands(count).colour = frmEditor_Events.scrlChatBubble.value
+ .Commands(count).TargetType = frmEditor_Events.cmbChatBubbleType.ListIndex
+ .Commands(count).target = frmEditor_Events.cmbChatBubble.ListIndex
+ Case EventType.evPlayerVar
+ .Commands(count).Type = EventType.evPlayerVar
+ .Commands(count).target = frmEditor_Events.cmbVariable.ListIndex
+ .Commands(count).colour = Val(frmEditor_Events.txtVariable.text)
+ Case EventType.evWarpPlayer
+ .Commands(count).Type = EventType.evWarpPlayer
+ .Commands(count).x = frmEditor_Events.scrlWPX.value
+ .Commands(count).y = frmEditor_Events.scrlWPY.value
+ .Commands(count).target = frmEditor_Events.scrlWPMap.value
+ End Select
+ End With
+ ' re-list the commands
+ EventListCommands
+End Sub
+
+Sub EditCommand()
+ With tmpEvent.EventPage(curPageNum).Commands(curCommand)
+ Select Case .Type
+ Case EventType.evAddText
+ .text = frmEditor_Events.txtAddText_Text.text
+ .colour = frmEditor_Events.scrlAddText_Colour.value
+ If frmEditor_Events.optAddText_Game.value Then
+ .channel = 0
+ ElseIf frmEditor_Events.optAddText_Map.value Then
+ .channel = 1
+ ElseIf frmEditor_Events.optAddText_Global.value Then
+ .channel = 2
+ End If
+ Case EventType.evShowChatBubble
+ .text = frmEditor_Events.txtChatBubble.text
+ .colour = frmEditor_Events.scrlChatBubble.value
+ .TargetType = frmEditor_Events.cmbChatBubbleType.ListIndex
+ .target = frmEditor_Events.cmbChatBubble.ListIndex
+ Case EventType.evPlayerVar
+ .target = frmEditor_Events.cmbVariable.ListIndex
+ .colour = Val(frmEditor_Events.txtVariable.text)
+ Case EventType.evWarpPlayer
+ .x = frmEditor_Events.scrlWPX.value
+ .y = frmEditor_Events.scrlWPY.value
+ End Select
+ End With
+ ' re-list the commands
+ EventListCommands
+End Sub
+
+Sub EventListCommands()
+Dim i As Long, count As Long
+ frmEditor_Events.lstCommands.Clear
+ ' check if there are any
+ count = tmpEvent.EventPage(curPageNum).CommandCount
+ If count > 0 Then
+ ' list them
+ For i = 1 To count
+ With tmpEvent.EventPage(curPageNum).Commands(i)
+ Select Case .Type
+ Case EventType.evAddText
+ ListCommandAdd "@>Add Text: " & .text & " - Colour: " & GetColourString(.colour) & " - Channel: " & .channel
+ Case EventType.evShowChatBubble
+ ListCommandAdd "@>Show Chat Bubble: " & .text & " - Colour: " & GetColourString(.colour) & " - Target Type: " & .TargetType & " - Target: " & .target
+ Case EventType.evPlayerVar
+ ListCommandAdd "@>Change variable #" & .target & " to " & .colour
+ Case EventType.evWarpPlayer
+ ListCommandAdd "@>Warp Player to Map #" & .target & ", X: " & .x & ", Y: " & .y
+ Case Else
+ ListCommandAdd "@>Unknown"
+ End Select
+ End With
+ Next
+ Else
+ frmEditor_Events.lstCommands.AddItem "@>"
+ End If
+ frmEditor_Events.lstCommands.ListIndex = 0
+ curCommand = 1
+End Sub
+
+Sub ListCommandAdd(s As String)
+Static x As Long
+ frmEditor_Events.lstCommands.AddItem s
+ ' scrollbar
+ If x < frmEditor_Events.TextWidth(s & " ") Then
+ x = frmEditor_Events.TextWidth(s & " ")
+ If frmEditor_Events.ScaleMode = vbTwips Then x = x / Screen.TwipsPerPixelX ' if twips change to pixels
+ SendMessageByNum frmEditor_Events.lstCommands.hWnd, LB_SETHORIZONTALEXTENT, x, 0
+ End If
+End Sub
+
+Sub EventEditorLoadPage(pageNum As Long)
+ ' populate form
+ With tmpEvent.EventPage(pageNum)
+ GraphicSelX = .GraphicX
+ GraphicSelY = .GraphicY
+ frmEditor_Events.cmbGraphic.ListIndex = .GraphicType
+ frmEditor_Events.cmbHasItem.ListIndex = .HasItemNum
+ frmEditor_Events.cmbMoveFreq.ListIndex = .MoveFreq
+ frmEditor_Events.cmbMoveSpeed.ListIndex = .MoveSpeed
+ frmEditor_Events.cmbMoveType.ListIndex = .MoveType
+ frmEditor_Events.cmbPlayerVar.ListIndex = .PlayerVarNum
+ frmEditor_Events.cmbPriority.ListIndex = .Priority
+ frmEditor_Events.cmbSelfSwitch.ListIndex = .SelfSwitchNum
+ frmEditor_Events.cmbTrigger.ListIndex = .Trigger
+ frmEditor_Events.chkDirFix.value = .DirFix
+ frmEditor_Events.chkHasItem.value = .chkHasItem
+ frmEditor_Events.chkPlayerVar.value = .chkPlayerVar
+ frmEditor_Events.chkSelfSwitch.value = .chkSelfSwitch
+ frmEditor_Events.chkStepAnim.value = .StepAnim
+ frmEditor_Events.chkWalkAnim.value = .WalkAnim
+ frmEditor_Events.chkWalkThrough.value = .WalkThrough
+ frmEditor_Events.txtPlayerVariable = .PlayerVariable
+ frmEditor_Events.scrlGraphic.value = .Graphic
+ If .chkHasItem = 0 Then frmEditor_Events.cmbHasItem.enabled = False Else frmEditor_Events.cmbHasItem.enabled = True
+ If .chkSelfSwitch = 0 Then frmEditor_Events.cmbSelfSwitch.enabled = False Else frmEditor_Events.cmbSelfSwitch.enabled = True
+ If .chkPlayerVar = 0 Then
+ frmEditor_Events.cmbPlayerVar.enabled = False
+ frmEditor_Events.txtPlayerVariable.enabled = False
+ Else
+ frmEditor_Events.cmbPlayerVar.enabled = True
+ frmEditor_Events.txtPlayerVariable.enabled = True
+ End If
+ ' show the commands
+ EventListCommands
+ End With
+End Sub
+
+Sub EventEditorOK()
+ ' copy the event data from the temp event
+ CopyMemory ByVal VarPtr(map.TileData.Events(EditorEvent)), ByVal VarPtr(tmpEvent), LenB(tmpEvent)
+ ' unload the form
+ Unload frmEditor_Events
+End Sub
diff --git a/client/src/modFMod.bas b/client/src/modFMod.bas
new file mode 100644
index 0000000..135b655
--- /dev/null
+++ b/client/src/modFMod.bas
@@ -0,0 +1,2 @@
+Attribute VB_Name = "modFMod"
+
diff --git a/client/src/modGameEditors.bas b/client/src/modGameEditors.bas
new file mode 100644
index 0000000..c0c5190
--- /dev/null
+++ b/client/src/modGameEditors.bas
@@ -0,0 +1,1425 @@
+Attribute VB_Name = "modGameEditors"
+Option Explicit
+
+' Temp event storage
+Public tmpEvent As EventRec
+Public tmpItem As ItemRec
+Public tmpSpell As SpellRec
+Public tmpNPC As NpcRec
+
+Public curPageNum As Long
+Public curCommand As Long
+Public GraphicSelX As Long
+Public GraphicSelY As Long
+
+' ////////////////
+' // Map Editor //
+' ////////////////
+Public Sub MapEditorInit()
+ Dim i As Long
+ ' set the width
+ frmEditor_Map.width = 9585
+ ' we're in the map editor
+ InMapEditor = True
+ ' show the form
+ frmEditor_Map.visible = True
+ ' set the scrolly bars
+ frmEditor_Map.scrlTileSet.Max = Count_Tileset
+ frmEditor_Map.fraTileSet.caption = "Tileset: " & 1
+ frmEditor_Map.scrlTileSet.value = 1
+ ' set the scrollbars
+ frmEditor_Map.scrlPictureY.Max = (frmEditor_Map.picBackSelect.height \ PIC_Y) - (frmEditor_Map.picBack.height \ PIC_Y)
+ frmEditor_Map.scrlPictureX.Max = (frmEditor_Map.picBackSelect.width \ PIC_X) - (frmEditor_Map.picBack.width \ PIC_X)
+ shpSelectedWidth = 32
+ shpSelectedHeight = 32
+ MapEditorTileScroll
+ ' set shops for the shop attribute
+ frmEditor_Map.cmbShop.AddItem "None"
+
+ For i = 1 To MAX_SHOPS
+ frmEditor_Map.cmbShop.AddItem i & ": " & Shop(i).name
+ Next
+
+ ' we're not in a shop
+ frmEditor_Map.cmbShop.ListIndex = 0
+End Sub
+
+Public Sub MapEditorProperties()
+ Dim x As Long, i As Long, tmpNum As Long
+
+ ' populate the cache if we need to
+ If Not hasPopulated Then
+ PopulateLists
+ End If
+
+ ' add the array to the combo
+ frmEditor_MapProperties.lstMusic.Clear
+ frmEditor_MapProperties.lstMusic.AddItem "None."
+ tmpNum = UBound(musicCache)
+
+ For i = 1 To tmpNum
+ frmEditor_MapProperties.lstMusic.AddItem musicCache(i)
+ Next
+
+ ' finished populating
+ With frmEditor_MapProperties
+ .scrlBoss.Max = MAX_MAP_NPCS
+ .txtName.text = Trim$(map.MapData.name)
+
+ ' find the music we have set
+ If .lstMusic.ListCount >= 0 Then
+ .lstMusic.ListIndex = 0
+ tmpNum = .lstMusic.ListCount
+
+ For i = 0 To tmpNum - 1
+
+ If .lstMusic.list(i) = Trim$(map.MapData.Music) Then
+ .lstMusic.ListIndex = i
+ End If
+
+ Next
+
+ End If
+
+ ' rest of it
+ .txtUp.text = CStr(map.MapData.Up)
+ .txtDown.text = CStr(map.MapData.Down)
+ .txtLeft.text = CStr(map.MapData.left)
+ .txtRight.text = CStr(map.MapData.Right)
+ .cmbMoral.ListIndex = map.MapData.Moral
+ .txtBootMap.text = CStr(map.MapData.BootMap)
+ .txtBootX.text = CStr(map.MapData.BootX)
+ .txtBootY.text = CStr(map.MapData.BootY)
+ .scrlBoss = map.MapData.BossNpc
+ ' show the map npcs
+ .lstNpcs.Clear
+
+ For x = 1 To MAX_MAP_NPCS
+
+ If map.MapData.Npc(x) > 0 Then
+ .lstNpcs.AddItem x & ": " & Trim$(Npc(map.MapData.Npc(x)).name)
+ Else
+ .lstNpcs.AddItem x & ": No NPC"
+ End If
+
+ Next
+
+ .lstNpcs.ListIndex = 0
+ ' show the npc selection combo
+ .cmbNpc.Clear
+ .cmbNpc.AddItem "No NPC"
+
+ For x = 1 To MAX_NPCS
+ .cmbNpc.AddItem x & ": " & Trim$(Npc(x).name)
+ Next
+
+ ' set the combo box properly
+ Dim tmpString() As String
+ Dim npcNum As Long
+ tmpString = Split(.lstNpcs.list(.lstNpcs.ListIndex))
+ npcNum = CLng(left$(tmpString(0), Len(tmpString(0)) - 1))
+ .cmbNpc.ListIndex = map.MapData.Npc(npcNum)
+ ' show the current map
+ .lblMap.caption = "Current map: " & GetPlayerMap(MyIndex)
+ .txtMaxX.text = map.MapData.MaxX
+ .txtMaxY.text = map.MapData.MaxY
+ End With
+
+End Sub
+
+Public Sub MapEditorSetTile(ByVal x As Long, ByVal y As Long, ByVal CurLayer As Long, Optional ByVal multitile As Boolean = False, Optional ByVal theAutotile As Byte = 0)
+ Dim x2 As Long, y2 As Long
+
+ If theAutotile > 0 Then
+
+ With map.TileData.Tile(x, y)
+ ' set layer
+ .Layer(CurLayer).x = EditorTileX
+ .Layer(CurLayer).y = EditorTileY
+ .Layer(CurLayer).tileSet = frmEditor_Map.scrlTileSet.value
+ .Autotile(CurLayer) = theAutotile
+ cacheRenderState x, y, CurLayer
+ End With
+
+ ' do a re-init so we can see our changes
+ initAutotiles
+ Exit Sub
+ End If
+
+ If Not multitile Then ' single
+
+ With map.TileData.Tile(x, y)
+ ' set layer
+ .Layer(CurLayer).x = EditorTileX
+ .Layer(CurLayer).y = EditorTileY
+ .Layer(CurLayer).tileSet = frmEditor_Map.scrlTileSet.value
+ .Autotile(CurLayer) = 0
+ cacheRenderState x, y, CurLayer
+ End With
+
+ Else ' multitile
+ y2 = 0 ' starting tile for y axis
+
+ For y = CurY To CurY + EditorTileHeight - 1
+ x2 = 0 ' re-set x count every y loop
+
+ For x = CurX To CurX + EditorTileWidth - 1
+
+ If x >= 0 And x <= map.MapData.MaxX Then
+ If y >= 0 And y <= map.MapData.MaxY Then
+
+ With map.TileData.Tile(x, y)
+ .Layer(CurLayer).x = EditorTileX + x2
+ .Layer(CurLayer).y = EditorTileY + y2
+ .Layer(CurLayer).tileSet = frmEditor_Map.scrlTileSet.value
+ .Autotile(CurLayer) = 0
+ cacheRenderState x, y, CurLayer
+ End With
+
+ End If
+ End If
+
+ x2 = x2 + 1
+ Next
+
+ y2 = y2 + 1
+ Next
+
+ End If
+
+End Sub
+
+Public Sub MapEditorMouseDown(ByVal Button As Integer, ByVal x As Long, ByVal y As Long, Optional ByVal movedMouse As Boolean = True)
+ Dim i As Long
+ Dim CurLayer As Long
+
+ ' find which layer we're on
+ For i = 1 To MapLayer.Layer_Count - 1
+
+ If frmEditor_Map.optLayer(i).value Then
+ CurLayer = i
+ Exit For
+ End If
+
+ Next
+
+ If Not isInBounds Then Exit Sub
+ If Button = vbLeftButton Then
+ If frmEditor_Map.optLayers.value Then
+
+ ' no autotiling
+ If EditorTileWidth = 1 And EditorTileHeight = 1 Then 'single tile
+ MapEditorSetTile CurX, CurY, CurLayer, , frmEditor_Map.scrlAutotile.value
+ Else ' multi tile!
+
+ If frmEditor_Map.scrlAutotile.value = 0 Then
+ MapEditorSetTile CurX, CurY, CurLayer, True
+ Else
+ MapEditorSetTile CurX, CurY, CurLayer, , frmEditor_Map.scrlAutotile.value
+ End If
+ End If
+
+ ElseIf frmEditor_Map.optAttribs.value Then
+
+ With map.TileData.Tile(CurX, CurY)
+
+ ' blocked tile
+ If frmEditor_Map.optBlocked.value Then .Type = TILE_TYPE_BLOCKED
+
+ ' warp tile
+ If frmEditor_Map.optWarp.value Then
+ .Type = TILE_TYPE_WARP
+ .Data1 = EditorWarpMap
+ .Data2 = EditorWarpX
+ .Data3 = EditorWarpY
+ .Data4 = EditorWarpFall
+ .Data5 = 0
+ End If
+
+ ' item spawn
+ If frmEditor_Map.optItem.value Then
+ .Type = TILE_TYPE_ITEM
+ .Data1 = ItemEditorNum
+ .Data2 = ItemEditorValue
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' npc avoid
+ If frmEditor_Map.optNpcAvoid.value Then
+ .Type = TILE_TYPE_NPCAVOID
+ .Data1 = 0
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' key
+ If frmEditor_Map.optKey.value Then
+ .Type = TILE_TYPE_KEY
+ .Data1 = KeyEditorNum
+ .Data2 = KeyEditorTake
+ .Data3 = KeyEditorTime
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' key open
+ If frmEditor_Map.optKeyOpen.value Then
+ .Type = TILE_TYPE_KEYOPEN
+ .Data1 = KeyOpenEditorX
+ .Data2 = KeyOpenEditorY
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' resource
+ If frmEditor_Map.optResource.value Then
+ .Type = TILE_TYPE_RESOURCE
+ .Data1 = ResourceEditorNum
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' door
+ If frmEditor_Map.optDoor.value Then
+ .Type = TILE_TYPE_DOOR
+ .Data1 = EditorWarpMap
+ .Data2 = EditorWarpX
+ .Data3 = EditorWarpY
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' npc spawn
+ If frmEditor_Map.optNpcSpawn.value Then
+ .Type = TILE_TYPE_NPCSPAWN
+ .Data1 = SpawnNpcNum
+ .Data2 = SpawnNpcDir
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' shop
+ If frmEditor_Map.optShop.value Then
+ .Type = TILE_TYPE_SHOP
+ .Data1 = EditorShop
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' bank
+ If frmEditor_Map.optBank.value Then
+ .Type = TILE_TYPE_BANK
+ .Data1 = 0
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' heal
+ If frmEditor_Map.optHeal.value Then
+ .Type = TILE_TYPE_HEAL
+ .Data1 = MapEditorHealType
+ .Data2 = MapEditorHealAmount
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' trap
+ If frmEditor_Map.optTrap.value Then
+ .Type = TILE_TYPE_TRAP
+ .Data1 = MapEditorHealAmount
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' slide
+ If frmEditor_Map.optSlide.value Then
+ .Type = TILE_TYPE_SLIDE
+ .Data1 = MapEditorSlideDir
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' chat
+ If frmEditor_Map.optChat.value Then
+ .Type = TILE_TYPE_CHAT
+ .Data1 = MapEditorChatNpc
+ .Data2 = MapEditorChatDir
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+
+ ' appear
+ If frmEditor_Map.optAppear.value Then
+ .Type = TILE_TYPE_APPEAR
+ .Data1 = EditorAppearRange
+ .Data2 = EditorAppearBottom
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End If
+ End With
+
+ ElseIf frmEditor_Map.optBlock.value Then
+
+ If movedMouse Then Exit Sub
+ ' find what tile it is
+ x = x - ((x \ 32) * 32)
+ y = y - ((y \ 32) * 32)
+
+ ' see if it hits an arrow
+ For i = 1 To 4
+ If x >= DirArrowX(i) And x <= DirArrowX(i) + 8 Then
+ If y >= DirArrowY(i) And y <= DirArrowY(i) + 8 Then
+ ' flip the value.
+ setDirBlock map.TileData.Tile(CurX, CurY).DirBlock, CByte(i), Not isDirBlocked(map.TileData.Tile(CurX, CurY).DirBlock, CByte(i))
+ Exit Sub
+ End If
+ End If
+ Next
+ End If
+ End If
+
+ If Button = vbRightButton Then
+ If frmEditor_Map.optLayers.value Then
+
+ With map.TileData.Tile(CurX, CurY)
+ ' clear layer
+ .Layer(CurLayer).x = 0
+ .Layer(CurLayer).y = 0
+ .Layer(CurLayer).tileSet = 0
+
+ If .Autotile(CurLayer) > 0 Then
+ .Autotile(CurLayer) = 0
+ ' do a re-init so we can see our changes
+ initAutotiles
+ End If
+
+ cacheRenderState x, y, CurLayer
+ End With
+
+ ElseIf frmEditor_Map.optAttribs.value Then
+
+ With map.TileData.Tile(CurX, CurY)
+ ' clear attribute
+ .Type = 0
+ .Data1 = 0
+ .Data2 = 0
+ .Data3 = 0
+ .Data4 = 0
+ .Data5 = 0
+ End With
+
+ End If
+ End If
+
+ CacheResources
+End Sub
+
+Public Sub MapEditorChooseTile(Button As Integer, x As Single, y As Single)
+
+ If Button = vbLeftButton Then
+ EditorTileWidth = 1
+ EditorTileHeight = 1
+ EditorTileX = x \ PIC_X
+ EditorTileY = y \ PIC_Y
+ shpSelectedTop = EditorTileY * PIC_Y
+ shpSelectedLeft = EditorTileX * PIC_X
+ shpSelectedWidth = PIC_X
+ shpSelectedHeight = PIC_Y
+ End If
+
+End Sub
+
+Public Sub MapEditorDrag(Button As Integer, x As Single, y As Single)
+
+ If Button = vbLeftButton Then
+ ' convert the pixel number to tile number
+ x = (x \ PIC_X) + 1
+ y = (y \ PIC_Y) + 1
+
+ ' check it's not out of bounds
+ If x < 0 Then x = 0
+ If x > frmEditor_Map.picBackSelect.width / PIC_X Then x = frmEditor_Map.picBackSelect.width / PIC_X
+ If y < 0 Then y = 0
+ If y > frmEditor_Map.picBackSelect.height / PIC_Y Then y = frmEditor_Map.picBackSelect.height / PIC_Y
+
+ ' find out what to set the width + height of map editor to
+ If x > EditorTileX Then ' drag right
+ EditorTileWidth = x - EditorTileX
+ Else ' drag left
+ ' TO DO
+ End If
+
+ If y > EditorTileY Then ' drag down
+ EditorTileHeight = y - EditorTileY
+ Else ' drag up
+ ' TO DO
+ End If
+
+ shpSelectedWidth = EditorTileWidth * PIC_X
+ shpSelectedHeight = EditorTileHeight * PIC_Y
+ End If
+
+End Sub
+
+Public Sub NudgeMap(ByVal theDir As Byte)
+Dim x As Long, y As Long, i As Long
+
+ ' if left or right
+ If theDir = DIR_UP Or theDir = DIR_LEFT Then
+ For y = 0 To map.MapData.MaxY
+ For x = 0 To map.MapData.MaxX
+ Select Case theDir
+ Case DIR_UP
+ ' move up all one
+ If y > 0 Then CopyTile map.TileData.Tile(x, y), map.TileData.Tile(x, y - 1)
+ Case DIR_LEFT
+ ' move left all one
+ If x > 0 Then CopyTile map.TileData.Tile(x, y), map.TileData.Tile(x - 1, y)
+ End Select
+ Next
+ Next
+ Else
+ For y = map.MapData.MaxY To 0 Step -1
+ For x = map.MapData.MaxX To 0 Step -1
+ Select Case theDir
+ Case DIR_DOWN
+ ' move down all one
+ If y < map.MapData.MaxY Then CopyTile map.TileData.Tile(x, y), map.TileData.Tile(x, y + 1)
+ Case DIR_RIGHT
+ ' move right all one
+ If x < map.MapData.MaxX Then CopyTile map.TileData.Tile(x, y), map.TileData.Tile(x + 1, y)
+ End Select
+ Next
+ Next
+ End If
+
+ ' do events
+ If map.TileData.EventCount > 0 Then
+ For i = 1 To map.TileData.EventCount
+ Select Case theDir
+ Case DIR_UP
+ map.TileData.Events(i).y = map.TileData.Events(i).y - 1
+ Case DIR_LEFT
+ map.TileData.Events(i).x = map.TileData.Events(i).x - 1
+ Case DIR_RIGHT
+ map.TileData.Events(i).x = map.TileData.Events(i).x + 1
+ Case DIR_DOWN
+ map.TileData.Events(i).y = map.TileData.Events(i).y + 1
+ End Select
+ Next
+ End If
+
+ initAutotiles
+End Sub
+
+Public Sub CopyTile(ByRef origTile As TileRec, ByRef newTile As TileRec)
+Dim tilesize As Long
+ tilesize = LenB(origTile)
+ CopyMemory ByVal VarPtr(newTile), ByVal VarPtr(origTile), tilesize
+ ZeroMemory ByVal VarPtr(origTile), tilesize
+End Sub
+
+Public Sub MapEditorTileScroll()
+
+ ' horizontal scrolling
+ If frmEditor_Map.picBackSelect.width < frmEditor_Map.picBack.width Then
+ frmEditor_Map.scrlPictureX.enabled = False
+ Else
+ frmEditor_Map.scrlPictureX.enabled = True
+ frmEditor_Map.picBackSelect.left = (frmEditor_Map.scrlPictureX.value * PIC_X) * -1
+ End If
+
+ ' vertical scrolling
+ If frmEditor_Map.picBackSelect.height < frmEditor_Map.picBack.height Then
+ frmEditor_Map.scrlPictureY.enabled = False
+ Else
+ frmEditor_Map.scrlPictureY.enabled = True
+ frmEditor_Map.picBackSelect.top = (frmEditor_Map.scrlPictureY.value * PIC_Y) * -1
+ End If
+
+End Sub
+
+Public Sub MapEditorSend()
+ Call SendMap
+ InMapEditor = False
+ 'Unload frmEditor_Map
+ frmEditor_Map.Hide
+End Sub
+
+Public Sub MapEditorCancel()
+ InMapEditor = False
+ LoadMap GetPlayerMap(MyIndex)
+ initAutotiles
+ 'Unload frmEditor_Map
+ frmEditor_Map.Hide
+End Sub
+
+Public Sub MapEditorClearLayer()
+ Dim i As Long
+ Dim x As Long
+ Dim y As Long
+ Dim CurLayer As Long
+
+ ' find which layer we're on
+ For i = 1 To MapLayer.Layer_Count - 1
+
+ If frmEditor_Map.optLayer(i).value Then
+ CurLayer = i
+ Exit For
+ End If
+
+ Next
+
+ If CurLayer = 0 Then Exit Sub
+
+ ' ask to clear layer
+ If MsgBox("Are you sure you wish to clear this layer?", vbYesNo, GAME_NAME) = vbYes Then
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ map.TileData.Tile(x, y).Layer(CurLayer).x = 0
+ map.TileData.Tile(x, y).Layer(CurLayer).y = 0
+ map.TileData.Tile(x, y).Layer(CurLayer).tileSet = 0
+ cacheRenderState x, y, CurLayer
+ Next
+ Next
+
+ ' re-cache autos
+ initAutotiles
+ End If
+
+End Sub
+
+Public Sub MapEditorFillLayer()
+ Dim i As Long
+ Dim x As Long
+ Dim y As Long
+ Dim CurLayer As Long
+
+ ' find which layer we're on
+ For i = 1 To MapLayer.Layer_Count - 1
+
+ If frmEditor_Map.optLayer(i).value Then
+ CurLayer = i
+ Exit For
+ End If
+
+ Next
+
+ ' Ground layer
+ If MsgBox("Are you sure you wish to fill this layer?", vbYesNo, GAME_NAME) = vbYes Then
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ map.TileData.Tile(x, y).Layer(CurLayer).x = EditorTileX
+ map.TileData.Tile(x, y).Layer(CurLayer).y = EditorTileY
+ map.TileData.Tile(x, y).Layer(CurLayer).tileSet = frmEditor_Map.scrlTileSet.value
+ map.TileData.Tile(x, y).Autotile(CurLayer) = frmEditor_Map.scrlAutotile.value
+ cacheRenderState x, y, CurLayer
+ Next
+ Next
+
+ ' now cache the positions
+ initAutotiles
+ End If
+
+End Sub
+
+Public Sub MapEditorClearAttribs()
+ Dim x As Long
+ Dim y As Long
+
+ If MsgBox("Are you sure you wish to clear the attributes on this map?", vbYesNo, GAME_NAME) = vbYes Then
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ map.TileData.Tile(x, y).Type = 0
+ Next
+ Next
+
+ End If
+
+End Sub
+
+Public Sub MapEditorLeaveMap()
+
+ If InMapEditor Then
+ If MsgBox("Save changes to current map?", vbYesNo) = vbYes Then
+ Call MapEditorSend
+ Else
+ Call MapEditorCancel
+ End If
+ End If
+
+End Sub
+
+' /////////////////
+' // Item Editor //
+' /////////////////
+Public Sub ItemEditorInit()
+ Dim i As Long, SoundSet As Boolean, tmpNum As Long
+
+ If frmEditor_Item.visible = False Then Exit Sub
+ EditorIndex = frmEditor_Item.lstIndex.ListIndex + 1
+
+ ' populate the cache if we need to
+ If Not hasPopulated Then
+ PopulateLists
+ End If
+
+ ' add the array to the combo
+ frmEditor_Item.cmbSound.Clear
+ frmEditor_Item.cmbSound.AddItem "None."
+ tmpNum = UBound(soundCache)
+
+ For i = 1 To tmpNum
+ frmEditor_Item.cmbSound.AddItem soundCache(i)
+ Next
+
+ ' finished populating
+ With Item(EditorIndex)
+ frmEditor_Item.txtName.text = Trim$(.name)
+
+ If .Pic > frmEditor_Item.scrlPic.Max Then .Pic = 0
+ frmEditor_Item.scrlPic.value = .Pic
+ frmEditor_Item.cmbType.ListIndex = .Type
+ frmEditor_Item.scrlAnim.value = .Animation
+ frmEditor_Item.txtDesc.text = Trim$(.Desc)
+
+ ' find the sound we have set
+ If frmEditor_Item.cmbSound.ListCount >= 0 Then
+ tmpNum = frmEditor_Item.cmbSound.ListCount
+
+ For i = 0 To tmpNum
+
+ If frmEditor_Item.cmbSound.list(i) = Trim$(.sound) Then
+ frmEditor_Item.cmbSound.ListIndex = i
+ SoundSet = True
+ End If
+
+ Next
+
+ If Not SoundSet Or frmEditor_Item.cmbSound.ListIndex = -1 Then frmEditor_Item.cmbSound.ListIndex = 0
+ End If
+
+ ' Type specific settings
+ If (frmEditor_Item.cmbType.ListIndex >= ITEM_TYPE_WEAPON) And (frmEditor_Item.cmbType.ListIndex <= ITEM_TYPE_SHIELD) Then
+ frmEditor_Item.fraEquipment.visible = True
+ frmEditor_Item.scrlDamage.value = .Data2
+ frmEditor_Item.cmbTool.ListIndex = .Data3
+
+ If .speed < 100 Then .speed = 100
+ frmEditor_Item.scrlSpeed.value = .speed
+
+ ' loop for stats
+ For i = 1 To Stats.Stat_Count - 1
+ frmEditor_Item.scrlStatBonus(i).value = .Add_Stat(i)
+ Next
+
+ If Not .Paperdoll > Count_Paperdoll Then frmEditor_Item.scrlPaperdoll = .Paperdoll
+ frmEditor_Item.scrlProf.value = .proficiency
+ Else
+ frmEditor_Item.fraEquipment.visible = False
+ End If
+
+ If frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_CONSUME Then
+ frmEditor_Item.fraVitals.visible = True
+ frmEditor_Item.scrlAddHp.value = .AddHP
+ frmEditor_Item.scrlAddMP.value = .AddMP
+ frmEditor_Item.scrlAddExp.value = .AddEXP
+ frmEditor_Item.scrlCastSpell.value = .CastSpell
+ frmEditor_Item.chkInstant.value = .instaCast
+ Else
+ frmEditor_Item.fraVitals.visible = False
+ End If
+
+ If (frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_SPELL) Then
+ frmEditor_Item.fraSpell.visible = True
+ frmEditor_Item.scrlSpell.value = .Data1
+ Else
+ frmEditor_Item.fraSpell.visible = False
+ End If
+
+ If frmEditor_Item.cmbType.ListIndex = ITEM_TYPE_FOOD Then
+ If .HPorSP = 2 Then
+ frmEditor_Item.optSP.value = True
+ Else
+ frmEditor_Item.optHP.value = True
+ End If
+
+ frmEditor_Item.scrlFoodHeal = .FoodPerTick
+ frmEditor_Item.scrlFoodTick = .FoodTickCount
+ frmEditor_Item.scrlFoodInterval = .FoodInterval
+ frmEditor_Item.fraFood.visible = True
+ Else
+ frmEditor_Item.fraFood.visible = False
+ End If
+
+ ' Basic requirements
+ frmEditor_Item.scrlAccessReq.value = .AccessReq
+ frmEditor_Item.scrlLevelReq.value = .LevelReq
+
+ ' loop for stats
+ For i = 1 To Stats.Stat_Count - 1
+ frmEditor_Item.scrlStatReq(i).value = .Stat_Req(i)
+ Next
+
+ ' Build cmbClassReq
+ frmEditor_Item.cmbClassReq.Clear
+ frmEditor_Item.cmbClassReq.AddItem "None"
+
+ For i = 1 To Max_Classes
+ frmEditor_Item.cmbClassReq.AddItem Class(i).name
+ Next
+
+ frmEditor_Item.cmbClassReq.ListIndex = .ClassReq
+ ' Info
+ frmEditor_Item.scrlPrice.value = .Price
+ frmEditor_Item.cmbBind.ListIndex = .BindType
+ frmEditor_Item.scrlRarity.value = .Rarity
+ EditorIndex = frmEditor_Item.lstIndex.ListIndex + 1
+ End With
+
+ Item_Changed(EditorIndex) = True
+End Sub
+
+Public Sub ItemEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_ITEMS
+
+ If Item_Changed(i) Then
+ Call SendSaveItem(i)
+ End If
+
+ Next
+
+ Unload frmEditor_Item
+ Editor = 0
+ ClearChanged_Item
+End Sub
+
+Sub ItemEditorCopy()
+ CopyMemory ByVal VarPtr(tmpItem), ByVal VarPtr(Item(EditorIndex)), LenB(Item(EditorIndex))
+End Sub
+
+Sub ItemEditorPaste()
+ CopyMemory ByVal VarPtr(Item(EditorIndex)), ByVal VarPtr(tmpItem), LenB(tmpItem)
+ ItemEditorInit
+ frmEditor_Item.txtName_Validate False
+End Sub
+
+Public Sub ItemEditorCancel()
+ Editor = 0
+ Unload frmEditor_Item
+ ClearChanged_Item
+ ClearItems
+ SendRequestItems
+End Sub
+
+Public Sub ClearChanged_Item()
+ ZeroMemory Item_Changed(1), MAX_ITEMS * 2 ' 2 = boolean length
+End Sub
+
+' /////////////////
+' // Animation Editor //
+' /////////////////
+Public Sub AnimationEditorInit()
+ Dim i As Long
+ Dim SoundSet As Boolean, tmpNum As Long
+
+ If frmEditor_Animation.visible = False Then Exit Sub
+ EditorIndex = frmEditor_Animation.lstIndex.ListIndex + 1
+
+ ' populate the cache if we need to
+ If Not hasPopulated Then
+ PopulateLists
+ End If
+
+ ' add the array to the combo
+ frmEditor_Animation.cmbSound.Clear
+ frmEditor_Animation.cmbSound.AddItem "None."
+ tmpNum = UBound(soundCache)
+
+ For i = 1 To tmpNum
+ frmEditor_Animation.cmbSound.AddItem soundCache(i)
+ Next
+
+ ' finished populating
+ With Animation(EditorIndex)
+ frmEditor_Animation.txtName.text = Trim$(.name)
+
+ ' find the sound we have set
+ If frmEditor_Animation.cmbSound.ListCount >= 0 Then
+ tmpNum = frmEditor_Animation.cmbSound.ListCount
+
+ For i = 0 To tmpNum
+
+ If frmEditor_Animation.cmbSound.list(i) = Trim$(.sound) Then
+ frmEditor_Animation.cmbSound.ListIndex = i
+ SoundSet = True
+ End If
+
+ Next
+
+ If Not SoundSet Or frmEditor_Animation.cmbSound.ListIndex = -1 Then frmEditor_Animation.cmbSound.ListIndex = 0
+ End If
+
+ For i = 0 To 1
+ frmEditor_Animation.scrlSprite(i).value = .sprite(i)
+ frmEditor_Animation.scrlFrameCount(i).value = .Frames(i)
+ frmEditor_Animation.scrlLoopCount(i).value = .LoopCount(i)
+
+ If .looptime(i) > 0 Then
+ frmEditor_Animation.scrlLoopTime(i).value = .looptime(i)
+ Else
+ frmEditor_Animation.scrlLoopTime(i).value = 45
+ End If
+
+ Next
+
+ EditorIndex = frmEditor_Animation.lstIndex.ListIndex + 1
+ End With
+
+ Animation_Changed(EditorIndex) = True
+End Sub
+
+Public Sub AnimationEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_ANIMATIONS
+
+ If Animation_Changed(i) Then
+ Call SendSaveAnimation(i)
+ End If
+
+ Next
+
+ Unload frmEditor_Animation
+ Editor = 0
+ ClearChanged_Animation
+End Sub
+
+Public Sub AnimationEditorCancel()
+ Editor = 0
+ Unload frmEditor_Animation
+ ClearChanged_Animation
+ ClearAnimations
+ SendRequestAnimations
+End Sub
+
+Public Sub ClearChanged_Animation()
+ ZeroMemory Animation_Changed(1), MAX_ANIMATIONS * 2 ' 2 = boolean length
+End Sub
+
+' ////////////////
+' // Npc Editor //
+' ////////////////
+Public Sub NpcEditorInit()
+ Dim i As Long
+ Dim SoundSet As Boolean
+
+ If frmEditor_NPC.visible = False Then Exit Sub
+ EditorIndex = frmEditor_NPC.lstIndex.ListIndex + 1
+
+ ' populate the cache if we need to
+ If Not hasPopulated Then
+ PopulateLists
+ End If
+
+ ' add the array to the combo
+ frmEditor_NPC.cmbSound.Clear
+ frmEditor_NPC.cmbSound.AddItem "None."
+
+ For i = 1 To UBound(soundCache)
+ frmEditor_NPC.cmbSound.AddItem soundCache(i)
+ Next
+
+ ' finished populating
+ With frmEditor_NPC
+ .scrlDrop.Max = MAX_NPC_DROPS
+ .scrlSpell.Max = MAX_NPC_SPELLS
+ .txtName.text = Trim$(Npc(EditorIndex).name)
+ .txtAttackSay.text = Trim$(Npc(EditorIndex).AttackSay)
+
+ If Npc(EditorIndex).sprite < 0 Or Npc(EditorIndex).sprite > .scrlSprite.Max Then Npc(EditorIndex).sprite = 0
+ .scrlSprite.value = Npc(EditorIndex).sprite
+ .txtSpawnSecs.text = CStr(Npc(EditorIndex).SpawnSecs)
+ .cmbBehaviour.ListIndex = Npc(EditorIndex).Behaviour
+ .scrlRange.value = Npc(EditorIndex).Range
+ .txtHP.text = Npc(EditorIndex).HP
+ .txtEXP.text = Npc(EditorIndex).EXP
+ .txtLevel.text = Npc(EditorIndex).Level
+ .txtDamage.text = Npc(EditorIndex).Damage
+ .scrlConv.value = Npc(EditorIndex).Conv
+ .scrlAnimation.value = Npc(EditorIndex).Animation
+
+ ' find the sound we have set
+ If .cmbSound.ListCount >= 0 Then
+
+ For i = 0 To .cmbSound.ListCount
+
+ If .cmbSound.list(i) = Trim$(Npc(EditorIndex).sound) Then
+ .cmbSound.ListIndex = i
+ SoundSet = True
+ End If
+
+ Next
+
+ If Not SoundSet Or .cmbSound.ListIndex = -1 Then .cmbSound.ListIndex = 0
+ End If
+
+ For i = 1 To Stats.Stat_Count - 1
+ .scrlStat(i).value = Npc(EditorIndex).Stat(i)
+ Next
+
+ ' show 1 data
+ .scrlDrop.value = 1
+ .scrlSpell.value = 1
+ End With
+
+ NPC_Changed(EditorIndex) = True
+End Sub
+
+Public Sub NpcEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_NPCS
+
+ If NPC_Changed(i) Then
+ Call SendSaveNpc(i)
+ End If
+
+ Next
+
+ Unload frmEditor_NPC
+ Editor = 0
+ ClearChanged_NPC
+End Sub
+
+Sub NpcEditorCopy()
+ CopyMemory ByVal VarPtr(tmpNPC), ByVal VarPtr(Npc(EditorIndex)), LenB(Npc(EditorIndex))
+End Sub
+
+Sub NpcEditorPaste()
+ CopyMemory ByVal VarPtr(Npc(EditorIndex)), ByVal VarPtr(tmpNPC), LenB(tmpNPC)
+ NpcEditorInit
+ frmEditor_NPC.txtName_Validate False
+End Sub
+
+Public Sub NpcEditorCancel()
+ Editor = 0
+ Unload frmEditor_NPC
+ ClearChanged_NPC
+ ClearNpcs
+ SendRequestNPCS
+End Sub
+
+Public Sub ClearChanged_NPC()
+ ZeroMemory NPC_Changed(1), MAX_NPCS * 2 ' 2 = boolean length
+End Sub
+
+' /////////////////
+' // Conv Editor //
+' /////////////////
+Public Sub ConvEditorInit()
+ Dim i As Long, n As Long
+
+ If frmEditor_Conv.visible = False Then Exit Sub
+ EditorIndex = frmEditor_Conv.lstIndex.ListIndex + 1
+
+ With frmEditor_Conv
+ .txtName.text = Trim$(Conv(EditorIndex).name)
+
+ If Conv(EditorIndex).chatCount = 0 Then
+ Conv(EditorIndex).chatCount = 1
+ ReDim Conv(EditorIndex).Conv(1 To Conv(EditorIndex).chatCount)
+ End If
+
+ For n = 1 To 4
+ .cmbReply(n).Clear
+ .cmbReply(n).AddItem "None"
+
+ For i = 1 To Conv(EditorIndex).chatCount
+ .cmbReply(n).AddItem i
+ Next
+ Next
+
+ .scrlChatCount = Conv(EditorIndex).chatCount
+ .scrlConv.Max = Conv(EditorIndex).chatCount
+ .scrlConv.value = 1
+ .txtConv = Conv(EditorIndex).Conv(.scrlConv.value).Conv
+
+ For i = 1 To 4
+ .txtReply(i).text = Conv(EditorIndex).Conv(.scrlConv.value).rText(i)
+ .cmbReply(i).ListIndex = Conv(EditorIndex).Conv(.scrlConv.value).rTarget(i)
+ Next
+
+ .cmbEvent.ListIndex = Conv(EditorIndex).Conv(.scrlConv.value).Event
+ .scrlData1.value = Conv(EditorIndex).Conv(.scrlConv.value).Data1
+ .scrlData2.value = Conv(EditorIndex).Conv(.scrlConv.value).Data2
+ .scrlData3.value = Conv(EditorIndex).Conv(.scrlConv.value).Data3
+ End With
+
+ Conv_Changed(EditorIndex) = True
+End Sub
+
+Public Sub ConvEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_CONVS
+
+ If Conv_Changed(i) Then
+ Call SendSaveConv(i)
+ End If
+
+ Next
+
+ Unload frmEditor_Conv
+ Editor = 0
+ ClearChanged_Conv
+End Sub
+
+Public Sub ConvEditorCancel()
+ Editor = 0
+ Unload frmEditor_Conv
+ ClearChanged_Conv
+ ClearConvs
+ SendRequestConvs
+End Sub
+
+Public Sub ClearChanged_Conv()
+ ZeroMemory Conv_Changed(1), MAX_CONVS * 2 ' 2 = boolean length
+End Sub
+
+' ////////////////
+' // Resource Editor //
+' ////////////////
+Public Sub ResourceEditorInit()
+ Dim i As Long
+ Dim SoundSet As Boolean
+
+ If frmEditor_Resource.visible = False Then Exit Sub
+ EditorIndex = frmEditor_Resource.lstIndex.ListIndex + 1
+
+ ' populate the cache if we need to
+ If Not hasPopulated Then
+ PopulateLists
+ End If
+
+ ' add the array to the combo
+ frmEditor_Resource.cmbSound.Clear
+ frmEditor_Resource.cmbSound.AddItem "None."
+
+ For i = 1 To UBound(soundCache)
+ frmEditor_Resource.cmbSound.AddItem soundCache(i)
+ Next
+
+ ' finished populating
+ With frmEditor_Resource
+ .scrlExhaustedPic.Max = Count_Resource
+ .scrlNormalPic.Max = Count_Resource
+ .scrlAnimation.Max = MAX_ANIMATIONS
+ .txtName.text = Trim$(Resource(EditorIndex).name)
+ .txtMessage.text = Trim$(Resource(EditorIndex).SuccessMessage)
+ .txtMessage2.text = Trim$(Resource(EditorIndex).EmptyMessage)
+ .cmbType.ListIndex = Resource(EditorIndex).ResourceType
+ .scrlNormalPic.value = Resource(EditorIndex).ResourceImage
+ .scrlExhaustedPic.value = Resource(EditorIndex).ExhaustedImage
+ .scrlReward.value = Resource(EditorIndex).ItemReward
+ .scrlTool.value = Resource(EditorIndex).ToolRequired
+ .scrlHealth.value = Resource(EditorIndex).health
+ .scrlRespawn.value = Resource(EditorIndex).RespawnTime
+ .scrlAnimation.value = Resource(EditorIndex).Animation
+
+ ' find the sound we have set
+ If .cmbSound.ListCount >= 0 Then
+
+ For i = 0 To .cmbSound.ListCount
+
+ If .cmbSound.list(i) = Trim$(Resource(EditorIndex).sound) Then
+ .cmbSound.ListIndex = i
+ SoundSet = True
+ End If
+
+ Next
+
+ If Not SoundSet Or .cmbSound.ListIndex = -1 Then .cmbSound.ListIndex = 0
+ End If
+
+ End With
+
+ Resource_Changed(EditorIndex) = True
+End Sub
+
+Public Sub ResourceEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_RESOURCES
+
+ If Resource_Changed(i) Then
+ Call SendSaveResource(i)
+ End If
+
+ Next
+
+ Unload frmEditor_Resource
+ Editor = 0
+ ClearChanged_Resource
+End Sub
+
+Public Sub ResourceEditorCancel()
+ Editor = 0
+ Unload frmEditor_Resource
+ ClearChanged_Resource
+ ClearResources
+ SendRequestResources
+End Sub
+
+Public Sub ClearChanged_Resource()
+ ZeroMemory Resource_Changed(1), MAX_RESOURCES * 2 ' 2 = boolean length
+End Sub
+
+' /////////////////
+' // Shop Editor //
+' /////////////////
+Public Sub ShopEditorInit()
+ Dim i As Long
+
+ If frmEditor_Shop.visible = False Then Exit Sub
+ EditorIndex = frmEditor_Shop.lstIndex.ListIndex + 1
+ frmEditor_Shop.txtName.text = Trim$(Shop(EditorIndex).name)
+
+ If Shop(EditorIndex).BuyRate > 0 Then
+ frmEditor_Shop.scrlBuy.value = Shop(EditorIndex).BuyRate
+ Else
+ frmEditor_Shop.scrlBuy.value = 100
+ End If
+
+ frmEditor_Shop.cmbItem.Clear
+ frmEditor_Shop.cmbItem.AddItem "None"
+ frmEditor_Shop.cmbCostItem.Clear
+ frmEditor_Shop.cmbCostItem.AddItem "None"
+
+ For i = 1 To MAX_ITEMS
+ frmEditor_Shop.cmbItem.AddItem i & ": " & Trim$(Item(i).name)
+ frmEditor_Shop.cmbCostItem.AddItem i & ": " & Trim$(Item(i).name)
+ Next
+
+ frmEditor_Shop.cmbItem.ListIndex = 0
+ frmEditor_Shop.cmbCostItem.ListIndex = 0
+ UpdateShopTrade
+ Shop_Changed(EditorIndex) = True
+End Sub
+
+Public Sub UpdateShopTrade(Optional ByVal tmpPos As Long = 0)
+ Dim i As Long
+ frmEditor_Shop.lstTradeItem.Clear
+
+ For i = 1 To MAX_TRADES
+
+ With Shop(EditorIndex).TradeItem(i)
+
+ ' if none, show as none
+ If .Item = 0 And .CostItem = 0 Then
+ frmEditor_Shop.lstTradeItem.AddItem "Empty Trade Slot"
+ Else
+ frmEditor_Shop.lstTradeItem.AddItem i & ": " & .ItemValue & "x " & Trim$(Item(.Item).name) & " for " & .CostValue & "x " & Trim$(Item(.CostItem).name)
+ End If
+
+ End With
+
+ Next
+
+ frmEditor_Shop.lstTradeItem.ListIndex = tmpPos
+End Sub
+
+Public Sub ShopEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_SHOPS
+
+ If Shop_Changed(i) Then
+ Call SendSaveShop(i)
+ End If
+
+ Next
+
+ Unload frmEditor_Shop
+ Editor = 0
+ ClearChanged_Shop
+End Sub
+
+Public Sub ShopEditorCancel()
+ Editor = 0
+ Unload frmEditor_Shop
+ ClearChanged_Shop
+ ClearShops
+ SendRequestShops
+End Sub
+
+Public Sub ClearChanged_Shop()
+ ZeroMemory Shop_Changed(1), MAX_SHOPS * 2 ' 2 = boolean length
+End Sub
+
+' //////////////////
+' // Spell Editor //
+' //////////////////
+Sub SpellEditorCopy()
+ CopyMemory ByVal VarPtr(tmpSpell), ByVal VarPtr(Spell(EditorIndex)), LenB(Spell(EditorIndex))
+End Sub
+
+Sub SpellEditorPaste()
+ CopyMemory ByVal VarPtr(Spell(EditorIndex)), ByVal VarPtr(tmpSpell), LenB(tmpSpell)
+ SpellEditorInit
+ frmEditor_Spell.txtName_Validate False
+End Sub
+
+Public Sub SpellEditorInit()
+ Dim i As Long
+ Dim SoundSet As Boolean
+
+ If frmEditor_Spell.visible = False Then Exit Sub
+ EditorIndex = frmEditor_Spell.lstIndex.ListIndex + 1
+
+ ' populate the cache if we need to
+ If Not hasPopulated Then
+ PopulateLists
+ End If
+
+ ' add the array to the combo
+ frmEditor_Spell.cmbSound.Clear
+ frmEditor_Spell.cmbSound.AddItem "None."
+
+ For i = 1 To UBound(soundCache)
+ frmEditor_Spell.cmbSound.AddItem soundCache(i)
+ Next
+
+ ' finished populating
+ With frmEditor_Spell
+ ' set max values
+ .scrlAnimCast.Max = MAX_ANIMATIONS
+ .scrlAnim.Max = MAX_ANIMATIONS
+ .scrlAOE.Max = MAX_BYTE
+ .scrlRange.Max = MAX_BYTE
+ .scrlMap.Max = MAX_MAPS
+ .scrlNext.Max = MAX_SPELLS
+ ' build class combo
+ .cmbClass.Clear
+ .cmbClass.AddItem "None"
+
+ For i = 1 To Max_Classes
+ .cmbClass.AddItem Trim$(Class(i).name)
+ Next
+
+ .cmbClass.ListIndex = 0
+ ' set values
+ .txtName.text = Trim$(Spell(EditorIndex).name)
+ .txtDesc.text = Trim$(Spell(EditorIndex).Desc)
+ .cmbType.ListIndex = Spell(EditorIndex).Type
+ .scrlMP.value = Spell(EditorIndex).MPCost
+ .scrlLevel.value = Spell(EditorIndex).LevelReq
+ .scrlAccess.value = Spell(EditorIndex).AccessReq
+ .cmbClass.ListIndex = Spell(EditorIndex).ClassReq
+ .scrlCast.value = Spell(EditorIndex).CastTime
+ .scrlCool.value = Spell(EditorIndex).CDTime
+ .scrlIcon.value = Spell(EditorIndex).icon
+ .scrlMap.value = Spell(EditorIndex).map
+ .scrlX.value = Spell(EditorIndex).x
+ .scrlY.value = Spell(EditorIndex).y
+ .scrlDir.value = Spell(EditorIndex).dir
+ .scrlVital.value = Spell(EditorIndex).Vital
+ .scrlDuration.value = Spell(EditorIndex).Duration
+ .scrlInterval.value = Spell(EditorIndex).Interval
+ .scrlRange.value = Spell(EditorIndex).Range
+
+ If Spell(EditorIndex).IsAoE Then
+ .chkAOE.value = 1
+ Else
+ .chkAOE.value = 0
+ End If
+
+ .scrlAOE.value = Spell(EditorIndex).AoE
+ .scrlAnimCast.value = Spell(EditorIndex).CastAnim
+ .scrlAnim.value = Spell(EditorIndex).SpellAnim
+ .scrlStun.value = Spell(EditorIndex).StunDuration
+ .scrlNext.value = Spell(EditorIndex).NextRank
+ .scrlIndex.value = Spell(EditorIndex).UniqueIndex
+ .scrlUses.value = Spell(EditorIndex).NextUses
+
+ ' find the sound we have set
+ If .cmbSound.ListCount >= 0 Then
+
+ For i = 0 To .cmbSound.ListCount
+
+ If .cmbSound.list(i) = Trim$(Spell(EditorIndex).sound) Then
+ .cmbSound.ListIndex = i
+ SoundSet = True
+ End If
+
+ Next
+
+ If Not SoundSet Or .cmbSound.ListIndex = -1 Then .cmbSound.ListIndex = 0
+ End If
+
+ End With
+
+ Spell_Changed(EditorIndex) = True
+End Sub
+
+Public Sub SpellEditorOk()
+ Dim i As Long
+
+ For i = 1 To MAX_SPELLS
+
+ If Spell_Changed(i) Then
+ Call SendSaveSpell(i)
+ End If
+
+ Next
+
+ Unload frmEditor_Spell
+ Editor = 0
+ ClearChanged_Spell
+End Sub
+
+Public Sub SpellEditorCancel()
+ Editor = 0
+ Unload frmEditor_Spell
+ ClearChanged_Spell
+ ClearSpells
+ SendRequestSpells
+End Sub
+
+Public Sub ClearChanged_Spell()
+ ZeroMemory Spell_Changed(1), MAX_SPELLS * 2 ' 2 = boolean length
+End Sub
+
+Public Sub ClearAttributeDialogue()
+ frmEditor_Map.fraNpcSpawn.visible = False
+ frmEditor_Map.fraResource.visible = False
+ frmEditor_Map.fraMapItem.visible = False
+ frmEditor_Map.fraMapKey.visible = False
+ frmEditor_Map.fraKeyOpen.visible = False
+ frmEditor_Map.fraMapWarp.visible = False
+ frmEditor_Map.fraShop.visible = False
+End Sub
diff --git a/client/src/modGameLogic.bas b/client/src/modGameLogic.bas
new file mode 100644
index 0000000..f16b865
--- /dev/null
+++ b/client/src/modGameLogic.bas
@@ -0,0 +1,4083 @@
+Attribute VB_Name = "modGameLogic"
+Option Explicit
+
+Public Sub GameLoop()
+ Dim FrameTime As Long, tick As Long, TickFPS As Long, FPS As Long, i As Long, WalkTimer As Long, x As Long, y As Long
+ Dim tmr25 As Long, tmr10000 As Long, tmr100 As Long, mapTimer As Long, chatTmr As Long, targetTmr As Long, fogTmr As Long, barTmr As Long
+ Dim barDifference As Long
+
+ ' *** Start GameLoop ***
+ Do While InGame
+ tick = GetTickCount ' Set the inital tick
+ ElapsedTime = tick - FrameTime ' Set the time difference for time-based movement
+ FrameTime = tick ' Set the time second loop time to the first.
+
+ ' handle input
+ If GetForegroundWindow() = frmMain.hWnd Then
+ HandleMouseInput
+ End If
+
+ ' * Check surface timers *
+ ' Sprites
+ If tmr10000 < tick Then
+ ' check ping
+ Call GetPing
+ tmr10000 = tick + 10000
+ End If
+
+ If tmr25 < tick Then
+ InGame = IsConnected
+ Call CheckKeys ' Check to make sure they aren't trying to auto do anything
+
+ If GetForegroundWindow() = frmMain.hWnd Then
+ Call CheckInputKeys ' Check which keys were pressed
+ End If
+
+ ' check if we need to end the CD icon
+ If Count_Spellicon > 0 Then
+ For i = 1 To MAX_PLAYER_SPELLS
+ If PlayerSpells(i).Spell > 0 Then
+ If SpellCD(i) > 0 Then
+ If SpellCD(i) + (Spell(PlayerSpells(i).Spell).CDTime * 1000) < tick Then
+ SpellCD(i) = 0
+ End If
+ End If
+ End If
+ Next
+ End If
+
+ ' check if we need to unlock the player's spell casting restriction
+ If SpellBuffer > 0 Then
+ If SpellBufferTimer + (Spell(PlayerSpells(SpellBuffer).Spell).CastTime * 1000) < tick Then
+ SpellBuffer = 0
+ SpellBufferTimer = 0
+ End If
+ End If
+
+ If CanMoveNow Then
+ Call CheckMovement ' Check if player is trying to move
+ Call CheckAttack ' Check to see if player is trying to attack
+ End If
+
+ For i = 1 To MAX_BYTE
+ CheckAnimInstance i
+ Next
+
+ ' appear tile logic
+ AppearTileFadeLogic
+ CheckAppearTiles
+
+ ' handle events
+ If inEvent Then
+ If eventNum > 0 Then
+ If eventPageNum > 0 Then
+ If eventCommandNum > 0 Then
+ EventLogic
+ End If
+ End If
+ End If
+ End If
+
+ tmr25 = tick + 25
+ End If
+
+ ' targetting
+ If targetTmr < tick Then
+ If tabDown Then
+ FindNearestTarget
+ End If
+
+ targetTmr = tick + 50
+ End If
+
+ ' chat timer
+ If chatTmr < tick Then
+ ' scrolling
+ If ChatButtonUp Then
+ ScrollChatBox 0
+ End If
+
+ If ChatButtonDown Then
+ ScrollChatBox 1
+ End If
+
+ ' remove messages
+ If chatLastRemove + CHAT_DIFFERENCE_TIMER < GetTickCount Then
+ ' remove timed out messages from chat
+ For i = Chat_HighIndex To 1 Step -1
+ If Len(Chat(i).text) > 0 Then
+ If Chat(i).visible Then
+ If Chat(i).timer + CHAT_TIMER < tick Then
+ Chat(i).visible = False
+ chatLastRemove = GetTickCount
+ Exit For
+ End If
+ End If
+ End If
+ Next
+ End If
+
+ chatTmr = tick + 50
+ End If
+
+ ' fog scrolling
+ If fogTmr < tick Then
+ ' move
+ fogOffsetX = fogOffsetX - 1
+ fogOffsetY = fogOffsetY - 1
+
+ ' reset
+ If fogOffsetX < -256 Then fogOffsetX = 0
+ If fogOffsetY < -256 Then fogOffsetY = 0
+
+ ' reset timer
+ fogTmr = tick + 20
+ End If
+
+ ' elastic bars
+ If barTmr < tick Then
+ SetBarWidth BarWidth_GuiHP_Max, BarWidth_GuiHP
+ SetBarWidth BarWidth_GuiSP_Max, BarWidth_GuiSP
+ SetBarWidth BarWidth_GuiEXP_Max, BarWidth_GuiEXP
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(i).num > 0 Then
+ SetBarWidth BarWidth_NpcHP_Max(i), BarWidth_NpcHP(i)
+ End If
+ Next
+
+ For i = 1 To MAX_PLAYERS
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ SetBarWidth BarWidth_PlayerHP_Max(i), BarWidth_PlayerHP(i)
+ End If
+ Next
+
+ ' reset timer
+ barTmr = tick + 10
+ End If
+
+ ' Animations!
+ If mapTimer < tick Then
+
+ ' animate waterfalls
+ Select Case waterfallFrame
+
+ Case 0
+ waterfallFrame = 1
+
+ Case 1
+ waterfallFrame = 2
+
+ Case 2
+ waterfallFrame = 0
+ End Select
+
+ ' animate autotiles
+ Select Case autoTileFrame
+
+ Case 0
+ autoTileFrame = 1
+
+ Case 1
+ autoTileFrame = 2
+
+ Case 2
+ autoTileFrame = 0
+ End Select
+
+ ' animate textbox
+ If chatShowLine = "|" Then
+ chatShowLine = vbNullString
+ Else
+ chatShowLine = "|"
+ End If
+
+ ' re-set timer
+ mapTimer = tick + 500
+ End If
+
+ ' Process input before rendering, otherwise input will be behind by 1 frame
+ If WalkTimer < tick Then
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ Call ProcessMovement(i)
+ End If
+
+ Next i
+
+ ' Process npc movements (actually move them)
+ For i = 1 To Npc_HighIndex
+
+ If map.MapData.Npc(i) > 0 Then
+ Call ProcessNpcMovement(i)
+ End If
+
+ Next i
+
+ WalkTimer = tick + 30 ' edit this value to change WalkTimer
+ End If
+
+ ' *********************
+ ' ** Render Graphics **
+ ' *********************
+ Call Render_Graphics
+
+ DoEvents
+
+ ' Lock fps
+ If Not FPS_Lock Then
+
+ Do While GetTickCount < tick + 20
+ DoEvents
+ Sleep 1
+ Loop
+
+ End If
+
+ ' Calculate fps
+ If TickFPS < tick Then
+ GameFPS = FPS
+ TickFPS = tick + 1000
+ FPS = 0
+ Else
+ FPS = FPS + 1
+ End If
+
+ Loop
+
+ frmMain.visible = False
+
+ If isLogging Then
+ isLogging = False
+ MenuLoop
+ GettingMap = True
+ Stop_Music
+ Play_Music MenuMusic
+ Else
+ ' Shutdown the game
+ Call SetStatus("Destroying game data.")
+ Call DestroyGame
+ End If
+
+End Sub
+
+Public Sub MenuLoop()
+ Dim FrameTime As Long, tick As Long, TickFPS As Long, FPS As Long, tmr500 As Long, fadeTmr As Long
+
+ ' *** Start GameLoop ***
+ Do While inMenu
+ tick = GetTickCount ' Set the inital tick
+ ElapsedTime = tick - FrameTime ' Set the time difference for time-based movement
+ FrameTime = tick ' Set the time second loop time to the first.
+
+ ' handle input
+ If GetForegroundWindow() = frmMain.hWnd Then
+ HandleMouseInput
+ End If
+
+ ' Animations!
+ If tmr500 < tick Then
+ ' animate textbox
+ If chatShowLine = "|" Then
+ chatShowLine = vbNullString
+ Else
+ chatShowLine = "|"
+ End If
+
+ ' re-set timer
+ tmr500 = tick + 500
+ End If
+
+ ' trailer
+ If videoPlaying Then VideoLoop
+
+ ' fading
+ If fadeTmr < tick Then
+ If Not videoPlaying Then
+ If fadeAlpha > 5 Then
+ ' lower fade
+ fadeAlpha = fadeAlpha - 5
+ Else
+ fadeAlpha = 0
+ End If
+ End If
+ fadeTmr = tick + 1
+ End If
+
+ ' *********************
+ ' ** Render Graphics **
+ ' *********************
+ Call Render_Menu
+
+ ' do events
+ DoEvents
+
+ ' Lock fps
+ If Not FPS_Lock Then
+
+ Do While GetTickCount < tick + 20
+ DoEvents
+ Sleep 1
+ Loop
+
+ End If
+
+ ' Calculate fps
+ If TickFPS < tick Then
+ GameFPS = FPS
+ TickFPS = tick + 1000
+ FPS = 0
+ Else
+ FPS = FPS + 1
+ End If
+
+ Loop
+
+End Sub
+
+Sub ProcessMovement(ByVal index As Long)
+ Dim MovementSpeed As Long
+
+ ' Check if player is walking, and if so process moving them over
+ Select Case Player(index).Moving
+
+ Case MOVING_WALKING: MovementSpeed = RUN_SPEED
+
+ Case MOVING_RUNNING: MovementSpeed = WALK_SPEED
+
+ Case Else: Exit Sub
+ End Select
+
+ Select Case GetPlayerDir(index)
+
+ Case DIR_UP
+ Player(index).yOffset = Player(index).yOffset - MovementSpeed
+
+ If Player(index).yOffset < 0 Then Player(index).yOffset = 0
+
+ Case DIR_DOWN
+ Player(index).yOffset = Player(index).yOffset + MovementSpeed
+
+ If Player(index).yOffset > 0 Then Player(index).yOffset = 0
+
+ Case DIR_LEFT
+ Player(index).xOffset = Player(index).xOffset - MovementSpeed
+
+ If Player(index).xOffset < 0 Then Player(index).xOffset = 0
+
+ Case DIR_RIGHT
+ Player(index).xOffset = Player(index).xOffset + MovementSpeed
+
+ If Player(index).xOffset > 0 Then Player(index).xOffset = 0
+ End Select
+
+ ' Check if completed walking over to the next tile
+ If Player(index).Moving > 0 Then
+ If GetPlayerDir(index) = DIR_RIGHT Or GetPlayerDir(index) = DIR_DOWN Then
+ If (Player(index).xOffset >= 0) And (Player(index).yOffset >= 0) Then
+ Player(index).Moving = 0
+
+ If Player(index).Step = 0 Then
+ Player(index).Step = 2
+ Else
+ Player(index).Step = 0
+ End If
+ End If
+
+ Else
+
+ If (Player(index).xOffset <= 0) And (Player(index).yOffset <= 0) Then
+ Player(index).Moving = 0
+
+ If Player(index).Step = 0 Then
+ Player(index).Step = 2
+ Else
+ Player(index).Step = 0
+ End If
+ End If
+ End If
+ End If
+
+End Sub
+
+Sub ProcessNpcMovement(ByVal MapNpcNum As Long)
+ Dim MovementSpeed As Long
+
+ ' Check if NPC is walking, and if so process moving them over
+ If MapNpc(MapNpcNum).Moving = MOVING_WALKING Then
+ MovementSpeed = RUN_SPEED
+ Else
+ Exit Sub
+ End If
+
+ Select Case MapNpc(MapNpcNum).dir
+
+ Case DIR_UP
+ MapNpc(MapNpcNum).yOffset = MapNpc(MapNpcNum).yOffset - MovementSpeed
+
+ If MapNpc(MapNpcNum).yOffset < 0 Then MapNpc(MapNpcNum).yOffset = 0
+
+ Case DIR_DOWN
+ MapNpc(MapNpcNum).yOffset = MapNpc(MapNpcNum).yOffset + MovementSpeed
+
+ If MapNpc(MapNpcNum).yOffset > 0 Then MapNpc(MapNpcNum).yOffset = 0
+
+ Case DIR_LEFT
+ MapNpc(MapNpcNum).xOffset = MapNpc(MapNpcNum).xOffset - MovementSpeed
+
+ If MapNpc(MapNpcNum).xOffset < 0 Then MapNpc(MapNpcNum).xOffset = 0
+
+ Case DIR_RIGHT
+ MapNpc(MapNpcNum).xOffset = MapNpc(MapNpcNum).xOffset + MovementSpeed
+
+ If MapNpc(MapNpcNum).xOffset > 0 Then MapNpc(MapNpcNum).xOffset = 0
+ End Select
+
+ ' Check if completed walking over to the next tile
+ If MapNpc(MapNpcNum).Moving > 0 Then
+ If MapNpc(MapNpcNum).dir = DIR_RIGHT Or MapNpc(MapNpcNum).dir = DIR_DOWN Then
+ If (MapNpc(MapNpcNum).xOffset >= 0) And (MapNpc(MapNpcNum).yOffset >= 0) Then
+ MapNpc(MapNpcNum).Moving = 0
+
+ If MapNpc(MapNpcNum).Step = 0 Then
+ MapNpc(MapNpcNum).Step = 2
+ Else
+ MapNpc(MapNpcNum).Step = 0
+ End If
+ End If
+
+ Else
+
+ If (MapNpc(MapNpcNum).xOffset <= 0) And (MapNpc(MapNpcNum).yOffset <= 0) Then
+ MapNpc(MapNpcNum).Moving = 0
+
+ If MapNpc(MapNpcNum).Step = 0 Then
+ MapNpc(MapNpcNum).Step = 2
+ Else
+ MapNpc(MapNpcNum).Step = 0
+ End If
+ End If
+ End If
+ End If
+
+End Sub
+
+Sub CheckMapGetItem()
+ Dim Buffer As New clsBuffer, tmpIndex As Long, i As Long, x As Long
+ Set Buffer = New clsBuffer
+
+ If GetTickCount > Player(MyIndex).MapGetTimer + 250 Then
+
+ ' find out if we want to pick it up
+ For i = 1 To MAX_MAP_ITEMS
+
+ If MapItem(i).x = Player(MyIndex).x And MapItem(i).y = Player(MyIndex).y Then
+ If MapItem(i).num > 0 Then
+ If Item(MapItem(i).num).BindType = 1 Then
+
+ ' make sure it's not a party drop
+ If Party.Leader > 0 Then
+
+ For x = 1 To MAX_PARTY_MEMBERS
+ tmpIndex = Party.Member(x)
+
+ If tmpIndex > 0 Then
+ If Trim$(GetPlayerName(tmpIndex)) = Trim$(MapItem(i).playerName) Then
+ If Item(MapItem(i).num).ClassReq > 0 Then
+ If Item(MapItem(i).num).ClassReq <> Player(MyIndex).Class Then
+ Dialogue "Loot Check", "This item is BoP and is not for your class.", "Are you sure you want to pick it up?", TypeLOOTITEM, StyleYESNO
+ Exit Sub
+ End If
+ End If
+ End If
+ End If
+
+ Next
+
+ End If
+
+ Else
+ 'not bound
+ Exit For
+ End If
+ End If
+ End If
+
+ Next
+
+ ' nevermind, pick it up
+ Player(MyIndex).MapGetTimer = GetTickCount
+ Buffer.WriteLong CMapGetItem
+ SendData Buffer.ToArray()
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Public Sub CheckAttack()
+ Dim Buffer As clsBuffer
+ Dim attackspeed As Long
+
+ 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
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CAttack
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+ End If
+ End If
+ End If
+
+End Sub
+
+Function IsTryingToMove() As Boolean
+
+ 'If DirUp Or DirDown Or DirLeft Or DirRight Then
+ If wDown Or sDown Or aDown Or dDown Or upDown Or leftDown Or downDown Or rightDown Then
+ IsTryingToMove = True
+ End If
+
+End Function
+
+Function CanMove() As Boolean
+ Dim d As Long
+ CanMove = True
+
+ ' Make sure they aren't trying to move when they are already moving
+ If Player(MyIndex).Moving <> 0 Then
+ CanMove = False
+ Exit Function
+ End If
+
+ ' Make sure they haven't just casted a spell
+ 'If SpellBuffer > 0 Then
+ ' CanMove = False
+ ' Exit Function
+ 'End If
+
+ ' make sure they're not stunned
+ If StunDuration > 0 Then
+ CanMove = False
+ Exit Function
+ End If
+
+ ' make sure they're not in a shop
+ If InShop > 0 Then
+ CanMove = False
+ Exit Function
+ End If
+
+ ' not in bank
+ If InBank Then
+ CanMove = False
+ Exit Function
+ End If
+
+ If inTutorial Then
+ CanMove = False
+ Exit Function
+ End If
+
+ d = GetPlayerDir(MyIndex)
+
+ If wDown Or upDown Then
+ Call SetPlayerDir(MyIndex, DIR_UP)
+
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerY(MyIndex) > 0 Then
+ If CheckDirection(DIR_UP) Then
+ CanMove = False
+
+ ' Set the new direction if they weren't facing that direction
+ If d <> DIR_UP Then
+ Call SendPlayerDir
+ End If
+
+ Exit Function
+ End If
+
+ Else
+
+ ' Check if they can warp to a new map
+ If map.MapData.Up > 0 Then
+ Call MapEditorLeaveMap
+ Call SendPlayerRequestNewMap
+ GettingMap = True
+ CanMoveNow = False
+ End If
+
+ CanMove = False
+ Exit Function
+ End If
+ End If
+
+ If downDown Or sDown Then
+ Call SetPlayerDir(MyIndex, DIR_DOWN)
+
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerY(MyIndex) < map.MapData.MaxY Then
+ If CheckDirection(DIR_DOWN) Then
+ CanMove = False
+
+ ' Set the new direction if they weren't facing that direction
+ If d <> DIR_DOWN Then
+ Call SendPlayerDir
+ End If
+
+ Exit Function
+ End If
+
+ Else
+
+ ' Check if they can warp to a new map
+ If map.MapData.Down > 0 Then
+ Call MapEditorLeaveMap
+ Call SendPlayerRequestNewMap
+ GettingMap = True
+ CanMoveNow = False
+ End If
+
+ CanMove = False
+ Exit Function
+ End If
+ End If
+
+ If aDown Or leftDown Then
+ Call SetPlayerDir(MyIndex, DIR_LEFT)
+
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerX(MyIndex) > 0 Then
+ If CheckDirection(DIR_LEFT) Then
+ CanMove = False
+
+ ' Set the new direction if they weren't facing that direction
+ If d <> DIR_LEFT Then
+ Call SendPlayerDir
+ End If
+
+ Exit Function
+ End If
+
+ Else
+
+ ' Check if they can warp to a new map
+ If map.MapData.left > 0 Then
+ Call MapEditorLeaveMap
+ Call SendPlayerRequestNewMap
+ GettingMap = True
+ CanMoveNow = False
+ End If
+
+ CanMove = False
+ Exit Function
+ End If
+ End If
+
+ If dDown Or rightDown Then
+ Call SetPlayerDir(MyIndex, DIR_RIGHT)
+
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerX(MyIndex) < map.MapData.MaxX Then
+ If CheckDirection(DIR_RIGHT) Then
+ CanMove = False
+
+ ' Set the new direction if they weren't facing that direction
+ If d <> DIR_RIGHT Then
+ Call SendPlayerDir
+ End If
+
+ Exit Function
+ End If
+
+ Else
+
+ ' Check if they can warp to a new map
+ If map.MapData.Right > 0 Then
+ Call MapEditorLeaveMap
+ Call SendPlayerRequestNewMap
+ GettingMap = True
+ CanMoveNow = False
+ End If
+
+ CanMove = False
+ Exit Function
+ End If
+ End If
+
+End Function
+
+Function CheckDirection(ByVal direction As Byte) As Boolean
+ Dim x As Long, y As Long, i As Long, EventCount As Long, page As Long
+
+ CheckDirection = False
+
+ If GettingMap Then Exit Function
+
+ ' check directional blocking
+ If isDirBlocked(map.TileData.Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex)).DirBlock, direction + 1) Then
+ CheckDirection = True
+ Exit Function
+ End If
+
+ Select Case direction
+
+ Case DIR_UP
+ x = GetPlayerX(MyIndex)
+ y = GetPlayerY(MyIndex) - 1
+
+ Case DIR_DOWN
+ x = GetPlayerX(MyIndex)
+ y = GetPlayerY(MyIndex) + 1
+
+ Case DIR_LEFT
+ x = GetPlayerX(MyIndex) - 1
+ y = GetPlayerY(MyIndex)
+
+ Case DIR_RIGHT
+ x = GetPlayerX(MyIndex) + 1
+ y = GetPlayerY(MyIndex)
+ End Select
+
+ ' Check to see if the map tile is blocked or not
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_BLOCKED Then
+ CheckDirection = True
+ Exit Function
+ End If
+
+ ' Check to see if the map tile is tree or not
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_RESOURCE Then
+ CheckDirection = True
+ Exit Function
+ End If
+
+ ' Check to make sure that any events on that space aren't blocked
+ EventCount = map.TileData.EventCount
+ For i = 1 To EventCount
+ With map.TileData.Events(i)
+ If .x = x And .y = y Then
+ ' Get the active event page
+ page = ActiveEventPage(i)
+ If page > 0 Then
+ If map.TileData.Events(i).EventPage(page).WalkThrough = 0 Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+ End If
+ End With
+ Next
+
+ ' Check to see if the key door is open or not
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_KEY Then
+ ' This actually checks if its open or not
+ If TempTile(x, y).DoorOpen = 0 Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+
+ ' Check to see if a player is already on that tile
+ If map.MapData.Moral = 0 Then
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ If GetPlayerX(i) = x Then
+ If GetPlayerY(i) = y Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+ End If
+ Next i
+ End If
+
+ ' Check to see if a npc is already on that tile
+ For i = 1 To Npc_HighIndex
+ If MapNpc(i).num > 0 Then
+ If MapNpc(i).x = x Then
+ If MapNpc(i).y = y Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+
+ ' check if it's a drop warp - avoid if walking
+ If ShiftDown Then
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_WARP Then
+ If map.TileData.Tile(x, y).Data4 Then
+ CheckDirection = True
+ End If
+ End If
+ End If
+
+End Function
+
+Sub CheckMovement()
+
+ If Not GettingMap Then
+ If IsTryingToMove Then
+ If CanMove Then
+
+ ' Check if player has the shift key down for running
+ If ShiftDown Then
+ Player(MyIndex).Moving = MOVING_RUNNING
+ Else
+ Player(MyIndex).Moving = MOVING_WALKING
+ End If
+
+ Select Case GetPlayerDir(MyIndex)
+
+ Case DIR_UP
+ Call SendPlayerMove
+ Player(MyIndex).yOffset = PIC_Y
+ Call SetPlayerY(MyIndex, GetPlayerY(MyIndex) - 1)
+
+ Case DIR_DOWN
+ Call SendPlayerMove
+ Player(MyIndex).yOffset = PIC_Y * -1
+ Call SetPlayerY(MyIndex, GetPlayerY(MyIndex) + 1)
+
+ Case DIR_LEFT
+ Call SendPlayerMove
+ Player(MyIndex).xOffset = PIC_X
+ Call SetPlayerX(MyIndex, GetPlayerX(MyIndex) - 1)
+
+ Case DIR_RIGHT
+ Call SendPlayerMove
+ Player(MyIndex).xOffset = PIC_X * -1
+ Call SetPlayerX(MyIndex, GetPlayerX(MyIndex) + 1)
+ End Select
+
+ If map.TileData.Tile(GetPlayerX(MyIndex), GetPlayerY(MyIndex)).Type = TILE_TYPE_WARP Then
+ GettingMap = True
+ End If
+ End If
+ End If
+ End If
+
+End Sub
+
+Public Function isInBounds()
+
+ If (CurX >= 0) Then
+ If (CurX <= map.MapData.MaxX) Then
+ If (CurY >= 0) Then
+ If (CurY <= map.MapData.MaxY) Then
+ isInBounds = True
+ End If
+ End If
+ End If
+ End If
+
+End Function
+
+Public Function IsValidMapPoint(ByVal x As Long, ByVal y As Long) As Boolean
+ IsValidMapPoint = False
+
+ If x < 0 Then Exit Function
+ If y < 0 Then Exit Function
+ If x > map.MapData.MaxX Then Exit Function
+ If y > map.MapData.MaxY Then Exit Function
+ IsValidMapPoint = True
+End Function
+
+Public Function IsItem(startX As Long, startY As Long) As Long
+Dim tempRec As RECT
+Dim i As Long
+ For i = 1 To MAX_INV
+ If GetPlayerInvItemNum(MyIndex, i) Then
+ With tempRec
+ .top = startY + InvTop + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ .bottom = .top + PIC_Y
+ .left = startX + InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+ .Right = .left + PIC_X
+ End With
+
+ If currMouseX >= tempRec.left And currMouseX <= tempRec.Right Then
+ If currMouseY >= tempRec.top And currMouseY <= tempRec.bottom Then
+ IsItem = i
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+End Function
+
+Public Function IsTrade(startX As Long, startY As Long) As Long
+Dim tempRec As RECT
+Dim i As Long
+
+ For i = 1 To MAX_INV
+ With tempRec
+ .top = startY + TradeTop + ((TradeOffsetY + 32) * ((i - 1) \ TradeColumns))
+ .bottom = .top + PIC_Y
+ .left = startX + TradeLeft + ((TradeOffsetX + 32) * (((i - 1) Mod TradeColumns)))
+ .Right = .left + PIC_X
+ End With
+
+ If currMouseX >= tempRec.left And currMouseX <= tempRec.Right Then
+ If currMouseY >= tempRec.top And currMouseY <= tempRec.bottom Then
+ IsTrade = i
+ Exit Function
+ End If
+ End If
+ Next
+End Function
+
+Public Function IsEqItem(startX As Long, startY As Long) As Long
+Dim tempRec As RECT
+Dim i As Long
+ For i = 1 To Equipment.Equipment_Count - 1
+ If GetPlayerEquipment(MyIndex, i) Then
+ With tempRec
+ .top = startY + EqTop + (32 * ((i - 1) \ EqColumns))
+ .bottom = .top + PIC_Y
+ .left = startX + EqLeft + ((EqOffsetX + 32) * (((i - 1) Mod EqColumns)))
+ .Right = .left + PIC_X
+ End With
+
+ If currMouseX >= tempRec.left And currMouseX <= tempRec.Right Then
+ If currMouseY >= tempRec.top And currMouseY <= tempRec.bottom Then
+ IsEqItem = i
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+End Function
+
+Public Function IsSkill(startX As Long, startY As Long) As Long
+Dim tempRec As RECT
+Dim i As Long
+
+ For i = 1 To MAX_PLAYER_SPELLS
+ If PlayerSpells(i).Spell Then
+ With tempRec
+ .top = startY + SkillTop + ((SkillOffsetY + 32) * ((i - 1) \ SkillColumns))
+ .bottom = .top + PIC_Y
+ .left = startX + SkillLeft + ((SkillOffsetX + 32) * (((i - 1) Mod SkillColumns)))
+ .Right = .left + PIC_X
+ End With
+
+ If currMouseX >= tempRec.left And currMouseX <= tempRec.Right Then
+ If currMouseY >= tempRec.top And currMouseY <= tempRec.bottom Then
+ IsSkill = i
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+End Function
+
+Public Function IsHotbar(startX As Long, startY As Long) As Long
+Dim tempRec As RECT
+Dim i As Long
+
+ For i = 1 To MAX_HOTBAR
+ If Hotbar(i).Slot Then
+ With tempRec
+ .top = startY + HotbarTop
+ .bottom = .top + PIC_Y
+ .left = startX + HotbarLeft + ((i - 1) * HotbarOffsetX)
+ .Right = .left + PIC_X
+ End With
+
+ If currMouseX >= tempRec.left And currMouseX <= tempRec.Right Then
+ If currMouseY >= tempRec.top And currMouseY <= tempRec.bottom Then
+ IsHotbar = i
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+End Function
+
+Public Sub UseItem()
+
+ ' Check for subscript out of range
+ If InventoryItemSelected < 1 Or InventoryItemSelected > MAX_INV Then
+ Exit Sub
+ End If
+
+ Call SendUseItem(InventoryItemSelected)
+End Sub
+
+Public Sub ForgetSpell(ByVal spellSlot As Long)
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If spellSlot < 1 Or spellSlot > MAX_PLAYER_SPELLS Then
+ Exit Sub
+ End If
+
+ ' dont let them forget a spell which is in CD
+ If SpellCD(spellSlot) > 0 Then
+ AddText "Cannot forget a spell which is cooling down!", BrightRed
+ Exit Sub
+ End If
+
+ ' dont let them forget a spell which is buffered
+ If SpellBuffer = spellSlot Then
+ AddText "Cannot forget a spell which you are casting!", BrightRed
+ Exit Sub
+ End If
+
+ If PlayerSpells(spellSlot).Spell > 0 Then
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CForgetSpell
+ Buffer.WriteLong spellSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+ Else
+ AddText "No spell here.", BrightRed
+ End If
+
+End Sub
+
+Public Sub CastSpell(ByVal spellSlot As Long)
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If spellSlot < 1 Or spellSlot > MAX_PLAYER_SPELLS Then
+ Exit Sub
+ End If
+
+ If SpellCD(spellSlot) > 0 Then
+ AddText "Spell has not cooled down yet!", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure we're not casting same spell
+ If SpellBuffer > 0 Then
+ If SpellBuffer = spellSlot Then
+ ' stop them
+ Exit Sub
+ End If
+ End If
+
+ If PlayerSpells(spellSlot).Spell = 0 Then Exit Sub
+
+ ' Check if player has enough MP
+ If GetPlayerVital(MyIndex, Vitals.MP) < Spell(PlayerSpells(spellSlot).Spell).MPCost Then
+ Call AddText("Not enough MP to cast " & Trim$(Spell(PlayerSpells(spellSlot).Spell).name) & ".", BrightRed)
+ Exit Sub
+ End If
+
+ If PlayerSpells(spellSlot).Spell > 0 Then
+ If GetTickCount > Player(MyIndex).AttackTimer + 1000 Then
+ If Player(MyIndex).Moving = 0 Then
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CCast
+ Buffer.WriteLong spellSlot
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+ SpellBuffer = spellSlot
+ SpellBufferTimer = GetTickCount
+ Else
+ Call AddText("Cannot cast while walking!", BrightRed)
+ End If
+ End If
+
+ Else
+ Call AddText("No spell here.", BrightRed)
+ End If
+
+End Sub
+
+Sub ClearTempTile()
+ Dim x As Long
+ Dim y As Long
+ ReDim TempTile(0 To map.MapData.MaxX, 0 To map.MapData.MaxY)
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ TempTile(x, y).DoorOpen = 0
+
+ If Not GettingMap Then cacheRenderState x, y, MapLayer.Mask
+ Next
+ Next
+
+End Sub
+
+Public Sub DevMsg(ByVal text As String, ByVal Color As Byte)
+
+ If InGame Then
+ If GetPlayerAccess(MyIndex) > ADMIN_DEVELOPER Then
+ Call AddText(text, Color)
+ End If
+ End If
+
+ Debug.Print text
+End Sub
+
+Public Function TwipsToPixels(ByVal twip_val As Long, ByVal XorY As Byte) As Long
+
+ If XorY = 0 Then
+ TwipsToPixels = twip_val / Screen.TwipsPerPixelX
+ ElseIf XorY = 1 Then
+ TwipsToPixels = twip_val / Screen.TwipsPerPixelY
+ End If
+
+End Function
+
+Public Function PixelsToTwips(ByVal pixel_val As Long, ByVal XorY As Byte) As Long
+
+ If XorY = 0 Then
+ PixelsToTwips = pixel_val * Screen.TwipsPerPixelX
+ ElseIf XorY = 1 Then
+ PixelsToTwips = pixel_val * Screen.TwipsPerPixelY
+ End If
+
+End Function
+
+Public Function ConvertCurrency(ByVal amount As Long) As String
+
+ If Int(amount) < 10000 Then
+ ConvertCurrency = amount
+ ElseIf Int(amount) < 999999 Then
+ ConvertCurrency = Int(amount / 1000) & "k"
+ ElseIf Int(amount) < 999999999 Then
+ ConvertCurrency = Int(amount / 1000000) & "m"
+ Else
+ ConvertCurrency = Int(amount / 1000000000) & "b"
+ End If
+
+End Function
+
+Public Sub CacheResources()
+ Dim x As Long, y As Long, Resource_Count As Long
+ Resource_Count = 0
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_RESOURCE Then
+ Resource_Count = Resource_Count + 1
+ ReDim Preserve MapResource(0 To Resource_Count)
+ MapResource(Resource_Count).x = x
+ MapResource(Resource_Count).y = y
+ End If
+
+ Next
+ Next
+
+ Resource_Index = Resource_Count
+End Sub
+
+Public Sub CreateActionMsg(ByVal message As String, ByVal Color As Integer, ByVal MsgType As Byte, ByVal x As Long, ByVal y As Long)
+ Dim i As Long
+ ActionMsgIndex = ActionMsgIndex + 1
+
+ If ActionMsgIndex >= MAX_BYTE Then ActionMsgIndex = 1
+
+ With ActionMsg(ActionMsgIndex)
+ .message = message
+ .Color = Color
+ .Type = MsgType
+ .Created = GetTickCount
+ .Scroll = 1
+ .x = x
+ .y = y
+ .alpha = 255
+ End With
+
+ If ActionMsg(ActionMsgIndex).Type = ACTIONMsgSCROLL Then
+ ActionMsg(ActionMsgIndex).y = ActionMsg(ActionMsgIndex).y + Rand(-2, 6)
+ ActionMsg(ActionMsgIndex).x = ActionMsg(ActionMsgIndex).x + Rand(-8, 8)
+ End If
+
+ ' find the new high index
+ For i = MAX_BYTE To 1 Step -1
+
+ If ActionMsg(i).Created > 0 Then
+ Action_HighIndex = i + 1
+ Exit For
+ End If
+
+ Next
+
+ ' make sure we don't overflow
+ If Action_HighIndex > MAX_BYTE Then Action_HighIndex = MAX_BYTE
+End Sub
+
+Public Sub ClearActionMsg(ByVal index As Byte)
+ Dim i As Long
+ ActionMsg(index).message = vbNullString
+ ActionMsg(index).Created = 0
+ ActionMsg(index).Type = 0
+ ActionMsg(index).Color = 0
+ ActionMsg(index).Scroll = 0
+ ActionMsg(index).x = 0
+ ActionMsg(index).y = 0
+
+ ' find the new high index
+ For i = MAX_BYTE To 1 Step -1
+
+ If ActionMsg(i).Created > 0 Then
+ Action_HighIndex = i + 1
+ Exit For
+ End If
+
+ Next
+
+ ' make sure we don't overflow
+ If Action_HighIndex > MAX_BYTE Then Action_HighIndex = MAX_BYTE
+End Sub
+
+Public Sub CheckAnimInstance(ByVal index As Long)
+ Dim looptime As Long
+ Dim Layer As Long
+ Dim FrameCount As Long
+
+ ' if doesn't exist then exit sub
+ If AnimInstance(index).Animation <= 0 Then Exit Sub
+ If AnimInstance(index).Animation >= MAX_ANIMATIONS Then Exit Sub
+
+ For Layer = 0 To 1
+
+ If AnimInstance(index).Used(Layer) Then
+ looptime = Animation(AnimInstance(index).Animation).looptime(Layer)
+
+ FrameCount = Animation(AnimInstance(index).Animation).Frames(Layer)
+
+ ' if zero'd then set so we don't have extra loop and/or frame
+ If AnimInstance(index).FrameIndex(Layer) = 0 Then AnimInstance(index).FrameIndex(Layer) = 1
+ If AnimInstance(index).LoopIndex(Layer) = 0 Then AnimInstance(index).LoopIndex(Layer) = 1
+
+ ' check if frame timer is set, and needs to have a frame change
+ If AnimInstance(index).timer(Layer) + looptime <= GetTickCount Then
+
+ ' check if out of range
+ If AnimInstance(index).FrameIndex(Layer) >= FrameCount Then
+ AnimInstance(index).LoopIndex(Layer) = AnimInstance(index).LoopIndex(Layer) + 1
+
+ If AnimInstance(index).LoopIndex(Layer) > Animation(AnimInstance(index).Animation).LoopCount(Layer) Then
+ AnimInstance(index).Used(Layer) = False
+ Else
+ AnimInstance(index).FrameIndex(Layer) = 1
+ End If
+
+ Else
+ AnimInstance(index).FrameIndex(Layer) = AnimInstance(index).FrameIndex(Layer) + 1
+ End If
+
+ AnimInstance(index).timer(Layer) = GetTickCount
+ End If
+ End If
+
+ Next
+
+ ' if neither layer is used, clear
+ If AnimInstance(index).Used(0) = False And AnimInstance(index).Used(1) = False Then ClearAnimInstance (index)
+End Sub
+
+Public Function GetBankItemNum(ByVal bankslot As Long) As Long
+
+ If bankslot = 0 Then
+ GetBankItemNum = 0
+ Exit Function
+ End If
+
+ If bankslot > MAX_BANK Then
+ GetBankItemNum = 0
+ Exit Function
+ End If
+
+ GetBankItemNum = Bank.Item(bankslot).num
+End Function
+
+Public Sub SetBankItemNum(ByVal bankslot As Long, ByVal itemNum As Long)
+ Bank.Item(bankslot).num = itemNum
+End Sub
+
+Public Function GetBankItemValue(ByVal bankslot As Long) As Long
+ GetBankItemValue = Bank.Item(bankslot).value
+End Function
+
+Public Sub SetBankItemValue(ByVal bankslot As Long, ByVal ItemValue As Long)
+ Bank.Item(bankslot).value = ItemValue
+End Sub
+
+' BitWise Operators for directional blocking
+Public Sub setDirBlock(ByRef blockvar As Byte, ByRef dir As Byte, ByVal block As Boolean)
+
+ If block Then
+ blockvar = blockvar Or (2 ^ dir)
+ Else
+ blockvar = blockvar And Not (2 ^ dir)
+ End If
+
+End Sub
+
+Public Function isDirBlocked(ByRef blockvar As Byte, ByRef dir As Byte) As Boolean
+
+ If Not blockvar And (2 ^ dir) Then
+ isDirBlocked = False
+ Else
+ isDirBlocked = True
+ End If
+
+End Function
+
+Public Sub PlayMapSound(ByVal x As Long, ByVal y As Long, ByVal entityType As Long, ByVal entityNum As Long)
+ Dim soundName As String
+
+ If entityNum <= 0 Then Exit Sub
+
+ ' find the sound
+ Select Case entityType
+
+ ' animations
+ Case SoundEntity.seAnimation
+
+ If entityNum > MAX_ANIMATIONS Then Exit Sub
+ soundName = Trim$(Animation(entityNum).sound)
+
+ ' items
+ Case SoundEntity.seItem
+
+ If entityNum > MAX_ITEMS Then Exit Sub
+ soundName = Trim$(Item(entityNum).sound)
+
+ ' npcs
+ Case SoundEntity.seNpc
+
+ If entityNum > MAX_NPCS Then Exit Sub
+ soundName = Trim$(Npc(entityNum).sound)
+
+ ' resources
+ Case SoundEntity.seResource
+
+ If entityNum > MAX_RESOURCES Then Exit Sub
+ soundName = Trim$(Resource(entityNum).sound)
+
+ ' spells
+ Case SoundEntity.seSpell
+
+ If entityNum > MAX_SPELLS Then Exit Sub
+ soundName = Trim$(Spell(entityNum).sound)
+
+ ' other
+ Case Else
+ Exit Sub
+ End Select
+
+ ' exit out if it's not set
+ If Trim$(soundName) = "None." Then Exit Sub
+
+ ' play the sound
+ If x > 0 And y > 0 Then Play_Sound soundName, x, y
+End Sub
+
+Public Sub CloseDialogue()
+ diaIndex = 0
+ HideWindow GetWindowIndex("winBlank")
+ HideWindow GetWindowIndex("winDialogue")
+End Sub
+
+Public Sub Dialogue(ByVal header As String, ByVal body As String, ByVal body2 As String, ByVal index As Long, Optional ByVal style As Byte = 1, Optional ByVal Data1 As Long = 0)
+
+ ' exit out if we've already got a dialogue open
+ If diaIndex > 0 Then Exit Sub
+
+ ' set buttons
+ With Windows(GetWindowIndex("winDialogue"))
+ If style = StyleYESNO Then
+ .Controls(GetControlIndex("winDialogue", "btnYes")).visible = True
+ .Controls(GetControlIndex("winDialogue", "btnNo")).visible = True
+ .Controls(GetControlIndex("winDialogue", "btnOkay")).visible = False
+ .Controls(GetControlIndex("winDialogue", "txtInput")).visible = False
+ .Controls(GetControlIndex("winDialogue", "lblBody_2")).visible = True
+ ElseIf style = StyleOKAY Then
+ .Controls(GetControlIndex("winDialogue", "btnYes")).visible = False
+ .Controls(GetControlIndex("winDialogue", "btnNo")).visible = False
+ .Controls(GetControlIndex("winDialogue", "btnOkay")).visible = True
+ .Controls(GetControlIndex("winDialogue", "txtInput")).visible = False
+ .Controls(GetControlIndex("winDialogue", "lblBody_2")).visible = True
+ ElseIf style = StyleINPUT Then
+ .Controls(GetControlIndex("winDialogue", "btnYes")).visible = False
+ .Controls(GetControlIndex("winDialogue", "btnNo")).visible = False
+ .Controls(GetControlIndex("winDialogue", "btnOkay")).visible = True
+ .Controls(GetControlIndex("winDialogue", "txtInput")).visible = True
+ .Controls(GetControlIndex("winDialogue", "lblBody_2")).visible = False
+ End If
+
+ ' set labels
+ .Controls(GetControlIndex("winDialogue", "lblHeader")).text = header
+ .Controls(GetControlIndex("winDialogue", "lblBody_1")).text = body
+ .Controls(GetControlIndex("winDialogue", "lblBody_2")).text = body2
+ .Controls(GetControlIndex("winDialogue", "txtInput")).text = vbNullString
+ End With
+
+ ' set it all up
+ diaIndex = index
+ diaData1 = Data1
+ diaStyle = style
+
+ ' make the windows visible
+ ShowWindow GetWindowIndex("winBlank"), True
+ ShowWindow GetWindowIndex("winDialogue"), True
+End Sub
+
+Public Sub dialogueHandler(ByVal index As Long)
+Dim value As Long, diaInput As String
+
+ Dim Buffer As New clsBuffer
+ Set Buffer = New clsBuffer
+
+ diaInput = Trim$(Windows(GetWindowIndex("winDialogue")).Controls(GetControlIndex("winDialogue", "txtInput")).text)
+
+ ' find out which button
+ If index = 1 Then ' okay button
+
+ ' dialogue index
+ Select Case diaIndex
+ Case TypeTRADEAMOUNT
+ value = Val(diaInput)
+ TradeItem diaData1, value
+ Case TypeDROPITEM
+ value = Val(diaInput)
+ SendDropItem diaData1, value
+ End Select
+
+ ElseIf index = 2 Then ' yes button
+
+ ' dialogue index
+ Select Case diaIndex
+
+ Case TypeTRADE
+ SendAcceptTradeRequest
+
+ Case TypeFORGET
+
+ ForgetSpell diaData1
+
+ Case TypePARTY
+ SendAcceptParty
+
+ Case TypeLOOTITEM
+ ' send the packet
+ Player(MyIndex).MapGetTimer = GetTickCount
+ Buffer.WriteLong CMapGetItem
+ SendData Buffer.ToArray()
+
+ Case TypeDELCHAR
+ ' send the deletion
+ SendDelChar diaData1
+ End Select
+
+ ElseIf index = 3 Then ' no button
+
+ ' dialogue index
+ Select Case diaIndex
+
+ Case TypeTRADE
+ SendDeclineTradeRequest
+
+ Case TypePARTY
+ SendDeclineParty
+ End Select
+ End If
+
+ CloseDialogue
+ diaIndex = 0
+ diaInput = vbNullString
+End Sub
+
+Public Function ConvertMapX(ByVal x As Long) As Long
+ ConvertMapX = x - (TileView.left * PIC_X) - Camera.left
+End Function
+
+Public Function ConvertMapY(ByVal y As Long) As Long
+ ConvertMapY = y - (TileView.top * PIC_Y) - Camera.top
+End Function
+
+Public Sub UpdateCamera()
+ Dim offsetX As Long, offsetY As Long, startX As Long, startY As Long, EndX As Long, EndY As Long
+
+ offsetX = Player(MyIndex).xOffset + PIC_X
+ offsetY = Player(MyIndex).yOffset + PIC_Y
+ startX = GetPlayerX(MyIndex) - ((TileWidth + 1) \ 2) - 1
+ startY = GetPlayerY(MyIndex) - ((TileHeight + 1) \ 2) - 1
+
+ If TileWidth + 1 <= map.MapData.MaxX Then
+ If startX < 0 Then
+ offsetX = 0
+
+ If startX = -1 Then
+ If Player(MyIndex).xOffset > 0 Then
+ offsetX = Player(MyIndex).xOffset
+ End If
+ End If
+
+ startX = 0
+ End If
+
+ EndX = startX + (TileWidth + 1) + 1
+
+ If EndX > map.MapData.MaxX Then
+ offsetX = 32
+
+ If EndX = map.MapData.MaxX + 1 Then
+ If Player(MyIndex).xOffset < 0 Then
+ offsetX = Player(MyIndex).xOffset + PIC_X
+ End If
+ End If
+
+ EndX = map.MapData.MaxX
+ startX = EndX - TileWidth - 1
+ End If
+ Else
+ EndX = startX + (TileWidth + 1) + 1
+ End If
+
+ If TileHeight + 1 <= map.MapData.MaxY Then
+ If startY < 0 Then
+ offsetY = 0
+
+ If startY = -1 Then
+ If Player(MyIndex).yOffset > 0 Then
+ offsetY = Player(MyIndex).yOffset
+ End If
+ End If
+
+ startY = 0
+ End If
+
+ EndY = startY + (TileHeight + 1) + 1
+
+ If EndY > map.MapData.MaxY Then
+ offsetY = 32
+
+ If EndY = map.MapData.MaxY + 1 Then
+ If Player(MyIndex).yOffset < 0 Then
+ offsetY = Player(MyIndex).yOffset + PIC_Y
+ End If
+ End If
+
+ EndY = map.MapData.MaxY
+ startY = EndY - TileHeight - 1
+ End If
+ Else
+ EndY = startY + (TileHeight + 1) + 1
+ End If
+
+ If TileWidth + 1 = map.MapData.MaxX Then
+ offsetX = 0
+ End If
+
+ If TileHeight + 1 = map.MapData.MaxY Then
+ offsetY = 0
+ End If
+
+ With TileView
+ .top = startY
+ .bottom = EndY
+ .left = startX
+ .Right = EndX
+ End With
+
+ With Camera
+ .top = offsetY
+ .bottom = .top + ScreenY
+ .left = offsetX
+ .Right = .left + ScreenX
+ End With
+
+ CurX = TileView.left + ((GlobalX + Camera.left) \ PIC_X)
+ CurY = TileView.top + ((GlobalY + Camera.top) \ PIC_Y)
+ GlobalX_Map = GlobalX + (TileView.left * PIC_X) + Camera.left
+ GlobalY_Map = GlobalY + (TileView.top * PIC_Y) + Camera.top
+End Sub
+
+Public Function CensorWord(ByVal sString As String) As String
+ CensorWord = String$(Len(sString), "*")
+End Function
+
+Public Sub placeAutotile(ByVal layernum As Long, ByVal x As Long, ByVal y As Long, ByVal tileQuarter As Byte, ByVal autoTileLetter As String)
+
+ With Autotile(x, y).Layer(layernum).QuarterTile(tileQuarter)
+
+ Select Case autoTileLetter
+
+ Case "a"
+ .x = autoInner(1).x
+ .y = autoInner(1).y
+
+ Case "b"
+ .x = autoInner(2).x
+ .y = autoInner(2).y
+
+ Case "c"
+ .x = autoInner(3).x
+ .y = autoInner(3).y
+
+ Case "d"
+ .x = autoInner(4).x
+ .y = autoInner(4).y
+
+ Case "e"
+ .x = autoNW(1).x
+ .y = autoNW(1).y
+
+ Case "f"
+ .x = autoNW(2).x
+ .y = autoNW(2).y
+
+ Case "g"
+ .x = autoNW(3).x
+ .y = autoNW(3).y
+
+ Case "h"
+ .x = autoNW(4).x
+ .y = autoNW(4).y
+
+ Case "i"
+ .x = autoNE(1).x
+ .y = autoNE(1).y
+
+ Case "j"
+ .x = autoNE(2).x
+ .y = autoNE(2).y
+
+ Case "k"
+ .x = autoNE(3).x
+ .y = autoNE(3).y
+
+ Case "l"
+ .x = autoNE(4).x
+ .y = autoNE(4).y
+
+ Case "m"
+ .x = autoSW(1).x
+ .y = autoSW(1).y
+
+ Case "n"
+ .x = autoSW(2).x
+ .y = autoSW(2).y
+
+ Case "o"
+ .x = autoSW(3).x
+ .y = autoSW(3).y
+
+ Case "p"
+ .x = autoSW(4).x
+ .y = autoSW(4).y
+
+ Case "q"
+ .x = autoSE(1).x
+ .y = autoSE(1).y
+
+ Case "r"
+ .x = autoSE(2).x
+ .y = autoSE(2).y
+
+ Case "s"
+ .x = autoSE(3).x
+ .y = autoSE(3).y
+
+ Case "t"
+ .x = autoSE(4).x
+ .y = autoSE(4).y
+ End Select
+
+ End With
+
+End Sub
+
+Public Sub initAutotiles()
+ Dim x As Long, y As Long, layernum As Long
+ ' Procedure used to cache autotile positions. All positioning is
+ ' independant from the tileset. Calculations are convoluted and annoying.
+ ' Maths is not my strong point. Luckily we're caching them so it's a one-off
+ ' thing when the map is originally loaded. As such optimisation isn't an issue.
+ ' For simplicity's sake we cache all subtile SOURCE positions in to an array.
+ ' We also give letters to each subtile for easy rendering tweaks. ;]
+ ' First, we need to re-size the array
+ ReDim Autotile(0 To map.MapData.MaxX, 0 To map.MapData.MaxY)
+ ' Inner tiles (Top right subtile region)
+ ' NW - a
+ autoInner(1).x = 32
+ autoInner(1).y = 0
+ ' NE - b
+ autoInner(2).x = 48
+ autoInner(2).y = 0
+ ' SW - c
+ autoInner(3).x = 32
+ autoInner(3).y = 16
+ ' SE - d
+ autoInner(4).x = 48
+ autoInner(4).y = 16
+ ' Outer Tiles - NW (bottom subtile region)
+ ' NW - e
+ autoNW(1).x = 0
+ autoNW(1).y = 32
+ ' NE - f
+ autoNW(2).x = 16
+ autoNW(2).y = 32
+ ' SW - g
+ autoNW(3).x = 0
+ autoNW(3).y = 48
+ ' SE - h
+ autoNW(4).x = 16
+ autoNW(4).y = 48
+ ' Outer Tiles - NE (bottom subtile region)
+ ' NW - i
+ autoNE(1).x = 32
+ autoNE(1).y = 32
+ ' NE - g
+ autoNE(2).x = 48
+ autoNE(2).y = 32
+ ' SW - k
+ autoNE(3).x = 32
+ autoNE(3).y = 48
+ ' SE - l
+ autoNE(4).x = 48
+ autoNE(4).y = 48
+ ' Outer Tiles - SW (bottom subtile region)
+ ' NW - m
+ autoSW(1).x = 0
+ autoSW(1).y = 64
+ ' NE - n
+ autoSW(2).x = 16
+ autoSW(2).y = 64
+ ' SW - o
+ autoSW(3).x = 0
+ autoSW(3).y = 80
+ ' SE - p
+ autoSW(4).x = 16
+ autoSW(4).y = 80
+ ' Outer Tiles - SE (bottom subtile region)
+ ' NW - q
+ autoSE(1).x = 32
+ autoSE(1).y = 64
+ ' NE - r
+ autoSE(2).x = 48
+ autoSE(2).y = 64
+ ' SW - s
+ autoSE(3).x = 32
+ autoSE(3).y = 80
+ ' SE - t
+ autoSE(4).x = 48
+ autoSE(4).y = 80
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ For layernum = 1 To MapLayer.Layer_Count - 1
+ ' calculate the subtile positions and place them
+ calculateAutotile x, y, layernum
+ ' cache the rendering state of the tiles and set them
+ cacheRenderState x, y, layernum
+ Next
+ Next
+ Next
+
+End Sub
+
+Public Sub cacheRenderState(ByVal x As Long, ByVal y As Long, ByVal layernum As Long)
+ Dim quarterNum As Long
+
+ ' exit out early
+ If x < 0 Or x > map.MapData.MaxX Or y < 0 Or y > map.MapData.MaxY Then Exit Sub
+
+ With map.TileData.Tile(x, y)
+
+ ' check if the tile can be rendered
+ If .Layer(layernum).tileSet <= 0 Or .Layer(layernum).tileSet > Count_Tileset Then
+ Autotile(x, y).Layer(layernum).renderState = RENDER_STATE_NONE
+ Exit Sub
+ End If
+
+ ' check if we're a bottom
+ If layernum = MapLayer.Ground Then
+ ' check if bottom
+ If y > 0 Then
+ If map.TileData.Tile(x, y - 1).Type = TILE_TYPE_APPEAR Then
+ If map.TileData.Tile(x, y - 1).Data2 Then
+ Autotile(x, y).Layer(layernum).renderState = RENDER_STATE_APPEAR
+ Exit Sub
+ End If
+ End If
+ End If
+ End If
+
+ ' check if it's a key - hide mask if key is closed
+ If layernum = MapLayer.Mask Then
+ If .Type = TILE_TYPE_KEY Then
+ If TempTile(x, y).DoorOpen = 0 Then
+ Autotile(x, y).Layer(layernum).renderState = RENDER_STATE_NONE
+ Exit Sub
+ End If
+ End If
+ If .Type = TILE_TYPE_APPEAR Then
+ Autotile(x, y).Layer(layernum).renderState = RENDER_STATE_APPEAR
+ Exit Sub
+ End If
+ End If
+
+ ' check if it needs to be rendered as an autotile
+ If .Autotile(layernum) = AUTOTILE_NONE Or .Autotile(layernum) = AUTOTILE_FAKE Or Options.NoAuto = 1 Then
+ ' default to... default
+ Autotile(x, y).Layer(layernum).renderState = RENDER_STATE_NORMAL
+ Else
+ Autotile(x, y).Layer(layernum).renderState = RENDER_STATE_AUTOTILE
+
+ ' cache tileset positioning
+ For quarterNum = 1 To 4
+ Autotile(x, y).Layer(layernum).srcX(quarterNum) = (map.TileData.Tile(x, y).Layer(layernum).x * 32) + Autotile(x, y).Layer(layernum).QuarterTile(quarterNum).x
+ Autotile(x, y).Layer(layernum).srcY(quarterNum) = (map.TileData.Tile(x, y).Layer(layernum).y * 32) + Autotile(x, y).Layer(layernum).QuarterTile(quarterNum).y
+ Next
+
+ End If
+
+ End With
+
+End Sub
+
+Public Sub calculateAutotile(ByVal x As Long, ByVal y As Long, ByVal layernum As Long)
+
+ ' Right, so we've split the tile block in to an easy to remember
+ ' collection of letters. We now need to do the calculations to find
+ ' out which little lettered block needs to be rendered. We do this
+ ' by reading the surrounding tiles to check for matches.
+ ' First we check to make sure an autotile situation is actually there.
+ ' Then we calculate exactly which situation has arisen.
+ ' The situations are "inner", "outer", "horizontal", "vertical" and "fill".
+ ' Exit out if we don't have an auatotile
+ If map.TileData.Tile(x, y).Autotile(layernum) = 0 Then Exit Sub
+
+ ' Okay, we have autotiling but which one?
+ Select Case map.TileData.Tile(x, y).Autotile(layernum)
+
+ ' Normal or animated - same difference
+ Case AUTOTILE_NORMAL, AUTOTILE_ANIM
+ ' North West Quarter
+ CalculateNW_Normal layernum, x, y
+ ' North East Quarter
+ CalculateNE_Normal layernum, x, y
+ ' South West Quarter
+ CalculateSW_Normal layernum, x, y
+ ' South East Quarter
+ CalculateSE_Normal layernum, x, y
+
+ ' Cliff
+ Case AUTOTILE_CLIFF
+ ' North West Quarter
+ CalculateNW_Cliff layernum, x, y
+ ' North East Quarter
+ CalculateNE_Cliff layernum, x, y
+ ' South West Quarter
+ CalculateSW_Cliff layernum, x, y
+ ' South East Quarter
+ CalculateSE_Cliff layernum, x, y
+
+ ' Waterfalls
+ Case AUTOTILE_WATERFALL
+ ' North West Quarter
+ CalculateNW_Waterfall layernum, x, y
+ ' North East Quarter
+ CalculateNE_Waterfall layernum, x, y
+ ' South West Quarter
+ CalculateSW_Waterfall layernum, x, y
+ ' South East Quarter
+ CalculateSE_Waterfall layernum, x, y
+
+ ' Anything else
+ Case Else
+ ' Don't need to render anything... it's fake or not an autotile
+ End Select
+
+End Sub
+
+' Normal autotiling
+Public Sub CalculateNW_Normal(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' North West
+ If checkTileMatch(layernum, x, y, x - 1, y - 1) Then tmpTile(1) = True
+
+ ' North
+ If checkTileMatch(layernum, x, y, x, y - 1) Then tmpTile(2) = True
+
+ ' West
+ If checkTileMatch(layernum, x, y, x - 1, y) Then tmpTile(3) = True
+
+ ' Calculate Situation - Inner
+ If Not tmpTile(2) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Horizontal
+ If Not tmpTile(2) And tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If tmpTile(2) And Not tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Outer
+ If Not tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_OUTER
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 1, "e"
+
+ Case AUTO_OUTER
+ placeAutotile layernum, x, y, 1, "a"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 1, "i"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 1, "m"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 1, "q"
+ End Select
+
+End Sub
+
+Public Sub CalculateNE_Normal(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' North
+ If checkTileMatch(layernum, x, y, x, y - 1) Then tmpTile(1) = True
+
+ ' North East
+ If checkTileMatch(layernum, x, y, x + 1, y - 1) Then tmpTile(2) = True
+
+ ' East
+ If checkTileMatch(layernum, x, y, x + 1, y) Then tmpTile(3) = True
+
+ ' Calculate Situation - Inner
+ If Not tmpTile(1) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Horizontal
+ If Not tmpTile(1) And tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If tmpTile(1) And Not tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Outer
+ If tmpTile(1) And Not tmpTile(2) And tmpTile(3) Then situation = AUTO_OUTER
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 2, "j"
+
+ Case AUTO_OUTER
+ placeAutotile layernum, x, y, 2, "b"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 2, "f"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 2, "r"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 2, "n"
+ End Select
+
+End Sub
+
+Public Sub CalculateSW_Normal(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' West
+ If checkTileMatch(layernum, x, y, x - 1, y) Then tmpTile(1) = True
+
+ ' South West
+ If checkTileMatch(layernum, x, y, x - 1, y + 1) Then tmpTile(2) = True
+
+ ' South
+ If checkTileMatch(layernum, x, y, x, y + 1) Then tmpTile(3) = True
+
+ ' Calculate Situation - Inner
+ If Not tmpTile(1) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Horizontal
+ If tmpTile(1) And Not tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If Not tmpTile(1) And tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Outer
+ If tmpTile(1) And Not tmpTile(2) And tmpTile(3) Then situation = AUTO_OUTER
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 3, "o"
+
+ Case AUTO_OUTER
+ placeAutotile layernum, x, y, 3, "c"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 3, "s"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 3, "g"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 3, "k"
+ End Select
+
+End Sub
+
+Public Sub CalculateSE_Normal(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' South
+ If checkTileMatch(layernum, x, y, x, y + 1) Then tmpTile(1) = True
+
+ ' South East
+ If checkTileMatch(layernum, x, y, x + 1, y + 1) Then tmpTile(2) = True
+
+ ' East
+ If checkTileMatch(layernum, x, y, x + 1, y) Then tmpTile(3) = True
+
+ ' Calculate Situation - Inner
+ If Not tmpTile(1) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Horizontal
+ If Not tmpTile(1) And tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If tmpTile(1) And Not tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Outer
+ If tmpTile(1) And Not tmpTile(2) And tmpTile(3) Then situation = AUTO_OUTER
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 4, "t"
+
+ Case AUTO_OUTER
+ placeAutotile layernum, x, y, 4, "d"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 4, "p"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 4, "l"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 4, "h"
+ End Select
+
+End Sub
+
+' Waterfall autotiling
+Public Sub CalculateNW_Waterfall(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile As Boolean
+
+ ' West
+ If checkTileMatch(layernum, x, y, x - 1, y) Then tmpTile = True
+
+ ' Actually place the subtile
+ If tmpTile Then
+ ' Extended
+ placeAutotile layernum, x, y, 1, "i"
+ Else
+ ' Edge
+ placeAutotile layernum, x, y, 1, "e"
+ End If
+
+End Sub
+
+Public Sub CalculateNE_Waterfall(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile As Boolean
+
+ ' East
+ If checkTileMatch(layernum, x, y, x + 1, y) Then tmpTile = True
+
+ ' Actually place the subtile
+ If tmpTile Then
+ ' Extended
+ placeAutotile layernum, x, y, 2, "f"
+ Else
+ ' Edge
+ placeAutotile layernum, x, y, 2, "j"
+ End If
+
+End Sub
+
+Public Sub CalculateSW_Waterfall(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile As Boolean
+
+ ' West
+ If checkTileMatch(layernum, x, y, x - 1, y) Then tmpTile = True
+
+ ' Actually place the subtile
+ If tmpTile Then
+ ' Extended
+ placeAutotile layernum, x, y, 3, "k"
+ Else
+ ' Edge
+ placeAutotile layernum, x, y, 3, "g"
+ End If
+
+End Sub
+
+Public Sub CalculateSE_Waterfall(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile As Boolean
+
+ ' East
+ If checkTileMatch(layernum, x, y, x + 1, y) Then tmpTile = True
+
+ ' Actually place the subtile
+ If tmpTile Then
+ ' Extended
+ placeAutotile layernum, x, y, 4, "h"
+ Else
+ ' Edge
+ placeAutotile layernum, x, y, 4, "l"
+ End If
+
+End Sub
+
+' Cliff autotiling
+Public Sub CalculateNW_Cliff(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' North West
+ If checkTileMatch(layernum, x, y, x - 1, y - 1) Then tmpTile(1) = True
+
+ ' North
+ If checkTileMatch(layernum, x, y, x, y - 1) Then tmpTile(2) = True
+
+ ' West
+ If checkTileMatch(layernum, x, y, x - 1, y) Then tmpTile(3) = True
+
+ ' Calculate Situation - Horizontal
+ If Not tmpTile(2) And tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If tmpTile(2) And Not tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Inner
+ If Not tmpTile(2) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 1, "e"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 1, "i"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 1, "m"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 1, "q"
+ End Select
+
+End Sub
+
+Public Sub CalculateNE_Cliff(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' North
+ If checkTileMatch(layernum, x, y, x, y - 1) Then tmpTile(1) = True
+
+ ' North East
+ If checkTileMatch(layernum, x, y, x + 1, y - 1) Then tmpTile(2) = True
+
+ ' East
+ If checkTileMatch(layernum, x, y, x + 1, y) Then tmpTile(3) = True
+
+ ' Calculate Situation - Horizontal
+ If Not tmpTile(1) And tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If tmpTile(1) And Not tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Inner
+ If Not tmpTile(1) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 2, "j"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 2, "f"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 2, "r"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 2, "n"
+ End Select
+
+End Sub
+
+Public Sub CalculateSW_Cliff(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' West
+ If checkTileMatch(layernum, x, y, x - 1, y) Then tmpTile(1) = True
+
+ ' South West
+ If checkTileMatch(layernum, x, y, x - 1, y + 1) Then tmpTile(2) = True
+
+ ' South
+ If checkTileMatch(layernum, x, y, x, y + 1) Then tmpTile(3) = True
+
+ ' Calculate Situation - Horizontal
+ If tmpTile(1) And Not tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If Not tmpTile(1) And tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Inner
+ If Not tmpTile(1) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 3, "o"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 3, "s"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 3, "g"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 3, "k"
+ End Select
+
+End Sub
+
+Public Sub CalculateSE_Cliff(ByVal layernum As Long, ByVal x As Long, ByVal y As Long)
+ Dim tmpTile(1 To 3) As Boolean
+ Dim situation As Byte
+
+ ' South
+ If checkTileMatch(layernum, x, y, x, y + 1) Then tmpTile(1) = True
+
+ ' South East
+ If checkTileMatch(layernum, x, y, x + 1, y + 1) Then tmpTile(2) = True
+
+ ' East
+ If checkTileMatch(layernum, x, y, x + 1, y) Then tmpTile(3) = True
+
+ ' Calculate Situation - Horizontal
+ If Not tmpTile(1) And tmpTile(3) Then situation = AUTO_HORIZONTAL
+
+ ' Vertical
+ If tmpTile(1) And Not tmpTile(3) Then situation = AUTO_VERTICAL
+
+ ' Fill
+ If tmpTile(1) And tmpTile(2) And tmpTile(3) Then situation = AUTO_FILL
+
+ ' Inner
+ If Not tmpTile(1) And Not tmpTile(3) Then situation = AUTO_INNER
+
+ ' Actually place the subtile
+ Select Case situation
+
+ Case AUTO_INNER
+ placeAutotile layernum, x, y, 4, "t"
+
+ Case AUTO_HORIZONTAL
+ placeAutotile layernum, x, y, 4, "p"
+
+ Case AUTO_VERTICAL
+ placeAutotile layernum, x, y, 4, "l"
+
+ Case AUTO_FILL
+ placeAutotile layernum, x, y, 4, "h"
+ End Select
+
+End Sub
+
+Public Function checkTileMatch(ByVal layernum As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Boolean
+ ' we'll exit out early if true
+ checkTileMatch = True
+
+ ' if it's off the map then set it as autotile and exit out early
+ If x2 < 0 Or x2 > map.MapData.MaxX Or y2 < 0 Or y2 > map.MapData.MaxY Then
+ checkTileMatch = True
+ Exit Function
+ End If
+
+ ' fakes ALWAYS return true
+ If map.TileData.Tile(x2, y2).Autotile(layernum) = AUTOTILE_FAKE Then
+ checkTileMatch = True
+ Exit Function
+ End If
+
+ ' check neighbour is an autotile
+ If map.TileData.Tile(x2, y2).Autotile(layernum) = 0 Then
+ checkTileMatch = False
+ Exit Function
+ End If
+
+ ' check we're a matching
+ If map.TileData.Tile(x1, y1).Layer(layernum).tileSet <> map.TileData.Tile(x2, y2).Layer(layernum).tileSet Then
+ checkTileMatch = False
+ Exit Function
+ End If
+
+ ' check tiles match
+ If map.TileData.Tile(x1, y1).Layer(layernum).x <> map.TileData.Tile(x2, y2).Layer(layernum).x Then
+ checkTileMatch = False
+ Exit Function
+ End If
+
+ If map.TileData.Tile(x1, y1).Layer(layernum).y <> map.TileData.Tile(x2, y2).Layer(layernum).y Then
+ checkTileMatch = False
+ Exit Function
+ End If
+
+End Function
+
+Public Sub OpenNpcChat(ByVal npcNum As Long, ByVal mT As String, ByRef o() As String)
+Dim i As Long, x As Long
+
+ ' find out how many options we have
+ convOptions = 0
+ For i = 1 To 4
+ If Len(o(i)) > 0 Then convOptions = convOptions + 1
+ Next
+
+ ' gui stuff
+ With Windows(GetWindowIndex("winNpcChat"))
+ ' set main text
+ .Window.text = "Conversation with " & Trim$(Npc(npcNum).name)
+ .Controls(GetControlIndex("winNpcChat", "lblChat")).text = mT
+ ' make everything visible
+ For i = 1 To 4
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).top = optPos(i)
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).visible = True
+ Next
+ ' set sizes
+ .Window.height = optHeight
+ .Controls(GetControlIndex("winNpcChat", "picParchment")).height = .Window.height - 30
+ ' move options depending on count
+ If convOptions < 4 Then
+ For i = convOptions + 1 To 4
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).top = optPos(i)
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).visible = False
+ Next
+ For i = 1 To convOptions
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).top = optPos(i + (4 - convOptions))
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).visible = True
+ Next
+ .Window.height = optHeight - ((4 - convOptions) * 18)
+ .Controls(GetControlIndex("winNpcChat", "picParchment")).height = .Window.height - 32
+ End If
+ ' set labels
+ x = convOptions
+ For i = 1 To 4
+ .Controls(GetControlIndex("winNpcChat", "btnOpt" & i)).text = x & ". " & o(i)
+ x = x - 1
+ Next
+ For i = 0 To 5
+ .Controls(GetControlIndex("winNpcChat", "picFace")).image(i) = Tex_Face(Npc(npcNum).sprite)
+ Next
+ End With
+
+ ' we're in chat now boy
+ inChat = True
+
+ ' show the window
+ ShowWindow GetWindowIndex("winNpcChat")
+End Sub
+
+Public Sub SetTutorialState(ByVal stateNum As Byte)
+ Dim i As Long
+
+ Select Case stateNum
+
+ Case 1 ' introduction
+ chatText = "Ah, so you have appeared at last my dear. Please, listen to what I have to say."
+ chatOpt(1) = "*sigh* I suppose I should..."
+
+ For i = 2 To 4
+ chatOpt(i) = vbNullString
+ Next
+
+ Case 2 ' next
+ chatText = "There are some important things you need to know. Here they are. To move, use W, A, S and D. To attack or to talk to someone, press CTRL. To initiate chat press ENTER."
+ chatOpt(1) = "Go on..."
+
+ For i = 2 To 4
+ chatOpt(i) = vbNullString
+ Next
+
+ Case 3 ' chatting
+ chatText = "When chatting you can talk in different channels. By default you're talking in the map channel. To talk globally append an apostrophe (') to the start of your message. To perform an emote append a hyphen (-) to the start of your message."
+ chatOpt(1) = "Wait, what about combat?"
+
+ For i = 2 To 4
+ chatOpt(i) = vbNullString
+ Next
+
+ Case 4 ' combat
+ chatText = "Combat can be done through melee and skills. You can melee an enemy by facing them and pressing CTRL. To use a skill you can double click it in your skill menu, double click it in the hotbar or use the number keys. (1, 2, 3, etc.)"
+ chatOpt(1) = "Oh! What do stats do?"
+
+ For i = 2 To 4
+ chatOpt(i) = vbNullString
+ Next
+
+ Case 5 ' stats
+ chatText = "Strength increases damage and allows you to equip better weaponry. Endurance increases your maximum health. Intelligence increases your maximum spirit. Agility allows you to reduce damage received and also increases critical hit chances. Willpower increase regeneration abilities."
+ chatOpt(1) = "Thanks. See you later."
+
+ For i = 2 To 4
+ chatOpt(i) = vbNullString
+ Next
+
+ Case Else ' goodbye
+ chatText = vbNullString
+
+ For i = 1 To 4
+ chatOpt(i) = vbNullString
+ Next
+
+ SendFinishTutorial
+ inTutorial = False
+ AddText "Well done, you finished the tutorial.", BrightGreen
+ Exit Sub
+ End Select
+
+ ' set the state
+ tutorialState = stateNum
+End Sub
+
+Public Sub ScrollChatBox(ByVal direction As Byte)
+ If direction = 0 Then ' up
+ If ChatScroll < ChatLines Then
+ ChatScroll = ChatScroll + 1
+ End If
+ Else
+ If ChatScroll > 0 Then
+ ChatScroll = ChatScroll - 1
+ End If
+ End If
+End Sub
+
+Public Sub ClearMapCache()
+ Dim i As Long, filename As String
+
+ For i = 1 To MAX_MAPS
+ filename = App.path & "\data files\maps\map" & i & ".map"
+
+ If FileExist(filename) Then
+ Kill filename
+ End If
+
+ Next
+
+ AddText "Map cache destroyed.", BrightGreen
+End Sub
+
+Public Sub AddChatBubble(ByVal target As Long, ByVal TargetType As Byte, ByVal Msg As String, ByVal Colour As Long)
+ Dim i As Long, index As Long
+ ' set the global index
+ chatBubbleIndex = chatBubbleIndex + 1
+
+ ' reset to yourself for eventing
+ If TargetType = 0 Then
+ TargetType = TARGET_TYPE_PLAYER
+ If target = 0 Then target = MyIndex
+ End If
+
+ If chatBubbleIndex < 1 Or chatBubbleIndex > MAX_BYTE Then chatBubbleIndex = 1
+ ' default to new bubble
+ index = chatBubbleIndex
+
+ ' loop through and see if that player/npc already has a chat bubble
+ For i = 1 To MAX_BYTE
+ If chatBubble(i).TargetType = TargetType Then
+ If chatBubble(i).target = target Then
+ ' reset master index
+ If chatBubbleIndex > 1 Then chatBubbleIndex = chatBubbleIndex - 1
+ ' we use this one now, yes?
+ index = i
+ Exit For
+ End If
+ End If
+ Next
+
+ ' set the bubble up
+ With chatBubble(index)
+ .target = target
+ .TargetType = TargetType
+ .Msg = Msg
+ .Colour = Colour
+ .timer = GetTickCount
+ .active = True
+ End With
+End Sub
+
+Public Sub FindNearestTarget()
+ Dim i As Long, x As Long, y As Long, x2 As Long, y2 As Long, xDif As Long, yDif As Long
+ Dim bestX As Long, bestY As Long, bestIndex As Long
+ x2 = GetPlayerX(MyIndex)
+ y2 = GetPlayerY(MyIndex)
+ bestX = 255
+ bestY = 255
+
+ For i = 1 To MAX_MAP_NPCS
+
+ If MapNpc(i).num > 0 Then
+ x = MapNpc(i).x
+ y = MapNpc(i).y
+
+ ' find the difference - x
+ If x < x2 Then
+ xDif = x2 - x
+ ElseIf x > x2 Then
+ xDif = x - x2
+ Else
+ xDif = 0
+ End If
+
+ ' find the difference - y
+ If y < y2 Then
+ yDif = y2 - y
+ ElseIf y > y2 Then
+ yDif = y - y2
+ Else
+ yDif = 0
+ End If
+
+ ' best so far?
+ If (xDif + yDif) < (bestX + bestY) Then
+ bestX = xDif
+ bestY = yDif
+ bestIndex = i
+ End If
+ End If
+
+ Next
+
+ ' target the best
+ If bestIndex > 0 And bestIndex <> myTarget Then PlayerTarget bestIndex, TARGET_TYPE_NPC
+End Sub
+
+Public Sub FindTarget()
+ Dim i As Long, x As Long, y As Long
+
+ ' check players
+ For i = 1 To MAX_PLAYERS
+
+ If IsPlaying(i) And GetPlayerMap(MyIndex) = GetPlayerMap(i) Then
+ x = (GetPlayerX(i) * 32) + Player(i).xOffset + 32
+ y = (GetPlayerY(i) * 32) + Player(i).yOffset + 32
+
+ If x >= GlobalX_Map And x <= GlobalX_Map + 32 Then
+ If y >= GlobalY_Map And y <= GlobalY_Map + 32 Then
+ ' found our target!
+ PlayerTarget i, TARGET_TYPE_PLAYER
+ Exit Sub
+ End If
+ End If
+ End If
+
+ Next
+
+ ' check npcs
+ For i = 1 To MAX_MAP_NPCS
+
+ If MapNpc(i).num > 0 Then
+ x = (MapNpc(i).x * 32) + MapNpc(i).xOffset + 32
+ y = (MapNpc(i).y * 32) + MapNpc(i).yOffset + 32
+
+ If x >= GlobalX_Map And x <= GlobalX_Map + 32 Then
+ If y >= GlobalY_Map And y <= GlobalY_Map + 32 Then
+ ' found our target!
+ PlayerTarget i, TARGET_TYPE_NPC
+ Exit Sub
+ End If
+ End If
+ End If
+
+ Next
+
+End Sub
+
+Public Sub SetBarWidth(ByRef MaxWidth As Long, ByRef width As Long)
+ Dim barDifference As Long
+
+ If MaxWidth < width Then
+ ' find out the amount to increase per loop
+ barDifference = ((width - MaxWidth) / 100) * 10
+
+ ' if it's less than 1 then default to 1
+ If barDifference < 1 Then barDifference = 1
+ ' set the width
+ width = width - barDifference
+ ElseIf MaxWidth > width Then
+ ' find out the amount to increase per loop
+ barDifference = ((MaxWidth - width) / 100) * 10
+
+ ' if it's less than 1 then default to 1
+ If barDifference < 1 Then barDifference = 1
+ ' set the width
+ width = width + barDifference
+ End If
+
+End Sub
+
+Public Sub AttemptLogin()
+ TcpInit GAME_SERVER_IP, GAME_SERVER_PORT
+
+ ' send login packet
+ If ConnectToServer Then
+ SendLogin Windows(GetWindowIndex("winLogin")).Controls(GetControlIndex("winLogin", "txtUser")).text
+ Exit Sub
+ End If
+
+ If Not IsConnected Then
+ ShowWindow GetWindowIndex("winLogin")
+ Dialogue "Connection Problem", "Cannot connect to game server.", "Please try again later.", TypeALERT
+ End If
+End Sub
+
+Public Sub DialogueAlert(ByVal index As Long)
+ Dim header As String, body As String, body2 As String
+
+ ' find the body/header
+ Select Case index
+
+ Case MsgCONNECTION
+ header = "Connection Problem"
+ body = "You lost connection to the server."
+ body2 = "Please try again later."
+
+ Case MsgBANNED
+ header = "Banned"
+ body = "You have been banned from playing Crystalshire."
+ body2 = "Please send all ban appeals to an administrator."
+
+ Case MsgKICKED
+ header = "Kicked"
+ body = "You have been kicked from Crystalshire."
+ body2 = "Please try and behave."
+
+ Case MsgOUTDATED
+ header = "Wrong Version"
+ body = "Your game client is the wrong version."
+ body2 = "Please re-load the game or wait for a patch."
+
+ Case MsgUSERLENGTH
+ header = "Invalid Length"
+ body = "Your username or password is too short or too long."
+ body2 = "Please enter a valid username and password."
+
+ Case MsgILLEGALNAME
+ header = "Illegal Characters"
+ body = "Your username or password contains illegal characters."
+ body2 = "Please enter a valid username and password."
+
+ Case MsgREBOOTING
+ header = "Connection Refused"
+ body = "The server is currently rebooting."
+ body2 = "Please try again soon."
+
+ Case MsgNAMETAKEN
+ header = "Invalid Name"
+ body = "This name is already in use."
+ body2 = "Please try another name."
+
+ Case MsgNAMELENGTH
+ header = "Invalid Name"
+ body = "This name is too short or too long."
+ body2 = "Please try another name."
+
+ Case MsgNAMEILLEGAL
+ header = "Invalid Name"
+ body = "This name contains illegal characters."
+ body2 = "Please try another name."
+
+ Case MsgMYSQL
+ header = "Connection Problem"
+ body = "Cannot connect to database."
+ body2 = "Please try again later."
+
+ Case MsgWRONGPASS
+ header = "Invalid Login"
+ body = "Invalid username or password."
+ body2 = "Please try again."
+
+ Case MsgACTIVATED
+ header = "Inactive Account"
+ body = "Your account is not activated."
+ body2 = "Please activate your account then try again."
+
+ Case MsgMERGE
+ header = "Successful Merge"
+ body = "Character merged with new account."
+ body2 = "Old account permanently destroyed."
+
+ Case MsgMAXCHARS
+ header = "Cannot Merge"
+ body = "You cannot merge a full account."
+ body2 = "Please clear a character slot."
+
+ Case MsgMERGENAME
+ header = "Cannot Merge"
+ body = "An existing character has this name."
+ body2 = "Please contact an administrator."
+
+ Case MsgDELCHAR
+ header = "Deleted Character"
+ body = "Your character was successfully deleted."
+ body2 = "Please log on to continue playing."
+ End Select
+
+ ' set the dialogue up!
+ Dialogue header, body, body2, TypeALERT
+End Sub
+
+Public Function hasProficiency(ByVal index As Long, ByVal proficiency As Long) As Boolean
+
+ Select Case proficiency
+
+ Case 0 ' None
+ hasProficiency = True
+ Exit Function
+
+ Case 1 ' Heavy
+
+ If GetPlayerClass(index) = 1 Then
+ hasProficiency = True
+ Exit Function
+ End If
+
+ Case 2 ' Light
+
+ If GetPlayerClass(index) = 2 Or GetPlayerClass(index) = 3 Then
+ hasProficiency = True
+ Exit Function
+ End If
+
+ End Select
+
+ hasProficiency = False
+End Function
+
+Public Function Clamp(ByVal value As Long, ByVal Min As Long, ByVal Max As Long) As Long
+ Clamp = value
+
+ If value < Min Then Clamp = Min
+ If value > Max Then Clamp = Max
+End Function
+
+Public Sub ShowClasses()
+ HideWindows
+ newCharClass = 1
+ newCharSprite = 1
+ newCharGender = SEX_MALE
+ Windows(GetWindowIndex("winClasses")).Controls(GetControlIndex("winClasses", "lblClassName")).text = Trim$(Class(newCharClass).name)
+ Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "txtName")).text = vbNullString
+ Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "chkMale")).value = 1
+ Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "chkFemale")).value = 0
+ ShowWindow GetWindowIndex("winClasses")
+End Sub
+
+Public Sub SetGoldLabel()
+Dim i As Long, amount As Long
+ amount = 0
+ For i = 1 To MAX_INV
+ If GetPlayerInvItemNum(MyIndex, i) = 1 Then
+ amount = GetPlayerInvItemValue(MyIndex, i)
+ End If
+ Next
+ Windows(GetWindowIndex("winShop")).Controls(GetControlIndex("winShop", "lblGold")).text = Format$(amount, "#,###,###,###") & "g"
+ Windows(GetWindowIndex("winInventory")).Controls(GetControlIndex("winInventory", "lblGold")).text = Format$(amount, "#,###,###,###") & "g"
+End Sub
+
+Public Sub ShowInvDesc(x As Long, y As Long, invNum As Long)
+Dim soulBound As Boolean
+
+ ' rte9
+ If invNum <= 0 Or invNum > MAX_INV Then Exit Sub
+
+ ' show
+ If GetPlayerInvItemNum(MyIndex, invNum) Then
+ If Item(GetPlayerInvItemNum(MyIndex, invNum)).BindType > 0 And PlayerInv(invNum).bound > 0 Then soulBound = True
+ ShowItemDesc x, y, GetPlayerInvItemNum(MyIndex, invNum), soulBound
+ End If
+End Sub
+
+Public Sub ShowShopDesc(x As Long, y As Long, itemNum As Long)
+ If itemNum <= 0 Or itemNum > MAX_ITEMS Then Exit Sub
+ ' show
+ ShowItemDesc x, y, itemNum, False
+End Sub
+
+Public Sub ShowEqDesc(x As Long, y As Long, eqNum As Long)
+Dim soulBound As Boolean
+
+ ' rte9
+ If eqNum <= 0 Or eqNum > Equipment.Equipment_Count - 1 Then Exit Sub
+
+ ' show
+ If Player(MyIndex).Equipment(eqNum) Then
+ If Item(Player(MyIndex).Equipment(eqNum)).BindType > 0 Then soulBound = True
+ ShowItemDesc x, y, Player(MyIndex).Equipment(eqNum), soulBound
+ End If
+End Sub
+
+Public Sub ShowPlayerSpellDesc(x As Long, y As Long, slotNum As Long)
+
+ ' rte9
+ If slotNum <= 0 Or slotNum > MAX_PLAYER_SPELLS Then Exit Sub
+
+ ' show
+ If PlayerSpells(slotNum).Spell Then
+ ShowSpellDesc x, y, PlayerSpells(slotNum).Spell, slotNum
+ End If
+End Sub
+
+Public Sub ShowSpellDesc(x As Long, y As Long, spellnum As Long, spellSlot As Long)
+Dim Colour As Long, theName As String, sUse As String, i As Long, barWidth As Long, tmpWidth As Long
+
+ ' set globals
+ descType = 2 ' spell
+ descItem = spellnum
+
+ ' set position
+ Windows(GetWindowIndex("winDescription")).Window.left = x
+ Windows(GetWindowIndex("winDescription")).Window.top = y
+
+ ' show the window
+ ShowWindow GetWindowIndex("winDescription"), , False
+
+ ' exit out early if last is same
+ If (descLastType = descType) And (descLastItem = descItem) Then Exit Sub
+
+ ' clear
+ ReDim descText(1 To 1) As TextColourRec
+
+ ' hide req. labels
+ Windows(GetWindowIndex("winDescription")).Controls(GetControlIndex("winDescription", "lblLevel")).visible = False
+ Windows(GetWindowIndex("winDescription")).Controls(GetControlIndex("winDescription", "picBar")).visible = True
+
+ ' set variables
+ With Windows(GetWindowIndex("winDescription"))
+ ' set name
+ .Controls(GetControlIndex("winDescription", "lblName")).text = Trim$(Spell(spellnum).name)
+ .Controls(GetControlIndex("winDescription", "lblName")).textColour = White
+
+ ' find ranks
+ If spellSlot > 0 Then
+ ' draw the rank bar
+ barWidth = 66
+ If Spell(spellnum).NextRank > 0 Then
+ tmpWidth = ((PlayerSpells(spellSlot).Uses / barWidth) / (Spell(spellnum).NextUses / barWidth)) * barWidth
+ Else
+ tmpWidth = 66
+ End If
+ .Controls(GetControlIndex("winDescription", "picBar")).value = tmpWidth
+ ' does it rank up?
+ If Spell(spellnum).NextRank > 0 Then
+ Colour = White
+ sUse = "Uses: " & PlayerSpells(spellSlot).Uses & "/" & Spell(spellnum).NextUses
+ If PlayerSpells(spellSlot).Uses = Spell(spellnum).NextUses Then
+ If Not GetPlayerLevel(MyIndex) >= Spell(Spell(spellnum).NextRank).LevelReq Then
+ Colour = BrightRed
+ sUse = "Lvl " & Spell(Spell(spellnum).NextRank).LevelReq & " req."
+ End If
+ End If
+ Else
+ Colour = Grey
+ sUse = "Max Rank"
+ End If
+ ' show controls
+ .Controls(GetControlIndex("winDescription", "lblClass")).visible = True
+ .Controls(GetControlIndex("winDescription", "picBar")).visible = True
+ 'set vals
+ .Controls(GetControlIndex("winDescription", "lblClass")).text = sUse
+ .Controls(GetControlIndex("winDescription", "lblClass")).textColour = Colour
+ Else
+ ' hide some controls
+ .Controls(GetControlIndex("winDescription", "lblClass")).visible = False
+ .Controls(GetControlIndex("winDescription", "picBar")).visible = False
+ End If
+ End With
+
+ Select Case Spell(spellnum).Type
+ Case SPELL_TYPE_DAMAGEHP
+ AddDescInfo "Damage HP"
+ Case SPELL_TYPE_DAMAGEMP
+ AddDescInfo "Damage SP"
+ Case SPELL_TYPE_HEALHP
+ AddDescInfo "Heal HP"
+ Case SPELL_TYPE_HEALMP
+ AddDescInfo "Heal SP"
+ Case SPELL_TYPE_WARP
+ AddDescInfo "Warp"
+ End Select
+
+ ' more info
+ Select Case Spell(spellnum).Type
+ Case SPELL_TYPE_DAMAGEHP, SPELL_TYPE_DAMAGEMP, SPELL_TYPE_HEALHP, SPELL_TYPE_HEALMP
+ ' damage
+ AddDescInfo "Vital: " & Spell(spellnum).Vital
+
+ ' mp cost
+ AddDescInfo "Cost: " & Spell(spellnum).MPCost & " SP"
+
+ ' cast time
+ AddDescInfo "Cast Time: " & Spell(spellnum).CastTime & "s"
+
+ ' cd time
+ AddDescInfo "Cooldown: " & Spell(spellnum).CDTime & "s"
+
+ ' aoe
+ If Spell(spellnum).AoE > 0 Then
+ AddDescInfo "AoE: " & Spell(spellnum).AoE
+ End If
+
+ ' stun
+ If Spell(spellnum).StunDuration > 0 Then
+ AddDescInfo "Stun: " & Spell(spellnum).StunDuration & "s"
+ End If
+
+ ' dot
+ If Spell(spellnum).Duration > 0 And Spell(spellnum).Interval > 0 Then
+ AddDescInfo "DoT: " & (Spell(spellnum).Duration / Spell(spellnum).Interval) & " tick"
+ End If
+ End Select
+End Sub
+
+Public Sub ShowItemDesc(x As Long, y As Long, itemNum As Long, soulBound As Boolean)
+Dim Colour As Long, theName As String, className As String, levelTxt As String, i As Long
+
+ ' set globals
+ descType = 1 ' inventory
+ descItem = itemNum
+
+ ' set position
+ Windows(GetWindowIndex("winDescription")).Window.left = x
+ Windows(GetWindowIndex("winDescription")).Window.top = y
+
+ ' show the window
+ ShowWindow GetWindowIndex("winDescription"), , False
+
+ ' exit out early if last is same
+ If (descLastType = descType) And (descLastItem = descItem) Then Exit Sub
+
+ ' set last to this
+ descLastType = descType
+ descLastItem = descItem
+
+ ' show req. labels
+ Windows(GetWindowIndex("winDescription")).Controls(GetControlIndex("winDescription", "lblClass")).visible = True
+ Windows(GetWindowIndex("winDescription")).Controls(GetControlIndex("winDescription", "lblLevel")).visible = True
+ Windows(GetWindowIndex("winDescription")).Controls(GetControlIndex("winDescription", "picBar")).visible = False
+
+ ' set variables
+ With Windows(GetWindowIndex("winDescription"))
+ ' name
+ If Not soulBound Then
+ theName = Trim$(Item(itemNum).name)
+ Else
+ theName = "(SB) " & Trim$(Item(itemNum).name)
+ End If
+ .Controls(GetControlIndex("winDescription", "lblName")).text = theName
+ Select Case Item(itemNum).Rarity
+ Case 0 ' white
+ Colour = White
+ Case 1 ' green
+ Colour = Green
+ Case 2 ' blue
+ Colour = BrightBlue
+ Case 3 ' maroon
+ Colour = Red
+ Case 4 ' purple
+ Colour = Pink
+ Case 5 ' orange
+ Colour = Brown
+ End Select
+ .Controls(GetControlIndex("winDescription", "lblName")).textColour = Colour
+ ' class req
+ If Item(itemNum).ClassReq > 0 Then
+ className = Trim$(Class(Item(itemNum).ClassReq).name)
+ ' do we match it?
+ If GetPlayerClass(MyIndex) = Item(itemNum).ClassReq Then
+ Colour = Green
+ Else
+ Colour = BrightRed
+ End If
+ ElseIf Item(itemNum).proficiency > 0 Then
+ Select Case Item(itemNum).proficiency
+ Case 1 ' Sword/Armour
+ If Item(itemNum).Type >= ITEM_TYPE_ARMOR And Item(itemNum).Type <= ITEM_TYPE_SHIELD Then
+ className = "Heavy Armour"
+ ElseIf Item(itemNum).Type = ITEM_TYPE_WEAPON Then
+ className = "Heavy Weapon"
+ End If
+ If hasProficiency(MyIndex, Item(itemNum).proficiency) Then
+ Colour = Green
+ Else
+ Colour = BrightRed
+ End If
+ Case 2 ' Staff/Cloth
+ If Item(itemNum).Type >= ITEM_TYPE_ARMOR And Item(itemNum).Type <= ITEM_TYPE_SHIELD Then
+ className = "Cloth Armour"
+ ElseIf Item(itemNum).Type = ITEM_TYPE_WEAPON Then
+ className = "Light Weapon"
+ End If
+ If hasProficiency(MyIndex, Item(itemNum).proficiency) Then
+ Colour = Green
+ Else
+ Colour = BrightRed
+ End If
+ End Select
+ Else
+ className = "No class req."
+ Colour = Green
+ End If
+ .Controls(GetControlIndex("winDescription", "lblClass")).text = className
+ .Controls(GetControlIndex("winDescription", "lblClass")).textColour = Colour
+ ' level
+ If Item(itemNum).LevelReq > 0 Then
+ levelTxt = "Level " & Item(itemNum).LevelReq
+ ' do we match it?
+ If GetPlayerLevel(MyIndex) >= Item(itemNum).LevelReq Then
+ Colour = Green
+ Else
+ Colour = BrightRed
+ End If
+ Else
+ levelTxt = "No level req."
+ Colour = Green
+ End If
+ .Controls(GetControlIndex("winDescription", "lblLevel")).text = levelTxt
+ .Controls(GetControlIndex("winDescription", "lblLevel")).textColour = Colour
+ End With
+
+ ' clear
+ ReDim descText(1 To 1) As TextColourRec
+
+ ' go through the rest of the text
+ Select Case Item(itemNum).Type
+ Case ITEM_TYPE_NONE
+ AddDescInfo "No type"
+ Case ITEM_TYPE_WEAPON
+ AddDescInfo "Weapon"
+ Case ITEM_TYPE_ARMOR
+ AddDescInfo "Armour"
+ Case ITEM_TYPE_HELMET
+ AddDescInfo "Helmet"
+ Case ITEM_TYPE_SHIELD
+ AddDescInfo "Shield"
+ Case ITEM_TYPE_CONSUME
+ AddDescInfo "Consume"
+ Case ITEM_TYPE_KEY
+ AddDescInfo "Key"
+ Case ITEM_TYPE_CURRENCY
+ AddDescInfo "Currency"
+ Case ITEM_TYPE_SPELL
+ AddDescInfo "Spell"
+ Case ITEM_TYPE_FOOD
+ AddDescInfo "Food"
+ End Select
+
+ ' more info
+ Select Case Item(itemNum).Type
+ Case ITEM_TYPE_NONE, ITEM_TYPE_KEY, ITEM_TYPE_CURRENCY
+ ' binding
+ If Item(itemNum).BindType = 1 Then
+ AddDescInfo "Bind on Pickup"
+ ElseIf Item(itemNum).BindType = 2 Then
+ AddDescInfo "Bind on Equip"
+ End If
+ ' price
+ AddDescInfo "Value: " & Item(itemNum).Price & "g"
+ Case ITEM_TYPE_WEAPON, ITEM_TYPE_ARMOR, ITEM_TYPE_HELMET, ITEM_TYPE_SHIELD
+ ' damage/defence
+ If Item(itemNum).Type = ITEM_TYPE_WEAPON Then
+ AddDescInfo "Damage: " & Item(itemNum).Data2
+ ' speed
+ AddDescInfo "Speed: " & (Item(itemNum).speed / 1000) & "s"
+ Else
+ If Item(itemNum).Data2 > 0 Then
+ AddDescInfo "Defence: " & Item(itemNum).Data2
+ End If
+ End If
+ ' binding
+ If Item(itemNum).BindType = 1 Then
+ AddDescInfo "Bind on Pickup"
+ ElseIf Item(itemNum).BindType = 2 Then
+ AddDescInfo "Bind on Equip"
+ End If
+ ' price
+ AddDescInfo "Value: " & Item(itemNum).Price & "g"
+ ' stat bonuses
+ If Item(itemNum).Add_Stat(Stats.Strength) > 0 Then
+ AddDescInfo "+" & Item(itemNum).Add_Stat(Stats.Strength) & " Str"
+ End If
+ If Item(itemNum).Add_Stat(Stats.Endurance) > 0 Then
+ AddDescInfo "+" & Item(itemNum).Add_Stat(Stats.Endurance) & " End"
+ End If
+ If Item(itemNum).Add_Stat(Stats.Intelligence) > 0 Then
+ AddDescInfo "+" & Item(itemNum).Add_Stat(Stats.Intelligence) & " Int"
+ End If
+ If Item(itemNum).Add_Stat(Stats.Agility) > 0 Then
+ AddDescInfo "+" & Item(itemNum).Add_Stat(Stats.Agility) & " Agi"
+ End If
+ If Item(itemNum).Add_Stat(Stats.Willpower) > 0 Then
+ AddDescInfo "+" & Item(itemNum).Add_Stat(Stats.Willpower) & " Will"
+ End If
+ Case ITEM_TYPE_CONSUME
+ If Item(itemNum).CastSpell > 0 Then
+ AddDescInfo "Casts Spell"
+ End If
+ If Item(itemNum).AddHP > 0 Then
+ AddDescInfo "+" & Item(itemNum).AddHP & " HP"
+ End If
+ If Item(itemNum).AddMP > 0 Then
+ AddDescInfo "+" & Item(itemNum).AddMP & " SP"
+ End If
+ If Item(itemNum).AddEXP > 0 Then
+ AddDescInfo "+" & Item(itemNum).AddEXP & " EXP"
+ End If
+ ' price
+ AddDescInfo "Value: " & Item(itemNum).Price & "g"
+ Case ITEM_TYPE_SPELL
+ ' price
+ AddDescInfo "Value: " & Item(itemNum).Price & "g"
+ Case ITEM_TYPE_FOOD
+ If Item(itemNum).HPorSP = 2 Then
+ AddDescInfo "Heal: " & (Item(itemNum).FoodPerTick * Item(itemNum).FoodTickCount) & " SP"
+ Else
+ AddDescInfo "Heal: " & (Item(itemNum).FoodPerTick * Item(itemNum).FoodTickCount) & " HP"
+ End If
+ ' time
+ AddDescInfo "Time: " & (Item(itemNum).FoodInterval * (Item(itemNum).FoodTickCount / 1000)) & "s"
+ ' price
+ AddDescInfo "Value: " & Item(itemNum).Price & "g"
+ End Select
+End Sub
+
+Public Sub AddDescInfo(text As String, Optional Colour As Long = White)
+Dim count As Long
+ count = UBound(descText)
+ ReDim Preserve descText(1 To count + 1) As TextColourRec
+ descText(count + 1).text = text
+ descText(count + 1).Colour = Colour
+End Sub
+
+Public Sub SwitchHotbar(oldSlot As Long, newSlot As Long)
+Dim oldSlot_type As Long, oldSlot_value As Long, newSlot_type As Long, newSlot_value As Long
+
+ oldSlot_type = Hotbar(oldSlot).sType
+ newSlot_type = Hotbar(newSlot).sType
+ oldSlot_value = Hotbar(oldSlot).Slot
+ newSlot_value = Hotbar(newSlot).Slot
+
+ ' send the changes
+ SendHotbarChange oldSlot_type, oldSlot_value, newSlot
+ SendHotbarChange newSlot_type, newSlot_value, oldSlot
+End Sub
+
+Public Sub ShowChat()
+ ShowWindow GetWindowIndex("winChat"), , False
+ HideWindow GetWindowIndex("winChatSmall")
+ ' Set the active control
+ activeWindow = GetWindowIndex("winChat")
+ SetActiveControl GetWindowIndex("winChat"), GetControlIndex("winChat", "txtChat")
+ inSmallChat = False
+ ChatScroll = 0
+End Sub
+
+Public Sub HideChat()
+ ShowWindow GetWindowIndex("winChatSmall"), , False
+ HideWindow GetWindowIndex("winChat")
+ inSmallChat = True
+ ChatScroll = 0
+End Sub
+
+Public Sub SetChatHeight(height As Long)
+ actChatHeight = height
+End Sub
+
+Public Sub SetChatWidth(width As Long)
+ actChatWidth = width
+End Sub
+
+Public Sub UpdateChat()
+ SaveOptions
+End Sub
+
+Sub OpenShop(shopNum As Long)
+ ' set globals
+ InShop = shopNum
+ shopSelectedSlot = 1
+ shopSelectedItem = Shop(InShop).TradeItem(1).Item
+ Windows(GetWindowIndex("winShop")).Controls(GetControlIndex("winShop", "chkSelling")).value = 0
+ Windows(GetWindowIndex("winShop")).Controls(GetControlIndex("winShop", "chkBuying")).value = 1
+ Windows(GetWindowIndex("winShop")).Controls(GetControlIndex("winShop", "btnSell")).visible = False
+ Windows(GetWindowIndex("winShop")).Controls(GetControlIndex("winShop", "btnBuy")).visible = True
+ shopIsSelling = False
+ ' set the current item
+ UpdateShop
+ ' show the window
+ ShowWindow GetWindowIndex("winShop")
+End Sub
+
+Sub CloseShop()
+ SendCloseShop
+ HideWindow GetWindowIndex("winShop")
+ shopSelectedSlot = 0
+ shopSelectedItem = 0
+ shopIsSelling = False
+ InShop = 0
+End Sub
+
+Sub UpdateShop()
+Dim i As Long, CostValue As Long
+
+ If InShop = 0 Then Exit Sub
+
+ ' make sure we have an item selected
+ If shopSelectedSlot = 0 Then shopSelectedSlot = 1
+
+ With Windows(GetWindowIndex("winShop"))
+ ' buying items
+ If Not shopIsSelling Then
+ shopSelectedItem = Shop(InShop).TradeItem(shopSelectedSlot).Item
+ ' labels
+ If shopSelectedItem > 0 Then
+ .Controls(GetControlIndex("winShop", "lblName")).text = Trim$(Item(shopSelectedItem).name)
+ ' check if it's gold
+ If Shop(InShop).TradeItem(shopSelectedSlot).CostItem = 1 Then
+ ' it's gold
+ .Controls(GetControlIndex("winShop", "lblCost")).text = Shop(InShop).TradeItem(shopSelectedSlot).CostValue & "g"
+ Else
+ ' if it's one then just print the name
+ If Shop(InShop).TradeItem(shopSelectedSlot).CostValue = 1 Then
+ .Controls(GetControlIndex("winShop", "lblCost")).text = Trim$(Item(Shop(InShop).TradeItem(shopSelectedSlot).CostItem).name)
+ Else
+ .Controls(GetControlIndex("winShop", "lblCost")).text = Shop(InShop).TradeItem(shopSelectedSlot).CostValue & " " & Trim$(Item(Shop(InShop).TradeItem(shopSelectedSlot).CostItem).name)
+ End If
+ End If
+ ' draw the item
+ For i = 0 To 5
+ .Controls(GetControlIndex("winShop", "picItem")).image(i) = Tex_Item(Item(shopSelectedItem).Pic)
+ Next
+ Else
+ .Controls(GetControlIndex("winShop", "lblName")).text = "Empty Slot"
+ .Controls(GetControlIndex("winShop", "lblCost")).text = vbNullString
+ ' draw the item
+ For i = 0 To 5
+ .Controls(GetControlIndex("winShop", "picItem")).image(i) = 0
+ Next
+ End If
+ Else
+ shopSelectedItem = GetPlayerInvItemNum(MyIndex, shopSelectedSlot)
+ ' labels
+ If shopSelectedItem > 0 Then
+ .Controls(GetControlIndex("winShop", "lblName")).text = Trim$(Item(shopSelectedItem).name)
+ ' calc cost
+ CostValue = (Item(shopSelectedItem).Price / 100) * Shop(InShop).BuyRate
+ .Controls(GetControlIndex("winShop", "lblCost")).text = CostValue & "g"
+ ' draw the item
+ For i = 0 To 5
+ .Controls(GetControlIndex("winShop", "picItem")).image(i) = Tex_Item(Item(shopSelectedItem).Pic)
+ Next
+ Else
+ .Controls(GetControlIndex("winShop", "lblName")).text = "Empty Slot"
+ .Controls(GetControlIndex("winShop", "lblCost")).text = vbNullString
+ ' draw the item
+ For i = 0 To 5
+ .Controls(GetControlIndex("winShop", "picItem")).image(i) = 0
+ Next
+ End If
+ End If
+ End With
+End Sub
+
+Public Function IsShopSlot(startX As Long, startY As Long) As Long
+Dim tempRec As RECT
+Dim i As Long
+
+ For i = 1 To MAX_TRADES
+ With tempRec
+ .top = startY + ShopTop + ((ShopOffsetY + 32) * ((i - 1) \ ShopColumns))
+ .bottom = .top + PIC_Y
+ .left = startX + ShopLeft + ((ShopOffsetX + 32) * (((i - 1) Mod ShopColumns)))
+ .Right = .left + PIC_X
+ End With
+
+ If currMouseX >= tempRec.left And currMouseX <= tempRec.Right Then
+ If currMouseY >= tempRec.top And currMouseY <= tempRec.bottom Then
+ IsShopSlot = i
+ Exit Function
+ End If
+ End If
+ Next
+End Function
+
+Sub ShowPlayerMenu(index As Long, x As Long, y As Long)
+ PlayerMenuIndex = index
+ If PlayerMenuIndex = 0 Then Exit Sub
+ Windows(GetWindowIndex("winPlayerMenu")).Window.left = x - 5
+ Windows(GetWindowIndex("winPlayerMenu")).Window.top = y - 5
+ Windows(GetWindowIndex("winPlayerMenu")).Controls(GetControlIndex("winPlayerMenu", "btnName")).text = Trim$(GetPlayerName(PlayerMenuIndex))
+ ShowWindow GetWindowIndex("winRightClickBG")
+ ShowWindow GetWindowIndex("winPlayerMenu"), , False
+End Sub
+
+Public Function AryCount(ByRef Ary() As Byte) As Long
+On Error Resume Next
+
+ AryCount = UBound(Ary) + 1
+End Function
+
+Public Function ByteToInt(ByVal B1 As Long, ByVal B2 As Long) As Long
+ ByteToInt = B1 * 256 + B2
+End Function
+
+Sub UpdateStats_UI()
+ ' set the bar labels
+ With Windows(GetWindowIndex("winBars"))
+ .Controls(GetControlIndex("winBars", "lblHP")).text = GetPlayerVital(MyIndex, HP) & "/" & GetPlayerMaxVital(MyIndex, HP)
+ .Controls(GetControlIndex("winBars", "lblMP")).text = GetPlayerVital(MyIndex, MP) & "/" & GetPlayerMaxVital(MyIndex, MP)
+ .Controls(GetControlIndex("winBars", "lblEXP")).text = GetPlayerExp(MyIndex) & "/" & TNL
+ End With
+ ' update character screen
+ With Windows(GetWindowIndex("winCharacter"))
+ .Controls(GetControlIndex("winCharacter", "lblHealth")).text = "Health: " & GetPlayerVital(MyIndex, HP) & "/" & GetPlayerMaxVital(MyIndex, HP)
+ .Controls(GetControlIndex("winCharacter", "lblSpirit")).text = "Spirit: " & GetPlayerVital(MyIndex, MP) & "/" & GetPlayerMaxVital(MyIndex, MP)
+ .Controls(GetControlIndex("winCharacter", "lblExperience")).text = "Experience: " & Player(MyIndex).EXP & "/" & TNL
+ End With
+End Sub
+
+Sub UpdatePartyInterface()
+Dim i As Long, image(0 To 5) As Long, x As Long, pIndex As Long, height As Long, cIn As Long
+
+ ' unload it if we're not in a party
+ If Party.Leader = 0 Then
+ HideWindow GetWindowIndex("winParty")
+ Exit Sub
+ End If
+
+ ' load the window
+ ShowWindow GetWindowIndex("winParty")
+ ' fill the controls
+ With Windows(GetWindowIndex("winParty"))
+ ' clear controls first
+ For i = 1 To 3
+ .Controls(GetControlIndex("winParty", "lblName" & i)).text = vbNullString
+ .Controls(GetControlIndex("winParty", "picEmptyBar_HP" & i)).visible = False
+ .Controls(GetControlIndex("winParty", "picEmptyBar_SP" & i)).visible = False
+ .Controls(GetControlIndex("winParty", "picBar_HP" & i)).visible = False
+ .Controls(GetControlIndex("winParty", "picBar_SP" & i)).visible = False
+ .Controls(GetControlIndex("winParty", "picShadow" & i)).visible = False
+ .Controls(GetControlIndex("winParty", "picChar" & i)).visible = False
+ .Controls(GetControlIndex("winParty", "picChar" & i)).value = 0
+ Next
+ ' labels
+ cIn = 1
+ For i = 1 To Party.MemberCount
+ ' cache the index
+ pIndex = Party.Member(i)
+ If pIndex > 0 Then
+ If pIndex <> MyIndex Then
+ If IsPlaying(pIndex) Then
+ ' name and level
+ .Controls(GetControlIndex("winParty", "lblName" & cIn)).visible = True
+ .Controls(GetControlIndex("winParty", "lblName" & cIn)).text = Trim$(GetPlayerName(pIndex))
+ ' picture
+ .Controls(GetControlIndex("winParty", "picShadow" & cIn)).visible = True
+ .Controls(GetControlIndex("winParty", "picChar" & cIn)).visible = True
+ ' store the player's index as a value for later use
+ .Controls(GetControlIndex("winParty", "picChar" & cIn)).value = pIndex
+ For x = 0 To 5
+ .Controls(GetControlIndex("winParty", "picChar" & cIn)).image(x) = Tex_Char(GetPlayerSprite(pIndex))
+ Next
+ ' bars
+ .Controls(GetControlIndex("winParty", "picEmptyBar_HP" & cIn)).visible = True
+ .Controls(GetControlIndex("winParty", "picEmptyBar_SP" & cIn)).visible = True
+ .Controls(GetControlIndex("winParty", "picBar_HP" & cIn)).visible = True
+ .Controls(GetControlIndex("winParty", "picBar_SP" & cIn)).visible = True
+ ' increment control usage
+ cIn = cIn + 1
+ End If
+ End If
+ End If
+ Next
+ ' update the bars
+ UpdatePartyBars
+ ' set the window size
+ Select Case Party.MemberCount
+ Case 2: height = 78
+ Case 3: height = 118
+ Case 4: height = 158
+ End Select
+ .Window.height = height
+ End With
+End Sub
+
+Sub UpdatePartyBars()
+Dim i As Long, pIndex As Long, barWidth As Long, width As Long
+
+ ' unload it if we're not in a party
+ If Party.Leader = 0 Then
+ Exit Sub
+ End If
+
+ ' max bar width
+ barWidth = 173
+
+ ' make sure we're in a party
+ With Windows(GetWindowIndex("winParty"))
+ For i = 1 To 3
+ ' get the pIndex from the control
+ If .Controls(GetControlIndex("winParty", "picChar" & i)).visible = True Then
+ pIndex = .Controls(GetControlIndex("winParty", "picChar" & i)).value
+ ' make sure they exist
+ If pIndex > 0 Then
+ If IsPlaying(pIndex) Then
+ ' get their health
+ If GetPlayerVital(pIndex, HP) > 0 And GetPlayerMaxVital(pIndex, HP) > 0 Then
+ width = ((GetPlayerVital(pIndex, Vitals.HP) / barWidth) / (GetPlayerMaxVital(pIndex, Vitals.HP) / barWidth)) * barWidth
+ .Controls(GetControlIndex("winParty", "picBar_HP" & i)).width = width
+ Else
+ .Controls(GetControlIndex("winParty", "picBar_HP" & i)).width = 0
+ End If
+ ' get their spirit
+ If GetPlayerVital(pIndex, MP) > 0 And GetPlayerMaxVital(pIndex, MP) > 0 Then
+ width = ((GetPlayerVital(pIndex, Vitals.MP) / barWidth) / (GetPlayerMaxVital(pIndex, Vitals.MP) / barWidth)) * barWidth
+ .Controls(GetControlIndex("winParty", "picBar_SP" & i)).width = width
+ Else
+ .Controls(GetControlIndex("winParty", "picBar_SP" & i)).width = 0
+ End If
+ End If
+ End If
+ End If
+ Next
+ End With
+End Sub
+
+Sub ShowTrade()
+ ' show the window
+ ShowWindow GetWindowIndex("winTrade")
+ ' set the controls up
+ With Windows(GetWindowIndex("winTrade"))
+ .Window.text = "Trading with " & Trim$(GetPlayerName(InTrade))
+ .Controls(GetControlIndex("winTrade", "lblYourTrade")).text = Trim$(GetPlayerName(MyIndex)) & "'s Offer"
+ .Controls(GetControlIndex("winTrade", "lblTheirTrade")).text = Trim$(GetPlayerName(InTrade)) & "'s Offer"
+ .Controls(GetControlIndex("winTrade", "lblYourValue")).text = "0g"
+ .Controls(GetControlIndex("winTrade", "lblTheirValue")).text = "0g"
+ .Controls(GetControlIndex("winTrade", "lblStatus")).text = "Choose items to offer."
+ End With
+End Sub
+
+Sub CheckResolution()
+Dim Resolution As Byte, width As Long, height As Long
+ ' find the selected resolution
+ Resolution = Options.Resolution
+ ' reset
+ If Resolution = 0 Then
+ Resolution = 12
+ ' loop through till we find one which fits
+ Do Until ScreenFit(Resolution) Or Resolution > RES_COUNT
+ ScreenFit Resolution
+ Resolution = Resolution + 1
+ DoEvents
+ Loop
+ ' right resolution
+ If Resolution > RES_COUNT Then Resolution = RES_COUNT
+ Options.Resolution = Resolution
+ End If
+
+ ' size the window
+ GetResolutionSize Options.Resolution, width, height
+ Resize width, height
+
+ ' save it
+ curResolution = Options.Resolution
+
+ SaveOptions
+End Sub
+
+Function ScreenFit(Resolution As Byte) As Boolean
+Dim sWidth As Long, sHeight As Long, width As Long, height As Long
+
+ ' exit out early
+ If Resolution = 0 Then
+ ScreenFit = False
+ Exit Function
+ End If
+
+ ' get screen size
+ sWidth = Screen.width / Screen.TwipsPerPixelX
+ sHeight = Screen.height / Screen.TwipsPerPixelY
+
+ GetResolutionSize Resolution, width, height
+
+ ' check if match
+ If width > sWidth Or height > sHeight Then
+ ScreenFit = False
+ Else
+ ScreenFit = True
+ End If
+End Function
+
+Function GetResolutionSize(Resolution As Byte, ByRef width As Long, ByRef height As Long)
+ Select Case Resolution
+ Case 1
+ width = 1920
+ height = 1080
+ Case 2
+ width = 1680
+ height = 1050
+ Case 3
+ width = 1600
+ height = 900
+ Case 4
+ width = 1440
+ height = 900
+ Case 5
+ width = 1440
+ height = 1050
+ Case 6
+ width = 1366
+ height = 768
+ Case 7
+ width = 1360
+ height = 1024
+ Case 8
+ width = 1360
+ height = 768
+ Case 9
+ width = 1280
+ height = 1024
+ Case 10
+ width = 1280
+ height = 800
+ Case 11
+ width = 1280
+ height = 768
+ Case 12
+ width = 1280
+ height = 720
+ Case 13
+ width = 1024
+ height = 768
+ Case 14
+ width = 1024
+ height = 576
+ Case 15
+ width = 800
+ height = 600
+ Case 16
+ width = 800
+ height = 450
+ End Select
+End Function
+
+Sub Resize(ByVal width As Long, ByVal height As Long)
+ frmMain.width = (frmMain.width \ 15 - frmMain.ScaleWidth + width) * 15
+ frmMain.height = (frmMain.height \ 15 - frmMain.ScaleHeight + height) * 15
+ frmMain.left = (Screen.width - frmMain.width) \ 2
+ frmMain.top = (Screen.height - frmMain.height) \ 2
+ DoEvents
+End Sub
+
+Sub ResizeGUI()
+Dim top As Long
+
+ ' move hotbar
+ Windows(GetWindowIndex("winHotbar")).Window.left = ScreenWidth - 430
+ ' move chat
+ Windows(GetWindowIndex("winChat")).Window.top = ScreenHeight - 178
+ Windows(GetWindowIndex("winChatSmall")).Window.top = ScreenHeight - 162
+ ' move menu
+ Windows(GetWindowIndex("winMenu")).Window.left = ScreenWidth - 236
+ Windows(GetWindowIndex("winMenu")).Window.top = ScreenHeight - 37
+ ' move invitations
+ Windows(GetWindowIndex("winInvite_Party")).Window.left = ScreenWidth - 234
+ Windows(GetWindowIndex("winInvite_Party")).Window.top = ScreenHeight - 80
+ ' loop through
+ top = ScreenHeight - 80
+ If Windows(GetWindowIndex("winInvite_Party")).Window.visible Then
+ top = top - 37
+ End If
+ Windows(GetWindowIndex("winInvite_Trade")).Window.left = ScreenWidth - 234
+ Windows(GetWindowIndex("winInvite_Trade")).Window.top = top
+ ' re-size right-click background
+ Windows(GetWindowIndex("winRightClickBG")).Window.width = ScreenWidth
+ Windows(GetWindowIndex("winRightClickBG")).Window.height = ScreenHeight
+ ' re-size black background
+ Windows(GetWindowIndex("winBlank")).Window.width = ScreenWidth
+ Windows(GetWindowIndex("winBlank")).Window.height = ScreenHeight
+ ' re-size combo background
+ Windows(GetWindowIndex("winComboMenuBG")).Window.width = ScreenWidth
+ Windows(GetWindowIndex("winComboMenuBG")).Window.height = ScreenHeight
+ ' centralise windows
+ CentraliseWindow GetWindowIndex("winLogin")
+ CentraliseWindow GetWindowIndex("winCharacters")
+ CentraliseWindow GetWindowIndex("winLoading")
+ CentraliseWindow GetWindowIndex("winDialogue")
+ CentraliseWindow GetWindowIndex("winClasses")
+ CentraliseWindow GetWindowIndex("winNewChar")
+ CentraliseWindow GetWindowIndex("winEscMenu")
+ CentraliseWindow GetWindowIndex("winInventory")
+ CentraliseWindow GetWindowIndex("winCharacter")
+ CentraliseWindow GetWindowIndex("winSkills")
+ CentraliseWindow GetWindowIndex("winOptions")
+ CentraliseWindow GetWindowIndex("winShop")
+ CentraliseWindow GetWindowIndex("winNpcChat")
+ CentraliseWindow GetWindowIndex("winTrade")
+ CentraliseWindow GetWindowIndex("winGuild")
+End Sub
+
+Sub SetResolution()
+Dim width As Long, height As Long
+ curResolution = Options.Resolution
+ GetResolutionSize curResolution, width, height
+ Resize width, height
+ ScreenWidth = width
+ ScreenHeight = height
+ TileWidth = (width / 32) - 1
+ TileHeight = (height / 32) - 1
+ ScreenX = (TileWidth) * PIC_X
+ ScreenY = (TileHeight) * PIC_Y
+ ResetGFX
+ ResizeGUI
+End Sub
+
+Sub ShowComboMenu(curWindow As Long, curControl As Long)
+Dim top As Long
+ With Windows(curWindow).Controls(curControl)
+ ' linked to
+ Windows(GetWindowIndex("winComboMenu")).Window.linkedToWin = curWindow
+ Windows(GetWindowIndex("winComboMenu")).Window.linkedToCon = curControl
+ ' set the size
+ Windows(GetWindowIndex("winComboMenu")).Window.height = 2 + (UBound(.list) * 16)
+ Windows(GetWindowIndex("winComboMenu")).Window.left = Windows(curWindow).Window.left + .left + 2
+ top = Windows(curWindow).Window.top + .top + .height
+ If top + Windows(GetWindowIndex("winComboMenu")).Window.height > ScreenHeight Then top = ScreenHeight - Windows(GetWindowIndex("winComboMenu")).Window.height
+ Windows(GetWindowIndex("winComboMenu")).Window.top = top
+ Windows(GetWindowIndex("winComboMenu")).Window.width = .width - 4
+ ' set the values
+ Windows(GetWindowIndex("winComboMenu")).Window.list() = .list()
+ Windows(GetWindowIndex("winComboMenu")).Window.value = .value
+ Windows(GetWindowIndex("winComboMenu")).Window.group = 0
+ ' load the menu
+ ShowWindow GetWindowIndex("winComboMenuBG"), True, False
+ ShowWindow GetWindowIndex("winComboMenu"), True, False
+ End With
+End Sub
+
+Sub ComboMenu_MouseMove(curWindow As Long)
+Dim y As Long, i As Long
+ With Windows(curWindow).Window
+ y = currMouseY - .top
+ ' find the option we're hovering over
+ If UBound(.list) > 0 Then
+ For i = 1 To UBound(.list)
+ If y >= (16 * (i - 1)) And y <= (16 * (i)) Then
+ .group = i
+ End If
+ Next
+ End If
+ End With
+End Sub
+
+Sub ComboMenu_MouseDown(curWindow As Long)
+Dim y As Long, i As Long
+ With Windows(curWindow).Window
+ y = currMouseY - .top
+ ' find the option we're hovering over
+ If UBound(.list) > 0 Then
+ For i = 1 To UBound(.list)
+ If y >= (16 * (i - 1)) And y <= (16 * (i)) Then
+ Windows(.linkedToWin).Controls(.linkedToCon).value = i
+ CloseComboMenu
+ End If
+ Next
+ End If
+ End With
+End Sub
+
+Sub SetOptionsScreen()
+ ' clear the combolists
+ Erase Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "cmbRes")).list
+ ReDim Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "cmbRes")).list(0)
+ Erase Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "cmbRender")).list
+ ReDim Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "cmbRender")).list(0)
+
+ ' Resolutions
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1920x1080"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1680x1050"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1600x900"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1440x900"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1440x1050"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1366x768"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1360x1024"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1360x768"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1280x1024"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1280x800"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1280x768"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1280x720"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1024x768"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "1024x576"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "800x600"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRes"), "800x450"
+
+ ' Render Options
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRender"), "Automatic"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRender"), "Hardware"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRender"), "Mixed"
+ Combobox_AddItem GetWindowIndex("winOptions"), GetControlIndex("winOptions", "cmbRender"), "Software"
+
+ ' fill the options screen
+ With Windows(GetWindowIndex("winOptions"))
+ .Controls(GetControlIndex("winOptions", "chkMusic")).value = Options.Music
+ .Controls(GetControlIndex("winOptions", "chkSound")).value = Options.sound
+ If Options.NoAuto = 1 Then
+ .Controls(GetControlIndex("winOptions", "chkAutotiles")).value = 0
+ Else
+ .Controls(GetControlIndex("winOptions", "chkAutotiles")).value = 1
+ End If
+ .Controls(GetControlIndex("winOptions", "chkFullscreen")).value = Options.Fullscreen
+ .Controls(GetControlIndex("winOptions", "cmbRes")).value = Options.Resolution
+ .Controls(GetControlIndex("winOptions", "cmbRender")).value = Options.Render + 1
+ End With
+End Sub
+
+Sub EventLogic()
+Dim target As Long
+ ' carry out the command
+ With map.TileData.Events(eventNum).EventPage(eventPageNum)
+ Select Case .Commands(eventCommandNum).Type
+ Case EventType.evAddText
+ AddText .Commands(eventCommandNum).text, .Commands(eventCommandNum).Colour, , .Commands(eventCommandNum).channel
+ Case EventType.evShowChatBubble
+ If .Commands(eventCommandNum).TargetType = TARGET_TYPE_PLAYER Then target = MyIndex Else target = .Commands(eventCommandNum).target
+ AddChatBubble target, .Commands(eventCommandNum).TargetType, .Commands(eventCommandNum).text, .Commands(eventCommandNum).Colour
+ Case EventType.evPlayerVar
+ If .Commands(eventCommandNum).target > 0 Then Player(MyIndex).Variable(.Commands(eventCommandNum).target) = .Commands(eventCommandNum).Colour
+ End Select
+ ' increment commands
+ If eventCommandNum < .CommandCount Then
+ eventCommandNum = eventCommandNum + 1
+ Exit Sub
+ End If
+ End With
+ ' we're done - close event
+ eventNum = 0
+ eventPageNum = 0
+ eventCommandNum = 0
+ inEvent = False
+End Sub
+
+Function HasItem(ByVal itemNum As Long) As Long
+ Dim i As Long
+
+ For i = 1 To MAX_INV
+ ' Check to see if the player has the item
+ If GetPlayerInvItemNum(MyIndex, i) = itemNum Then
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ HasItem = GetPlayerInvItemValue(MyIndex, i)
+ Else
+ HasItem = 1
+ End If
+ Exit Function
+ End If
+ Next
+End Function
+
+Function ActiveEventPage(ByVal eventNum As Long) As Long
+Dim x As Long, process As Boolean
+ For x = map.TileData.Events(eventNum).pageCount To 1 Step -1
+ ' check if we match
+ With map.TileData.Events(eventNum).EventPage(x)
+ process = True
+ ' player var check
+ If .chkPlayerVar Then
+ If .PlayerVarNum > 0 Then
+ If Player(MyIndex).Variable(.PlayerVarNum) < .PlayerVariable Then
+ process = False
+ End If
+ End If
+ End If
+ ' has item check
+ If .chkHasItem Then
+ If .HasItemNum > 0 Then
+ If HasItem(.HasItemNum) = 0 Then
+ process = False
+ End If
+ End If
+ End If
+ ' this page
+ If process = True Then
+ ActiveEventPage = x
+ Exit Function
+ End If
+ End With
+ Next
+End Function
+
+Sub PlayerSwitchInvSlots(ByVal oldSlot As Long, ByVal newSlot As Long)
+Dim OldNum As Long, OldValue As Long, oldBound As Byte
+Dim NewNum As Long, NewValue As Long, newBound As Byte
+
+ If oldSlot = 0 Or newSlot = 0 Then
+ Exit Sub
+ End If
+
+ OldNum = GetPlayerInvItemNum(MyIndex, oldSlot)
+ OldValue = GetPlayerInvItemValue(MyIndex, oldSlot)
+ oldBound = PlayerInv(oldSlot).bound
+ NewNum = GetPlayerInvItemNum(MyIndex, newSlot)
+ NewValue = GetPlayerInvItemValue(MyIndex, newSlot)
+ newBound = PlayerInv(newSlot).bound
+
+ SetPlayerInvItemNum MyIndex, newSlot, OldNum
+ SetPlayerInvItemValue MyIndex, newSlot, OldValue
+ PlayerInv(newSlot).bound = oldBound
+
+ SetPlayerInvItemNum MyIndex, oldSlot, NewNum
+ SetPlayerInvItemValue MyIndex, oldSlot, NewValue
+ PlayerInv(oldSlot).bound = newBound
+End Sub
+
+Sub PlayerSwitchSpellSlots(ByVal oldSlot As Long, ByVal newSlot As Long)
+Dim OldNum As Long, NewNum As Long, OldUses As Long, NewUses As Long
+
+ If oldSlot = 0 Or newSlot = 0 Then
+ Exit Sub
+ End If
+
+ OldNum = PlayerSpells(oldSlot).Spell
+ NewNum = PlayerSpells(newSlot).Spell
+ OldUses = PlayerSpells(oldSlot).Uses
+ NewUses = PlayerSpells(newSlot).Uses
+
+ PlayerSpells(oldSlot).Spell = NewNum
+ PlayerSpells(oldSlot).Uses = NewUses
+ PlayerSpells(newSlot).Spell = OldNum
+ PlayerSpells(newSlot).Uses = OldUses
+End Sub
+
+Sub CheckAppearTiles()
+Dim x As Long, y As Long, i As Long
+ If GettingMap Then Exit Sub
+
+ ' clear
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_APPEAR Then
+ TempTile(x, y).DoorOpen = 0
+ End If
+ Next
+ Next
+
+ ' set
+ For i = 1 To MAX_PLAYERS
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ x = GetPlayerX(i)
+ y = GetPlayerY(i)
+ CheckAppearTile x, y
+ If y - 1 >= 0 Then CheckAppearTile x, y - 1
+ If y + 1 <= map.MapData.MaxY Then CheckAppearTile x, y + 1
+ If x - 1 >= 0 Then CheckAppearTile x - 1, y
+ If x + 1 <= map.MapData.MaxX Then CheckAppearTile x + 1, y
+ End If
+ End If
+ Next
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(i).num > 0 Then
+ If MapNpc(i).Vital(Vitals.HP) > 0 Then
+ x = MapNpc(i).x
+ y = MapNpc(i).y
+ CheckAppearTile x, y
+ If y - 1 >= 0 Then CheckAppearTile x, y - 1
+ If y + 1 <= map.MapData.MaxY Then CheckAppearTile x, y + 1
+ If x - 1 >= 0 Then CheckAppearTile x - 1, y
+ If x + 1 <= map.MapData.MaxX Then CheckAppearTile x + 1, y
+ End If
+ End If
+ Next
+
+ ' fade out old
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ If TempTile(x, y).DoorOpen = 0 Then
+ ' exit if our mother is a bottom
+ If y > 0 Then
+ If map.TileData.Tile(x, y - 1).Data2 Then
+ If TempTile(x, y - 1).DoorOpen = 1 Then GoTo continueLoop
+ End If
+ End If
+ ' not open - fade them out
+ For i = 1 To MapLayer.Layer_Count - 1
+ If TempTile(x, y).fadeAlpha(i) > 0 Then
+ TempTile(x, y).isFading(i) = True
+ TempTile(x, y).fadeAlpha(i) = TempTile(x, y).fadeAlpha(i) - 1
+ TempTile(x, y).FadeDir(i) = DIR_DOWN
+ End If
+ Next
+ End If
+continueLoop:
+ Next
+ Next
+End Sub
+
+Sub CheckAppearTile(ByVal x As Long, ByVal y As Long)
+ If y < 0 Or x < 0 Or y > map.MapData.MaxY Or x > map.MapData.MaxX Then Exit Sub
+
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_APPEAR Then
+ TempTile(x, y).DoorOpen = 1
+
+ If TempTile(x, y).fadeAlpha(MapLayer.Mask) = 255 Then Exit Sub
+ If TempTile(x, y).isFading(MapLayer.Mask) Then
+ If TempTile(x, y).FadeDir(MapLayer.Mask) = DIR_DOWN Then
+ TempTile(x, y).FadeDir(MapLayer.Mask) = DIR_UP
+ ' check if bottom
+ If y < map.MapData.MaxY Then
+ If map.TileData.Tile(x, y).Data2 Then
+ TempTile(x, y + 1).FadeDir(MapLayer.Ground) = DIR_UP
+ End If
+ End If
+ ' / bottom
+ End If
+ Exit Sub
+ End If
+
+ TempTile(x, y).FadeDir(MapLayer.Mask) = DIR_UP
+ TempTile(x, y).isFading(MapLayer.Mask) = True
+ TempTile(x, y).fadeAlpha(MapLayer.Mask) = TempTile(x, y).fadeAlpha(MapLayer.Mask) + 1
+
+ ' check if bottom
+ If y < map.MapData.MaxY Then
+ If map.TileData.Tile(x, y).Data2 Then
+ TempTile(x, y + 1).FadeDir(MapLayer.Ground) = DIR_UP
+ TempTile(x, y + 1).isFading(MapLayer.Ground) = True
+ TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) = TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) + 1
+ End If
+ End If
+ ' / bottom
+ End If
+End Sub
+
+Public Sub AppearTileFadeLogic()
+Dim x As Long, y As Long
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ If map.TileData.Tile(x, y).Type = TILE_TYPE_APPEAR Then
+ ' check if it's fading
+ If TempTile(x, y).isFading(MapLayer.Mask) Then
+ ' fading in
+ If TempTile(x, y).FadeDir(MapLayer.Mask) = DIR_UP Then
+ If TempTile(x, y).fadeAlpha(MapLayer.Mask) < 255 Then
+ TempTile(x, y).fadeAlpha(MapLayer.Mask) = TempTile(x, y).fadeAlpha(MapLayer.Mask) + 20
+ ' check if bottom
+ If y < map.MapData.MaxY Then
+ If map.TileData.Tile(x, y).Data2 Then
+ TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) = TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) + 20
+ End If
+ End If
+ ' / bottom
+ End If
+ If TempTile(x, y).fadeAlpha(MapLayer.Mask) >= 255 Then
+ TempTile(x, y).fadeAlpha(MapLayer.Mask) = 255
+ TempTile(x, y).isFading(MapLayer.Mask) = False
+ ' check if bottom
+ If y < map.MapData.MaxY Then
+ If map.TileData.Tile(x, y).Data2 Then
+ TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) = 255
+ TempTile(x, y + 1).isFading(MapLayer.Ground) = False
+ End If
+ End If
+ ' / bottom
+ End If
+ ElseIf TempTile(x, y).FadeDir(MapLayer.Mask) = DIR_DOWN Then
+ If TempTile(x, y).fadeAlpha(MapLayer.Mask) > 0 Then
+ TempTile(x, y).fadeAlpha(MapLayer.Mask) = TempTile(x, y).fadeAlpha(MapLayer.Mask) - 20
+ ' check if bottom
+ If y < map.MapData.MaxY Then
+ If map.TileData.Tile(x, y).Data2 Then
+ TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) = TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) - 20
+ End If
+ End If
+ ' / bottom
+ End If
+ If TempTile(x, y).fadeAlpha(MapLayer.Mask) <= 0 Then
+ TempTile(x, y).fadeAlpha(MapLayer.Mask) = 0
+ TempTile(x, y).isFading(MapLayer.Mask) = False
+ ' check if bottom
+ If y < map.MapData.MaxY Then
+ If map.TileData.Tile(x, y).Data2 Then
+ TempTile(x, y + 1).fadeAlpha(MapLayer.Ground) = 0
+ TempTile(x, y + 1).isFading(MapLayer.Ground) = False
+ End If
+ End If
+ ' / bottom
+ End If
+ End If
+ End If
+ End If
+ Next
+ Next
+End Sub
diff --git a/client/src/modGeneral.bas b/client/src/modGeneral.bas
new file mode 100644
index 0000000..7af4f79
--- /dev/null
+++ b/client/src/modGeneral.bas
@@ -0,0 +1,288 @@
+Attribute VB_Name = "modGeneral"
+Option Explicit
+' halts thread of execution
+Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+' get system uptime in milliseconds
+Public Declare Function GetTickCount Lib "kernel32" () As Long
+'For Clear functions
+Public Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal length As Long)
+
+Public Sub Main()
+Dim i As Long
+ InitCRC32
+ ' Check if the directory is there, if its not make it
+ ChkDir App.path & "\data files\", "graphics"
+ ChkDir App.path & "\data files\graphics\", "animations"
+ ChkDir App.path & "\data files\graphics\", "characters"
+ ChkDir App.path & "\data files\graphics\", "items"
+ ChkDir App.path & "\data files\graphics\", "paperdolls"
+ ChkDir App.path & "\data files\graphics\", "resources"
+ ChkDir App.path & "\data files\graphics\", "spellicons"
+ ChkDir App.path & "\data files\graphics\", "tilesets"
+ ChkDir App.path & "\data files\graphics\", "faces"
+ ChkDir App.path & "\data files\graphics\", "gui"
+ ChkDir App.path & "\data files\", "logs"
+ ChkDir App.path & "\data files\", "maps"
+ ChkDir App.path & "\data files\", "music"
+ ChkDir App.path & "\data files\", "sound"
+ ChkDir App.path & "\data files\", "video"
+ ' load options
+ LoadOptions
+ ' check the resolution
+ CheckResolution
+ ' load dx8
+ If Options.Fullscreen Then
+ frmMain.BorderStyle = 0
+ frmMain.caption = frmMain.caption
+ End If
+ frmMain.Show
+ InitDX8 frmMain.hWnd
+ DoEvents
+ LoadTextures
+ LoadFonts
+ ' initialise the gui
+ InitGUI
+ ' Resize the GUI to screen size
+ ResizeGUI
+ ' initialise sound & music engines
+ Init_Music
+ ' load the main game (and by extension, pre-load DD7)
+ GettingMap = True
+ vbQuote = ChrW$(34)
+ ' Update the form with the game's name before it's loaded
+ frmMain.caption = GAME_NAME
+ ' randomize rnd's seed
+ Randomize
+ Call SetStatus("Initializing TCP settings.")
+ Call TcpInit(AUTH_SERVER_IP, AUTH_SERVER_PORT)
+ Call InitMessages
+ ' Reset values
+ Ping = -1
+ ' cache the buttons then reset & render them
+ Call SetStatus("Caching map CRC32 checksums...")
+ ' cache map crc32s
+ For i = 1 To MAX_MAPS
+ GetMapCRC32 i
+ Next
+ ' set values for directional blocking arrows
+ DirArrowX(1) = 12 ' up
+ DirArrowY(1) = 0
+ DirArrowX(2) = 12 ' down
+ DirArrowY(2) = 23
+ DirArrowX(3) = 0 ' left
+ DirArrowY(3) = 12
+ DirArrowX(4) = 23 ' right
+ DirArrowY(4) = 12
+ ' set the paperdoll order
+ ReDim PaperdollOrder(1 To Equipment.Equipment_Count - 1) As Long
+ PaperdollOrder(1) = Equipment.Armor
+ PaperdollOrder(2) = Equipment.Helmet
+ PaperdollOrder(3) = Equipment.Shield
+ PaperdollOrder(4) = Equipment.Weapon
+ ' set status
+ SetStatus vbNullString
+ ' show the main menu
+ frmMain.Show
+ inMenu = True
+ ' show login window
+ ShowWindow GetWindowIndex("winLogin")
+ 'ShowWindow GetWindowIndex("winGuild")
+ inSmallChat = True
+ ' Set the loop going
+ fadeAlpha = 255
+ If Options.PlayIntro = 1 Then
+ PlayIntro
+ Else
+ videoPlaying = False
+ frmMain.picIntro.visible = False
+ ' play the menu music
+ If Len(Trim$(MenuMusic)) > 0 Then Play_Music Trim$(MenuMusic)
+ End If
+ MenuLoop
+End Sub
+
+Public Sub AddChar(name As String, sex As Long, Class As Long, sprite As Long)
+
+ If ConnectToServer Then
+ Call SetStatus("Sending character information.")
+ Call SendAddChar(name, sex, Class, sprite)
+ Exit Sub
+ Else
+ ShowWindow GetWindowIndex("winLogin")
+ Dialogue "Connection Problem", "Cannot connect to game server.", "", TypeALERT
+ End If
+
+End Sub
+
+Public Sub Login(name As String, password As String)
+ TcpInit AUTH_SERVER_IP, AUTH_SERVER_PORT
+
+ If ConnectToServer Then
+ Call SetStatus("Sending login information.")
+ Call SendAuthLogin(name, password)
+ ' save details
+ If Options.SaveUser Then Options.Username = name Else Options.Username = vbNullString
+ SaveOptions
+ Exit Sub
+ Else
+ ShowWindow GetWindowIndex("winLogin")
+ Dialogue "Connection Problem", "Cannot connect to login server.", "Please try again later.", TypeALERT
+ End If
+
+End Sub
+
+Public Sub logoutGame()
+ Dim i As Long
+ isLogging = True
+ InGame = False
+
+ DestroyTCP
+
+ ' destroy the animations loaded
+ For i = 1 To MAX_BYTE
+ ClearAnimInstance (i)
+ Next
+
+ ' destroy temp values
+ DragInvSlotNum = 0
+ LastItemDesc = 0
+ MyIndex = 0
+ InventoryItemSelected = 0
+ SpellBuffer = 0
+ SpellBufferTimer = 0
+ tmpCurrencyItem = 0
+ ' unload editors
+ Unload frmEditor_Animation
+ Unload frmEditor_Item
+ Unload frmEditor_Map
+ Unload frmEditor_MapProperties
+ Unload frmEditor_NPC
+ Unload frmEditor_Resource
+ Unload frmEditor_Shop
+ Unload frmEditor_Spell
+ ' clear chat
+ For i = 1 To ChatLines
+ Chat(i).text = vbNullString
+ Next
+
+ inMenu = True
+ MenuLoop
+End Sub
+
+Sub GameInit()
+ Dim musicFile As String
+ ' hide gui
+ InBank = False
+ InTrade = False
+ CloseShop
+ ' get ping
+ GetPing
+ ' play music
+ musicFile = Trim$(Map.MapData.Music)
+
+ If Not musicFile = "None." Then
+ Play_Music musicFile
+ Else
+ Stop_Music
+ End If
+
+ SetStatus vbNullString
+End Sub
+
+Public Sub DestroyGame()
+ StopIntro
+ Call DestroyTCP
+ ' destroy music & sound engines
+ Destroy_Music
+ Call UnloadAllForms
+ End
+End Sub
+
+Public Sub UnloadAllForms()
+ Dim frm As Form
+
+ For Each frm In VB.Forms
+ Unload frm
+ Next
+
+End Sub
+
+Public Sub SetStatus(ByVal caption As String)
+ HideWindows
+ If Len(Trim$(caption)) > 0 Then
+ ShowWindow GetWindowIndex("winLoading")
+ Windows(GetWindowIndex("winLoading")).Controls(GetControlIndex("winLoading", "lblLoading")).text = caption
+ Else
+ HideWindow GetWindowIndex("winLoading")
+ Windows(GetWindowIndex("winLoading")).Controls(GetControlIndex("winLoading", "lblLoading")).text = vbNullString
+ End If
+End Sub
+
+' Used for adding text to packet debugger
+Public Sub TextAdd(ByVal Txt As TextBox, Msg As String, NewLine As Boolean)
+
+ If NewLine Then
+ Txt.text = Txt.text + Msg + vbCrLf
+ Else
+ Txt.text = Txt.text + Msg
+ End If
+
+ Txt.SelStart = Len(Txt.text) - 1
+End Sub
+
+Public Function Rand(ByVal Low As Long, ByVal High As Long) As Long
+ Rand = Int((High - Low + 1) * Rnd) + Low
+End Function
+
+Public Function isLoginLegal(ByVal Username As String, ByVal password As String) As Boolean
+
+ If LenB(Trim$(Username)) >= 3 Then
+ If LenB(Trim$(password)) >= 3 Then
+ isLoginLegal = True
+ End If
+ End If
+
+End Function
+
+Public Function isStringLegal(ByVal sInput As String) As Boolean
+ Dim i As Long, tmpNum As Long
+ ' Prevent high ascii chars
+ tmpNum = Len(sInput)
+
+ For i = 1 To tmpNum
+
+ If Asc(Mid$(sInput, i, 1)) < vbKeySpace Or Asc(Mid$(sInput, i, 1)) > vbKeyF15 Then
+ Dialogue "Illegal Characters", "This string contains illegal characters.", "", TypeALERT
+ Exit Function
+ End If
+
+ Next
+
+ isStringLegal = True
+End Function
+
+Public Sub PopulateLists()
+ Dim strLoad As String, i As Long
+ ' Cache music list
+ strLoad = dir$(App.path & MUSIC_PATH & "*.*")
+ i = 1
+
+ Do While strLoad > vbNullString
+ ReDim Preserve musicCache(1 To i) As String
+ musicCache(i) = strLoad
+ strLoad = dir
+ i = i + 1
+ Loop
+
+ ' Cache sound list
+ strLoad = dir$(App.path & SOUND_PATH & "*.*")
+ i = 1
+
+ Do While strLoad > vbNullString
+ ReDim Preserve soundCache(1 To i) As String
+ soundCache(i) = strLoad
+ strLoad = dir
+ i = i + 1
+ Loop
+
+End Sub
diff --git a/client/src/modGlobals.bas b/client/src/modGlobals.bas
new file mode 100644
index 0000000..5c12b63
--- /dev/null
+++ b/client/src/modGlobals.bas
@@ -0,0 +1,255 @@
+Attribute VB_Name = "modGlobals"
+Option Explicit
+' loading screen
+Public loadingText As String
+' description
+Public descType As Byte
+Public descItem As Long
+Public descLastType As Byte
+Public descLastItem As Long
+Public descText() As TextColourRec
+' chars
+Public CharName(1 To MAX_CHARS) As String
+Public CharSprite(1 To MAX_CHARS) As Long
+Public CharAccess(1 To MAX_CHARS) As Long
+Public CharClass(1 To MAX_CHARS) As Long
+Public CharNum As Long
+Public usergroup As Long
+' login
+Public loginToken As String
+'elastic bars
+Public BarWidth_NpcHP(1 To MAX_MAP_NPCS) As Long
+Public BarWidth_PlayerHP(1 To MAX_PLAYERS) As Long
+Public BarWidth_NpcHP_Max(1 To MAX_MAP_NPCS) As Long
+Public BarWidth_PlayerHP_Max(1 To MAX_PLAYERS) As Long
+Public BarWidth_GuiHP As Long
+Public BarWidth_GuiSP As Long
+Public BarWidth_GuiEXP As Long
+Public BarWidth_GuiHP_Max As Long
+Public BarWidth_GuiSP_Max As Long
+Public BarWidth_GuiEXP_Max As Long
+' fog
+Public fogOffsetX As Long
+Public fogOffsetY As Long
+' chat bubble
+Public chatBubble(1 To MAX_BYTE) As ChatBubbleRec
+Public chatBubbleIndex As Long
+' Map animations
+Public waterfallFrame As Long
+Public autoTileFrame As Long
+' tutorial
+Public inTutorial As Long
+Public tutorialState As Byte
+' NPC Chat
+Public chatNpc As Long
+Public chatText As String
+Public chatOpt(1 To 4) As String
+' gui
+Public hideGUI As Boolean
+Public chatOn As Boolean
+Public chatShowLine As String * 1
+' map editor boxes
+Public shpSelectedTop As Long
+Public shpSelectedLeft As Long
+Public shpSelectedHeight As Long
+Public shpSelectedWidth As Long
+Public shpLocTop As Long
+Public shpLocLeft As Long
+' autotiling
+Public autoInner(1 To 4) As PointRec
+Public autoNW(1 To 4) As PointRec
+Public autoNE(1 To 4) As PointRec
+Public autoSW(1 To 4) As PointRec
+Public autoSE(1 To 4) As PointRec
+' menu
+Public inMenu As Boolean
+' Cursor
+Public GlobalX As Long
+Public GlobalY As Long
+Public GlobalX_Map As Long
+Public GlobalY_Map As Long
+' Paperdoll rendering order
+Public PaperdollOrder() As Long
+' music & sound list cache
+Public musicCache() As String
+Public soundCache() As String
+Public hasPopulated As Boolean
+' global dialogue index
+Public diaHeader As String
+Public diaBody As String
+Public diaBody2 As String
+Public diaIndex As Long
+Public diaData1 As Long
+Public diaDataString As String
+Public diaStyle As Byte
+' Hotbar
+Public Hotbar(1 To MAX_HOTBAR) As HotbarRec
+' Amount of blood decals
+Public BloodCount As Long
+' targetting
+Public myTarget As Long
+Public myTargetType As Long
+' for directional blocking
+Public DirArrowX(1 To 4) As Byte
+Public DirArrowY(1 To 4) As Byte
+' trading
+Public InTrade As Long
+Public TradeYourOffer(1 To MAX_INV) As PlayerInvRec
+Public TradeTheirOffer(1 To MAX_INV) As PlayerInvRec
+' Cache the Resources in an array
+Public MapResource() As MapResourceRec
+Public Resource_Index As Long
+Public Resources_Init As Boolean
+' drag + drop
+Public DragInvSlotNum As Long
+' gui
+Public LastItemDesc As Long ' Stores the last item we showed in desc
+Public tmpCurrencyItem As Long
+Public InShop As Long ' is the player in a shop?
+Public InBank As Long
+Public inChat As Boolean
+' Player variables
+Public MyIndex As Long ' Index of actual player
+Public PlayerInv(1 To MAX_INV) As PlayerInvRec ' Inventory
+Public PlayerSpells(1 To MAX_PLAYER_SPELLS) As PlayerSpellRec
+Public InventoryItemSelected As Long
+Public SpellBuffer As Long
+Public SpellBufferTimer As Long
+Public SpellCD(1 To MAX_PLAYER_SPELLS) As Long
+Public StunDuration As Long
+Public TNL As Long
+' Stops movement when updating a map
+Public CanMoveNow As Boolean
+' Debug mode
+Public DEBUG_MODE As Boolean
+' TCP variables
+Public PlayerBuffer As String
+' Controls main gameloop
+Public InGame As Boolean
+Public isLogging As Boolean
+' Game direction vars
+Public ShiftDown As Boolean
+Public ControlDown As Boolean
+Public tabDown As Boolean
+Public wDown As Boolean
+Public sDown As Boolean
+Public aDown As Boolean
+Public dDown As Boolean
+Public upDown As Boolean
+Public downDown As Boolean
+Public leftDown As Boolean
+Public rightDown As Boolean
+' Used to freeze controls when getting a new map
+Public GettingMap As Boolean
+' Used to check if FPS needs to be drawn
+Public BFPS As Boolean
+Public BLoc As Boolean
+' FPS and Time-based movement vars
+Public ElapsedTime As Long
+Public GameFPS As Long
+' Text vars
+Public vbQuote As String
+' Mouse cursor tile location
+Public CurX As Long
+Public CurY As Long
+' Game editors
+Public Editor As Byte
+Public EditorIndex As Long
+Public AnimEditorFrame(0 To 1) As Long
+Public AnimEditorTimer(0 To 1) As Long
+' Used to check if in editor or not and variables for use in editor
+Public InMapEditor As Boolean
+Public EditorTileX As Long
+Public EditorTileY As Long
+Public EditorTileWidth As Long
+Public EditorTileHeight As Long
+Public EditorWarpMap As Long
+Public EditorWarpX As Long
+Public EditorWarpY As Long
+Public EditorWarpFall As Long
+Public SpawnNpcNum As Long
+Public SpawnNpcDir As Byte
+Public EditorShop As Long
+Public EditorEvent As Long
+' appear
+Public EditorAppearRange As Long
+Public EditorAppearBottom As Long
+' Used for map item editor
+Public ItemEditorNum As Long
+Public ItemEditorValue As Long
+' Used for map key editor
+Public KeyEditorNum As Long
+Public KeyEditorTake As Long
+Public KeyEditorTime As Long
+' Used for map key open editor
+Public KeyOpenEditorX As Long
+Public KeyOpenEditorY As Long
+' Map Resources
+Public ResourceEditorNum As Long
+' Used for map editor heal & trap & slide tiles
+Public MapEditorHealType As Long
+Public MapEditorHealAmount As Long
+Public MapEditorSlideDir As Long
+' used for map editor chat
+Public MapEditorChatDir As Byte
+Public MapEditorChatNpc As Long
+' Maximum classes
+Public Max_Classes As Long
+Public Camera As RECT
+Public TileView As RECT
+' Pinging
+Public PingStart As Long
+Public PingEnd As Long
+Public Ping As Long
+' indexing
+Public ActionMsgIndex As Byte
+Public BloodIndex As Byte
+Public AnimationIndex As Byte
+' fps lock
+Public FPS_Lock As Boolean
+' Editor edited items array
+Public Item_Changed(1 To MAX_ITEMS) As Boolean
+Public NPC_Changed(1 To MAX_NPCS) As Boolean
+Public Resource_Changed(1 To MAX_RESOURCES) As Boolean
+Public Animation_Changed(1 To MAX_ANIMATIONS) As Boolean
+Public Spell_Changed(1 To MAX_SPELLS) As Boolean
+Public Shop_Changed(1 To MAX_SHOPS) As Boolean
+Public Conv_Changed(1 To MAX_CONVS) As Boolean
+' New char
+Public newCharSprite As Long
+Public newCharClass As Long
+Public newCharGender As Long
+' looping saves
+Public Player_HighIndex As Long
+Public Npc_HighIndex As Long
+Public Action_HighIndex As Long
+' fading
+Public fadeAlpha As Long
+' screenshot mode
+Public screenshotMode As Long
+' shop
+Public shopSelectedSlot As Long
+Public shopSelectedItem As Long
+Public shopIsSelling As Boolean
+' conv
+Public convOptions As Long
+Public optPos(1 To 4) As Long
+Public optHeight As Long
+' right click menu
+Public PlayerMenuIndex As Long
+' chat
+Public inSmallChat As Boolean
+Public actChatHeight As Long
+Public actChatWidth As Long
+Public ChatButtonUp As Boolean
+Public ChatButtonDown As Boolean
+' Events
+Public selTileX As Long
+Public selTileY As Long
+Public inEvent As Boolean
+Public eventNum As Long
+Public eventPageNum As Long
+Public eventCommandNum As Long
+' Map
+Public applyingMap As Boolean
+Public MapEditorAppearDistance As Long
diff --git a/client/src/modHandleData.bas b/client/src/modHandleData.bas
new file mode 100644
index 0000000..ed47ee1
--- /dev/null
+++ b/client/src/modHandleData.bas
@@ -0,0 +1,1929 @@
+Attribute VB_Name = "modHandleData"
+Option Explicit
+
+' ******************************************
+' ** Parses and handles String packets **
+' ******************************************
+Public Function GetAddress(FunAddr As Long) As Long
+ GetAddress = FunAddr
+End Function
+
+Public Sub InitMessages()
+ HandleDataSub(SAlertMsg) = GetAddress(AddressOf HandleAlertMsg)
+ HandleDataSub(SLoginOk) = GetAddress(AddressOf HandleLoginOk)
+ HandleDataSub(SNewCharClasses) = GetAddress(AddressOf HandleNewCharClasses)
+ HandleDataSub(SClassesData) = GetAddress(AddressOf HandleClassesData)
+ HandleDataSub(SInGame) = GetAddress(AddressOf HandleInGame)
+ HandleDataSub(SPlayerInv) = GetAddress(AddressOf HandlePlayerInv)
+ HandleDataSub(SPlayerInvUpdate) = GetAddress(AddressOf HandlePlayerInvUpdate)
+ HandleDataSub(SPlayerWornEq) = GetAddress(AddressOf HandlePlayerWornEq)
+ HandleDataSub(SPlayerHp) = GetAddress(AddressOf HandlePlayerHp)
+ HandleDataSub(SPlayerMp) = GetAddress(AddressOf HandlePlayerMp)
+ HandleDataSub(SPlayerStats) = GetAddress(AddressOf HandlePlayerStats)
+ HandleDataSub(SPlayerData) = GetAddress(AddressOf HandlePlayerData)
+ HandleDataSub(SPlayerMove) = GetAddress(AddressOf HandlePlayerMove)
+ HandleDataSub(SNpcMove) = GetAddress(AddressOf HandleNpcMove)
+ HandleDataSub(SPlayerDir) = GetAddress(AddressOf HandlePlayerDir)
+ HandleDataSub(SNpcDir) = GetAddress(AddressOf HandleNpcDir)
+ HandleDataSub(SPlayerXY) = GetAddress(AddressOf HandlePlayerXY)
+ HandleDataSub(SPlayerXYMap) = GetAddress(AddressOf HandlePlayerXYMap)
+ HandleDataSub(SAttack) = GetAddress(AddressOf HandleAttack)
+ HandleDataSub(SNpcAttack) = GetAddress(AddressOf HandleNpcAttack)
+ HandleDataSub(SCheckForMap) = GetAddress(AddressOf HandleCheckForMap)
+ HandleDataSub(SMapData) = GetAddress(AddressOf HandleMapData)
+ HandleDataSub(SMapItemData) = GetAddress(AddressOf HandleMapItemData)
+ HandleDataSub(SMapNpcData) = GetAddress(AddressOf HandleMapNpcData)
+ HandleDataSub(SMapDone) = GetAddress(AddressOf HandleMapDone)
+ HandleDataSub(SGlobalMsg) = GetAddress(AddressOf HandleGlobalMsg)
+ HandleDataSub(SAdminMsg) = GetAddress(AddressOf HandleAdminMsg)
+ HandleDataSub(SPlayerMsg) = GetAddress(AddressOf HandlePlayerMsg)
+ HandleDataSub(SMapMsg) = GetAddress(AddressOf HandleMapMsg)
+ HandleDataSub(SSpawnItem) = GetAddress(AddressOf HandleSpawnItem)
+ HandleDataSub(SItemEditor) = GetAddress(AddressOf HandleItemEditor)
+ HandleDataSub(SUpdateItem) = GetAddress(AddressOf HandleUpdateItem)
+ HandleDataSub(SSpawnNpc) = GetAddress(AddressOf HandleSpawnNpc)
+ HandleDataSub(SNpcDead) = GetAddress(AddressOf HandleNpcDead)
+ HandleDataSub(SNpcEditor) = GetAddress(AddressOf HandleNpcEditor)
+ HandleDataSub(SUpdateNpc) = GetAddress(AddressOf HandleUpdateNpc)
+ HandleDataSub(SMapKey) = GetAddress(AddressOf HandleMapKey)
+ HandleDataSub(SEditMap) = GetAddress(AddressOf HandleEditMap)
+ HandleDataSub(SShopEditor) = GetAddress(AddressOf HandleShopEditor)
+ HandleDataSub(SUpdateShop) = GetAddress(AddressOf HandleUpdateShop)
+ HandleDataSub(SSpellEditor) = GetAddress(AddressOf HandleSpellEditor)
+ HandleDataSub(SUpdateSpell) = GetAddress(AddressOf HandleUpdateSpell)
+ HandleDataSub(SSpells) = GetAddress(AddressOf HandleSpells)
+ HandleDataSub(SLeft) = GetAddress(AddressOf HandleLeft)
+ HandleDataSub(SResourceCache) = GetAddress(AddressOf HandleResourceCache)
+ HandleDataSub(SResourceEditor) = GetAddress(AddressOf HandleResourceEditor)
+ HandleDataSub(SUpdateResource) = GetAddress(AddressOf HandleUpdateResource)
+ HandleDataSub(SSendPing) = GetAddress(AddressOf HandleSendPing)
+ HandleDataSub(SDoorAnimation) = GetAddress(AddressOf HandleDoorAnimation)
+ HandleDataSub(SActionMsg) = GetAddress(AddressOf HandleActionMsg)
+ HandleDataSub(SPlayerEXP) = GetAddress(AddressOf HandlePlayerExp)
+ HandleDataSub(SBlood) = GetAddress(AddressOf HandleBlood)
+ HandleDataSub(SAnimationEditor) = GetAddress(AddressOf HandleAnimationEditor)
+ HandleDataSub(SUpdateAnimation) = GetAddress(AddressOf HandleUpdateAnimation)
+ HandleDataSub(SAnimation) = GetAddress(AddressOf HandleAnimation)
+ HandleDataSub(SMapNpcVitals) = GetAddress(AddressOf HandleMapNpcVitals)
+ HandleDataSub(SCooldown) = GetAddress(AddressOf HandleCooldown)
+ HandleDataSub(SClearSpellBuffer) = GetAddress(AddressOf HandleClearSpellBuffer)
+ HandleDataSub(SSayMsg) = GetAddress(AddressOf HandleSayMsg)
+ HandleDataSub(SOpenShop) = GetAddress(AddressOf HandleOpenShop)
+ HandleDataSub(SResetShopAction) = GetAddress(AddressOf HandleResetShopAction)
+ HandleDataSub(SStunned) = GetAddress(AddressOf HandleStunned)
+ HandleDataSub(SMapWornEq) = GetAddress(AddressOf HandleMapWornEq)
+ HandleDataSub(SBank) = GetAddress(AddressOf HandleBank)
+ HandleDataSub(STrade) = GetAddress(AddressOf HandleTrade)
+ HandleDataSub(SCloseTrade) = GetAddress(AddressOf HandleCloseTrade)
+ HandleDataSub(STradeUpdate) = GetAddress(AddressOf HandleTradeUpdate)
+ HandleDataSub(STradeStatus) = GetAddress(AddressOf HandleTradeStatus)
+ HandleDataSub(STarget) = GetAddress(AddressOf HandleTarget)
+ HandleDataSub(SHotbar) = GetAddress(AddressOf HandleHotbar)
+ HandleDataSub(SHighIndex) = GetAddress(AddressOf HandleHighIndex)
+ HandleDataSub(SSound) = GetAddress(AddressOf HandleSound)
+ HandleDataSub(STradeRequest) = GetAddress(AddressOf HandleTradeRequest)
+ HandleDataSub(SPartyInvite) = GetAddress(AddressOf HandlePartyInvite)
+ HandleDataSub(SPartyUpdate) = GetAddress(AddressOf HandlePartyUpdate)
+ HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
+ HandleDataSub(SChatUpdate) = GetAddress(AddressOf HandleChatUpdate)
+ HandleDataSub(SConvEditor) = GetAddress(AddressOf HandleConvEditor)
+ HandleDataSub(SUpdateConv) = GetAddress(AddressOf HandleUpdateConv)
+ HandleDataSub(SStartTutorial) = GetAddress(AddressOf HandleStartTutorial)
+ HandleDataSub(SChatBubble) = GetAddress(AddressOf HandleChatBubble)
+ HandleDataSub(SSetPlayerLoginToken) = GetAddress(AddressOf HandleSetPlayerLoginToken)
+ HandleDataSub(SPlayerChars) = GetAddress(AddressOf HandlePlayerChars)
+ HandleDataSub(SCancelAnimation) = GetAddress(AddressOf HandleCancelAnimation)
+ HandleDataSub(SPlayerVariables) = GetAddress(AddressOf HandlePlayerVariables)
+ HandleDataSub(SEvent) = GetAddress(AddressOf HandleEvent)
+End Sub
+
+Sub HandleData(ByRef data() As Byte)
+ Dim Buffer As clsBuffer
+ Dim MsgType As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ MsgType = Buffer.ReadLong
+
+ If MsgType < 0 Then
+ DestroyGame
+ Exit Sub
+ End If
+
+ If MsgType >= SMsgCOUNT Then
+ DestroyGame
+ Exit Sub
+ End If
+
+ CallWindowProc HandleDataSub(MsgType), 1, Buffer.ReadBytes(Buffer.length), 0, 0
+End Sub
+
+Sub HandleAlertMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, dialogue_index As Long, menuReset As Long, kick As Long
+
+ SetStatus vbNullString
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteBytes data()
+ dialogue_index = Buffer.ReadLong
+ menuReset = Buffer.ReadLong
+ kick = Buffer.ReadLong
+
+ Set Buffer = Nothing
+
+ If menuReset > 0 Then
+ HideWindows
+ Select Case menuReset
+ Case MenuCount.menuLogin
+ ShowWindow GetWindowIndex("winLogin")
+ Case MenuCount.menuChars
+ ShowWindow GetWindowIndex("winCharacters")
+ Case MenuCount.menuClass
+ ShowWindow GetWindowIndex("winClasses")
+ Case MenuCount.menuNewChar
+ ShowWindow GetWindowIndex("winNewChar")
+ Case MenuCount.menuMain
+ ShowWindow GetWindowIndex("winLogin")
+ End Select
+ Else
+ If kick > 0 Or inMenu = True Then
+ ShowWindow GetWindowIndex("winLogin")
+ DialogueAlert dialogue_index
+ logoutGame
+ Exit Sub
+ End If
+ End If
+
+ DialogueAlert dialogue_index
+End Sub
+
+Sub HandleLoginOk(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ ' Now we can receive game data
+ MyIndex = Buffer.ReadLong
+ ' player high index
+ Player_HighIndex = MAX_PLAYERS 'Buffer.ReadLong
+ Set Buffer = Nothing
+ Call SetStatus("Receiving game data.")
+End Sub
+
+Sub HandleNewCharClasses(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim i As Long
+ Dim z As Long, x As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = 1
+ ' Max classes
+ Max_Classes = Buffer.ReadLong
+ ReDim Class(1 To Max_Classes)
+ n = n + 1
+
+ For i = 1 To Max_Classes
+
+ With Class(i)
+ .name = Buffer.ReadString
+ .Vital(Vitals.HP) = Buffer.ReadLong
+ .Vital(Vitals.MP) = Buffer.ReadLong
+ ' get array size
+ z = Buffer.ReadLong
+ ' redim array
+ ReDim .MaleSprite(0 To z)
+
+ ' loop-receive data
+ For x = 0 To z
+ .MaleSprite(x) = Buffer.ReadLong
+ Next
+
+ ' get array size
+ z = Buffer.ReadLong
+ ' redim array
+ ReDim .FemaleSprite(0 To z)
+
+ ' loop-receive data
+ For x = 0 To z
+ .FemaleSprite(x) = Buffer.ReadLong
+ Next
+
+ For x = 1 To Stats.Stat_Count - 1
+ .Stat(x) = Buffer.ReadLong
+ Next
+
+ End With
+
+ n = n + 10
+ Next
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleClassesData(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim i As Long
+ Dim z As Long, x As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = 1
+ ' Max classes
+ Max_Classes = Buffer.ReadLong 'CByte(Parse(n))
+ ReDim Class(1 To Max_Classes)
+ n = n + 1
+
+ For i = 1 To Max_Classes
+
+ With Class(i)
+ .name = Buffer.ReadString 'Trim$(Parse(n))
+ .Vital(Vitals.HP) = Buffer.ReadLong 'CLng(Parse(n + 1))
+ .Vital(Vitals.MP) = Buffer.ReadLong 'CLng(Parse(n + 2))
+ ' get array size
+ z = Buffer.ReadLong
+ ' redim array
+ ReDim .MaleSprite(0 To z)
+
+ ' loop-receive data
+ For x = 0 To z
+ .MaleSprite(x) = Buffer.ReadLong
+ Next
+
+ ' get array size
+ z = Buffer.ReadLong
+ ' redim array
+ ReDim .FemaleSprite(0 To z)
+
+ ' loop-receive data
+ For x = 0 To z
+ .FemaleSprite(x) = Buffer.ReadLong
+ Next
+
+ For x = 1 To Stats.Stat_Count - 1
+ .Stat(x) = Buffer.ReadLong
+ Next
+
+ End With
+
+ n = n + 10
+ Next
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleInGame(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ InGame = True
+ inMenu = False
+ SetStatus vbNullString
+ ' show gui
+ ShowWindow GetWindowIndex("winBars"), , False
+ ShowWindow GetWindowIndex("winMenu"), , False
+ ShowWindow GetWindowIndex("winHotbar"), , False
+ ShowWindow GetWindowIndex("winChatSmall"), , False
+ ' enter loop
+ GameLoop
+End Sub
+
+Sub HandlePlayerInv(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_INV
+ Call SetPlayerInvItemNum(MyIndex, i, Buffer.ReadLong)
+ Call SetPlayerInvItemValue(MyIndex, i, Buffer.ReadLong)
+ PlayerInv(i).bound = Buffer.ReadByte
+ Next
+
+ SetGoldLabel
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandlePlayerInvUpdate(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong 'CLng(Parse(1))
+ Call SetPlayerInvItemNum(MyIndex, n, Buffer.ReadLong) 'CLng(Parse(2)))
+ Call SetPlayerInvItemValue(MyIndex, n, Buffer.ReadLong) 'CLng(Parse(3)))
+ PlayerInv(n).bound = Buffer.ReadByte
+ Set Buffer = Nothing
+ SetGoldLabel
+End Sub
+
+Sub HandlePlayerWornEq(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Call SetPlayerEquipment(MyIndex, Buffer.ReadLong, Armor)
+ Call SetPlayerEquipment(MyIndex, Buffer.ReadLong, Weapon)
+ Call SetPlayerEquipment(MyIndex, Buffer.ReadLong, Helmet)
+ Call SetPlayerEquipment(MyIndex, Buffer.ReadLong, Shield)
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleMapWornEq(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim playerNum As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ playerNum = Buffer.ReadLong
+ Call SetPlayerEquipment(playerNum, Buffer.ReadLong, Armor)
+ Call SetPlayerEquipment(playerNum, Buffer.ReadLong, Weapon)
+ Call SetPlayerEquipment(playerNum, Buffer.ReadLong, Helmet)
+ Call SetPlayerEquipment(playerNum, Buffer.ReadLong, Shield)
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandlePlayerHp(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ If MyIndex = 0 Then Exit Sub
+ Buffer.WriteBytes data()
+ Player(MyIndex).MaxVital(Vitals.HP) = Buffer.ReadLong
+ Call SetPlayerVital(MyIndex, Vitals.HP, Buffer.ReadLong)
+ ' set max width
+ If GetPlayerVital(MyIndex, Vitals.HP) > 0 Then
+ BarWidth_GuiHP_Max = ((GetPlayerVital(MyIndex, Vitals.HP) / 209) / (GetPlayerMaxVital(MyIndex, Vitals.HP) / 209)) * 209
+ Else
+ BarWidth_GuiHP_Max = 0
+ End If
+ ' Update GUI
+ UpdateStats_UI
+End Sub
+
+Private Sub HandlePlayerMp(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Player(MyIndex).MaxVital(Vitals.MP) = Buffer.ReadLong
+ Call SetPlayerVital(MyIndex, Vitals.MP, Buffer.ReadLong)
+ ' set max width
+ If GetPlayerVital(MyIndex, Vitals.MP) > 0 Then
+ BarWidth_GuiSP_Max = ((GetPlayerVital(MyIndex, Vitals.MP) / 209) / (GetPlayerMaxVital(MyIndex, Vitals.MP) / 209)) * 209
+ Else
+ BarWidth_GuiSP_Max = 0
+ End If
+ ' Update GUI
+ UpdateStats_UI
+End Sub
+
+Private Sub HandlePlayerStats(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To Stats.Stat_Count - 1
+ SetPlayerStat index, i, Buffer.ReadLong
+ Next
+End Sub
+
+Private Sub HandlePlayerExp(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ SetPlayerExp MyIndex, Buffer.ReadLong
+ TNL = Buffer.ReadLong
+ ' set max width
+ If GetPlayerLevel(MyIndex) <= MAX_LEVELS Then
+ If GetPlayerExp(MyIndex) > 0 Then
+ BarWidth_GuiEXP_Max = ((GetPlayerExp(MyIndex) / 209) / (TNL / 209)) * 209
+ Else
+ BarWidth_GuiEXP_Max = 0
+ End If
+ Else
+ BarWidth_GuiEXP_Max = 209
+ End If
+ ' Update GUI
+ UpdateStats_UI
+End Sub
+
+Private Sub HandlePlayerData(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long, x As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ i = Buffer.ReadLong
+ Call SetPlayerName(i, Buffer.ReadString)
+ Player(i).usergroup = Buffer.ReadLong
+ Call SetPlayerLevel(i, Buffer.ReadLong)
+ Call SetPlayerPOINTS(i, Buffer.ReadLong)
+ Call SetPlayerSprite(i, Buffer.ReadLong)
+ Call SetPlayerMap(i, Buffer.ReadLong)
+ Call SetPlayerX(i, Buffer.ReadLong)
+ Call SetPlayerY(i, Buffer.ReadLong)
+ Call SetPlayerDir(i, Buffer.ReadLong)
+ Call SetPlayerAccess(i, Buffer.ReadLong)
+ Call SetPlayerPK(i, Buffer.ReadLong)
+ Call SetPlayerClass(i, Buffer.ReadLong)
+
+ For x = 1 To Stats.Stat_Count - 1
+ SetPlayerStat i, x, Buffer.ReadLong
+ Next
+
+ ' Check if the player is the client player
+ If i = MyIndex Then
+ ' Reset directions
+ wDown = False
+ aDown = False
+ sDown = False
+ dDown = False
+ upDown = False
+ leftDown = False
+ downDown = False
+ rightDown = False
+ ' set form
+ With Windows(GetWindowIndex("winCharacter"))
+ .Controls(GetControlIndex("winCharacter", "lblName")).text = "Name: " & Trim$(GetPlayerName(MyIndex))
+ .Controls(GetControlIndex("winCharacter", "lblClass")).text = "Class: " & Trim$(Class(GetPlayerClass(MyIndex)).name)
+ .Controls(GetControlIndex("winCharacter", "lblLevel")).text = "Level: " & GetPlayerLevel(MyIndex)
+ .Controls(GetControlIndex("winCharacter", "lblGuild")).text = "Guild: " & "None"
+ .Controls(GetControlIndex("winCharacter", "lblHealth")).text = "Health: " & GetPlayerVital(MyIndex, HP) & "/" & GetPlayerMaxVital(MyIndex, HP)
+ .Controls(GetControlIndex("winCharacter", "lblSpirit")).text = "Spirit: " & GetPlayerVital(MyIndex, MP) & "/" & GetPlayerMaxVital(MyIndex, MP)
+ .Controls(GetControlIndex("winCharacter", "lblExperience")).text = "Experience: " & Player(MyIndex).EXP & "/" & TNL
+ ' stats
+ For x = 1 To Stats.Stat_Count - 1
+ .Controls(GetControlIndex("winCharacter", "lblStat_" & x)).text = GetPlayerStat(MyIndex, x)
+ Next
+ ' points
+ .Controls(GetControlIndex("winCharacter", "lblPoints")).text = GetPlayerPOINTS(MyIndex)
+ ' grey out buttons
+ If GetPlayerPOINTS(MyIndex) = 0 Then
+ For x = 1 To Stats.Stat_Count - 1
+ .Controls(GetControlIndex("winCharacter", "btnGreyStat_" & x)).visible = True
+ Next
+ Else
+ For x = 1 To Stats.Stat_Count - 1
+ .Controls(GetControlIndex("winCharacter", "btnGreyStat_" & x)).visible = False
+ Next
+ End If
+ End With
+ End If
+
+ ' Make sure they aren't walking
+ Player(i).Moving = 0
+ Player(i).xOffset = 0
+ Player(i).yOffset = 0
+End Sub
+
+Private Sub HandlePlayerMove(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim x As Long
+ Dim y As Long
+ Dim dir As Long
+ Dim n As Byte
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ i = Buffer.ReadLong
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ dir = Buffer.ReadLong
+ n = Buffer.ReadLong
+ Call SetPlayerX(i, x)
+ Call SetPlayerY(i, y)
+ Call SetPlayerDir(i, dir)
+ Player(i).xOffset = 0
+ Player(i).yOffset = 0
+ Player(i).Moving = n
+
+ Select Case GetPlayerDir(i)
+
+ Case DIR_UP
+ Player(i).yOffset = PIC_Y
+
+ Case DIR_DOWN
+ Player(i).yOffset = PIC_Y * -1
+
+ Case DIR_LEFT
+ Player(i).xOffset = PIC_X
+
+ Case DIR_RIGHT
+ Player(i).xOffset = PIC_X * -1
+ End Select
+End Sub
+
+Private Sub HandleNpcMove(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim MapNpcNum As Long
+ Dim x As Long
+ Dim y As Long
+ Dim dir As Long
+ Dim Movement As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ MapNpcNum = Buffer.ReadLong
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ dir = Buffer.ReadLong
+ Movement = Buffer.ReadLong
+
+ With MapNpc(MapNpcNum)
+ .x = x
+ .y = y
+ .dir = dir
+ .xOffset = 0
+ .yOffset = 0
+ .Moving = Movement
+
+ Select Case .dir
+
+ Case DIR_UP
+ .yOffset = PIC_Y
+
+ Case DIR_DOWN
+ .yOffset = PIC_Y * -1
+
+ Case DIR_LEFT
+ .xOffset = PIC_X
+
+ Case DIR_RIGHT
+ .xOffset = PIC_X * -1
+ End Select
+
+ End With
+
+End Sub
+
+Private Sub HandlePlayerDir(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim dir As Byte
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ i = Buffer.ReadLong
+ dir = Buffer.ReadLong
+ Call SetPlayerDir(i, dir)
+
+ With Player(i)
+ .xOffset = 0
+ .yOffset = 0
+ .Moving = 0
+ End With
+
+End Sub
+
+Private Sub HandleNpcDir(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim dir As Byte
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ i = Buffer.ReadLong
+ dir = Buffer.ReadLong
+
+ With MapNpc(i)
+ .dir = dir
+ .xOffset = 0
+ .yOffset = 0
+ .Moving = 0
+ End With
+
+End Sub
+
+Private Sub HandlePlayerXY(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim x As Long
+ Dim y As Long
+ Dim dir As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ dir = Buffer.ReadLong
+ Call SetPlayerX(MyIndex, x)
+ Call SetPlayerY(MyIndex, y)
+ Call SetPlayerDir(MyIndex, dir)
+ ' Make sure they aren't walking
+ Player(MyIndex).Moving = 0
+ Player(MyIndex).xOffset = 0
+ Player(MyIndex).yOffset = 0
+End Sub
+
+Private Sub HandlePlayerXYMap(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim x As Long
+ Dim y As Long
+ Dim dir As Long
+ Dim Buffer As clsBuffer
+ Dim thePlayer As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ thePlayer = Buffer.ReadLong
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ dir = Buffer.ReadLong
+ Call SetPlayerX(thePlayer, x)
+ Call SetPlayerY(thePlayer, y)
+ Call SetPlayerDir(thePlayer, dir)
+ ' Make sure they aren't walking
+ Player(thePlayer).Moving = 0
+ Player(thePlayer).xOffset = 0
+ Player(thePlayer).yOffset = 0
+End Sub
+
+Private Sub HandleAttack(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ i = Buffer.ReadLong
+ ' Set player to attacking
+ Player(i).Attacking = 1
+ Player(i).AttackTimer = GetTickCount
+End Sub
+
+Private Sub HandleNpcAttack(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ i = Buffer.ReadLong
+ ' Set player to attacking
+ MapNpc(i).Attacking = 1
+ MapNpc(i).AttackTimer = GetTickCount
+End Sub
+
+Private Sub HandleCheckForMap(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long, NeedMap As Byte, Buffer As clsBuffer, MapDataCRC As Long, MapTileCRC As Long, mapNum As Long
+
+ GettingMap = True
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ ' Erase all players except self
+ For i = 1 To MAX_PLAYERS
+ If i <> MyIndex Then
+ Call SetPlayerMap(i, 0)
+ End If
+ Next
+
+ ' Erase all temporary tile values
+ Call ClearTempTile
+ Call ClearMapNpcs
+ Call ClearMapItems
+ Call ClearMap
+
+ ' clear the blood
+ For i = 1 To MAX_BYTE
+ Blood(i).x = 0
+ Blood(i).y = 0
+ Blood(i).sprite = 0
+ Blood(i).timer = 0
+ Next
+
+ ' Get map num
+ mapNum = Buffer.ReadLong
+ MapDataCRC = Buffer.ReadLong
+ MapTileCRC = Buffer.ReadLong
+
+ ' check against our own CRC32s
+ NeedMap = 0
+ If MapDataCRC <> MapCRC32(mapNum).MapDataCRC Then
+ NeedMap = 1
+ End If
+ If MapTileCRC <> MapCRC32(mapNum).MapTileCRC Then
+ NeedMap = 1
+ End If
+
+ ' Either the revisions didn't match or we dont have the map, so we need it
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CNeedMap
+ Buffer.WriteLong NeedMap
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+
+ ' Check if we get a map from someone else and if we were editing a map cancel it out
+ If Not applyingMap Then
+ If InMapEditor Then
+ InMapEditor = False
+ frmEditor_Map.visible = False
+ ClearAttributeDialogue
+
+ If frmEditor_MapProperties.visible Then
+ frmEditor_MapProperties.visible = False
+ End If
+ End If
+ End If
+
+ ' load the map if we don't need it
+ If NeedMap = 0 Then
+ LoadMap mapNum
+ applyingMap = False
+ End If
+End Sub
+
+Sub HandleMapData(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, mapNum As Long, i As Long, x As Long, y As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ mapNum = Buffer.ReadLong
+
+ With map.MapData
+ .name = Buffer.ReadString
+ .Music = Buffer.ReadString
+ .Moral = Buffer.ReadByte
+ .Up = Buffer.ReadLong
+ .Down = Buffer.ReadLong
+ .left = Buffer.ReadLong
+ .Right = Buffer.ReadLong
+ .BootMap = Buffer.ReadLong
+ .BootX = Buffer.ReadByte
+ .BootY = Buffer.ReadByte
+ .MaxX = Buffer.ReadByte
+ .MaxY = Buffer.ReadByte
+ .BossNpc = Buffer.ReadLong
+ For i = 1 To MAX_MAP_NPCS
+ .Npc(i) = Buffer.ReadLong
+ Next
+ End With
+
+ map.TileData.EventCount = Buffer.ReadLong
+ If map.TileData.EventCount > 0 Then
+ ReDim Preserve map.TileData.Events(1 To map.TileData.EventCount)
+ For i = 1 To map.TileData.EventCount
+ With map.TileData.Events(i)
+ .name = Buffer.ReadString
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ .pageCount = Buffer.ReadLong
+ End With
+ If map.TileData.Events(i).pageCount > 0 Then
+ ReDim Preserve map.TileData.Events(i).EventPage(1 To map.TileData.Events(i).pageCount)
+ For x = 1 To map.TileData.Events(i).pageCount
+ With map.TileData.Events(i).EventPage(x)
+ .chkPlayerVar = Buffer.ReadByte
+ .chkSelfSwitch = Buffer.ReadByte
+ .chkHasItem = Buffer.ReadByte
+ .PlayerVarNum = Buffer.ReadLong
+ .SelfSwitchNum = Buffer.ReadLong
+ .HasItemNum = Buffer.ReadLong
+ .PlayerVariable = Buffer.ReadLong
+ .GraphicType = Buffer.ReadByte
+ .Graphic = Buffer.ReadLong
+ .GraphicX = Buffer.ReadLong
+ .GraphicY = Buffer.ReadLong
+ .MoveType = Buffer.ReadByte
+ .MoveSpeed = Buffer.ReadByte
+ .MoveFreq = Buffer.ReadByte
+ .WalkAnim = Buffer.ReadByte
+ .StepAnim = Buffer.ReadByte
+ .DirFix = Buffer.ReadByte
+ .WalkThrough = Buffer.ReadByte
+ .Priority = Buffer.ReadByte
+ .Trigger = Buffer.ReadByte
+ .CommandCount = Buffer.ReadLong
+ End With
+ If map.TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ ReDim Preserve map.TileData.Events(i).EventPage(x).Commands(1 To map.TileData.Events(i).EventPage(x).CommandCount)
+ For y = 1 To map.TileData.Events(i).EventPage(x).CommandCount
+ With map.TileData.Events(i).EventPage(x).Commands(y)
+ .Type = Buffer.ReadByte
+ .text = Buffer.ReadString
+ .Colour = Buffer.ReadLong
+ .channel = Buffer.ReadByte
+ .TargetType = Buffer.ReadByte
+ .target = Buffer.ReadLong
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ ReDim map.TileData.Tile(0 To map.MapData.MaxX, 0 To map.MapData.MaxY)
+
+ For x = 0 To map.MapData.MaxX
+ For y = 0 To map.MapData.MaxY
+ For i = 1 To MapLayer.Layer_Count - 1
+ map.TileData.Tile(x, y).Layer(i).x = Buffer.ReadLong
+ map.TileData.Tile(x, y).Layer(i).y = Buffer.ReadLong
+ map.TileData.Tile(x, y).Layer(i).tileset = Buffer.ReadLong
+ map.TileData.Tile(x, y).Autotile(i) = Buffer.ReadByte
+ Next
+ map.TileData.Tile(x, y).Type = Buffer.ReadByte
+ map.TileData.Tile(x, y).Data1 = Buffer.ReadLong
+ map.TileData.Tile(x, y).Data2 = Buffer.ReadLong
+ map.TileData.Tile(x, y).Data3 = Buffer.ReadLong
+ map.TileData.Tile(x, y).Data4 = Buffer.ReadLong
+ map.TileData.Tile(x, y).Data5 = Buffer.ReadLong
+ map.TileData.Tile(x, y).DirBlock = Buffer.ReadByte
+ Next
+ Next
+
+ ClearTempTile
+ initAutotiles
+ Set Buffer = Nothing
+ ' Save the map
+ Call SaveMap(mapNum)
+ GetMapCRC32 mapNum
+ AddText "Downloaded new map.", BrightGreen
+
+ ' Check if we get a map from someone else and if we were editing a map cancel it out
+ If Not applyingMap Then
+ If InMapEditor Then
+ InMapEditor = False
+ frmEditor_Map.visible = False
+ ClearAttributeDialogue
+ If frmEditor_MapProperties.visible Then
+ frmEditor_MapProperties.visible = False
+ End If
+ End If
+ End If
+ applyingMap = False
+
+End Sub
+
+Private Sub HandleMapItemData(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer, tmpLong As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_MAP_ITEMS
+
+ With MapItem(i)
+ .playerName = Buffer.ReadString
+ .num = Buffer.ReadLong
+ .value = Buffer.ReadLong
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ tmpLong = Buffer.ReadLong
+
+ If tmpLong = 0 Then
+ .bound = False
+ Else
+ .bound = True
+ End If
+
+ End With
+
+ Next
+
+End Sub
+
+Private Sub HandleMapNpcData(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_MAP_NPCS
+
+ With MapNpc(i)
+ .num = Buffer.ReadLong
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ .dir = Buffer.ReadLong
+ .Vital(HP) = Buffer.ReadLong
+ End With
+
+ Next
+
+End Sub
+
+Private Sub HandleMapDone()
+ Dim i As Long
+ Dim musicFile As String
+
+ ' clear the action msgs
+ For i = 1 To MAX_BYTE
+ ClearActionMsg (i)
+ Next i
+
+ Action_HighIndex = 1
+
+ ' player music
+ If InGame Then
+ musicFile = Trim$(map.MapData.Music)
+
+ If Not musicFile = "None." Then
+ Play_Music musicFile
+ Else
+ Stop_Music
+ End If
+ End If
+
+ ' get the npc high index
+ For i = MAX_MAP_NPCS To 1 Step -1
+
+ If MapNpc(i).num > 0 Then
+ Npc_HighIndex = i + 1
+ Exit For
+ End If
+
+ Next
+
+ ' make sure we're not overflowing
+ If Npc_HighIndex > MAX_MAP_NPCS Then Npc_HighIndex = MAX_MAP_NPCS
+ ' now cache the positions
+ initAutotiles
+ GettingMap = False
+ CanMoveNow = True
+End Sub
+
+Private Sub HandleBroadcastMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Msg As String
+ Dim Color As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Msg = Buffer.ReadString
+ Color = Buffer.ReadLong
+ Call AddText(Msg, Color)
+End Sub
+
+Private Sub HandleGlobalMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Msg As String
+ Dim Color As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Msg = Buffer.ReadString
+ Color = Buffer.ReadLong
+ Call AddText(Msg, Color)
+End Sub
+
+Private Sub HandlePlayerMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Msg As String
+ Dim Color As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Msg = Buffer.ReadString
+ Color = Buffer.ReadLong
+ Call AddText(Msg, Color)
+End Sub
+
+Private Sub HandleMapMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Msg As String
+ Dim Color As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Msg = Buffer.ReadString
+ Color = Buffer.ReadLong
+ Call AddText(Msg, Color)
+End Sub
+
+Private Sub HandleAdminMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Msg As String
+ Dim Color As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Msg = Buffer.ReadString
+ Color = Buffer.ReadLong
+ Call AddText(Msg, Color)
+End Sub
+
+Private Sub HandleSpawnItem(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer, tmpLong As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong
+
+ With MapItem(n)
+ .playerName = Buffer.ReadString
+ .num = Buffer.ReadLong
+ .value = Buffer.ReadLong
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ tmpLong = Buffer.ReadLong
+
+ If tmpLong = 0 Then
+ .bound = False
+ Else
+ .bound = True
+ End If
+
+ End With
+
+End Sub
+
+Private Sub HandleItemEditor()
+ Dim i As Long
+
+ With frmEditor_Item
+ Editor = EDITOR_ITEM
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_ITEMS
+ .lstIndex.AddItem i & ": " & Trim$(Item(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ ItemEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleAnimationEditor()
+ Dim i As Long
+
+ With frmEditor_Animation
+ Editor = EDITOR_ANIMATION
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_ANIMATIONS
+ .lstIndex.AddItem i & ": " & Trim$(Animation(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ AnimationEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleUpdateItem(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Dim ItemSize As Long
+ Dim ItemData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong
+ ' Update the item
+ ItemSize = LenB(Item(n))
+ ReDim ItemData(ItemSize - 1)
+ ItemData = Buffer.ReadBytes(ItemSize)
+ CopyMemory ByVal VarPtr(Item(n)), ByVal VarPtr(ItemData(0)), ItemSize
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleUpdateAnimation(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Dim AnimationSize As Long
+ Dim AnimationData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong
+ ' Update the Animation
+ AnimationSize = LenB(Animation(n))
+ ReDim AnimationData(AnimationSize - 1)
+ AnimationData = Buffer.ReadBytes(AnimationSize)
+ CopyMemory ByVal VarPtr(Animation(n)), ByVal VarPtr(AnimationData(0)), AnimationSize
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleSpawnNpc(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong
+
+ With MapNpc(n)
+ .num = Buffer.ReadLong
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ .dir = Buffer.ReadLong
+ ' Client use only
+ .xOffset = 0
+ .yOffset = 0
+ .Moving = 0
+ End With
+
+End Sub
+
+Private Sub HandleNpcDead(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong
+ Call ClearMapNpc(n)
+End Sub
+
+Private Sub HandleNpcEditor()
+ Dim i As Long
+
+ With frmEditor_NPC
+ Editor = EDITOR_NPC
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_NPCS
+ .lstIndex.AddItem i & ": " & Trim$(Npc(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ NpcEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleUpdateNpc(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Dim NpcSize As Long
+ Dim NpcData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ n = Buffer.ReadLong
+ NpcSize = LenB(Npc(n))
+ ReDim NpcData(NpcSize - 1)
+ NpcData = Buffer.ReadBytes(NpcSize)
+ CopyMemory ByVal VarPtr(Npc(n)), ByVal VarPtr(NpcData(0)), NpcSize
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleResourceEditor()
+ Dim i As Long
+
+ With frmEditor_Resource
+ Editor = EDITOR_RESOURCE
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_RESOURCES
+ .lstIndex.AddItem i & ": " & Trim$(Resource(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ ResourceEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleUpdateResource(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim ResourceNum As Long
+ Dim Buffer As clsBuffer
+ Dim ResourceSize As Long
+ Dim ResourceData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ ResourceNum = Buffer.ReadLong
+ ResourceSize = LenB(Resource(ResourceNum))
+ ReDim ResourceData(ResourceSize - 1)
+ ResourceData = Buffer.ReadBytes(ResourceSize)
+ ClearResource ResourceNum
+ CopyMemory ByVal VarPtr(Resource(ResourceNum)), ByVal VarPtr(ResourceData(0)), ResourceSize
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleMapKey(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim x As Long
+ Dim y As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ n = Buffer.ReadByte
+ TempTile(x, y).DoorOpen = n
+
+ ' re-cache rendering
+ If Not GettingMap Then cacheRenderState x, y, MapLayer.Mask
+End Sub
+
+Private Sub HandleEditMap()
+ Call MapEditorInit
+End Sub
+
+Private Sub HandleShopEditor()
+ Dim i As Long
+
+ With frmEditor_Shop
+ Editor = EDITOR_SHOP
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_SHOPS
+ .lstIndex.AddItem i & ": " & Trim$(Shop(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ ShopEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleUpdateShop(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim shopNum As Long
+ Dim Buffer As clsBuffer
+ Dim ShopSize As Long
+ Dim ShopData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ shopNum = Buffer.ReadLong
+ ShopSize = LenB(Shop(shopNum))
+ ReDim ShopData(ShopSize - 1)
+ ShopData = Buffer.ReadBytes(ShopSize)
+ CopyMemory ByVal VarPtr(Shop(shopNum)), ByVal VarPtr(ShopData(0)), ShopSize
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleSpellEditor()
+ Dim i As Long
+
+ With frmEditor_Spell
+ Editor = EDITOR_SPELL
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_SPELLS
+ .lstIndex.AddItem i & ": " & Trim$(Spell(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ SpellEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleUpdateSpell(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim spellnum As Long
+ Dim Buffer As clsBuffer
+ Dim SpellSize As Long
+ Dim SpellData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ spellnum = Buffer.ReadLong
+ SpellSize = LenB(Spell(spellnum))
+ ReDim SpellData(SpellSize - 1)
+ SpellData = Buffer.ReadBytes(SpellSize)
+ CopyMemory ByVal VarPtr(Spell(spellnum)), ByVal VarPtr(SpellData(0)), SpellSize
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleSpells(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_PLAYER_SPELLS
+ PlayerSpells(i).Spell = Buffer.ReadLong
+ PlayerSpells(i).Uses = Buffer.ReadLong
+ Next
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleLeft(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Call ClearPlayer(Buffer.ReadLong)
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleResourceCache(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+
+ ' if in map editor, we cache shit ourselves
+ If InMapEditor Then Exit Sub
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Resource_Index = Buffer.ReadLong
+ Resources_Init = False
+
+ If Resource_Index > 0 Then
+ ReDim Preserve MapResource(0 To Resource_Index)
+
+ For i = 0 To Resource_Index
+ MapResource(i).ResourceState = Buffer.ReadByte
+ MapResource(i).x = Buffer.ReadLong
+ MapResource(i).y = Buffer.ReadLong
+ Next
+
+ Resources_Init = True
+ Else
+ ReDim MapResource(0 To 1)
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleSendPing(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ PingEnd = GetTickCount
+ Ping = PingEnd - PingStart
+End Sub
+
+Private Sub HandleDoorAnimation(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim x As Long, y As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+
+ With TempTile(x, y)
+ .DoorFrame = 1
+ .DoorAnimate = 1 ' 0 = nothing| 1 = opening | 2 = closing
+ .DoorTimer = GetTickCount
+ End With
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleActionMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim x As Long, y As Long, message As String, Color As Long, tmpType As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ message = Buffer.ReadString
+ Color = Buffer.ReadLong
+ tmpType = Buffer.ReadLong
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ Set Buffer = Nothing
+ CreateActionMsg message, Color, tmpType, x, y
+End Sub
+
+Private Sub HandleBlood(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim x As Long, y As Long, sprite As Long, i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ Set Buffer = Nothing
+ ' randomise sprite
+ sprite = Rand(1, BloodCount)
+
+ ' make sure tile doesn't already have blood
+ For i = 1 To MAX_BYTE
+
+ If Blood(i).x = x And Blood(i).y = y Then
+ ' already have blood :(
+ Exit Sub
+ End If
+
+ Next
+
+ ' carry on with the set
+ BloodIndex = BloodIndex + 1
+
+ If BloodIndex >= MAX_BYTE Then BloodIndex = 1
+
+ With Blood(BloodIndex)
+ .x = x
+ .y = y
+ .sprite = sprite
+ .timer = GetTickCount
+ End With
+
+End Sub
+
+Private Sub HandleAnimation(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, x As Long, y As Long, isCasting As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ AnimationIndex = AnimationIndex + 1
+
+ If AnimationIndex >= MAX_BYTE Then AnimationIndex = 1
+
+ With AnimInstance(AnimationIndex)
+ .Animation = Buffer.ReadLong
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ .LockType = Buffer.ReadByte
+ .lockindex = Buffer.ReadLong
+ .isCasting = Buffer.ReadByte
+ .Used(0) = True
+ .Used(1) = True
+ End With
+
+ Set Buffer = Nothing
+
+ ' play the sound if we've got one
+ With AnimInstance(AnimationIndex)
+
+ If .LockType = 0 Then
+ x = AnimInstance(AnimationIndex).x
+ y = AnimInstance(AnimationIndex).y
+ ElseIf .LockType = TARGET_TYPE_PLAYER Then
+ x = GetPlayerX(.lockindex)
+ y = GetPlayerY(.lockindex)
+ ElseIf .LockType = TARGET_TYPE_NPC Then
+ x = MapNpc(.lockindex).x
+ y = MapNpc(.lockindex).y
+ End If
+
+ End With
+
+ PlayMapSound x, y, SoundEntity.seAnimation, AnimInstance(AnimationIndex).Animation
+End Sub
+
+Private Sub HandleMapNpcVitals(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Dim MapNpcNum As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ MapNpcNum = Buffer.ReadLong
+
+ For i = 1 To Vitals.Vital_Count - 1
+ MapNpc(MapNpcNum).Vital(i) = Buffer.ReadLong
+ Next
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleCooldown(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Slot As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Slot = Buffer.ReadLong
+ SpellCD(Slot) = GetTickCount
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleClearSpellBuffer(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SpellBuffer = 0
+ SpellBufferTimer = 0
+End Sub
+
+Private Sub HandleSayMsg(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, Access As Long, name As String, message As String, Colour As Long, header As String, PK As Long, saycolour As Long, usergroup As Long
+ Dim channel As Byte, colStr As String
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ name = Buffer.ReadString
+ Access = Buffer.ReadLong
+ usergroup = Buffer.ReadLong
+ PK = Buffer.ReadLong
+ message = Buffer.ReadString
+ header = Buffer.ReadString
+ saycolour = Buffer.ReadLong
+ Set Buffer = Nothing
+
+ ' Check access level
+ Colour = White
+
+ If usergroup = 10 Or usergroup = 11 Then Colour = Gold
+ If Access > 0 Then Colour = Pink
+ If PK > 0 Then Colour = BrightRed
+
+ ' find channel
+ channel = 0
+ Select Case header
+ Case "[Map] "
+ channel = ChatChannel.chMap
+ Case "[Global] "
+ channel = ChatChannel.chGlobal
+ End Select
+
+ ' remove the colour char from the message
+ message = Replace$(message, ColourChar, vbNullString)
+ ' add to the chat box
+ AddText ColourChar & GetColStr(Colour) & header & name & ": " & ColourChar & GetColStr(Grey) & message, Grey, , channel
+End Sub
+
+Private Sub HandleOpenShop(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim shopNum As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ shopNum = Buffer.ReadLong
+ OpenShop shopNum
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleStunned(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ StunDuration = Buffer.ReadLong
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleBank(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_BANK
+ Bank.Item(i).num = Buffer.ReadLong
+ Bank.Item(i).value = Buffer.ReadLong
+ Next
+
+ InBank = True
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleTrade(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ InTrade = Buffer.ReadLong
+ Set Buffer = Nothing
+
+ ShowTrade
+End Sub
+
+Private Sub HandleCloseTrade(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ InTrade = 0
+ HideWindow GetWindowIndex("winTrade")
+End Sub
+
+Private Sub HandleTradeUpdate(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, dataType As Byte, i As Long, yourWorth As Long, theirWorth As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ dataType = Buffer.ReadByte
+
+ If dataType = 0 Then ' ours!
+ For i = 1 To MAX_INV
+ TradeYourOffer(i).num = Buffer.ReadLong
+ TradeYourOffer(i).value = Buffer.ReadLong
+ Next
+ yourWorth = Buffer.ReadLong
+ Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "lblYourValue")).text = yourWorth & "g"
+ ElseIf dataType = 1 Then 'theirs
+ For i = 1 To MAX_INV
+ TradeTheirOffer(i).num = Buffer.ReadLong
+ TradeTheirOffer(i).value = Buffer.ReadLong
+ Next
+ theirWorth = Buffer.ReadLong
+ Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "lblTheirValue")).text = theirWorth & "g"
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleTradeStatus(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim tradeStatus As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ tradeStatus = Buffer.ReadByte
+ Set Buffer = Nothing
+
+ Select Case tradeStatus
+ Case 0 ' clear
+ Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "lblStatus")).text = "Choose items to offer."
+ Case 1 ' they've accepted
+ Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "lblStatus")).text = "Other player has accepted."
+ Case 2 ' you've accepted
+ Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "lblStatus")).text = "Waiting for other player to accept."
+ Case 3 ' no room
+ Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "lblStatus")).text = "Not enough inventory space."
+ End Select
+End Sub
+
+Private Sub HandleTarget(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ myTarget = Buffer.ReadLong
+ myTargetType = Buffer.ReadLong
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleHotbar(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_HOTBAR
+ Hotbar(i).Slot = Buffer.ReadLong
+ Hotbar(i).sType = Buffer.ReadByte
+ Next
+End Sub
+
+Private Sub HandleHighIndex(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Player_HighIndex = MAX_PLAYERS 'Buffer.ReadLong
+End Sub
+
+Private Sub HandleResetShopAction(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ UpdateShop
+End Sub
+
+Private Sub HandleSound(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim x As Long, y As Long, entityType As Long, entityNum As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+ entityType = Buffer.ReadLong
+ entityNum = Buffer.ReadLong
+ PlayMapSound x, y, entityType, entityNum
+End Sub
+
+Private Sub HandleTradeRequest(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, theName As String, top As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ theName = Buffer.ReadString
+ ' cache name and show invitation
+ diaDataString = theName
+ ShowWindow GetWindowIndex("winInvite_Trade")
+ Windows(GetWindowIndex("winInvite_Trade")).Controls(GetControlIndex("winInvite_Trade", "btnInvite")).text = ColourChar & White & theName & ColourChar & "-1" & " has invited you to trade."
+ AddText Trim$(theName) & " has invited you to trade.", White
+ ' loop through
+ top = ScreenHeight - 80
+ If Windows(GetWindowIndex("winInvite_Party")).Window.visible Then
+ top = top - 37
+ End If
+ Windows(GetWindowIndex("winInvite_Trade")).Window.top = top
+End Sub
+
+Private Sub HandlePartyInvite(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, theName As String, top As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ theName = Buffer.ReadString
+ ' cache name and show invitation popup
+ diaDataString = theName
+ ShowWindow GetWindowIndex("winInvite_Party")
+ Windows(GetWindowIndex("winInvite_Party")).Controls(GetControlIndex("winInvite_Party", "btnInvite")).text = ColourChar & White & theName & ColourChar & "-1" & " has invited you to a party."
+ AddText Trim$(theName) & " has invited you to a party.", White
+ ' loop through
+ top = ScreenHeight - 80
+ If Windows(GetWindowIndex("winInvite_Trade")).Window.visible Then
+ top = top - 37
+ End If
+ Windows(GetWindowIndex("winInvite_Party")).Window.top = top
+End Sub
+
+Private Sub HandlePartyUpdate(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, i As Long, inParty As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ inParty = Buffer.ReadByte
+
+ ' exit out if we're not in a party
+ If inParty = 0 Then
+ Call ZeroMemory(ByVal VarPtr(Party), LenB(Party))
+ UpdatePartyInterface
+ ' exit out early
+ Exit Sub
+ End If
+
+ ' carry on otherwise
+ Party.Leader = Buffer.ReadLong
+
+ For i = 1 To MAX_PARTY_MEMBERS
+ Party.Member(i) = Buffer.ReadLong
+ Next
+
+ Party.MemberCount = Buffer.ReadLong
+
+ ' update the party interface
+ UpdatePartyInterface
+End Sub
+
+Private Sub HandlePartyVitals(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim playerNum As Long
+ Dim Buffer As clsBuffer, i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ ' which player?
+ playerNum = Buffer.ReadLong
+
+ ' set vitals
+ For i = 1 To Vitals.Vital_Count - 1
+ Player(playerNum).MaxVital(i) = Buffer.ReadLong
+ Player(playerNum).Vital(i) = Buffer.ReadLong
+ Next
+
+ ' update the party interface
+ UpdatePartyBars
+End Sub
+
+Private Sub HandleConvEditor(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+
+ With frmEditor_Conv
+ Editor = EDITOR_CONV
+ .lstIndex.Clear
+
+ ' Add the names
+ For i = 1 To MAX_CONVS
+ .lstIndex.AddItem i & ": " & Trim$(Conv(i).name)
+ Next
+
+ .Show
+ .lstIndex.ListIndex = 0
+ ConvEditorInit
+ End With
+
+End Sub
+
+Private Sub HandleUpdateConv(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Convnum As Long
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Dim x As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ Convnum = Buffer.ReadLong
+
+ With Conv(Convnum)
+ .name = Buffer.ReadString
+ .chatCount = Buffer.ReadLong
+ ReDim Conv(Convnum).Conv(1 To .chatCount)
+
+ For i = 1 To .chatCount
+ .Conv(i).Conv = Buffer.ReadString
+
+ For x = 1 To 4
+ .Conv(i).rText(x) = Buffer.ReadString
+ .Conv(i).rTarget(x) = Buffer.ReadLong
+ Next
+
+ .Conv(i).Event = Buffer.ReadLong
+ .Conv(i).Data1 = Buffer.ReadLong
+ .Conv(i).Data2 = Buffer.ReadLong
+ .Conv(i).Data3 = Buffer.ReadLong
+ Next
+
+ End With
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleChatUpdate(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, npcNum As Long, mT As String, o(1 To 4) As String, i As Long
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteBytes data()
+
+ npcNum = Buffer.ReadLong
+ mT = Buffer.ReadString
+ For i = 1 To 4
+ o(i) = Buffer.ReadString
+ Next
+
+ Set Buffer = Nothing
+
+ ' if npcNum is 0, exit the chat system
+ If npcNum = 0 Then
+ inChat = False
+ HideWindow GetWindowIndex("winNpcChat")
+ Exit Sub
+ End If
+
+ ' set chat going
+ OpenNpcChat npcNum, mT, o
+End Sub
+
+Private Sub HandleStartTutorial(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ 'inTutorial = True
+ ' set the first message
+ 'SetTutorialState 1
+End Sub
+
+Private Sub HandleChatBubble(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, TargetType As Long, target As Long, message As String, Colour As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ target = Buffer.ReadLong
+ TargetType = Buffer.ReadLong
+ message = Buffer.ReadString
+ Colour = Buffer.ReadLong
+ AddChatBubble target, TargetType, message, Colour
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleSetPlayerLoginToken(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ loginToken = Buffer.ReadString
+ Set Buffer = Nothing
+ ' try and login to game server
+ AttemptLogin
+End Sub
+
+Private Sub HandlePlayerChars(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, i As Long, winNum As Long, conNum As Long, isSlotEmpty(1 To MAX_CHARS) As Boolean, x As Long
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteBytes data()
+ usergroup = Buffer.ReadLong
+
+ For i = 1 To MAX_CHARS
+ CharName(i) = Trim$(Buffer.ReadString)
+ CharSprite(i) = Buffer.ReadLong
+ CharAccess(i) = Buffer.ReadLong
+ CharClass(i) = Buffer.ReadLong
+ ' set as empty or not
+ If Not Len(Trim$(CharName(i))) > 0 Then isSlotEmpty(i) = True
+ Next
+
+ Set Buffer = Nothing
+
+ HideWindows
+ ShowWindow GetWindowIndex("winCharacters")
+
+ ' set GUI window up
+ winNum = GetWindowIndex("winCharacters")
+ For i = 1 To MAX_CHARS
+ conNum = GetControlIndex("winCharacters", "lblCharName_" & i)
+ With Windows(winNum).Controls(conNum)
+ If Not isSlotEmpty(i) Then
+ .text = CharName(i)
+ Else
+ .text = "Blank Slot"
+ End If
+ End With
+ ' hide/show buttons
+ If isSlotEmpty(i) Then
+ ' create button
+ conNum = GetControlIndex("winCharacters", "btnCreateChar_" & i)
+ Windows(winNum).Controls(conNum).visible = True
+ ' select button
+ conNum = GetControlIndex("winCharacters", "btnSelectChar_" & i)
+ Windows(winNum).Controls(conNum).visible = False
+ ' delete button
+ conNum = GetControlIndex("winCharacters", "btnDelChar_" & i)
+ Windows(winNum).Controls(conNum).visible = False
+ Else
+ ' create button
+ conNum = GetControlIndex("winCharacters", "btnCreateChar_" & i)
+ Windows(winNum).Controls(conNum).visible = False
+ ' select button
+ conNum = GetControlIndex("winCharacters", "btnSelectChar_" & i)
+ Windows(winNum).Controls(conNum).visible = True
+ ' delete button
+ conNum = GetControlIndex("winCharacters", "btnDelChar_" & i)
+ Windows(winNum).Controls(conNum).visible = True
+ End If
+ Next
+End Sub
+
+Private Sub HandleCancelAnimation(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim theIndex As Long, Buffer As clsBuffer, i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+ theIndex = Buffer.ReadLong
+ Set Buffer = Nothing
+ ' find the casting animation
+ For i = 1 To MAX_BYTE
+ If AnimInstance(i).LockType = TARGET_TYPE_PLAYER Then
+ If AnimInstance(i).lockindex = theIndex Then
+ If AnimInstance(i).isCasting = 1 Then
+ ' clear it
+ ClearAnimInstance i
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Private Sub HandlePlayerVariables(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ For i = 1 To MAX_BYTE
+ Player(MyIndex).Variable(i) = Buffer.ReadLong
+ Next
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleEvent(ByVal index As Long, ByRef data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes data()
+
+ If Buffer.ReadLong = 1 Then
+ inEvent = True
+ Else
+ inEvent = False
+ End If
+ eventNum = Buffer.ReadLong
+ eventPageNum = Buffer.ReadLong
+ eventCommandNum = Buffer.ReadLong
+
+ Set Buffer = Nothing
+End Sub
diff --git a/client/src/modIcon.bas b/client/src/modIcon.bas
new file mode 100644
index 0000000..7be6bf0
--- /dev/null
+++ b/client/src/modIcon.bas
@@ -0,0 +1,103 @@
+Attribute VB_Name = "modIcon"
+Option Explicit
+
+Private Declare Function GetSystemMetrics Lib "user32" ( _
+ ByVal nIndex As Long _
+ ) As Long
+
+Private Const SM_CXICON = 11
+Private Const SM_CYICON = 12
+
+Private Const SM_CXSMICON = 49
+Private Const SM_CYSMICON = 50
+
+Private Declare Function LoadImageAsString Lib "user32" Alias "LoadImageA" ( _
+ ByVal hInst As Long, _
+ ByVal lpsz As String, _
+ ByVal uType As Long, _
+ ByVal cxDesired As Long, _
+ ByVal cyDesired As Long, _
+ ByVal fuLoad As Long _
+ ) As Long
+
+Private Const LR_DEFAULTCOLOR = &H0
+Private Const LR_MONOCHROME = &H1
+Private Const LR_COLOR = &H2
+Private Const LR_COPYRETURNORG = &H4
+Private Const LR_COPYDELETEORG = &H8
+Private Const LR_LOADFROMFILE = &H10
+Private Const LR_LOADTRANSPARENT = &H20
+Private Const LR_DEFAULTSIZE = &H40
+Private Const LR_VGACOLOR = &H80
+Private Const LR_LOADMAP3DCOLORS = &H1000
+Private Const LR_CREATEDIBSECTION = &H2000
+Private Const LR_COPYFROMRESOURCE = &H4000
+Private Const LR_SHARED = &H8000&
+
+Private Const IMAGE_ICON = 1
+
+Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
+ ByVal hWnd As Long, ByVal wMsg As Long, _
+ ByVal wParam As Long, ByVal lParam As Long _
+ ) As Long
+
+Private Const WM_SETICON = &H80
+
+Private Const ICON_SMALL = 0
+Private Const ICON_BIG = 1
+
+Private Declare Function GetWindow Lib "user32" ( _
+ ByVal hWnd As Long, ByVal wCmd As Long) As Long
+Private Const GW_OWNER = 4
+
+
+Public Sub SetIcon( _
+ ByVal hWnd As Long, _
+ ByVal sIconResName As String, _
+ Optional ByVal bSetAsAppIcon As Boolean = True _
+ )
+Dim lhWndTop As Long
+Dim lhWnd As Long
+Dim cx As Long
+Dim cy As Long
+Dim hIconLarge As Long
+Dim hIconSmall As Long
+
+ If (bSetAsAppIcon) Then
+ ' Find VB's hidden parent window:
+ lhWnd = hWnd
+ lhWndTop = lhWnd
+ Do While Not (lhWnd = 0)
+ lhWnd = GetWindow(lhWnd, GW_OWNER)
+ If Not (lhWnd = 0) Then
+ lhWndTop = lhWnd
+ End If
+ Loop
+ End If
+
+ cx = GetSystemMetrics(SM_CXICON)
+ cy = GetSystemMetrics(SM_CYICON)
+ hIconLarge = LoadImageAsString( _
+ App.hInstance, sIconResName, _
+ IMAGE_ICON, _
+ cx, cy, _
+ LR_SHARED)
+ If (bSetAsAppIcon) Then
+ SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
+ End If
+ SendMessageLong hWnd, WM_SETICON, ICON_BIG, hIconLarge
+
+ cx = GetSystemMetrics(SM_CXSMICON)
+ cy = GetSystemMetrics(SM_CYSMICON)
+ hIconSmall = LoadImageAsString( _
+ App.hInstance, sIconResName, _
+ IMAGE_ICON, _
+ cx, cy, _
+ LR_SHARED)
+ If (bSetAsAppIcon) Then
+ SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
+ End If
+ SendMessageLong hWnd, WM_SETICON, ICON_SMALL, hIconSmall
+
+End Sub
+
diff --git a/client/src/modInput.bas b/client/src/modInput.bas
new file mode 100644
index 0000000..d8fe3ef
--- /dev/null
+++ b/client/src/modInput.bas
@@ -0,0 +1,665 @@
+Attribute VB_Name = "modInput"
+Option Explicit
+' keyboard input
+Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
+Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
+
+' Actual input
+Public Sub CheckKeys()
+
+ ' exit out if dialogue
+ If diaIndex > 0 Then Exit Sub
+ If GetAsyncKeyState(VK_W) >= 0 Then wDown = False
+ If GetAsyncKeyState(VK_S) >= 0 Then sDown = False
+ If GetAsyncKeyState(VK_A) >= 0 Then aDown = False
+ If GetAsyncKeyState(VK_D) >= 0 Then dDown = False
+ If GetAsyncKeyState(VK_UP) >= 0 Then upDown = False
+ If GetAsyncKeyState(VK_DOWN) >= 0 Then downDown = False
+ If GetAsyncKeyState(VK_LEFT) >= 0 Then leftDown = False
+ If GetAsyncKeyState(VK_RIGHT) >= 0 Then rightDown = False
+ If GetAsyncKeyState(VK_CONTROL) >= 0 Then ControlDown = False
+ If GetAsyncKeyState(VK_SHIFT) >= 0 Then ShiftDown = False
+ If GetAsyncKeyState(VK_TAB) >= 0 Then tabDown = False
+End Sub
+
+Public Sub CheckInputKeys()
+
+ ' exit out if dialogue
+ If diaIndex > 0 Then Exit Sub
+
+ ' exit out if talking
+ If Windows(GetWindowIndex("winChat")).Window.visible Then Exit Sub
+
+ ' continue
+ If GetKeyState(vbKeyShift) < 0 Then
+ ShiftDown = True
+ Else
+ ShiftDown = False
+ End If
+
+ If GetKeyState(vbKeyControl) < 0 Then
+ ControlDown = True
+ Else
+ ControlDown = False
+ End If
+
+ If GetKeyState(vbKeyTab) < 0 Then
+ tabDown = True
+ Else
+ tabDown = False
+ End If
+
+ 'Move Up
+ If Not chatOn Then
+ If GetKeyState(vbKeySpace) < 0 Then
+ CheckMapGetItem
+ End If
+
+ ' move up
+ If GetKeyState(vbKeyW) < 0 Then
+ wDown = True
+ sDown = False
+ aDown = False
+ dDown = False
+ Exit Sub
+ Else
+ wDown = False
+ End If
+
+ 'Move Right
+ If GetKeyState(vbKeyD) < 0 Then
+ wDown = False
+ sDown = False
+ aDown = False
+ dDown = True
+ Exit Sub
+ Else
+ dDown = False
+ End If
+
+ 'Move down
+ If GetKeyState(vbKeyS) < 0 Then
+ wDown = False
+ sDown = True
+ aDown = False
+ dDown = False
+ Exit Sub
+ Else
+ sDown = False
+ End If
+
+ 'Move left
+ If GetKeyState(vbKeyA) < 0 Then
+ wDown = False
+ sDown = False
+ aDown = True
+ dDown = False
+ Exit Sub
+ Else
+ aDown = False
+ End If
+
+ ' move up
+ If GetKeyState(vbKeyUp) < 0 Then
+ upDown = True
+ leftDown = False
+
+ downDown = False
+ rightDown = False
+ Exit Sub
+ Else
+ upDown = False
+ End If
+
+ 'Move Right
+ If GetKeyState(vbKeyRight) < 0 Then
+ upDown = False
+ leftDown = False
+
+ downDown = False
+ rightDown = True
+ Exit Sub
+ Else
+ rightDown = False
+ End If
+
+ 'Move down
+ If GetKeyState(vbKeyDown) < 0 Then
+ upDown = False
+ leftDown = False
+
+ downDown = True
+ rightDown = False
+ Exit Sub
+ Else
+
+ downDown = False
+ End If
+
+ 'Move left
+ If GetKeyState(vbKeyLeft) < 0 Then
+ upDown = False
+ leftDown = True
+
+ downDown = False
+ rightDown = False
+ Exit Sub
+ Else
+ leftDown = False
+ End If
+
+ Else
+ wDown = False
+ sDown = False
+ aDown = False
+ dDown = False
+ upDown = False
+ leftDown = False
+
+ downDown = False
+ rightDown = False
+ End If
+
+End Sub
+
+Public Sub HandleKeyPresses(ByVal KeyAscii As Integer)
+ Dim chatText As String, name As String, i As Long, n As Long, Command() As String, Buffer As clsBuffer, tmpNum As Long
+
+ ' check if we're skipping video
+ If KeyAscii = vbKeyEscape Then
+ ' hide options screen
+ HideWindow GetWindowIndex("winOptions")
+ CloseComboMenu
+ ' handle the video
+ If videoPlaying Then
+ videoPlaying = False
+ FadeAlpha = 0
+ frmMain.picIntro.visible = False
+ StopIntro
+ Exit Sub
+ End If
+ If Windows(GetWindowIndex("winEscMenu")).Window.visible Then
+ ' hide it
+ HideWindow GetWindowIndex("winBlank")
+ HideWindow GetWindowIndex("winEscMenu")
+ Exit Sub
+ Else
+ ' show them
+ ShowWindow GetWindowIndex("winBlank"), True
+ ShowWindow GetWindowIndex("winEscMenu"), True
+ Exit Sub
+ End If
+ End If
+
+ If InGame Then
+ chatText = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text
+ End If
+
+ ' Do we have an active window
+ If activeWindow > 0 Then
+ ' make sure it's visible
+ If Windows(activeWindow).Window.visible Then
+ ' Do we have an active control
+ If Windows(activeWindow).activeControl > 0 Then
+ ' Do our thing
+ With Windows(activeWindow).Controls(Windows(activeWindow).activeControl)
+ ' Handle input
+ Select Case KeyAscii
+ Case vbKeyBack
+ If LenB(.text) > 0 Then
+ .text = left$(.text, Len(.text) - 1)
+ End If
+ Case vbKeyReturn
+ ' override for function callbacks
+ If .entCallBack(entStates.Enter) > 0 Then
+ entCallBack .entCallBack(entStates.Enter), activeWindow, Windows(activeWindow).activeControl, 0, 0
+ Exit Sub
+ Else
+ n = 0
+ For i = Windows(activeWindow).ControlCount To 1 Step -1
+ If i > Windows(activeWindow).activeControl Then
+ If SetActiveControl(activeWindow, i) Then n = i
+ End If
+ Next
+ If n = 0 Then
+ For i = Windows(activeWindow).ControlCount To 1 Step -1
+ SetActiveControl activeWindow, i
+ Next
+ End If
+ End If
+ Case vbKeyTab
+ n = 0
+ For i = Windows(activeWindow).ControlCount To 1 Step -1
+ If i > Windows(activeWindow).activeControl Then
+ If SetActiveControl(activeWindow, i) Then n = i
+ End If
+ Next
+ If n = 0 Then
+ For i = Windows(activeWindow).ControlCount To 1 Step -1
+ SetActiveControl activeWindow, i
+ Next
+ End If
+ Case Else
+ .text = .text & ChrW$(KeyAscii)
+ End Select
+ ' exit out early - if not chatting
+ If Windows(activeWindow).Window.name <> "winChat" Then Exit Sub
+ End With
+ End If
+ End If
+ End If
+
+ ' exit out early if we're not ingame
+ If Not InGame Then Exit Sub
+
+ Select Case KeyAscii
+ Case vbKeyEscape
+ ' hide options screen
+ HideWindow GetWindowIndex("winOptions")
+ CloseComboMenu
+ ' hide/show chat window
+ If Windows(GetWindowIndex("winChat")).Window.visible Then
+ Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text = vbNullString
+ HideChat
+ inSmallChat = True
+ Exit Sub
+ End If
+
+ If Windows(GetWindowIndex("winEscMenu")).Window.visible Then
+ ' hide it
+ HideWindow GetWindowIndex("winBlank")
+ HideWindow GetWindowIndex("winEscMenu")
+ Else
+ ' show them
+ ShowWindow GetWindowIndex("winBlank"), True
+ ShowWindow GetWindowIndex("winEscMenu"), True
+ End If
+ ' exit out early
+ Exit Sub
+ Case 105
+ ' hide/show inventory
+ If Not Windows(GetWindowIndex("winChat")).Window.visible Then btnMenu_Inv
+ Case 99
+ ' hide/show inventory
+ If Not Windows(GetWindowIndex("winChat")).Window.visible Then btnMenu_Char
+ Case 109
+ ' hide/show skills
+ If Not Windows(GetWindowIndex("winChat")).Window.visible Then btnMenu_Skills
+ End Select
+
+ ' handles hotbar
+ If inSmallChat Then
+ For i = 1 To 9
+ If KeyAscii = 48 + i Then
+ SendHotbarUse i
+ End If
+ If KeyAscii = 48 Then SendHotbarUse 10
+ Next
+ End If
+
+ ' Handle when the player presses the return key
+ If KeyAscii = vbKeyReturn Then
+ If Windows(GetWindowIndex("winChatSmall")).Window.visible Then
+ ShowChat
+ inSmallChat = False
+ Exit Sub
+ End If
+
+ ' Broadcast message
+ If left$(chatText, 1) = "'" Then
+ chatText = Mid$(chatText, 2, Len(chatText) - 1)
+
+ If Len(chatText) > 0 Then
+ Call BroadcastMsg(chatText)
+ End If
+
+ Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text = vbNullString
+ HideChat
+ Exit Sub
+ End If
+
+ ' Emote message
+ If left$(chatText, 1) = "-" Then
+ chatText = Mid$(chatText, 2, Len(chatText) - 1)
+
+ If Len(chatText) > 0 Then
+ Call EmoteMsg(chatText)
+ End If
+
+ Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text = vbNullString
+ HideChat
+ Exit Sub
+ End If
+
+ ' Player message
+ If left$(chatText, 1) = "!" Then
+ Exit Sub
+ chatText = Mid$(chatText, 2, Len(chatText) - 1)
+ name = vbNullString
+ ' Get the desired player from the user text
+ tmpNum = Len(chatText)
+
+ For i = 1 To tmpNum
+
+ If Mid$(chatText, i, 1) <> Space$(1) Then
+ name = name & Mid$(chatText, i, 1)
+ Else
+ Exit For
+ End If
+
+ Next
+
+ chatText = Mid$(chatText, i, Len(chatText) - 1)
+
+ ' Make sure they are actually sending something
+ If Len(chatText) - i > 0 Then
+ chatText = Mid$(chatText, i + 1, Len(chatText) - i)
+ ' Send the message to the player
+ Call PlayerMsg(chatText, name)
+ Else
+ Call AddText("Usage: !playername (message)", AlertColor)
+ End If
+
+ Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text = vbNullString
+ HideChat
+ Exit Sub
+ End If
+
+ If left$(chatText, 1) = "/" Then
+ Command = Split(chatText, Space$(1))
+
+ Select Case Command(0)
+
+ Case "/help"
+ Call AddText("Social Commands:", HelpColor)
+ Call AddText("'msghere = Global Message", HelpColor)
+ Call AddText("-msghere = Emote Message", HelpColor)
+ Call AddText("!namehere msghere = Player Message", HelpColor)
+ Call AddText("Available Commands: /who, /fps, /fpslock, /gui, /maps", HelpColor)
+
+ Case "/maps"
+ ClearMapCache
+
+ Case "/gui"
+ hideGUI = Not hideGUI
+
+ Case "/info"
+
+ ' Checks to make sure we have more than one string in the array
+ If UBound(Command) < 1 Then
+ AddText "Usage: /info (name)", AlertColor
+ GoTo continue
+ End If
+
+ If IsNumeric(Command(1)) Then
+ AddText "Usage: /info (name)", AlertColor
+ GoTo continue
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CPlayerInfoRequest
+ Buffer.WriteString Command(1)
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+
+ ' Whos Online
+ Case "/who"
+ SendWhosOnline
+
+ ' Checking fps
+ Case "/fps"
+ BFPS = Not BFPS
+
+ ' toggle fps lock
+ Case "/fpslock"
+ FPS_Lock = Not FPS_Lock
+
+ ' Request stats
+ Case "/stats"
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong CGetStats
+ SendData Buffer.ToArray()
+ Set Buffer = Nothing
+
+ ' // Monitor Admin Commands //
+ ' Kicking a player
+ Case "/kick"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MONITOR Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /kick (name)", AlertColor
+ GoTo continue
+ End If
+
+ If IsNumeric(Command(1)) Then
+ AddText "Usage: /kick (name)", AlertColor
+ GoTo continue
+ End If
+
+ SendKick Command(1)
+
+ ' // Mapper Admin Commands //
+ ' Location
+ Case "/loc"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ BLoc = Not BLoc
+
+ ' Map Editor
+ Case "/editmap"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ SendRequestEditMap
+
+ ' Warping to a player
+ Case "/warpmeto"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /warpmeto (name)", AlertColor
+ GoTo continue
+ End If
+
+ If IsNumeric(Command(1)) Then
+ AddText "Usage: /warpmeto (name)", AlertColor
+ GoTo continue
+ End If
+
+ GettingMap = True
+ WarpMeTo Command(1)
+
+ ' Warping a player to you
+ Case "/warptome"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /warptome (name)", AlertColor
+ GoTo continue
+ End If
+
+ If IsNumeric(Command(1)) Then
+ AddText "Usage: /warptome (name)", AlertColor
+ GoTo continue
+ End If
+
+ WarpToMe Command(1)
+
+ ' Warping to a map
+ Case "/warpto"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /warpto (map #)", AlertColor
+ GoTo continue
+ End If
+
+ If Not IsNumeric(Command(1)) Then
+ AddText "Usage: /warpto (map #)", AlertColor
+ GoTo continue
+ End If
+
+ n = CLng(Command(1))
+
+ ' Check to make sure its a valid map #
+ If n > 0 And n <= MAX_MAPS Then
+ GettingMap = True
+ Call WarpTo(n)
+ Else
+ Call AddText("Invalid map number.", Red)
+ End If
+
+ ' Setting sprite
+ Case "/setsprite"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /setsprite (sprite #)", AlertColor
+ GoTo continue
+ End If
+
+ If Not IsNumeric(Command(1)) Then
+ AddText "Usage: /setsprite (sprite #)", AlertColor
+ GoTo continue
+ End If
+
+ SendSetSprite CLng(Command(1))
+
+ ' Map report
+ Case "/mapreport"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ SendMapReport
+
+ ' Respawn request
+ Case "/respawn"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ SendMapRespawn
+
+ ' MOTD change
+ Case "/motd"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /motd (new motd)", AlertColor
+ GoTo continue
+ End If
+
+ SendMOTDChange Right$(chatText, Len(chatText) - 5)
+
+ ' Check the ban list
+ Case "/banlist"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ SendBanList
+
+ ' Banning a player
+ Case "/ban"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_MAPPER Then GoTo continue
+ If UBound(Command) < 1 Then
+ AddText "Usage: /ban (name)", AlertColor
+ GoTo continue
+ End If
+
+ SendBan Command(1)
+
+ ' // Developer Admin Commands //
+ ' Editing item request
+ Case "/edititem"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditItem
+
+ ' editing conv request
+ Case "/editconv"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditConv
+
+ ' Editing animation request
+ Case "/editanimation"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditAnimation
+
+ ' Editing npc request
+ Case "/editnpc"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditNpc
+
+ Case "/editresource"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditResource
+
+ ' Editing shop request
+ Case "/editshop"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditShop
+
+ ' Editing spell request
+ Case "/editspell"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_DEVELOPER Then GoTo continue
+ SendRequestEditSpell
+
+ ' // Creator Admin Commands //
+ ' Giving another player access
+ Case "/setaccess"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_CREATOR Then GoTo continue
+ If UBound(Command) < 2 Then
+ AddText "Usage: /setaccess (name) (access)", AlertColor
+ GoTo continue
+ End If
+
+ If IsNumeric(Command(1)) Or Not IsNumeric(Command(2)) Then
+ AddText "Usage: /setaccess (name) (access)", AlertColor
+ GoTo continue
+ End If
+
+ SendSetAccess Command(1), CLng(Command(2))
+
+ ' Ban destroy
+ Case "/destroybanlist"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_CREATOR Then GoTo continue
+ SendBanDestroy
+
+ ' Packet debug mode
+ Case "/debug"
+
+ If GetPlayerAccess(MyIndex) < ADMIN_CREATOR Then GoTo continue
+ DEBUG_MODE = (Not DEBUG_MODE)
+
+ Case Else
+ AddText "Not a valid command!", HelpColor
+ End Select
+
+ 'continue label where we go instead of exiting the sub
+continue:
+ Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text = vbNullString
+ HideChat
+ Exit Sub
+ End If
+
+ ' Say message
+ If Len(chatText) > 0 Then
+ Call SayMsg(chatText)
+ End If
+
+ Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "txtChat")).text = vbNullString
+
+ ' hide/show chat window
+ If Windows(GetWindowIndex("winChat")).Window.visible Then HideChat
+ Exit Sub
+ End If
+
+ ' hide/show chat window
+ If Windows(GetWindowIndex("winChatSmall")).Window.visible Then
+ Exit Sub
+ End If
+End Sub
diff --git a/client/src/modInterface.bas b/client/src/modInterface.bas
new file mode 100644
index 0000000..8956844
--- /dev/null
+++ b/client/src/modInterface.bas
@@ -0,0 +1,1813 @@
+Attribute VB_Name = "modInterface"
+Option Explicit
+
+' Entity Types
+Public Enum EntityTypes
+ entLabel = 1
+ entWindow
+ entButton
+ entTextBox
+ entScrollbar
+ entPictureBox
+ entCheckbox
+ entCombobox
+ entCombomenu
+End Enum
+
+' Design Types
+Public Enum DesignTypes
+ ' Boxes
+ desWood = 1
+ desWood_Small
+ desWood_Empty
+ desGreen
+ desGreen_Hover
+ desGreen_Click
+ desRed
+ desRed_Hover
+ desRed_Click
+ desBlue
+ desBlue_Hover
+ desBlue_Click
+ desOrange
+ desOrange_Hover
+ desOrange_Click
+ desGrey
+ desDescPic
+ ' Windows
+ desWin_Black
+ desWin_Norm
+ desWin_NoBar
+ desWin_Empty
+ desWin_Desc
+ desWin_Shadow
+ desWin_Party
+ ' Pictures
+ desParchment
+ desBlackOval
+ ' Textboxes
+ desTextBlack
+ desTextWhite
+ desTextBlack_Sq
+ ' Checkboxes
+ desChkNorm
+ desChkChat
+ desChkCustom_Buying
+ desChkCustom_Selling
+ ' Right-click Menu
+ desMenuHeader
+ desMenuOption
+ ' Comboboxes
+ desComboNorm
+ desComboMenuNorm
+ ' tile Selection
+ desTileBox
+End Enum
+
+' Button States
+Public Enum entStates
+ Normal = 0
+ Hover
+ MouseDown
+ MouseMove
+ MouseUp
+ DblClick
+ Enter
+ ' Count
+ state_Count
+End Enum
+
+' Alignment
+Public Enum Alignment
+ alignLeft = 0
+ alignRight
+ alignCentre
+End Enum
+
+' Part Types
+Public Enum PartType
+ part_None = 0
+ Part_Item
+ Part_spell
+End Enum
+
+' Origins
+Public Enum PartTypeOrigins
+ origin_None = 0
+ origin_Inventory
+ origin_Hotbar
+ origin_Spells
+End Enum
+
+' Entity UDT
+Public Type EntityRec
+ ' constants
+ name As String
+ ' values
+ Type As Byte
+ top As Long
+ left As Long
+ width As Long
+ height As Long
+ enabled As Boolean
+ visible As Boolean
+ canDrag As Boolean
+ Max As Long
+ Min As Long
+ value As Long
+ text As String
+ image(0 To entStates.state_Count - 1) As Long
+ design(0 To entStates.state_Count - 1) As Long
+ entCallBack(0 To entStates.state_Count - 1) As Long
+ alpha As Long
+ clickThrough As Boolean
+ xOffset As Long
+ yOffset As Long
+ align As Byte
+ font As Long
+ textColour As Long
+ textColour_Hover As Long
+ textColour_Click As Long
+ zChange As Byte
+ onDraw As Long
+ origLeft As Long
+ origTop As Long
+ tooltip As String
+ group As Long
+ list() As String
+ activated As Boolean
+ linkedToWin As Long
+ linkedToCon As Long
+ ' window
+ icon As Long
+ ' textbox
+ isCensor As Boolean
+ ' temp
+ state As entStates
+ movedX As Long
+ movedY As Long
+ zOrder As Long
+End Type
+
+' For small parts
+Public Type EntityPartRec
+ Type As PartType
+ Origin As PartTypeOrigins
+ value As Long
+ Slot As Long
+End Type
+
+' Window UDT
+Public Type WindowRec
+ Window As EntityRec
+ Controls() As EntityRec
+ ControlCount As Long
+ activeControl As Long
+End Type
+
+' actual GUI
+Public Windows() As WindowRec
+Public WindowCount As Long
+Public activeWindow As Long
+' GUI parts
+Public DragBox As EntityPartRec
+' Used for automatically the zOrder
+Private zOrder_Win As Long
+Private zOrder_Con As Long
+
+Public Sub CreateEntity(winNum As Long, zOrder As Long, name As String, tType As EntityTypes, ByRef design() As Long, ByRef image() As Long, ByRef entCallBack() As Long, _
+ Optional left As Long, Optional top As Long, Optional width As Long, Optional height As Long, Optional visible As Boolean = True, Optional canDrag As Boolean, Optional Max As Long, _
+ Optional Min As Long, Optional value As Long, Optional text As String, Optional align As Byte, Optional font As Long = Fonts.georgia_16, Optional textColour As Long = White, _
+ Optional alpha As Long = 255, Optional clickThrough As Boolean, Optional xOffset As Long, Optional yOffset As Long, Optional zChange As Byte, Optional ByVal icon As Long, _
+ Optional ByVal onDraw As Long, Optional isActive As Boolean, Optional isCensor As Boolean, Optional textColour_Hover As Long, Optional textColour_Click As Long, _
+ Optional tooltip As String, Optional group As Long)
+ Dim i As Long
+
+ ' check if it's a legal number
+ If winNum <= 0 Or winNum > WindowCount Then
+ Exit Sub
+ End If
+
+ ' re-dim the control array
+ With Windows(winNum)
+ .ControlCount = .ControlCount + 1
+ ReDim Preserve .Controls(1 To .ControlCount) As EntityRec
+ End With
+
+ ' Set the new control values
+ With Windows(winNum).Controls(Windows(winNum).ControlCount)
+ .name = name
+ .Type = tType
+
+ ' loop through states
+ For i = 0 To entStates.state_Count - 1
+ .design(i) = design(i)
+ .image(i) = image(i)
+ .entCallBack(i) = entCallBack(i)
+ Next
+
+ .left = left
+ .top = top
+ .origLeft = left
+ .origTop = top
+ .width = width
+ .height = height
+ .visible = visible
+ .canDrag = canDrag
+ .Max = Max
+ .Min = Min
+ .value = value
+ .text = text
+ .align = align
+ .font = font
+ .textColour = textColour
+ .textColour_Hover = textColour_Hover
+ .textColour_Click = textColour_Click
+ .alpha = alpha
+ .clickThrough = clickThrough
+ .xOffset = xOffset
+ .yOffset = yOffset
+ .zChange = zChange
+ .zOrder = zOrder
+ .enabled = True
+ .icon = icon
+ .onDraw = onDraw
+ .isCensor = isCensor
+ .tooltip = tooltip
+ .group = group
+ ReDim .list(0 To 0) As String
+ End With
+
+ ' set the active control
+ If isActive Then Windows(winNum).activeControl = Windows(winNum).ControlCount
+
+ ' set the zOrder
+ zOrder_Con = zOrder_Con + 1
+End Sub
+
+Public Sub UpdateZOrder(winNum As Long, Optional forced As Boolean = False)
+ Dim i As Long
+ Dim oldZOrder As Long
+
+ With Windows(winNum).Window
+
+ If Not forced Then If .zChange = 0 Then Exit Sub
+ If .zOrder = WindowCount Then Exit Sub
+ oldZOrder = .zOrder
+
+ For i = 1 To WindowCount
+
+ If Windows(i).Window.zOrder > oldZOrder Then
+ Windows(i).Window.zOrder = Windows(i).Window.zOrder - 1
+ End If
+
+ Next
+
+ .zOrder = WindowCount
+ End With
+
+End Sub
+
+Public Sub SortWindows()
+ Dim tempWindow As WindowRec
+ Dim i As Long, x As Long
+ x = 1
+
+ While x <> 0
+ x = 0
+
+ For i = 1 To WindowCount - 1
+
+ If Windows(i).Window.zOrder > Windows(i + 1).Window.zOrder Then
+ tempWindow = Windows(i)
+ Windows(i) = Windows(i + 1)
+ Windows(i + 1) = tempWindow
+ x = 1
+ End If
+
+ Next
+
+ Wend
+
+End Sub
+
+Public Sub RenderEntities()
+ Dim i As Long, x As Long, curZOrder As Long
+
+ ' don't render anything if we don't have any containers
+ If WindowCount = 0 Then Exit Sub
+ ' reset zOrder
+ curZOrder = 1
+
+ ' loop through windows
+ Do While curZOrder <= WindowCount
+ For i = 1 To WindowCount
+ If curZOrder = Windows(i).Window.zOrder Then
+ ' increment
+ curZOrder = curZOrder + 1
+ ' make sure it's visible
+ If Windows(i).Window.visible Then
+ ' render container
+ RenderWindow i
+ ' render controls
+ For x = 1 To Windows(i).ControlCount
+ If Windows(i).Controls(x).visible Then RenderEntity i, x
+ Next
+ End If
+ End If
+ Next
+ Loop
+End Sub
+
+Public Sub RenderEntity(winNum As Long, entNum As Long)
+ Dim xO As Long, yO As Long, hor_centre As Long, ver_centre As Long, height As Long, width As Long, left As Long, texNum As Long, xOffset As Long
+ Dim callBack As Long, taddText As String, Colour As Long, textArray() As String, count As Long, yOffset As Long, i As Long, y As Long, x As Long
+
+ ' check if the window exists
+ If winNum <= 0 Or winNum > WindowCount Then
+ Exit Sub
+ End If
+
+ ' check if the entity exists
+ If entNum <= 0 Or entNum > Windows(winNum).ControlCount Then
+ Exit Sub
+ End If
+
+ ' check the container's position
+ xO = Windows(winNum).Window.left
+ yO = Windows(winNum).Window.top
+
+ With Windows(winNum).Controls(entNum)
+
+ ' find the control type
+ Select Case .Type
+ ' picture box
+ Case EntityTypes.entPictureBox
+ ' render specific designs
+ If .design(.state) > 0 Then RenderDesign .design(.state), .left + xO, .top + yO, .width, .height, .alpha
+ ' render image
+ If .image(.state) > 0 Then RenderTexture .image(.state), .left + xO, .top + yO, 0, 0, .width, .height, .width, .height, DX8Colour(White, .alpha)
+
+ ' textbox
+ Case EntityTypes.entTextBox
+ ' render specific designs
+ If .design(.state) > 0 Then RenderDesign .design(.state), .left + xO, .top + yO, .width, .height, .alpha
+ ' render image
+ If .image(.state) > 0 Then RenderTexture .image(.state), .left + xO, .top + yO, 0, 0, .width, .height, .width, .height, DX8Colour(White, .alpha)
+ ' render text
+ If activeWindow = winNum And Windows(winNum).activeControl = entNum Then taddText = chatShowLine
+ ' if it's censored then render censored
+ If Not .isCensor Then
+ RenderText font(.font), .text & taddText, .left + xO + .xOffset, .top + yO + .yOffset, .textColour
+ Else
+ RenderText font(.font), CensorWord(.text) & taddText, .left + xO + .xOffset, .top + yO + .yOffset, .textColour
+ End If
+
+ ' buttons
+ Case EntityTypes.entButton
+ ' render specific designs
+ If .design(.state) > 0 Then
+ If .design(.state) > 0 Then
+ RenderDesign .design(.state), .left + xO, .top + yO, .width, .height
+ End If
+ End If
+ ' render image
+ If .image(.state) > 0 Then
+ If .image(.state) > 0 Then
+ RenderTexture .image(.state), .left + xO, .top + yO, 0, 0, .width, .height, .width, .height
+ End If
+ End If
+ ' render icon
+ If .icon > 0 Then
+ width = mTexture(.icon).w
+ height = mTexture(.icon).h
+ RenderTexture .icon, .left + xO + .xOffset, .top + yO + .yOffset, 0, 0, width, height, width, height
+ End If
+ ' for changing the text space
+ xOffset = width
+ ' calculate the vertical centre
+ height = TextHeight(font(Fonts.georgiaDec_16))
+ If height > .height Then
+ ver_centre = .top + yO
+ Else
+ ver_centre = .top + yO + ((.height - height) \ 2) + 1
+ End If
+ ' calculate the horizontal centre
+ width = TextWidth(font(.font), .text)
+ If width > .width Then
+ hor_centre = .left + xO + xOffset
+ Else
+ hor_centre = .left + xO + xOffset + ((.width - width - xOffset) \ 2)
+ End If
+ ' get the colour
+ If .state = Hover Then
+ Colour = .textColour_Hover
+ ElseIf .state = MouseDown Then
+ Colour = .textColour_Click
+ Else
+ Colour = .textColour
+ End If
+ RenderText font(.font), .text, hor_centre, ver_centre, Colour
+
+ ' labels
+ Case EntityTypes.entLabel
+ If Len(.text) > 0 Then
+ Select Case .align
+ Case Alignment.alignLeft
+ ' check if need to word wrap
+ If TextWidth(font(.font), .text) > .width Then
+ ' wrap text
+ WordWrap_Array .text, .width, textArray()
+ ' render text
+ count = UBound(textArray)
+ For i = 1 To count
+ RenderText font(.font), textArray(i), .left + xO, .top + yO + yOffset, .textColour, .alpha
+ yOffset = yOffset + 14
+ Next
+ Else
+ ' just one line
+ RenderText font(.font), .text, .left + xO, .top + yO, .textColour, .alpha
+ End If
+ Case Alignment.alignRight
+ ' check if need to word wrap
+ If TextWidth(font(.font), .text) > .width Then
+ ' wrap text
+ WordWrap_Array .text, .width, textArray()
+ ' render text
+ count = UBound(textArray)
+ For i = 1 To count
+ left = .left + .width - TextWidth(font(.font), textArray(i))
+ RenderText font(.font), textArray(i), left + xO, .top + yO + yOffset, .textColour, .alpha
+ yOffset = yOffset + 14
+ Next
+ Else
+ ' just one line
+ left = .left + .width - TextWidth(font(.font), .text)
+ RenderText font(.font), .text, left + xO, .top + yO, .textColour, .alpha
+ End If
+ Case Alignment.alignCentre
+ ' check if need to word wrap
+ If TextWidth(font(.font), .text) > .width Then
+ ' wrap text
+ WordWrap_Array .text, .width, textArray()
+ ' render text
+ count = UBound(textArray)
+ For i = 1 To count
+ left = .left + (.width \ 2) - (TextWidth(font(.font), textArray(i)) \ 2)
+ RenderText font(.font), textArray(i), left + xO, .top + yO + yOffset, .textColour, .alpha
+ yOffset = yOffset + 14
+ Next
+ Else
+ ' just one line
+ left = .left + (.width \ 2) - (TextWidth(font(.font), .text) \ 2)
+ RenderText font(.font), .text, left + xO, .top + yO, .textColour, .alpha
+ End If
+ End Select
+ End If
+
+ ' checkboxes
+ Case EntityTypes.entCheckbox
+
+ Select Case .design(0)
+ Case DesignTypes.desChkNorm
+ ' empty?
+ If .value = 0 Then texNum = Tex_GUI(2) Else texNum = Tex_GUI(3)
+ ' render box
+ RenderTexture texNum, .left + xO, .top + yO, 0, 0, 14, 14, 14, 14
+ ' find text position
+ Select Case .align
+ Case Alignment.alignLeft
+ left = .left + 18 + xO
+ Case Alignment.alignRight
+ left = .left + 18 + (.width - 18) - TextWidth(font(.font), .text) + xO
+ Case Alignment.alignCentre
+ left = .left + 18 + ((.width - 18) / 2) - (TextWidth(font(.font), .text) / 2) + xO
+ End Select
+ ' render text
+ RenderText font(.font), .text, left, .top + yO, .textColour, .alpha
+ Case DesignTypes.desChkChat
+ If .value = 0 Then .alpha = 150 Else .alpha = 255
+ ' render box
+ RenderTexture Tex_GUI(51), .left + xO, .top + yO, 0, 0, 49, 23, 49, 23, DX8Colour(White, .alpha)
+ ' render text
+ left = .left + (49 / 2) - (TextWidth(font(.font), .text) / 2) + xO
+ ' render text
+ RenderText font(.font), .text, left, .top + yO + 4, .textColour, .alpha
+ Case DesignTypes.desChkCustom_Buying
+ If .value = 0 Then texNum = Tex_GUI(58) Else texNum = Tex_GUI(56)
+ RenderTexture texNum, .left + xO, .top + yO, 0, 0, 49, 20, 49, 20
+ Case DesignTypes.desChkCustom_Selling
+ If .value = 0 Then texNum = Tex_GUI(59) Else texNum = Tex_GUI(57)
+ RenderTexture texNum, .left + xO, .top + yO, 0, 0, 49, 20, 49, 20
+ End Select
+
+ ' comboboxes
+ Case EntityTypes.entCombobox
+ Select Case .design(0)
+ Case DesignTypes.desComboNorm
+ ' draw the background
+ RenderDesign DesignTypes.desTextBlack, .left + xO, .top + yO, .width, .height
+ ' render the text
+ If .value > 0 Then
+ If .value <= UBound(.list) Then
+ RenderText font(.font), .list(.value), .left + xO + 5, .top + yO + 3, White
+ End If
+ End If
+ ' draw the little arow
+ RenderTexture Tex_GUI(66), .left + xO + .width - 11, .top + yO + 7, 0, 0, 5, 4, 5, 4
+ End Select
+ End Select
+
+ ' callback draw
+ callBack = .onDraw
+
+ If callBack <> 0 Then entCallBack callBack, winNum, entNum, 0, 0
+ End With
+
+End Sub
+
+Public Sub RenderWindow(winNum As Long)
+ Dim width As Long, height As Long, callBack As Long, x As Long, y As Long, i As Long, left As Long
+
+ ' check if the window exists
+ If winNum <= 0 Or winNum > WindowCount Then
+ Exit Sub
+ End If
+
+ With Windows(winNum).Window
+
+ Select Case .design(0)
+ Case DesignTypes.desComboMenuNorm
+ RenderTexture Tex_Blank, .left, .top, 0, 0, .width, .height, 1, 1, DX8Colour(Black, 157)
+ ' text
+ If UBound(.list) > 0 Then
+ y = .top + 2
+ x = .left
+ For i = 1 To UBound(.list)
+ ' render select
+ If i = .value Or i = .group Then RenderTexture Tex_Blank, x, y - 1, 0, 0, .width, 15, 1, 1, DX8Colour(Black, 255)
+ ' render text
+ left = x + (.width \ 2) - (TextWidth(font(.font), .list(i)) \ 2)
+ If i = .value Or i = .group Then
+ RenderText font(.font), .list(i), left, y, Yellow
+ Else
+ RenderText font(.font), .list(i), left, y, White
+ End If
+ y = y + 16
+ Next
+ End If
+ Exit Sub
+ End Select
+
+ Select Case .design(.state)
+
+ Case DesignTypes.desWin_Black
+ RenderTexture Tex_Fader, .left, .top, 0, 0, .width, .height, 32, 32, DX8Colour(Black, 190)
+
+ Case DesignTypes.desWin_Norm
+ ' render window
+ RenderDesign DesignTypes.desWood, .left, .top, .width, .height
+ RenderDesign DesignTypes.desGreen, .left + 2, .top + 2, .width - 4, 21
+ ' render the icon
+ width = mTexture(.icon).w
+ height = mTexture(.icon).h
+ RenderTexture .icon, .left + .xOffset, .top - (width - 18) + .yOffset, 0, 0, width, height, width, height
+ ' render the caption
+ RenderText font(.font), Trim$(.text), .left + height + 2, .top + 5, .textColour
+
+ Case DesignTypes.desWin_NoBar
+ ' render window
+ RenderDesign DesignTypes.desWood, .left, .top, .width, .height
+
+ Case DesignTypes.desWin_Empty
+ ' render window
+ RenderDesign DesignTypes.desWood_Empty, .left, .top, .width, .height
+ RenderDesign DesignTypes.desGreen, .left + 2, .top + 2, .width - 4, 21
+ ' render the icon
+ width = mTexture(.icon).w
+ height = mTexture(.icon).h
+ RenderTexture .icon, .left + .xOffset, .top - (width - 18) + .yOffset, 0, 0, width, height, width, height
+ ' render the caption
+ RenderText font(.font), Trim$(.text), .left + height + 2, .top + 5, .textColour
+
+ Case DesignTypes.desWin_Desc
+ ' render window
+ RenderDesign DesignTypes.desWin_Desc, .left, .top, .width, .height
+
+ Case desWin_Shadow
+ ' render window
+ RenderDesign DesignTypes.desWin_Shadow, .left, .top, .width, .height
+
+ Case desWin_Party
+ ' render window
+ RenderDesign DesignTypes.desWin_Party, .left, .top, .width, .height
+ End Select
+
+ ' OnDraw call back
+ callBack = .onDraw
+
+ If callBack <> 0 Then entCallBack callBack, winNum, 0, 0, 0
+ End With
+
+End Sub
+
+Public Sub RenderDesign(design As Long, left As Long, top As Long, width As Long, height As Long, Optional alpha As Long = 255)
+ Dim bs As Long, Colour As Long
+ ' change colour for alpha
+ Colour = DX8Colour(White, alpha)
+
+ Select Case design
+
+ Case DesignTypes.desMenuHeader
+ ' render the header
+ RenderTexture Tex_Blank, left, top, 0, 0, width, height, 32, 32, D3DColorARGB(200, 47, 77, 29)
+
+ Case DesignTypes.desMenuOption
+ ' render the option
+ RenderTexture Tex_Blank, left, top, 0, 0, width, height, 32, 32, D3DColorARGB(200, 98, 98, 98)
+
+ Case DesignTypes.desWood
+ bs = 4
+ ' render the wood box
+ RenderEntity_Square Tex_Design(1), left, top, width, height, bs, alpha
+ ' render wood texture
+ RenderTexture Tex_GUI(1), left + bs, top + bs, 100, 100, width - (bs * 2), height - (bs * 2), width - (bs * 2), height - (bs * 2), Colour
+
+ Case DesignTypes.desWood_Small
+ bs = 2
+ ' render the wood box
+ RenderEntity_Square Tex_Design(8), left, top, width, height, bs, alpha
+ ' render wood texture
+ RenderTexture Tex_GUI(1), left + bs, top + bs, 100, 100, width - (bs * 2), height - (bs * 2), width - (bs * 2), height - (bs * 2), Colour
+
+ Case DesignTypes.desWood_Empty
+ bs = 4
+ ' render the wood box
+ RenderEntity_Square Tex_Design(9), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desGreen
+ bs = 2
+ ' render the green box
+ RenderEntity_Square Tex_Design(2), left, top, width, height, bs, alpha
+ ' render green gradient overlay
+ RenderTexture Tex_Gradient(1), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desGreen_Hover
+ bs = 2
+ ' render the green box
+ RenderEntity_Square Tex_Design(2), left, top, width, height, bs, alpha
+ ' render green gradient overlay
+ RenderTexture Tex_Gradient(2), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desGreen_Click
+ bs = 2
+ ' render the green box
+ RenderEntity_Square Tex_Design(2), left, top, width, height, bs, alpha
+ ' render green gradient overlay
+ RenderTexture Tex_Gradient(3), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desRed
+ bs = 2
+ ' render the red box
+ RenderEntity_Square Tex_Design(3), left, top, width, height, bs, alpha
+ ' render red gradient overlay
+ RenderTexture Tex_Gradient(4), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desRed_Hover
+ bs = 2
+ ' render the red box
+ RenderEntity_Square Tex_Design(3), left, top, width, height, bs, alpha
+ ' render red gradient overlay
+ RenderTexture Tex_Gradient(5), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desRed_Click
+ bs = 2
+ ' render the red box
+ RenderEntity_Square Tex_Design(3), left, top, width, height, bs, alpha
+ ' render red gradient overlay
+ RenderTexture Tex_Gradient(6), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desBlue
+ bs = 2
+ ' render the Blue box
+ RenderEntity_Square Tex_Design(14), left, top, width, height, bs, alpha
+ ' render Blue gradient overlay
+ RenderTexture Tex_Gradient(8), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desBlue_Hover
+ bs = 2
+ ' render the Blue box
+ RenderEntity_Square Tex_Design(14), left, top, width, height, bs, alpha
+ ' render Blue gradient overlay
+ RenderTexture Tex_Gradient(9), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desBlue_Click
+ bs = 2
+ ' render the Blue box
+ RenderEntity_Square Tex_Design(14), left, top, width, height, bs, alpha
+ ' render Blue gradient overlay
+ RenderTexture Tex_Gradient(10), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desOrange
+ bs = 2
+ ' render the Orange box
+ RenderEntity_Square Tex_Design(15), left, top, width, height, bs, alpha
+ ' render Orange gradient overlay
+ RenderTexture Tex_Gradient(11), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desOrange_Hover
+ bs = 2
+ ' render the Orange box
+ RenderEntity_Square Tex_Design(15), left, top, width, height, bs, alpha
+ ' render Orange gradient overlay
+ RenderTexture Tex_Gradient(12), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desOrange_Click
+ bs = 2
+ ' render the Orange box
+ RenderEntity_Square Tex_Design(15), left, top, width, height, bs, alpha
+ ' render Orange gradient overlay
+ RenderTexture Tex_Gradient(13), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desGrey
+ bs = 2
+ ' render the Orange box
+ RenderEntity_Square Tex_Design(17), left, top, width, height, bs, alpha
+ ' render Orange gradient overlay
+ RenderTexture Tex_Gradient(14), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desParchment
+ bs = 20
+ ' render the parchment box
+ RenderEntity_Square Tex_Design(4), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desBlackOval
+ bs = 4
+ ' render the black oval
+ RenderEntity_Square Tex_Design(5), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desTextBlack
+ bs = 5
+ ' render the black oval
+ RenderEntity_Square Tex_Design(6), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desTextWhite
+ bs = 5
+ ' render the black oval
+ RenderEntity_Square Tex_Design(7), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desTextBlack_Sq
+ bs = 4
+ ' render the black oval
+ RenderEntity_Square Tex_Design(10), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desWin_Desc
+ bs = 8
+ ' render black square
+ RenderEntity_Square Tex_Design(11), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desDescPic
+ bs = 3
+ ' render the green box
+ RenderEntity_Square Tex_Design(12), left, top, width, height, bs, alpha
+ ' render green gradient overlay
+ RenderTexture Tex_Gradient(7), left + bs, top + bs, 0, 0, width - (bs * 2), height - (bs * 2), 128, 128, Colour
+
+ Case DesignTypes.desWin_Shadow
+ bs = 35
+ ' render the green box
+ RenderEntity_Square Tex_Design(13), left - bs, top - bs, width + (bs * 2), height + (bs * 2), bs, alpha
+
+ Case DesignTypes.desWin_Party
+ bs = 12
+ ' render black square
+ RenderEntity_Square Tex_Design(16), left, top, width, height, bs, alpha
+
+ Case DesignTypes.desTileBox
+ bs = 4
+ ' render box
+ RenderEntity_Square Tex_Design(18), left, top, width, height, bs, alpha
+ End Select
+
+End Sub
+
+Public Sub RenderEntity_Square(texNum As Long, x As Long, y As Long, width As Long, height As Long, borderSize As Long, Optional alpha As Long = 255)
+ Dim bs As Long, Colour As Long
+ ' change colour for alpha
+ Colour = DX8Colour(White, alpha)
+ ' Set the border size
+ bs = borderSize
+ ' Draw centre
+ RenderTexture texNum, x + bs, y + bs, bs + 1, bs + 1, width - (bs * 2), height - (bs * 2), 1, 1, Colour
+ ' Draw top side
+ RenderTexture texNum, x + bs, y, bs, 0, width - (bs * 2), bs, 1, bs, Colour
+ ' Draw left side
+ RenderTexture texNum, x, y + bs, 0, bs, bs, height - (bs * 2), bs, 1, Colour
+ ' Draw right side
+ RenderTexture texNum, x + width - bs, y + bs, bs + 3, bs, bs, height - (bs * 2), bs, 1, Colour
+ ' Draw bottom side
+ RenderTexture texNum, x + bs, y + height - bs, bs, bs + 3, width - (bs * 2), bs, 1, bs, Colour
+ ' Draw top left corner
+ RenderTexture texNum, x, y, 0, 0, bs, bs, bs, bs, Colour
+ ' Draw top right corner
+ RenderTexture texNum, x + width - bs, y, bs + 3, 0, bs, bs, bs, bs, Colour
+ ' Draw bottom left corner
+ RenderTexture texNum, x, y + height - bs, 0, bs + 3, bs, bs, bs, bs, Colour
+ ' Draw bottom right corner
+ RenderTexture texNum, x + width - bs, y + height - bs, bs + 3, bs + 3, bs, bs, bs, bs, Colour
+End Sub
+
+Sub Combobox_AddItem(winIndex As Long, controlIndex As Long, text As String)
+Dim count As Long
+ count = UBound(Windows(winIndex).Controls(controlIndex).list)
+ ReDim Preserve Windows(winIndex).Controls(controlIndex).list(0 To count + 1)
+ Windows(winIndex).Controls(controlIndex).list(count + 1) = text
+End Sub
+
+Public Sub CreateWindow(name As String, caption As String, zOrder As Long, left As Long, top As Long, width As Long, height As Long, icon As Long, _
+ Optional visible As Boolean = True, Optional font As Long = Fonts.georgia_16, Optional textColour As Long = White, Optional xOffset As Long, _
+ Optional yOffset As Long, Optional design_norm As Long, Optional design_hover As Long, Optional design_mousedown As Long, Optional image_norm As Long, _
+ Optional image_hover As Long, Optional image_mousedown As Long, Optional entCallBack_norm As Long, Optional entCallBack_hover As Long, Optional entCallBack_mousedown As Long, _
+ Optional entCallBack_mousemove As Long, Optional entCallBack_dblclick As Long, Optional canDrag As Boolean = True, Optional zChange As Byte = True, Optional ByVal onDraw As Long, _
+ Optional isActive As Boolean, Optional clickThrough As Boolean)
+
+ Dim i As Long
+ Dim design(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+
+ ' fill temp arrays
+ design(entStates.Normal) = design_norm
+ design(entStates.Hover) = design_hover
+ design(entStates.MouseDown) = design_mousedown
+ design(entStates.DblClick) = design_norm
+ design(entStates.MouseUp) = design_norm
+ image(entStates.Normal) = image_norm
+ image(entStates.Hover) = image_hover
+ image(entStates.MouseDown) = image_mousedown
+ image(entStates.DblClick) = image_norm
+ image(entStates.MouseUp) = image_norm
+ entCallBack(entStates.Normal) = entCallBack_norm
+ entCallBack(entStates.Hover) = entCallBack_hover
+ entCallBack(entStates.MouseDown) = entCallBack_mousedown
+ entCallBack(entStates.MouseMove) = entCallBack_mousemove
+ entCallBack(entStates.DblClick) = entCallBack_dblclick
+ ' redim the windows
+ WindowCount = WindowCount + 1
+ ReDim Preserve Windows(1 To WindowCount) As WindowRec
+
+ ' set the properties
+ With Windows(WindowCount).Window
+ .name = name
+ .Type = EntityTypes.entWindow
+
+ ' loop through states
+ For i = 0 To entStates.state_Count - 1
+ .design(i) = design(i)
+ .image(i) = image(i)
+ .entCallBack(i) = entCallBack(i)
+ Next
+
+ .left = left
+ .top = top
+ .origLeft = left
+ .origTop = top
+ .width = width
+ .height = height
+ .visible = visible
+ .canDrag = canDrag
+ .text = caption
+ .font = font
+ .textColour = textColour
+ .xOffset = xOffset
+ .yOffset = yOffset
+ .icon = icon
+ .enabled = True
+ .zChange = zChange
+ .zOrder = zOrder
+ .onDraw = onDraw
+ .clickThrough = clickThrough
+ ' set active
+ If .visible Then activeWindow = WindowCount
+ End With
+
+ ' set the zOrder
+ zOrder_Win = zOrder_Win + 1
+End Sub
+
+Public Sub CreateTextbox(winNum As Long, name As String, left As Long, top As Long, width As Long, height As Long, Optional text As String, Optional font As Long = Fonts.georgia_16, _
+ Optional textColour As Long = White, Optional align As Byte = Alignment.alignLeft, Optional visible As Boolean = True, Optional alpha As Long = 255, Optional image_norm As Long, _
+ Optional image_hover As Long, Optional image_mousedown As Long, Optional design_norm As Long, Optional design_hover As Long, Optional design_mousedown As Long, _
+ Optional entCallBack_norm As Long, Optional entCallBack_hover As Long, Optional entCallBack_mousedown As Long, Optional entCallBack_mousemove As Long, Optional entCallBack_dblclick As Long, _
+ Optional isActive As Boolean, Optional xOffset As Long, Optional yOffset As Long, Optional isCensor As Boolean, Optional entCallBack_enter As Long)
+ Dim design(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+ ' fill temp arrays
+ design(entStates.Normal) = design_norm
+ design(entStates.Hover) = design_hover
+ design(entStates.MouseDown) = design_mousedown
+ image(entStates.Normal) = image_norm
+ image(entStates.Hover) = image_hover
+ image(entStates.MouseDown) = image_mousedown
+ entCallBack(entStates.Normal) = entCallBack_norm
+ entCallBack(entStates.Hover) = entCallBack_hover
+ entCallBack(entStates.MouseDown) = entCallBack_mousedown
+ entCallBack(entStates.MouseMove) = entCallBack_mousemove
+ entCallBack(entStates.DblClick) = entCallBack_dblclick
+ entCallBack(entStates.Enter) = entCallBack_enter
+ ' create the textbox
+ CreateEntity winNum, zOrder_Con, name, entTextBox, design(), image(), entCallBack(), left, top, width, height, visible, , , , , text, align, font, textColour, alpha, , xOffset, yOffset, , , , isActive, isCensor
+ End Sub
+
+Public Sub CreatePictureBox(winNum As Long, name As String, left As Long, top As Long, width As Long, height As Long, Optional visible As Boolean = True, Optional canDrag As Boolean, _
+ Optional alpha As Long = 255, Optional clickThrough As Boolean, Optional image_norm As Long, Optional image_hover As Long, Optional image_mousedown As Long, Optional design_norm As Long, _
+ Optional design_hover As Long, Optional design_mousedown As Long, Optional entCallBack_norm As Long, Optional entCallBack_hover As Long, Optional entCallBack_mousedown As Long, _
+ Optional entCallBack_mousemove As Long, Optional entCallBack_dblclick As Long, Optional onDraw As Long)
+ Dim design(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+ ' fill temp arrays
+ design(entStates.Normal) = design_norm
+ design(entStates.Hover) = design_hover
+ design(entStates.MouseDown) = design_mousedown
+ image(entStates.Normal) = image_norm
+ image(entStates.Hover) = image_hover
+ image(entStates.MouseDown) = image_mousedown
+ entCallBack(entStates.Normal) = entCallBack_norm
+ entCallBack(entStates.Hover) = entCallBack_hover
+ entCallBack(entStates.MouseDown) = entCallBack_mousedown
+ entCallBack(entStates.MouseMove) = entCallBack_mousemove
+ entCallBack(entStates.DblClick) = entCallBack_dblclick
+ ' create the box
+ CreateEntity winNum, zOrder_Con, name, entPictureBox, design(), image(), entCallBack(), left, top, width, height, visible, canDrag, , , , , , , , alpha, clickThrough, , , , , onDraw
+End Sub
+
+Public Sub CreateButton(winNum As Long, name As String, left As Long, top As Long, width As Long, height As Long, Optional text As String, Optional font As Fonts = Fonts.georgia_16, _
+ Optional textColour As Long = White, Optional icon As Long, Optional visible As Boolean = True, Optional alpha As Long = 255, Optional image_norm As Long, Optional image_hover As Long, _
+ Optional image_mousedown As Long, Optional design_norm As Long, Optional design_hover As Long, Optional design_mousedown As Long, Optional entCallBack_norm As Long, _
+ Optional entCallBack_hover As Long, Optional entCallBack_mousedown As Long, Optional entCallBack_mousemove As Long, Optional entCallBack_dblclick As Long, Optional xOffset As Long, _
+ Optional yOffset As Long, Optional textColour_Hover As Long = -1, Optional textColour_Click As Long = -1, Optional tooltip As String)
+ Dim design(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+ ' default the colours
+ If textColour_Hover = -1 Then textColour_Hover = textColour
+ If textColour_Click = -1 Then textColour_Click = textColour
+ ' fill temp arrays
+ design(entStates.Normal) = design_norm
+ design(entStates.Hover) = design_hover
+ design(entStates.MouseDown) = design_mousedown
+ image(entStates.Normal) = image_norm
+ image(entStates.Hover) = image_hover
+ image(entStates.MouseDown) = image_mousedown
+ entCallBack(entStates.Normal) = entCallBack_norm
+ entCallBack(entStates.Hover) = entCallBack_hover
+ entCallBack(entStates.MouseDown) = entCallBack_mousedown
+ entCallBack(entStates.MouseMove) = entCallBack_mousemove
+ entCallBack(entStates.DblClick) = entCallBack_dblclick
+ ' create the box
+ CreateEntity winNum, zOrder_Con, name, entButton, design(), image(), entCallBack(), left, top, width, height, visible, , , , , text, , font, textColour, alpha, , xOffset, yOffset, , icon, , , , textColour_Hover, textColour_Click, tooltip
+End Sub
+
+Public Sub CreateLabel(winNum As Long, name As String, left As Long, top As Long, width As Long, Optional height As Long, Optional text As String, Optional font As Fonts = Fonts.georgia_16, _
+ Optional textColour As Long = White, Optional align As Byte = Alignment.alignLeft, Optional visible As Boolean = True, Optional alpha As Long = 255, Optional clickThrough As Boolean, _
+ Optional entCallBack_norm As Long, Optional entCallBack_hover As Long, Optional entCallBack_mousedown As Long, Optional entCallBack_mousemove As Long, Optional entCallBack_dblclick As Long)
+ Dim design(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+ ' fill temp arrays
+ entCallBack(entStates.Normal) = entCallBack_norm
+ entCallBack(entStates.Hover) = entCallBack_hover
+ entCallBack(entStates.MouseDown) = entCallBack_mousedown
+ entCallBack(entStates.MouseMove) = entCallBack_mousemove
+ entCallBack(entStates.DblClick) = entCallBack_dblclick
+ ' create the box
+ CreateEntity winNum, zOrder_Con, name, entLabel, design(), image(), entCallBack(), left, top, width, height, visible, , , , , text, align, font, textColour, alpha, clickThrough
+End Sub
+
+Public Sub CreateCheckbox(winNum As Long, name As String, left As Long, top As Long, width As Long, Optional height As Long = 15, Optional value As Long, Optional text As String, _
+ Optional font As Fonts = Fonts.georgia_16, Optional textColour As Long = White, Optional align As Byte = Alignment.alignLeft, Optional visible As Boolean = True, Optional alpha As Long = 255, _
+ Optional theDesign As Long, Optional entCallBack_norm As Long, Optional entCallBack_hover As Long, Optional entCallBack_mousedown As Long, Optional entCallBack_mousemove As Long, _
+ Optional entCallBack_dblclick As Long, Optional group As Long)
+ Dim design(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+ ' fill temp arrays
+ entCallBack(entStates.Normal) = entCallBack_norm
+ entCallBack(entStates.Hover) = entCallBack_hover
+ entCallBack(entStates.MouseDown) = entCallBack_mousedown
+ entCallBack(entStates.MouseMove) = entCallBack_mousemove
+ entCallBack(entStates.DblClick) = entCallBack_dblclick
+ ' fill temp array
+ design(0) = theDesign
+ ' create the box
+ CreateEntity winNum, zOrder_Con, name, entCheckbox, design(), image(), entCallBack(), left, top, width, height, visible, , , , value, text, align, font, textColour, alpha, , , , , , , , , , , , group
+End Sub
+
+Public Sub CreateComboBox(winNum As Long, name As String, left As Long, top As Long, width As Long, height As Long, design As Long, Optional font As Fonts = Fonts.georgia_16)
+ Dim theDesign(0 To entStates.state_Count - 1) As Long
+ Dim image(0 To entStates.state_Count - 1) As Long
+ Dim entCallBack(0 To entStates.state_Count - 1) As Long
+ theDesign(0) = design
+ ' create the box
+ CreateEntity winNum, zOrder_Con, name, entCombobox, theDesign(), image(), entCallBack(), left, top, width, height, , , , , , , , font
+End Sub
+
+Public Function GetWindowIndex(winName As String) As Long
+ Dim i As Long
+
+ For i = 1 To WindowCount
+
+ If LCase$(Windows(i).Window.name) = LCase$(winName) Then
+ GetWindowIndex = i
+ Exit Function
+ End If
+
+ Next
+
+ GetWindowIndex = 0
+End Function
+
+Public Function GetControlIndex(winName As String, controlName As String) As Long
+ Dim i As Long, winIndex As Long
+
+ winIndex = GetWindowIndex(winName)
+
+ If Not winIndex > 0 Or Not winIndex <= WindowCount Then Exit Function
+
+ For i = 1 To Windows(winIndex).ControlCount
+
+ If LCase$(Windows(winIndex).Controls(i).name) = LCase$(controlName) Then
+ GetControlIndex = i
+ Exit Function
+ End If
+
+ Next
+
+ GetControlIndex = 0
+End Function
+
+Public Function SetActiveControl(curWindow As Long, curControl As Long) As Boolean
+ ' make sure it's something which CAN be active
+ Select Case Windows(curWindow).Controls(curControl).Type
+ Case EntityTypes.entTextBox
+ Windows(curWindow).activeControl = curControl
+ SetActiveControl = True
+ End Select
+End Function
+
+Public Sub CentraliseWindow(curWindow As Long)
+ With Windows(curWindow).Window
+ .left = (ScreenWidth / 2) - (.width / 2)
+ .top = (ScreenHeight / 2) - (.height / 2)
+ .origLeft = .left
+ .origTop = .top
+ End With
+End Sub
+
+Public Sub HideWindows()
+Dim i As Long
+ For i = 1 To WindowCount
+ HideWindow i
+ Next
+End Sub
+
+Public Sub ShowWindow(curWindow As Long, Optional forced As Boolean, Optional resetPosition As Boolean = True)
+ Windows(curWindow).Window.visible = True
+ If forced Then
+ UpdateZOrder curWindow, forced
+ activeWindow = curWindow
+ ElseIf Windows(curWindow).Window.zChange Then
+ UpdateZOrder curWindow
+ activeWindow = curWindow
+ End If
+ If resetPosition Then
+ With Windows(curWindow).Window
+ .left = .origLeft
+ .top = .origTop
+ End With
+ End If
+End Sub
+
+Public Sub HideWindow(curWindow As Long)
+Dim i As Long
+ Windows(curWindow).Window.visible = False
+ ' find next window to set as active
+ For i = WindowCount To 1 Step -1
+ If Windows(i).Window.visible And Windows(i).Window.zChange Then
+ 'UpdateZOrder i
+ activeWindow = i
+ Exit Sub
+ End If
+ Next
+End Sub
+
+Public Sub CreateWindow_Login()
+ ' Create the window
+ CreateWindow "winLogin", "Login", zOrder_Win, 0, 0, 276, 182, Tex_Item(45), , Fonts.rockwellDec_15, , 3, 5, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf DestroyGame)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 264, 150, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Shadows
+ CreatePictureBox WindowCount, "picShadow_1", 67, 43, 142, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreatePictureBox WindowCount, "picShadow_2", 67, 79, 142, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ ' Buttons
+ CreateButton WindowCount, "btnAccept", 68, 134, 67, 22, "Accept", rockwellDec_15, White, , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnLogin_Click)
+ CreateButton WindowCount, "btnExit", 142, 134, 67, 22, "Exit", rockwellDec_15, White, , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf DestroyGame)
+ ' Labels
+ CreateLabel WindowCount, "lblUsername", 66, 39, 142, , "Username", rockwellDec_15, White, Alignment.alignCentre
+ CreateLabel WindowCount, "lblPassword", 66, 75, 142, , "Password", rockwellDec_15, White, Alignment.alignCentre
+ ' Textboxes
+ CreateTextbox WindowCount, "txtUser", 67, 55, 142, 19, Options.Username, Fonts.rockwell_15, , Alignment.alignLeft, , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite, , , , , , , 5, 3
+ CreateTextbox WindowCount, "txtPass", 67, 91, 142, 19, vbNullString, Fonts.rockwell_15, , Alignment.alignLeft, , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite, , , , , , , 5, 3, True, GetAddress(AddressOf btnLogin_Click)
+ ' Checkbox
+ CreateCheckbox WindowCount, "chkSaveUser", 67, 114, 142, , Options.SaveUser, "Save Username?", rockwell_15, , , , , DesignTypes.desChkNorm, , , GetAddress(AddressOf chkSaveUser_Click)
+
+ ' Set the active control
+ If Not Len(Windows(GetWindowIndex("winLogin")).Controls(GetControlIndex("winLogin", "txtUser")).text) > 0 Then
+ SetActiveControl GetWindowIndex("winLogin"), GetControlIndex("winLogin", "txtUser")
+ Else
+ SetActiveControl GetWindowIndex("winLogin"), GetControlIndex("winLogin", "txtPass")
+ End If
+End Sub
+
+Public Sub CreateWindow_Characters()
+ ' Create the window
+ CreateWindow "winCharacters", "Characters", zOrder_Win, 0, 0, 364, 229, Tex_Item(62), False, Fonts.rockwellDec_15, , 3, 5, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnCharacters_Close)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 352, 197, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Names
+ CreatePictureBox WindowCount, "picShadow_1", 22, 41, 98, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblCharName_1", 22, 37, 98, , "Blank Slot", rockwellDec_15, White, Alignment.alignCentre
+ CreatePictureBox WindowCount, "picShadow_2", 132, 41, 98, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblCharName_2", 132, 37, 98, , "Blank Slot", rockwellDec_15, White, Alignment.alignCentre
+ CreatePictureBox WindowCount, "picShadow_3", 242, 41, 98, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblCharName_3", 242, 37, 98, , "Blank Slot", rockwellDec_15, White, Alignment.alignCentre
+ ' Scenery Boxes
+ CreatePictureBox WindowCount, "picScene_1", 23, 55, 96, 96, , , , , Tex_GUI(11), Tex_GUI(11), Tex_GUI(11)
+ CreatePictureBox WindowCount, "picScene_2", 133, 55, 96, 96, , , , , Tex_GUI(11), Tex_GUI(11), Tex_GUI(11)
+ CreatePictureBox WindowCount, "picScene_3", 243, 55, 96, 96, , , , , Tex_GUI(11), Tex_GUI(11), Tex_GUI(11), , , , , , , , , GetAddress(AddressOf Chars_DrawFace)
+ ' Create Buttons
+ CreateButton WindowCount, "btnSelectChar_1", 22, 155, 98, 24, "Select", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnAcceptChar_1)
+ CreateButton WindowCount, "btnCreateChar_1", 22, 155, 98, 24, "Create", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnCreateChar_1)
+ CreateButton WindowCount, "btnDelChar_1", 22, 183, 98, 24, "Delete", rockwellDec_15, , , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnDelChar_1)
+ CreateButton WindowCount, "btnSelectChar_2", 132, 155, 98, 24, "Select", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnAcceptChar_2)
+ CreateButton WindowCount, "btnCreateChar_2", 132, 155, 98, 24, "Create", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnCreateChar_2)
+ CreateButton WindowCount, "btnDelChar_2", 132, 183, 98, 24, "Delete", rockwellDec_15, , , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnDelChar_2)
+ CreateButton WindowCount, "btnSelectChar_3", 242, 155, 98, 24, "Select", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnAcceptChar_3)
+ CreateButton WindowCount, "btnCreateChar_3", 242, 155, 98, 24, "Create", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnCreateChar_3)
+ CreateButton WindowCount, "btnDelChar_3", 242, 183, 98, 24, "Delete", rockwellDec_15, , , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnDelChar_3)
+End Sub
+
+Public Sub CreateWindow_Loading()
+ ' Create the window
+ CreateWindow "winLoading", "Loading", zOrder_Win, 0, 0, 278, 79, Tex_Item(104), True, Fonts.rockwellDec_15, , 2, 7, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 266, 47, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Text background
+ CreatePictureBox WindowCount, "picRecess", 26, 39, 226, 22, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ ' Label
+ CreateLabel WindowCount, "lblLoading", 6, 43, 266, , "Loading Game Data...", rockwell_15, , Alignment.alignCentre
+End Sub
+
+Public Sub CreateWindow_Dialogue()
+ ' Create black background
+ CreateWindow "winBlank", "", zOrder_Win, 0, 0, 800, 600, 0, , , , , , DesignTypes.desWin_Black, DesignTypes.desWin_Black, DesignTypes.desWin_Black, , , , , , , , , False, False
+ ' Create dialogue window
+ CreateWindow "winDialogue", "Warning", zOrder_Win, 0, 0, 348, 145, Tex_Item(38), , Fonts.rockwellDec_15, , 3, 5, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, , , , , , , , , , False
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnDialogue_Close)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 335, 113, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Header
+ CreatePictureBox WindowCount, "picShadow", 103, 44, 144, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblHeader", 103, 41, 144, , "Header", rockwellDec_15, White, Alignment.alignCentre
+ ' Labels
+ CreateLabel WindowCount, "lblBody_1", 15, 60, 314, , "Invalid username or password.", rockwell_15, , Alignment.alignCentre
+ CreateLabel WindowCount, "lblBody_2", 15, 75, 314, , "Please try again.", rockwell_15, , Alignment.alignCentre
+ ' Buttons
+ CreateButton WindowCount, "btnYes", 104, 98, 68, 24, "Yes", rockwellDec_15, , , False, , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf Dialogue_Yes)
+ CreateButton WindowCount, "btnNo", 180, 98, 68, 24, "No", rockwellDec_15, , , False, , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf Dialogue_No)
+ CreateButton WindowCount, "btnOkay", 140, 98, 68, 24, "Okay", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf Dialogue_Okay)
+ ' Input
+ CreateTextbox WindowCount, "txtInput", 93, 75, 162, 18, , rockwell_15, White, Alignment.alignCentre, , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack, , , , , , , 4, 2
+ ' set active control
+ SetActiveControl WindowCount, GetControlIndex("winDialogue", "txtInput")
+End Sub
+
+Public Sub CreateWindow_Classes()
+ ' Create window
+ CreateWindow "winClasses", "Select Class", zOrder_Win, 0, 0, 364, 229, Tex_Item(17), False, Fonts.rockwellDec_15, , 2, 6, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnClasses_Close)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 352, 197, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment, , , , , , GetAddress(AddressOf Classes_DrawFace)
+ ' Class Name
+ CreatePictureBox WindowCount, "picShadow", 183, 42, 98, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblClassName", 183, 39, 98, , "Warrior", rockwellDec_15, White, Alignment.alignCentre
+ ' Select Buttons
+ CreateButton WindowCount, "btnLeft", 171, 40, 11, 13, , , , , , , Tex_GUI(12), Tex_GUI(14), Tex_GUI(16), , , , , , GetAddress(AddressOf btnClasses_Left)
+ CreateButton WindowCount, "btnRight", 282, 40, 11, 13, , , , , , , Tex_GUI(13), Tex_GUI(15), Tex_GUI(17), , , , , , GetAddress(AddressOf btnClasses_Right)
+ ' Accept Button
+ CreateButton WindowCount, "btnAccept", 183, 185, 98, 22, "Accept", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnClasses_Accept)
+ ' Text background
+ CreatePictureBox WindowCount, "picBackground", 127, 55, 210, 124, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ ' Overlay
+ CreatePictureBox WindowCount, "picOverlay", 6, 26, 0, 0, , , , , , , , , , , , , , , , GetAddress(AddressOf Classes_DrawText)
+End Sub
+
+Public Sub CreateWindow_NewChar()
+ ' Create window
+ CreateWindow "winNewChar", "Create Character", zOrder_Win, 0, 0, 291, 172, Tex_Item(17), False, Fonts.rockwellDec_15, , 2, 6, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnNewChar_Cancel)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 278, 140, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Name
+ CreatePictureBox WindowCount, "picShadow_1", 29, 42, 124, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblName", 29, 39, 124, , "Name", rockwellDec_15, White, Alignment.alignCentre
+ ' Textbox
+ CreateTextbox WindowCount, "txtName", 29, 55, 124, 19, , Fonts.rockwell_15, , Alignment.alignLeft, , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite, , , , , , , 5, 3
+ ' Gender
+ CreatePictureBox WindowCount, "picShadow_2", 29, 85, 124, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblGender", 29, 82, 124, , "Gender", rockwellDec_15, White, Alignment.alignCentre
+ ' Checkboxes
+ CreateCheckbox WindowCount, "chkMale", 29, 103, 55, , 1, "Male", rockwell_15, , Alignment.alignCentre, , , DesignTypes.desChkNorm, , , GetAddress(AddressOf chkNewChar_Male), , , 1
+ CreateCheckbox WindowCount, "chkFemale", 90, 103, 62, , 0, "Female", rockwell_15, , Alignment.alignCentre, , , DesignTypes.desChkNorm, , , GetAddress(AddressOf chkNewChar_Female), , , 1
+ ' Buttons
+ CreateButton WindowCount, "btnAccept", 29, 127, 60, 24, "Accept", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnNewChar_Accept)
+ CreateButton WindowCount, "btnCancel", 93, 127, 60, 24, "Cancel", rockwellDec_15, , , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnNewChar_Cancel)
+ ' Sprite
+ CreatePictureBox WindowCount, "picShadow_3", 175, 42, 76, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblSprite", 175, 39, 76, , "Sprite", rockwellDec_15, White, Alignment.alignCentre
+ ' Scene
+ CreatePictureBox WindowCount, "picScene", 165, 55, 96, 96, , , , , Tex_GUI(11), Tex_GUI(11), Tex_GUI(11), , , , , , , , , GetAddress(AddressOf NewChar_OnDraw)
+ ' Buttons
+ CreateButton WindowCount, "btnLeft", 163, 40, 11, 13, , , , , , , Tex_GUI(12), Tex_GUI(14), Tex_GUI(16), , , , , , GetAddress(AddressOf btnNewChar_Left)
+ CreateButton WindowCount, "btnRight", 252, 40, 11, 13, , , , , , , Tex_GUI(13), Tex_GUI(15), Tex_GUI(17), , , , , , GetAddress(AddressOf btnNewChar_Right)
+
+ ' Set the active control
+ SetActiveControl GetWindowIndex("winNewChar"), GetControlIndex("winNewChar", "txtName")
+End Sub
+
+Public Sub CreateWindow_EscMenu()
+ ' Create window
+ CreateWindow "winEscMenu", "", zOrder_Win, 0, 0, 210, 156, 0, , , , , , DesignTypes.desWin_NoBar, DesignTypes.desWin_NoBar, DesignTypes.desWin_NoBar, , , , , , , , , False, False
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 6, 198, 144, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Buttons
+ CreateButton WindowCount, "btnReturn", 16, 16, 178, 28, "Return to Game (Esc)", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnEscMenu_Return)
+ CreateButton WindowCount, "btnOptions", 16, 48, 178, 28, "Options", rockwellDec_15, , , , , , , , DesignTypes.desOrange, DesignTypes.desOrange_Hover, DesignTypes.desOrange_Click, , , GetAddress(AddressOf btnEscMenu_Options)
+ CreateButton WindowCount, "btnMainMenu", 16, 80, 178, 28, "Back to Main Menu", rockwellDec_15, , , , , , , , DesignTypes.desBlue, DesignTypes.desBlue_Hover, DesignTypes.desBlue_Click, , , GetAddress(AddressOf btnEscMenu_MainMenu)
+ CreateButton WindowCount, "btnExit", 16, 112, 178, 28, "Exit the Game", rockwellDec_15, , , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnEscMenu_Exit)
+End Sub
+
+Public Sub CreateWindow_Bars()
+ ' Create window
+ CreateWindow "winBars", "", zOrder_Win, 10, 10, 239, 77, 0, , , , , , DesignTypes.desWin_NoBar, DesignTypes.desWin_NoBar, DesignTypes.desWin_NoBar, , , , , , , , , False, False
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 6, 227, 65, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Blank Bars
+ CreatePictureBox WindowCount, "picHP_Blank", 15, 15, 209, 13, , , , , Tex_GUI(24), Tex_GUI(24), Tex_GUI(24)
+ CreatePictureBox WindowCount, "picSP_Blank", 15, 32, 209, 13, , , , , Tex_GUI(25), Tex_GUI(25), Tex_GUI(25)
+ CreatePictureBox WindowCount, "picEXP_Blank", 15, 49, 209, 13, , , , , Tex_GUI(26), Tex_GUI(26), Tex_GUI(26)
+ ' Draw the bars
+ CreatePictureBox WindowCount, "picBlank", 0, 0, 0, 0, , , , , , , , , , , , , , , , GetAddress(AddressOf Bars_OnDraw)
+ ' Bar Labels
+ CreatePictureBox WindowCount, "picHealth", 16, 11, 44, 14, , , , , Tex_GUI(21), Tex_GUI(21), Tex_GUI(21)
+ CreatePictureBox WindowCount, "picSpirit", 16, 28, 44, 14, , , , , Tex_GUI(22), Tex_GUI(22), Tex_GUI(22)
+ CreatePictureBox WindowCount, "picExperience", 16, 45, 74, 14, , , , , Tex_GUI(23), Tex_GUI(23), Tex_GUI(23)
+ ' Labels
+ CreateLabel WindowCount, "lblHP", 15, 14, 209, 12, "999/999", rockwellDec_10, White, Alignment.alignCentre
+ CreateLabel WindowCount, "lblMP", 15, 31, 209, 12, "999/999", rockwellDec_10, White, Alignment.alignCentre
+ CreateLabel WindowCount, "lblEXP", 15, 48, 209, 12, "999/999", rockwellDec_10, White, Alignment.alignCentre
+End Sub
+
+Public Sub CreateWindow_Menu()
+ ' Create window
+ CreateWindow "winMenu", "", zOrder_Win, 564, 563, 229, 31, 0, , , , , , , , , , , , , , , , , False, False
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Wood part
+ CreatePictureBox WindowCount, "picWood", 0, 5, 228, 21, , , , , , , , DesignTypes.desWood, DesignTypes.desWood, DesignTypes.desWood
+ ' Buttons
+ CreateButton WindowCount, "btnChar", 8, 1, 29, 29, , , , Tex_Item(108), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnMenu_Char), , , -1, -2, , , "Character (C)"
+ CreateButton WindowCount, "btnInv", 44, 1, 29, 29, , , , Tex_Item(1), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnMenu_Inv), , , -1, -2, , , "Inventory (I)"
+ CreateButton WindowCount, "btnSkills", 82, 1, 29, 29, , , , Tex_Item(109), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnMenu_Skills), , , -1, -2, , , "Skills (M)"
+ 'CreateButton WindowCount, "btnMap", 119, 1, 29, 29, , , , Tex_Item(106), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnMenu_Map), , , -1, -2
+ 'CreateButton WindowCount, "btnGuild", 155, 1, 29, 29, , , , Tex_Item(107), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnMenu_Guild), , , -1, -1
+ 'CreateButton WindowCount, "btnQuest", 191, 1, 29, 29, , , , Tex_Item(23), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnMenu_Quest), , , -1, -2
+ CreateButton WindowCount, "btnMap", 119, 1, 29, 29, , , , Tex_Item(106), , , , , , DesignTypes.desGrey, DesignTypes.desGrey, DesignTypes.desGrey, , , GetAddress(AddressOf btnMenu_Map), , , -1, -2
+ CreateButton WindowCount, "btnGuild", 155, 1, 29, 29, , , , Tex_Item(107), , , , , , DesignTypes.desGrey, DesignTypes.desGrey, DesignTypes.desGrey, , , GetAddress(AddressOf btnMenu_Guild), , , -1, -1
+ CreateButton WindowCount, "btnQuest", 191, 1, 29, 29, , , , Tex_Item(23), , , , , , DesignTypes.desGrey, DesignTypes.desGrey, DesignTypes.desGrey, , , GetAddress(AddressOf btnMenu_Quest), , , -1, -2
+End Sub
+
+Public Sub CreateWindow_Hotbar()
+ ' Create window
+ CreateWindow "winHotbar", "", zOrder_Win, 372, 10, 418, 36, 0, , , , , , , , , , , , , GetAddress(AddressOf Hotbar_MouseMove), GetAddress(AddressOf Hotbar_MouseDown), GetAddress(AddressOf Hotbar_MouseMove), GetAddress(AddressOf Hotbar_DblClick), False, False, GetAddress(AddressOf DrawHotbar)
+End Sub
+
+Public Sub CreateWindow_Inventory()
+ ' Create window
+ CreateWindow "winInventory", "Inventory", zOrder_Win, 0, 0, 202, 319, Tex_Item(1), False, Fonts.rockwellDec_15, , 2, 7, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, , , , , GetAddress(AddressOf Inventory_MouseMove), GetAddress(AddressOf Inventory_MouseDown), GetAddress(AddressOf Inventory_MouseMove), GetAddress(AddressOf Inventory_DblClick), , , GetAddress(AddressOf DrawInventory)
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnMenu_Inv)
+ ' Gold amount
+ CreatePictureBox WindowCount, "picBlank", 8, 293, 186, 18, , , , , Tex_GUI(67), Tex_GUI(67), Tex_GUI(67)
+ CreateLabel WindowCount, "lblGold", 42, 296, 100, , "0g", verdana_12
+ ' Drop
+ CreateButton WindowCount, "btnDrop", 155, 294, 38, 16, , , , Tex_GUI(36), , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , , , , 5, 3
+End Sub
+
+Public Sub CreateWindow_Character()
+ ' Create window
+ CreateWindow "winCharacter", "Character Status", zOrder_Win, 0, 0, 174, 356, Tex_Item(62), False, Fonts.rockwellDec_15, , 2, 6, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, , , , , GetAddress(AddressOf Character_MouseMove), GetAddress(AddressOf Character_MouseDown), GetAddress(AddressOf Character_MouseMove), GetAddress(AddressOf Character_MouseMove), , , GetAddress(AddressOf DrawCharacter)
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnMenu_Char)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 162, 287, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' White boxes
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 34, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 54, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 74, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 94, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 114, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 134, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 154, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ ' Labels
+ CreateLabel WindowCount, "lblName", 18, 36, 147, 16, "Name", rockwellDec_10
+ CreateLabel WindowCount, "lblClass", 18, 56, 147, 16, "Class", rockwellDec_10
+ CreateLabel WindowCount, "lblLevel", 18, 76, 147, 16, "Level", rockwellDec_10
+ CreateLabel WindowCount, "lblGuild", 18, 96, 147, 16, "Guild", rockwellDec_10
+ CreateLabel WindowCount, "lblHealth", 18, 116, 147, 16, "Health", rockwellDec_10
+ CreateLabel WindowCount, "lblSpirit", 18, 136, 147, 16, "Spirit", rockwellDec_10
+ CreateLabel WindowCount, "lblExperience", 18, 156, 147, 16, "Experience", rockwellDec_10
+ ' Attributes
+ CreatePictureBox WindowCount, "picShadow", 18, 176, 138, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblLabel", 18, 173, 138, , "Character Attributes", rockwellDec_15, , Alignment.alignCentre
+ ' Black boxes
+ CreatePictureBox WindowCount, "picBlackBox", 13, 186, 148, 19, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ CreatePictureBox WindowCount, "picBlackBox", 13, 206, 148, 19, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ CreatePictureBox WindowCount, "picBlackBox", 13, 226, 148, 19, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ CreatePictureBox WindowCount, "picBlackBox", 13, 246, 148, 19, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ CreatePictureBox WindowCount, "picBlackBox", 13, 266, 148, 19, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ CreatePictureBox WindowCount, "picBlackBox", 13, 286, 148, 19, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ ' Labels
+ CreateLabel WindowCount, "lblLabel", 18, 188, 138, , "Strength", rockwellDec_10, Gold, Alignment.alignRight
+ CreateLabel WindowCount, "lblLabel", 18, 208, 138, , "Endurance", rockwellDec_10, Gold, Alignment.alignRight
+ CreateLabel WindowCount, "lblLabel", 18, 228, 138, , "Intelligence", rockwellDec_10, Gold, Alignment.alignRight
+ CreateLabel WindowCount, "lblLabel", 18, 248, 138, , "Agility", rockwellDec_10, Gold, Alignment.alignRight
+ CreateLabel WindowCount, "lblLabel", 18, 268, 138, , "Willpower", rockwellDec_10, Gold, Alignment.alignRight
+ CreateLabel WindowCount, "lblLabel", 18, 288, 138, , "Unused Stat Points", rockwellDec_10, LightGreen, Alignment.alignRight
+ ' Buttons
+ CreateButton WindowCount, "btnStat_1", 15, 188, 15, 15, , , , , , , Tex_GUI(48), Tex_GUI(49), Tex_GUI(50), , , , , , GetAddress(AddressOf Character_SpendPoint1)
+ CreateButton WindowCount, "btnStat_2", 15, 208, 15, 15, , , , , , , Tex_GUI(48), Tex_GUI(49), Tex_GUI(50), , , , , , GetAddress(AddressOf Character_SpendPoint2)
+ CreateButton WindowCount, "btnStat_3", 15, 228, 15, 15, , , , , , , Tex_GUI(48), Tex_GUI(49), Tex_GUI(50), , , , , , GetAddress(AddressOf Character_SpendPoint3)
+ CreateButton WindowCount, "btnStat_4", 15, 248, 15, 15, , , , , , , Tex_GUI(48), Tex_GUI(49), Tex_GUI(50), , , , , , GetAddress(AddressOf Character_SpendPoint4)
+ CreateButton WindowCount, "btnStat_5", 15, 268, 15, 15, , , , , , , Tex_GUI(48), Tex_GUI(49), Tex_GUI(50), , , , , , GetAddress(AddressOf Character_SpendPoint5)
+ ' fake buttons
+ CreatePictureBox WindowCount, "btnGreyStat_1", 15, 188, 15, 15, , , , , Tex_GUI(47), Tex_GUI(47), Tex_GUI(47)
+ CreatePictureBox WindowCount, "btnGreyStat_2", 15, 208, 15, 15, , , , , Tex_GUI(47), Tex_GUI(47), Tex_GUI(47)
+ CreatePictureBox WindowCount, "btnGreyStat_3", 15, 228, 15, 15, , , , , Tex_GUI(47), Tex_GUI(47), Tex_GUI(47)
+ CreatePictureBox WindowCount, "btnGreyStat_4", 15, 248, 15, 15, , , , , Tex_GUI(47), Tex_GUI(47), Tex_GUI(47)
+ CreatePictureBox WindowCount, "btnGreyStat_5", 15, 268, 15, 15, , , , , Tex_GUI(47), Tex_GUI(47), Tex_GUI(47)
+ ' Labels
+ CreateLabel WindowCount, "lblStat_1", 32, 188, 100, , "255", rockwellDec_10
+ CreateLabel WindowCount, "lblStat_2", 32, 208, 100, , "255", rockwellDec_10
+ CreateLabel WindowCount, "lblStat_3", 32, 228, 100, , "255", rockwellDec_10
+ CreateLabel WindowCount, "lblStat_4", 32, 248, 100, , "255", rockwellDec_10
+ CreateLabel WindowCount, "lblStat_5", 32, 268, 100, , "255", rockwellDec_10
+ CreateLabel WindowCount, "lblPoints", 18, 288, 100, , "255", rockwellDec_10
+End Sub
+
+Public Sub CreateWindow_Description()
+ ' Create window
+ CreateWindow "winDescription", "", zOrder_Win, 0, 0, 193, 142, 0, , , , , , DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, , , , , , , , , False
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Name
+ CreateLabel WindowCount, "lblName", 8, 12, 177, , "(SB) Flame Sword", rockwellDec_15, BrightBlue, Alignment.alignCentre
+ ' Sprite box
+ CreatePictureBox WindowCount, "picSprite", 18, 32, 68, 68, , , , , , , , DesignTypes.desDescPic, DesignTypes.desDescPic, DesignTypes.desDescPic, , , , , , GetAddress(AddressOf Description_OnDraw)
+ ' Sep
+ CreatePictureBox WindowCount, "picSep", 96, 28, 1, 92, , , , , Tex_GUI(44), Tex_GUI(44), Tex_GUI(44)
+ ' Requirements
+ CreateLabel WindowCount, "lblClass", 5, 102, 92, , "Warrior", verdana_12, LightGreen, Alignment.alignCentre
+ CreateLabel WindowCount, "lblLevel", 5, 114, 92, , "Level 20", verdana_12, BrightRed, Alignment.alignCentre
+ ' Bar
+ CreatePictureBox WindowCount, "picBar", 19, 114, 66, 12, False, , , , Tex_GUI(45), Tex_GUI(45), Tex_GUI(45)
+End Sub
+
+Public Sub CreateWindow_DragBox()
+ ' Create window
+ CreateWindow "winDragBox", "", zOrder_Win, 0, 0, 32, 32, 0, , , , , , , , , , , , GetAddress(AddressOf DragBox_Check), , , , , , , GetAddress(AddressOf DragBox_OnDraw)
+ ' Need to set up unique mouseup event
+ Windows(WindowCount).Window.entCallBack(entStates.MouseUp) = GetAddress(AddressOf DragBox_Check)
+End Sub
+
+Public Sub CreateWindow_Skills()
+ ' Create window
+ CreateWindow "winSkills", "Skills", zOrder_Win, 0, 0, 202, 297, Tex_Item(109), False, Fonts.rockwellDec_15, , 2, 7, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, , , , , GetAddress(AddressOf Skills_MouseMove), GetAddress(AddressOf Skills_MouseDown), GetAddress(AddressOf Skills_MouseMove), GetAddress(AddressOf Skills_DblClick), , , GetAddress(AddressOf DrawSkills)
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnMenu_Skills)
+End Sub
+
+Public Sub CreateWindow_Chat()
+ ' Create window
+ CreateWindow "winChat", "", zOrder_Win, 8, 422, 352, 152, 0, False, , , , , , , , , , , , , , , , False
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Channel boxes
+ CreateCheckbox WindowCount, "chkGame", 10, 2, 49, 23, 1, "Game", rockwellDec_10, , , , , DesignTypes.desChkChat, , , GetAddress(AddressOf chkChat_Game)
+ CreateCheckbox WindowCount, "chkMap", 60, 2, 49, 23, 1, "Map", rockwellDec_10, , , , , DesignTypes.desChkChat, , , GetAddress(AddressOf chkChat_Map)
+ CreateCheckbox WindowCount, "chkGlobal", 110, 2, 49, 23, 1, "Global", rockwellDec_10, , , , , DesignTypes.desChkChat, , , GetAddress(AddressOf chkChat_Global)
+ CreateCheckbox WindowCount, "chkParty", 160, 2, 49, 23, 1, "Party", rockwellDec_10, , , , , DesignTypes.desChkChat, , , GetAddress(AddressOf chkChat_Party)
+ CreateCheckbox WindowCount, "chkGuild", 210, 2, 49, 23, 1, "Guild", rockwellDec_10, , , , , DesignTypes.desChkChat, , , GetAddress(AddressOf chkChat_Guild)
+ CreateCheckbox WindowCount, "chkPrivate", 260, 2, 49, 23, 1, "Private", rockwellDec_10, , , , , DesignTypes.desChkChat, , , GetAddress(AddressOf chkChat_Private)
+ ' Blank picturebox - ondraw wrapper
+ CreatePictureBox WindowCount, "picNull", 0, 0, 0, 0, , , , , , , , , , , , , , , , GetAddress(AddressOf OnDraw_Chat)
+ ' Chat button
+ CreateButton WindowCount, "btnChat", 296, 124 + 16, 48, 20, "Say", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnSay_Click)
+ ' Chat Textbox
+ CreateTextbox WindowCount, "txtChat", 12, 127 + 16, 286, 25, , Fonts.verdana_12
+ ' buttons
+ CreateButton WindowCount, "btnUp", 328, 28, 11, 13, , , , , , , Tex_GUI(4), Tex_GUI(52), Tex_GUI(4), , , , , , GetAddress(AddressOf btnChat_Up)
+ CreateButton WindowCount, "btnDown", 327, 122, 11, 13, , , , , , , Tex_GUI(5), Tex_GUI(53), Tex_GUI(5), , , , , , GetAddress(AddressOf btnChat_Down)
+
+ ' Custom Handlers for mouse up
+ Windows(WindowCount).Controls(GetControlIndex("winChat", "btnUp")).entCallBack(entStates.MouseUp) = GetAddress(AddressOf btnChat_Up_MouseUp)
+ Windows(WindowCount).Controls(GetControlIndex("winChat", "btnDown")).entCallBack(entStates.MouseUp) = GetAddress(AddressOf btnChat_Down_MouseUp)
+
+ ' Set the active control
+ SetActiveControl GetWindowIndex("winChat"), GetControlIndex("winChat", "txtChat")
+
+ ' sort out the tabs
+ With Windows(GetWindowIndex("winChat"))
+ .Controls(GetControlIndex("winChat", "chkGame")).value = Options.channelState(ChatChannel.chGame)
+ .Controls(GetControlIndex("winChat", "chkMap")).value = Options.channelState(ChatChannel.chMap)
+ .Controls(GetControlIndex("winChat", "chkGlobal")).value = Options.channelState(ChatChannel.chGlobal)
+ .Controls(GetControlIndex("winChat", "chkParty")).value = Options.channelState(ChatChannel.chParty)
+ .Controls(GetControlIndex("winChat", "chkGuild")).value = Options.channelState(ChatChannel.chGuild)
+ .Controls(GetControlIndex("winChat", "chkPrivate")).value = Options.channelState(ChatChannel.chPrivate)
+ End With
+End Sub
+
+Public Sub CreateWindow_ChatSmall()
+ ' Create window
+ CreateWindow "winChatSmall", "", zOrder_Win, 8, 438, 0, 0, 0, False, , , , , , , , , , , , , , , , False, , GetAddress(AddressOf OnDraw_ChatSmall), , True
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Chat Label
+ CreateLabel WindowCount, "lblMsg", 12, 127, 286, 25, "Press 'Enter' to open chatbox.", verdana_12, Grey
+End Sub
+
+Public Sub CreateWindow_Options()
+ ' Create window
+ CreateWindow "winOptions", "", zOrder_Win, 0, 0, 210, 212, 0, , , , , , DesignTypes.desWin_NoBar, DesignTypes.desWin_NoBar, DesignTypes.desWin_NoBar, , , , , , , , , False, False
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 6, 198, 200, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' General
+ CreatePictureBox WindowCount, "picBlank", 35, 25, 140, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblBlank", 35, 22, 140, , "General Options", rockwellDec_15, White, Alignment.alignCentre
+ ' Check boxes
+ CreateCheckbox WindowCount, "chkMusic", 35, 40, 80, , , "Music", rockwellDec_10, , , , , DesignTypes.desChkNorm
+ CreateCheckbox WindowCount, "chkSound", 115, 40, 80, , , "Sound", rockwellDec_10, , , , , DesignTypes.desChkNorm
+ CreateCheckbox WindowCount, "chkAutotiles", 35, 60, 80, , , "Autotiles", rockwellDec_10, , , , , DesignTypes.desChkNorm
+ CreateCheckbox WindowCount, "chkFullscreen", 115, 60, 80, , , "Fullscreen", rockwellDec_10, , , , , DesignTypes.desChkNorm
+ ' Resolution
+ CreatePictureBox WindowCount, "picBlank", 35, 85, 140, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblBlank", 35, 82, 140, , "Select Resolution", rockwellDec_15, White, Alignment.alignCentre
+ ' combobox
+ CreateComboBox WindowCount, "cmbRes", 30, 100, 150, 18, DesignTypes.desComboNorm, verdana_12
+ ' Renderer
+ CreatePictureBox WindowCount, "picBlank", 35, 125, 140, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblBlank", 35, 122, 140, , "DirectX Mode", rockwellDec_15, White, Alignment.alignCentre
+ ' Check boxes
+ CreateComboBox WindowCount, "cmbRender", 30, 140, 150, 18, DesignTypes.desComboNorm, verdana_12
+ ' Button
+ CreateButton WindowCount, "btnConfirm", 65, 168, 80, 22, "Confirm", rockwellDec_15, , , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnOptions_Confirm)
+
+ ' Populate the options screen
+ SetOptionsScreen
+End Sub
+
+Public Sub CreateWindow_Shop()
+ ' Create window
+ CreateWindow "winShop", "Shop", zOrder_Win, 0, 0, 278, 293, Tex_Item(17), False, Fonts.rockwellDec_15, , 2, 5, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, , , , , GetAddress(AddressOf Shop_MouseMove), GetAddress(AddressOf Shop_MouseDown), GetAddress(AddressOf Shop_MouseMove), GetAddress(AddressOf Shop_MouseMove), , , GetAddress(AddressOf DrawShopBackground)
+ ' additional mouse event
+ Windows(WindowCount).Window.entCallBack(entStates.MouseUp) = GetAddress(AddressOf Shop_MouseMove)
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnShop_Close)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 215, 266, 50, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment, , , , , , GetAddress(AddressOf DrawShop)
+ ' Picture Box
+ CreatePictureBox WindowCount, "picItemBG", 13, 222, 36, 36, , , , , Tex_GUI(54), Tex_GUI(54), Tex_GUI(54)
+ CreatePictureBox WindowCount, "picItem", 15, 224, 32, 32
+ ' Buttons
+ CreateButton WindowCount, "btnBuy", 190, 228, 70, 24, "Buy", rockwellDec_15, White, , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnShopBuy)
+ CreateButton WindowCount, "btnSell", 190, 228, 70, 24, "Sell", rockwellDec_15, White, , False, , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnShopSell)
+ ' Gold
+ CreatePictureBox WindowCount, "picBlank", 9, 266, 162, 18, , , , , Tex_GUI(55), Tex_GUI(55), Tex_GUI(55)
+ ' Buying/Selling
+ CreateCheckbox WindowCount, "chkBuying", 173, 265, 49, 20, 1, , , , , , , DesignTypes.desChkCustom_Buying, , , GetAddress(AddressOf chkShopBuying)
+ CreateCheckbox WindowCount, "chkSelling", 222, 265, 49, 20, 0, , , , , , , DesignTypes.desChkCustom_Selling, , , GetAddress(AddressOf chkShopSelling)
+ ' Labels
+ CreateLabel WindowCount, "lblName", 56, 226, 300, , "Test Item", verdanaBold_12, Black, Alignment.alignLeft
+ CreateLabel WindowCount, "lblCost", 56, 240, 300, , "1000g", verdana_12, Black, Alignment.alignLeft
+ ' Gold
+ CreateLabel WindowCount, "lblGold", 44, 269, 300, , "0g", verdana_12
+End Sub
+
+Public Sub CreateWindow_NpcChat()
+ ' Create window
+ CreateWindow "winNpcChat", "Conversation with [Name]", zOrder_Win, 0, 0, 480, 228, Tex_Item(111), False, Fonts.rockwellDec_15, , 2, 11, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Close Button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnNpcChat_Close)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 468, 198, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Face background
+ CreatePictureBox WindowCount, "picFaceBG", 20, 40, 102, 102, , , , , Tex_GUI(60), Tex_GUI(60), Tex_GUI(60)
+ ' Actual Face
+ CreatePictureBox WindowCount, "picFace", 23, 43, 96, 96, , , , , Tex_Face(1), Tex_Face(1), Tex_Face(1)
+ ' Chat BG
+ CreatePictureBox WindowCount, "picChatBG", 128, 39, 334, 104, , , , , , , , DesignTypes.desTextBlack, DesignTypes.desTextBlack, DesignTypes.desTextBlack
+ ' Chat
+ CreateLabel WindowCount, "lblChat", 136, 44, 318, 102, "[Text]", rockwellDec_15, White, Alignment.alignCentre
+ ' Reply buttons
+ CreateButton WindowCount, "btnOpt4", 69, 145, 343, 15, "[Text]", verdana_12, Black, , , , , , , , , , , , GetAddress(AddressOf btnOpt4), , , , , DarkGrey
+ CreateButton WindowCount, "btnOpt3", 69, 162, 343, 15, "[Text]", verdana_12, Black, , , , , , , , , , , , GetAddress(AddressOf btnOpt3), , , , , DarkGrey
+ CreateButton WindowCount, "btnOpt2", 69, 179, 343, 15, "[Text]", verdana_12, Black, , , , , , , , , , , , GetAddress(AddressOf btnOpt2), , , , , DarkGrey
+ CreateButton WindowCount, "btnOpt1", 69, 196, 343, 15, "[Text]", verdana_12, Black, , , , , , , , , , , , GetAddress(AddressOf btnOpt1), , , , , DarkGrey
+
+ ' Cache positions
+ optPos(1) = 196
+ optPos(2) = 179
+ optPos(3) = 162
+ optPos(4) = 145
+ optHeight = 228
+End Sub
+
+Public Sub CreateWindow_RightClick()
+ ' Create window
+ CreateWindow "winRightClickBG", "", zOrder_Win, 0, 0, 800, 600, 0, , , , , , , , , , , , , , GetAddress(AddressOf RightClick_Close), , , False
+ ' Centralise it
+ CentraliseWindow WindowCount
+End Sub
+
+Public Sub CreateWindow_PlayerMenu()
+ ' Create window
+ CreateWindow "winPlayerMenu", "", zOrder_Win, 0, 0, 110, 106, 0, , , , , , DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, , , , , , GetAddress(AddressOf RightClick_Close), , , False
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Name
+ CreateButton WindowCount, "btnName", 8, 8, 94, 18, "[Name]", verdanaBold_12, White, , , , , , , DesignTypes.desMenuHeader, DesignTypes.desMenuHeader, DesignTypes.desMenuHeader, , , GetAddress(AddressOf RightClick_Close)
+ ' Options
+ CreateButton WindowCount, "btnParty", 8, 26, 94, 18, "Invite to Party", verdana_12, White, , , , , , , , DesignTypes.desMenuOption, , , , GetAddress(AddressOf PlayerMenu_Party)
+ CreateButton WindowCount, "btnTrade", 8, 44, 94, 18, "Request Trade", verdana_12, White, , , , , , , , DesignTypes.desMenuOption, , , , GetAddress(AddressOf PlayerMenu_Trade)
+ CreateButton WindowCount, "btnGuild", 8, 62, 94, 18, "Invite to Guild", verdana_12, White, , , , , , , , DesignTypes.desMenuOption, , , , GetAddress(AddressOf PlayerMenu_Guild)
+ CreateButton WindowCount, "btnPM", 8, 80, 94, 18, "Private Message", verdana_12, White, , , , , , , , DesignTypes.desMenuOption, , , , GetAddress(AddressOf PlayerMenu_PM)
+End Sub
+
+Public Sub CreateWindow_Party()
+ ' Create window
+ CreateWindow "winParty", "", zOrder_Win, 4, 78, 252, 158, 0, , , , , , DesignTypes.desWin_Party, DesignTypes.desWin_Party, DesignTypes.desWin_Party, , , , , , , , , False
+
+ ' Name labels
+ CreateLabel WindowCount, "lblName1", 60, 20, 173, , "Richard - Level 10", rockwellDec_10
+ CreateLabel WindowCount, "lblName2", 60, 60, 173, , "Anna - Level 18", rockwellDec_10
+ CreateLabel WindowCount, "lblName3", 60, 100, 173, , "Doleo - Level 25", rockwellDec_10
+ ' Empty Bars - HP
+ CreatePictureBox WindowCount, "picEmptyBar_HP1", 58, 34, 173, 9, , , , , Tex_GUI(62), Tex_GUI(62), Tex_GUI(62)
+ CreatePictureBox WindowCount, "picEmptyBar_HP2", 58, 74, 173, 9, , , , , Tex_GUI(62), Tex_GUI(62), Tex_GUI(62)
+ CreatePictureBox WindowCount, "picEmptyBar_HP3", 58, 114, 173, 9, , , , , Tex_GUI(62), Tex_GUI(62), Tex_GUI(62)
+ ' Empty Bars - SP
+ CreatePictureBox WindowCount, "picEmptyBar_SP1", 58, 44, 173, 9, , , , , Tex_GUI(63), Tex_GUI(63), Tex_GUI(63)
+ CreatePictureBox WindowCount, "picEmptyBar_SP2", 58, 84, 173, 9, , , , , Tex_GUI(63), Tex_GUI(63), Tex_GUI(63)
+ CreatePictureBox WindowCount, "picEmptyBar_SP3", 58, 124, 173, 9, , , , , Tex_GUI(63), Tex_GUI(63), Tex_GUI(63)
+ ' Filled bars - HP
+ CreatePictureBox WindowCount, "picBar_HP1", 58, 34, 173, 9, , , , , Tex_GUI(64), Tex_GUI(64), Tex_GUI(64)
+ CreatePictureBox WindowCount, "picBar_HP2", 58, 74, 173, 9, , , , , Tex_GUI(64), Tex_GUI(64), Tex_GUI(64)
+ CreatePictureBox WindowCount, "picBar_HP3", 58, 114, 173, 9, , , , , Tex_GUI(64), Tex_GUI(64), Tex_GUI(64)
+ ' Filled bars - SP
+ CreatePictureBox WindowCount, "picBar_SP1", 58, 44, 173, 9, , , , , Tex_GUI(65), Tex_GUI(65), Tex_GUI(65)
+ CreatePictureBox WindowCount, "picBar_SP2", 58, 84, 173, 9, , , , , Tex_GUI(65), Tex_GUI(65), Tex_GUI(65)
+ CreatePictureBox WindowCount, "picBar_SP3", 58, 124, 173, 9, , , , , Tex_GUI(65), Tex_GUI(65), Tex_GUI(65)
+ ' Shadows
+ CreatePictureBox WindowCount, "picShadow1", 20, 24, 32, 32, , , , , Tex_Shadow, Tex_Shadow, Tex_Shadow
+ CreatePictureBox WindowCount, "picShadow2", 20, 64, 32, 32, , , , , Tex_Shadow, Tex_Shadow, Tex_Shadow
+ CreatePictureBox WindowCount, "picShadow3", 20, 104, 32, 32, , , , , Tex_Shadow, Tex_Shadow, Tex_Shadow
+ ' Characters
+ CreatePictureBox WindowCount, "picChar1", 20, 20, 32, 32, , , , , Tex_Char(1), Tex_Char(1), Tex_Char(1)
+ CreatePictureBox WindowCount, "picChar2", 20, 60, 32, 32, , , , , Tex_Char(1), Tex_Char(1), Tex_Char(1)
+ CreatePictureBox WindowCount, "picChar3", 20, 100, 32, 32, , , , , Tex_Char(1), Tex_Char(1), Tex_Char(1)
+End Sub
+
+Public Sub CreateWindow_Invitations()
+ ' Create window
+ CreateWindow "winInvite_Party", "", zOrder_Win, ScreenWidth - 234, ScreenHeight - 80, 223, 37, 0, , , , , , DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, , , , , , , , , False
+ ' Button
+ CreateButton WindowCount, "btnInvite", 11, 12, 201, 14, ColourChar & White & "Richard " & ColourChar & "-1" & "has invited you to a party.", verdana_12, Grey, , , , , , , , , , , , GetAddress(AddressOf btnInvite_Party), , , , , Green
+
+ ' Create window
+ CreateWindow "winInvite_Trade", "", zOrder_Win, ScreenWidth - 234, ScreenHeight - 80, 223, 37, 0, , , , , , DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, DesignTypes.desWin_Desc, , , , , , , , , False
+ ' Button
+ CreateButton WindowCount, "btnInvite", 11, 12, 201, 14, ColourChar & White & "Richard " & ColourChar & "-1" & "has invited you to a party.", verdana_12, Grey, , , , , , , , , , , , GetAddress(AddressOf btnInvite_Trade), , , , , Green
+End Sub
+
+Public Sub CreateWindow_Trade()
+ ' Create window
+ CreateWindow "winTrade", "Trading with [Name]", zOrder_Win, 0, 0, 412, 386, Tex_Item(112), False, Fonts.rockwellDec_15, , 2, 5, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, DesignTypes.desWin_Empty, , , , , , , , , , , GetAddress(AddressOf DrawTrade)
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Close Button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnTrade_Close)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 10, 312, 392, 66, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Labels
+ CreatePictureBox WindowCount, "picShadow", 36, 30, 142, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblYourTrade", 36, 27, 142, 9, "Robin's Offer", rockwellDec_15, White, Alignment.alignCentre
+ CreatePictureBox WindowCount, "picShadow", 36 + 200, 30, 142, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblTheirTrade", 36 + 200, 27, 142, 9, "Richard's Offer", rockwellDec_15, White, Alignment.alignCentre
+ ' Buttons
+ CreateButton WindowCount, "btnAccept", 134, 340, 68, 24, "Accept", rockwellDec_15, White, , , , , , , DesignTypes.desGreen, DesignTypes.desGreen_Hover, DesignTypes.desGreen_Click, , , GetAddress(AddressOf btnTrade_Accept)
+ CreateButton WindowCount, "btnDecline", 210, 340, 68, 24, "Decline", rockwellDec_15, White, , , , , , , DesignTypes.desRed, DesignTypes.desRed_Hover, DesignTypes.desRed_Click, , , GetAddress(AddressOf btnTrade_Close)
+ ' Labels
+ CreateLabel WindowCount, "lblStatus", 114, 322, 184, , "", verdanaBold_12, Red, Alignment.alignCentre
+ ' Amounts
+ CreateLabel WindowCount, "lblBlank", 25, 330, 100, , "Total Value", verdanaBold_12, Black, Alignment.alignCentre
+ CreateLabel WindowCount, "lblBlank", 285, 330, 100, , "Total Value", verdanaBold_12, Black, Alignment.alignCentre
+ CreateLabel WindowCount, "lblYourValue", 25, 344, 100, , "52,812g", verdana_12, Black, Alignment.alignCentre
+ CreateLabel WindowCount, "lblTheirValue", 285, 344, 100, , "12,531g", verdana_12, Black, Alignment.alignCentre
+ ' Item Containers
+ CreatePictureBox WindowCount, "picYour", 14, 46, 184, 260, , , , , , , , , , , , GetAddress(AddressOf TradeMouseMove_Your), GetAddress(AddressOf TradeMouseDown_Your), GetAddress(AddressOf TradeMouseMove_Your), , GetAddress(AddressOf DrawYourTrade)
+ CreatePictureBox WindowCount, "picTheir", 214, 46, 184, 260, , , , , , , , , , , , GetAddress(AddressOf TradeMouseMove_Their), GetAddress(AddressOf TradeMouseMove_Their), GetAddress(AddressOf TradeMouseMove_Their), , GetAddress(AddressOf DrawTheirTrade)
+End Sub
+
+Public Sub CreateWindow_Combobox()
+ ' background window
+ CreateWindow "winComboMenuBG", "ComboMenuBG", zOrder_Win, 0, 0, 800, 600, 0, , , , , , , , , , , , , , GetAddress(AddressOf CloseComboMenu), , , False, False
+
+ ' window
+ CreateWindow "winComboMenu", "ComboMenu", zOrder_Win, 0, 0, 100, 100, 0, , Fonts.verdana_12, , , , DesignTypes.desComboMenuNorm, , , , , , , , , , , False, False
+ ' centralise it
+ CentraliseWindow WindowCount
+End Sub
+
+Public Sub CreateWindow_Guild()
+ ' Create window
+ CreateWindow "winGuild", "Guild", zOrder_Win, 0, 0, 174, 320, Tex_Item(107), False, Fonts.rockwellDec_15, , 2, 6, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm, DesignTypes.desWin_Norm
+ ' Centralise it
+ CentraliseWindow WindowCount
+
+ ' Set the index for spawning controls
+ zOrder_Con = 1
+
+ ' Close button
+ CreateButton WindowCount, "btnClose", Windows(WindowCount).Window.width - 19, 6, 13, 13, , , , , , , Tex_GUI(8), Tex_GUI(9), Tex_GUI(10), , , , , , GetAddress(AddressOf btnMenu_Guild)
+ ' Parchment
+ CreatePictureBox WindowCount, "picParchment", 6, 26, 162, 287, , , , , , , , DesignTypes.desParchment, DesignTypes.desParchment, DesignTypes.desParchment
+ ' Attributes
+ CreatePictureBox WindowCount, "picShadow", 18, 38, 138, 9, , , , , , , , DesignTypes.desBlackOval, DesignTypes.desBlackOval, DesignTypes.desBlackOval
+ CreateLabel WindowCount, "lblGuild", 18, 35, 138, , "Guild Name", rockwellDec_15, , Alignment.alignCentre
+ ' White boxes
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 51, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 71, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 91, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ CreatePictureBox WindowCount, "picWhiteBox", 13, 111, 148, 19, , , , , , , , DesignTypes.desTextWhite, DesignTypes.desTextWhite, DesignTypes.desTextWhite
+ ' Labels
+ CreateLabel WindowCount, "lblRank", 18, 53, 147, 16, "Guild Rank: None", rockwellDec_10
+ CreateLabel WindowCount, "lblKills", 18, 73, 147, 16, "Enemy Kills: 0", rockwellDec_10
+ CreateLabel WindowCount, "lblGold", 18, 93, 147, 16, "Bank Gold: 0g", rockwellDec_10
+ CreateLabel WindowCount, "lblMembers", 18, 113, 147, 16, "Guild Members: 0", rockwellDec_10
+End Sub
+
+' Rendering & Initialisation
+Public Sub InitGUI()
+
+ ' Starter values
+ zOrder_Win = 1
+ zOrder_Con = 1
+
+ ' Menu
+ CreateWindow_Login
+ CreateWindow_Characters
+ CreateWindow_Loading
+ CreateWindow_Dialogue
+ CreateWindow_Classes
+ CreateWindow_NewChar
+
+ ' Game
+ CreateWindow_Combobox
+ CreateWindow_EscMenu
+ CreateWindow_Bars
+ CreateWindow_Menu
+ CreateWindow_Hotbar
+ CreateWindow_Inventory
+ CreateWindow_Character
+ CreateWindow_Description
+ CreateWindow_DragBox
+ CreateWindow_Skills
+ CreateWindow_Chat
+ CreateWindow_ChatSmall
+ CreateWindow_Options
+ CreateWindow_Shop
+ CreateWindow_NpcChat
+ CreateWindow_Party
+ CreateWindow_Invitations
+ CreateWindow_Trade
+ CreateWindow_Guild
+
+ ' Menus
+ CreateWindow_RightClick
+ CreateWindow_PlayerMenu
+End Sub
diff --git a/client/src/modInterfaceEvents.bas b/client/src/modInterfaceEvents.bas
new file mode 100644
index 0000000..2707568
--- /dev/null
+++ b/client/src/modInterfaceEvents.bas
@@ -0,0 +1,1657 @@
+Attribute VB_Name = "modInterfaceEvents"
+Option Explicit
+Public Declare Sub GetCursorPos Lib "user32" (lpPoint As POINTAPI)
+Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
+Public Declare Function entCallBack Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal Window As Long, ByRef Control As Long, ByVal forced As Long, ByVal lParam As Long) As Long
+Public Const VK_LBUTTON = &H1
+Public Const VK_RBUTTON = &H2
+Public lastMouseX As Long, lastMouseY As Long
+Public currMouseX As Long, currMouseY As Long
+Public clickedX As Long, clickedY As Long
+Public mouseClick(1 To 2) As Long
+Public lastMouseClick(1 To 2) As Long
+
+Public Function MouseX(Optional ByVal hWnd As Long) As Long
+ Dim lpPoint As POINTAPI
+ GetCursorPos lpPoint
+
+ If hWnd Then ScreenToClient hWnd, lpPoint
+ MouseX = lpPoint.x
+End Function
+
+Public Function MouseY(Optional ByVal hWnd As Long) As Long
+ Dim lpPoint As POINTAPI
+ GetCursorPos lpPoint
+
+ If hWnd Then ScreenToClient hWnd, lpPoint
+ MouseY = lpPoint.y
+End Function
+
+Public Sub HandleMouseInput()
+ Dim entState As entStates, i As Long, x As Long
+
+ ' exit out if we're playing video
+ If videoPlaying Then Exit Sub
+
+ ' set values
+ lastMouseX = currMouseX
+ lastMouseY = currMouseY
+ currMouseX = MouseX(frmMain.hWnd)
+ currMouseY = MouseY(frmMain.hWnd)
+ GlobalX = currMouseX
+ GlobalY = currMouseY
+ lastMouseClick(VK_LBUTTON) = mouseClick(VK_LBUTTON)
+ lastMouseClick(VK_RBUTTON) = mouseClick(VK_RBUTTON)
+ mouseClick(VK_LBUTTON) = GetAsyncKeyState(VK_LBUTTON)
+ mouseClick(VK_RBUTTON) = GetAsyncKeyState(VK_RBUTTON)
+
+ ' Hover
+ entState = entStates.Hover
+
+ ' MouseDown
+ If (mouseClick(VK_LBUTTON) And lastMouseClick(VK_LBUTTON) = 0) Or (mouseClick(VK_RBUTTON) And lastMouseClick(VK_RBUTTON) = 0) Then
+ clickedX = currMouseX
+ clickedY = currMouseY
+ entState = entStates.MouseDown
+ ' MouseUp
+ ElseIf (mouseClick(VK_LBUTTON) = 0 And lastMouseClick(VK_LBUTTON)) Or (mouseClick(VK_RBUTTON) = 0 And lastMouseClick(VK_RBUTTON)) Then
+ entState = entStates.MouseUp
+ ' MouseMove
+ ElseIf (currMouseX <> lastMouseX) Or (currMouseY <> lastMouseY) Then
+ entState = entStates.MouseMove
+ End If
+
+ ' Handle everything else
+ If Not HandleGuiMouse(entState) Then
+ ' reset /all/ control mouse events
+ For i = 1 To WindowCount
+ For x = 1 To Windows(i).ControlCount
+ Windows(i).Controls(x).state = Normal
+ Next
+ Next
+ If InGame Then
+ If entState = entStates.MouseDown Then
+ ' Handle events
+ If currMouseX >= 0 And currMouseX <= frmMain.ScaleWidth Then
+ If currMouseY >= 0 And currMouseY <= frmMain.ScaleHeight Then
+ If InMapEditor Then
+ If (mouseClick(VK_LBUTTON) And lastMouseClick(VK_LBUTTON) = 0) Then
+ If frmEditor_Map.optEvents.value Then
+ selTileX = CurX
+ selTileY = CurY
+ Else
+ Call MapEditorMouseDown(vbLeftButton, GlobalX, GlobalY, False)
+ End If
+ ElseIf (mouseClick(VK_RBUTTON) And lastMouseClick(VK_RBUTTON) = 0) Then
+ If Not frmEditor_Map.optEvents.value Then Call MapEditorMouseDown(vbRightButton, GlobalX, GlobalY, False)
+ End If
+ Else
+ ' left click
+ If (mouseClick(VK_LBUTTON) And lastMouseClick(VK_LBUTTON) = 0) Then
+ ' targetting
+ FindTarget
+ ' right click
+ ElseIf (mouseClick(VK_RBUTTON) And lastMouseClick(VK_RBUTTON) = 0) Then
+ If ShiftDown Then
+ ' admin warp if we're pressing shift and right clicking
+ If GetPlayerAccess(MyIndex) >= 2 Then AdminWarp CurX, CurY
+ Exit Sub
+ End If
+ ' right-click menu
+ For i = 1 To MAX_PLAYERS
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = GetPlayerMap(MyIndex) Then
+ If GetPlayerX(i) = CurX And GetPlayerY(i) = CurY Then
+ ShowPlayerMenu i, currMouseX, currMouseY
+ End If
+ End If
+ End If
+ Next
+ End If
+ End If
+ End If
+ End If
+ ElseIf entState = entStates.MouseMove Then
+ GlobalX_Map = GlobalX + (TileView.left * PIC_X) + Camera.left
+ GlobalY_Map = GlobalY + (TileView.top * PIC_Y) + Camera.top
+ ' Handle the events
+ CurX = TileView.left + ((currMouseX + Camera.left) \ PIC_X)
+ CurY = TileView.top + ((currMouseY + Camera.top) \ PIC_Y)
+
+ If InMapEditor Then
+ If (mouseClick(VK_LBUTTON)) Then
+ If Not frmEditor_Map.optEvents.value Then Call MapEditorMouseDown(vbLeftButton, CurX, CurY, False)
+ ElseIf (mouseClick(VK_RBUTTON)) Then
+ If Not frmEditor_Map.optEvents.value Then Call MapEditorMouseDown(vbRightButton, CurX, CurY, False)
+ End If
+ End If
+ End If
+ End If
+ End If
+End Sub
+
+Public Function HandleGuiMouse(entState As entStates) As Boolean
+ Dim i As Long, curWindow As Long, curControl As Long, callBack As Long, x As Long
+
+ ' if hiding gui
+ If hideGUI = True Or InMapEditor Then Exit Function
+
+ ' Find the container
+ For i = 1 To WindowCount
+ With Windows(i).Window
+ If .enabled And .visible Then
+ If .state <> entStates.MouseDown Then .state = entStates.Normal
+ If currMouseX >= .left And currMouseX <= .width + .left Then
+ If currMouseY >= .top And currMouseY <= .height + .top Then
+ ' set the combomenu
+ If .design(0) = DesignTypes.desComboMenuNorm Then
+ ' set the hover menu
+ If entState = MouseMove Or entState = Hover Then
+ ComboMenu_MouseMove i
+ ElseIf entState = MouseDown Then
+ ComboMenu_MouseDown i
+ End If
+ End If
+ ' everything else
+ If curWindow = 0 Then curWindow = i
+ If .zOrder > Windows(curWindow).Window.zOrder Then curWindow = i
+ End If
+ End If
+ If entState = entStates.MouseMove Then
+ If .canDrag Then
+ If .state = entStates.MouseDown Then
+ .left = Clamp(.left + ((currMouseX - .left) - .movedX), 0, ScreenWidth - .width)
+ .top = Clamp(.top + ((currMouseY - .top) - .movedY), 0, ScreenHeight - .height)
+ End If
+ End If
+ End If
+ End If
+ End With
+ Next
+
+ ' Handle any controls first
+ If curWindow Then
+ ' reset /all other/ control mouse events
+ For i = 1 To WindowCount
+ If i <> curWindow Then
+ For x = 1 To Windows(i).ControlCount
+ Windows(i).Controls(x).state = Normal
+ Next
+ End If
+ Next
+ For i = 1 To Windows(curWindow).ControlCount
+ With Windows(curWindow).Controls(i)
+ If .enabled And .visible Then
+ If .state <> entStates.MouseDown Then .state = entStates.Normal
+ If currMouseX >= .left + Windows(curWindow).Window.left And currMouseX <= .left + .width + Windows(curWindow).Window.left Then
+ If currMouseY >= .top + Windows(curWindow).Window.top And currMouseY <= .top + .height + Windows(curWindow).Window.top Then
+ If curControl = 0 Then curControl = i
+ If .zOrder > Windows(curWindow).Controls(curControl).zOrder Then curControl = i
+ End If
+ End If
+ If entState = entStates.MouseMove Then
+ If .canDrag Then
+ If .state = entStates.MouseDown Then
+ .left = Clamp(.left + ((currMouseX - .left) - .movedX), 0, Windows(curWindow).Window.width - .width)
+ .top = Clamp(.top + ((currMouseY - .top) - .movedY), 0, Windows(curWindow).Window.height - .height)
+ End If
+ End If
+ End If
+ End If
+ End With
+ Next
+ ' Handle control
+ If curControl Then
+ HandleGuiMouse = True
+ With Windows(curWindow).Controls(curControl)
+ If .state <> entStates.MouseDown Then
+ If entState <> entStates.MouseMove Then
+ .state = entState
+ Else
+ .state = entStates.Hover
+ End If
+ End If
+ If entState = entStates.MouseDown Then
+ If .canDrag Then
+ .movedX = clickedX - .left
+ .movedY = clickedY - .top
+ End If
+ ' toggle boxes
+ Select Case .Type
+ Case EntityTypes.entCheckbox
+ ' grouped boxes
+ If .group > 0 Then
+ If .value = 0 Then
+ For i = 1 To Windows(curWindow).ControlCount
+ If Windows(curWindow).Controls(i).Type = EntityTypes.entCheckbox Then
+ If Windows(curWindow).Controls(i).group = .group Then
+ Windows(curWindow).Controls(i).value = 0
+ End If
+ End If
+ Next
+ .value = 1
+ End If
+ Else
+ If .value = 0 Then
+ .value = 1
+ Else
+ .value = 0
+ End If
+ End If
+ Case EntityTypes.entCombobox
+ ShowComboMenu curWindow, curControl
+ End Select
+ ' set active input
+ SetActiveControl curWindow, curControl
+ End If
+ callBack = .entCallBack(entState)
+ End With
+ Else
+ ' Handle container
+ With Windows(curWindow).Window
+ HandleGuiMouse = True
+ If .state <> entStates.MouseDown Then
+ If entState <> entStates.MouseMove Then
+ .state = entState
+ Else
+ .state = entStates.Hover
+ End If
+ End If
+ If entState = entStates.MouseDown Then
+ If .canDrag Then
+ .movedX = clickedX - .left
+ .movedY = clickedY - .top
+ End If
+ End If
+ callBack = .entCallBack(entState)
+ End With
+ End If
+ ' bring to front
+ If entState = entStates.MouseDown Then
+ UpdateZOrder curWindow
+ activeWindow = curWindow
+ End If
+ ' call back
+ If callBack <> 0 Then entCallBack callBack, curWindow, curControl, 0, 0
+ End If
+
+ ' Reset
+ If entState = entStates.MouseUp Then ResetMouseDown
+End Function
+
+Public Sub ResetGUI()
+ Dim i As Long, x As Long
+
+ For i = 1 To WindowCount
+
+ If Windows(i).Window.state <> MouseDown Then Windows(i).Window.state = Normal
+
+ For x = 1 To Windows(i).ControlCount
+
+ If Windows(i).Controls(x).state <> MouseDown Then Windows(i).Controls(x).state = Normal
+ Next
+ Next
+
+End Sub
+
+Public Sub ResetMouseDown()
+ Dim callBack As Long
+ Dim i As Long, x As Long
+
+ For i = 1 To WindowCount
+
+ With Windows(i)
+ .Window.state = entStates.Normal
+ callBack = .Window.entCallBack(entStates.Normal)
+
+ If callBack <> 0 Then entCallBack callBack, i, 0, 0, 0
+
+ For x = 1 To .ControlCount
+ .Controls(x).state = entStates.Normal
+ callBack = .Controls(x).entCallBack(entStates.Normal)
+
+ If callBack <> 0 Then entCallBack callBack, i, x, 0, 0
+ Next
+
+ End With
+
+ Next
+
+End Sub
+
+' ##################
+' ## Login Window ##
+' ##################
+
+Public Sub btnLogin_Click()
+ Dim user As String, pass As String
+
+ With Windows(GetWindowIndex("winLogin"))
+ user = .Controls(GetControlIndex("winLogin", "txtUser")).text
+ pass = .Controls(GetControlIndex("winLogin", "txtPass")).text
+ End With
+
+ Login user, pass
+End Sub
+
+Public Sub chkSaveUser_Click()
+
+ With Windows(GetWindowIndex("winLogin")).Controls(GetControlIndex("winLogin", "chkSaveUser"))
+ If .value = 0 Then ' set as false
+ Options.SaveUser = 0
+ Options.Username = vbNullString
+ SaveOptions
+ Else
+ Options.SaveUser = 1
+ SaveOptions
+ End If
+ End With
+End Sub
+
+' #######################
+' ## Characters Window ##
+' #######################
+
+Public Sub Chars_DrawFace()
+Dim xO As Long, yO As Long, imageFace As Long, imageChar As Long, x As Long, i As Long
+
+ xO = Windows(GetWindowIndex("winCharacters")).Window.left
+ yO = Windows(GetWindowIndex("winCharacters")).Window.top
+
+ x = xO + 24
+ For i = 1 To MAX_CHARS
+ If LenB(Trim$(CharName(i))) > 0 Then
+ If CharSprite(i) > 0 Then
+ If Not CharSprite(i) > Count_Char And Not CharSprite(i) > Count_Face Then
+ imageFace = Tex_Face(CharSprite(i))
+ imageChar = Tex_Char(CharSprite(i))
+ RenderTexture imageFace, x, yO + 56, 0, 0, 94, 94, 94, 94
+ RenderTexture imageChar, x - 1, yO + 117, 32, 0, 32, 32, 32, 32
+ End If
+ End If
+ End If
+ x = x + 110
+ Next
+End Sub
+
+Public Sub btnAcceptChar_1()
+ SendUseChar 1
+End Sub
+
+Public Sub btnAcceptChar_2()
+ SendUseChar 2
+End Sub
+
+Public Sub btnAcceptChar_3()
+ SendUseChar 3
+End Sub
+
+Public Sub btnDelChar_1()
+ Dialogue "Delete Character", "Deleting this character is permanent.", "Are you sure you want to delete this character?", TypeDELCHAR, StyleYESNO, 1
+End Sub
+
+Public Sub btnDelChar_2()
+ Dialogue "Delete Character", "Deleting this character is permanent.", "Are you sure you want to delete this character?", TypeDELCHAR, StyleYESNO, 2
+End Sub
+
+Public Sub btnDelChar_3()
+ Dialogue "Delete Character", "Deleting this character is permanent.", "Are you sure you want to delete this character?", TypeDELCHAR, StyleYESNO, 3
+End Sub
+
+Public Sub btnCreateChar_1()
+ CharNum = 1
+ ShowClasses
+End Sub
+
+Public Sub btnCreateChar_2()
+ CharNum = 2
+ ShowClasses
+End Sub
+
+Public Sub btnCreateChar_3()
+ CharNum = 3
+ ShowClasses
+End Sub
+
+Public Sub btnCharacters_Close()
+ DestroyTCP
+ HideWindows
+ ShowWindow GetWindowIndex("winLogin")
+End Sub
+
+' #####################
+' ## Dialogue Window ##
+' #####################
+
+Public Sub btnDialogue_Close()
+ If diaStyle = StyleOKAY Then
+ dialogueHandler 1
+ ElseIf diaStyle = StyleYESNO Then
+ dialogueHandler 3
+ End If
+End Sub
+
+Public Sub Dialogue_Okay()
+ dialogueHandler 1
+End Sub
+
+Public Sub Dialogue_Yes()
+ dialogueHandler 2
+End Sub
+
+Public Sub Dialogue_No()
+ dialogueHandler 3
+End Sub
+
+' ####################
+' ## Classes Window ##
+' ####################
+
+Public Sub Classes_DrawFace()
+Dim imageFace As Long, xO As Long, yO As Long
+
+ xO = Windows(GetWindowIndex("winClasses")).Window.left
+ yO = Windows(GetWindowIndex("winClasses")).Window.top
+
+ Max_Classes = 3
+
+ If newCharClass = 0 Then newCharClass = 1
+
+ Select Case newCharClass
+ Case 1 ' Warrior
+ imageFace = Tex_GUI(18)
+ Case 2 ' Wizard
+ imageFace = Tex_GUI(19)
+ Case 3 ' Whisperer
+ imageFace = Tex_GUI(20)
+ End Select
+
+ ' render face
+ RenderTexture imageFace, xO + 14, yO - 41, 0, 0, 256, 256, 256, 256
+End Sub
+
+Public Sub Classes_DrawText()
+Dim image As Long, text As String, xO As Long, yO As Long, textArray() As String, i As Long, count As Long, y As Long, x As Long
+
+ xO = Windows(GetWindowIndex("winClasses")).Window.left
+ yO = Windows(GetWindowIndex("winClasses")).Window.top
+
+ Select Case newCharClass
+ Case 1 ' Warrior
+ text = "The way of a warrior has never been an easy one. Skilled use of a sword is not something learnt overnight. Being able to take a decent amount of hits is important for these characters and as such they weigh a lot of importance on endurance and strength."
+ Case 2 ' Wizard
+ text = "Wizards are often mistrusted characters who have mastered the practise of using their own spirit to create elemental entities. Generally seen as playful and almost childish because of the huge amounts of pleasure they take from setting things on fire."
+ Case 3 ' Whisperer
+ text = "The art of healing is one which comes with tremendous amounts of pressure and guilt. Constantly being put under high-pressure situations where their abilities could mean the difference between life and death leads many Whisperers to insanity."
+ End Select
+
+ ' wrap text
+ WordWrap_Array text, 200, textArray()
+ ' render text
+ count = UBound(textArray)
+ y = yO + 60
+ For i = 1 To count
+ x = xO + 132 + (200 \ 2) - (TextWidth(font(Fonts.rockwell_15), textArray(i)) \ 2)
+ RenderText font(Fonts.rockwell_15), textArray(i), x, y, White
+ y = y + 14
+ Next
+End Sub
+
+Public Sub btnClasses_Left()
+Dim text As String
+ newCharClass = newCharClass - 1
+ If newCharClass <= 0 Then
+ newCharClass = Max_Classes
+ End If
+ Windows(GetWindowIndex("winClasses")).Controls(GetControlIndex("winClasses", "lblClassName")).text = Trim$(Class(newCharClass).name)
+End Sub
+
+Public Sub btnClasses_Right()
+Dim text As String
+ newCharClass = newCharClass + 1
+ If newCharClass > Max_Classes Then
+ newCharClass = 1
+ End If
+ Windows(GetWindowIndex("winClasses")).Controls(GetControlIndex("winClasses", "lblClassName")).text = Trim$(Class(newCharClass).name)
+End Sub
+
+Public Sub btnClasses_Accept()
+ HideWindow GetWindowIndex("winClasses")
+ ShowWindow GetWindowIndex("winNewChar")
+End Sub
+
+Public Sub btnClasses_Close()
+ HideWindows
+ ShowWindow GetWindowIndex("winCharacters")
+End Sub
+
+' ###################
+' ## New Character ##
+' ###################
+
+Public Sub NewChar_OnDraw()
+Dim imageFace As Long, imageChar As Long, xO As Long, yO As Long
+
+ xO = Windows(GetWindowIndex("winNewChar")).Window.left
+ yO = Windows(GetWindowIndex("winNewChar")).Window.top
+
+ If newCharGender = SEX_MALE Then
+ imageFace = Tex_Face(Class(newCharClass).MaleSprite(newCharSprite))
+ imageChar = Tex_Char(Class(newCharClass).MaleSprite(newCharSprite))
+ Else
+ imageFace = Tex_Face(Class(newCharClass).FemaleSprite(newCharSprite))
+ imageChar = Tex_Char(Class(newCharClass).FemaleSprite(newCharSprite))
+ End If
+
+ ' render face
+ RenderTexture imageFace, xO + 166, yO + 56, 0, 0, 94, 94, 94, 94
+ ' render char
+ RenderTexture imageChar, xO + 166, yO + 116, 32, 0, 32, 32, 32, 32
+End Sub
+
+Public Sub btnNewChar_Left()
+Dim spriteCount As Long
+
+ If newCharGender = SEX_MALE Then
+ spriteCount = UBound(Class(newCharClass).MaleSprite)
+ Else
+ spriteCount = UBound(Class(newCharClass).FemaleSprite)
+ End If
+
+ If newCharSprite <= 0 Then
+ newCharSprite = spriteCount
+ Else
+ newCharSprite = newCharSprite - 1
+ End If
+End Sub
+
+Public Sub btnNewChar_Right()
+Dim spriteCount As Long
+
+ If newCharGender = SEX_MALE Then
+ spriteCount = UBound(Class(newCharClass).MaleSprite)
+ Else
+ spriteCount = UBound(Class(newCharClass).FemaleSprite)
+ End If
+
+ If newCharSprite >= spriteCount Then
+ newCharSprite = 0
+ Else
+ newCharSprite = newCharSprite + 1
+ End If
+End Sub
+
+Public Sub chkNewChar_Male()
+ newCharSprite = 1
+ newCharGender = SEX_MALE
+End Sub
+
+Public Sub chkNewChar_Female()
+ newCharSprite = 1
+ newCharGender = SEX_FEMALE
+End Sub
+
+Public Sub btnNewChar_Cancel()
+ Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "txtName")).text = vbNullString
+ Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "chkMale")).value = 1
+ Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "chkFemale")).value = 0
+ newCharSprite = 1
+ newCharGender = SEX_MALE
+ HideWindows
+ ShowWindow GetWindowIndex("winClasses")
+End Sub
+
+Public Sub btnNewChar_Accept()
+Dim name As String
+ name = Windows(GetWindowIndex("winNewChar")).Controls(GetControlIndex("winNewChar", "txtName")).text
+ HideWindows
+ AddChar name, newCharGender, newCharClass, newCharSprite
+End Sub
+
+' ##############
+' ## Esc Menu ##
+' ##############
+
+Public Sub btnEscMenu_Return()
+ HideWindow GetWindowIndex("winBlank")
+ HideWindow GetWindowIndex("winEscMenu")
+End Sub
+
+Public Sub btnEscMenu_Options()
+ HideWindow GetWindowIndex("winEscMenu")
+ ShowWindow GetWindowIndex("winOptions"), True, True
+End Sub
+
+Public Sub btnEscMenu_MainMenu()
+ HideWindows
+ ShowWindow GetWindowIndex("winLogin")
+ Stop_Music
+ ' play the menu music
+ If Len(Trim$(MenuMusic)) > 0 Then Play_Music Trim$(MenuMusic)
+ logoutGame
+End Sub
+
+Public Sub btnEscMenu_Exit()
+ HideWindow GetWindowIndex("winBlank")
+ HideWindow GetWindowIndex("winEscMenu")
+ DestroyGame
+End Sub
+
+' ##########
+' ## Bars ##
+' ##########
+
+Public Sub Bars_OnDraw()
+ Dim xO As Long, yO As Long, width As Long
+
+ xO = Windows(GetWindowIndex("winBars")).Window.left
+ yO = Windows(GetWindowIndex("winBars")).Window.top
+
+ ' Bars
+ RenderTexture Tex_GUI(27), xO + 15, yO + 15, 0, 0, BarWidth_GuiHP, 13, BarWidth_GuiHP, 13
+ RenderTexture Tex_GUI(28), xO + 15, yO + 32, 0, 0, BarWidth_GuiSP, 13, BarWidth_GuiSP, 13
+ RenderTexture Tex_GUI(29), xO + 15, yO + 49, 0, 0, BarWidth_GuiEXP, 13, BarWidth_GuiEXP, 13
+End Sub
+
+' ##########
+' ## Menu ##
+' ##########
+
+Public Sub btnMenu_Char()
+Dim curWindow As Long
+ curWindow = GetWindowIndex("winCharacter")
+ If Windows(curWindow).Window.visible Then
+ HideWindow curWindow
+ Else
+ ShowWindow curWindow, , False
+ End If
+End Sub
+
+Public Sub btnMenu_Inv()
+Dim curWindow As Long
+ curWindow = GetWindowIndex("winInventory")
+ If Windows(curWindow).Window.visible Then
+ HideWindow curWindow
+ Else
+ ShowWindow curWindow, , False
+ End If
+End Sub
+
+Public Sub btnMenu_Skills()
+Dim curWindow As Long
+ curWindow = GetWindowIndex("winSkills")
+ If Windows(curWindow).Window.visible Then
+ HideWindow curWindow
+ Else
+ ShowWindow curWindow, , False
+ End If
+End Sub
+
+Public Sub btnMenu_Map()
+ 'Windows(GetWindowIndex("winCharacter")).Window.visible = Not Windows(GetWindowIndex("winCharacter")).Window.visible
+End Sub
+
+Public Sub btnMenu_Guild()
+ 'Windows(GetWindowIndex("winCharacter")).Window.visible = Not Windows(GetWindowIndex("winCharacter")).Window.visible
+End Sub
+
+Public Sub btnMenu_Quest()
+ 'Windows(GetWindowIndex("winCharacter")).Window.visible = Not Windows(GetWindowIndex("winCharacter")).Window.visible
+End Sub
+
+' ###############
+' ## Inventory ##
+' ###############
+
+Public Sub Inventory_MouseDown()
+Dim invNum As Long, winIndex As Long, i As Long
+
+ ' is there an item?
+ invNum = IsItem(Windows(GetWindowIndex("winInventory")).Window.left, Windows(GetWindowIndex("winInventory")).Window.top)
+
+ If invNum Then
+ ' exit out if we're offering that item
+ If InTrade > 0 Then
+ For i = 1 To MAX_INV
+ If TradeYourOffer(i).num = invNum Then
+ ' is currency?
+ If Item(GetPlayerInvItemNum(MyIndex, TradeYourOffer(i).num)).Type = ITEM_TYPE_CURRENCY Then
+ ' only exit out if we're offering all of it
+ If TradeYourOffer(i).value = GetPlayerInvItemValue(MyIndex, TradeYourOffer(i).num) Then
+ Exit Sub
+ End If
+ Else
+ Exit Sub
+ End If
+ End If
+ Next
+ ' currency handler
+ If Item(GetPlayerInvItemNum(MyIndex, invNum)).Type = ITEM_TYPE_CURRENCY Then
+ Dialogue "Select Amount", "Please choose how many to offer", "", TypeTRADEAMOUNT, StyleINPUT, invNum
+ Exit Sub
+ End If
+ ' trade the normal item
+ Call TradeItem(invNum, 0)
+ Exit Sub
+ End If
+
+ ' drag it
+ With DragBox
+ .Type = Part_Item
+ .value = GetPlayerInvItemNum(MyIndex, invNum)
+ .Origin = origin_Inventory
+ .Slot = invNum
+ End With
+
+ winIndex = GetWindowIndex("winDragBox")
+ With Windows(winIndex).Window
+ .state = MouseDown
+ .left = lastMouseX - 16
+ .top = lastMouseY - 16
+ .movedX = clickedX - .left
+ .movedY = clickedY - .top
+ End With
+ ShowWindow winIndex, , False
+ ' stop dragging inventory
+ Windows(GetWindowIndex("winInventory")).Window.state = Normal
+ End If
+
+ ' show desc. if needed
+ Inventory_MouseMove
+End Sub
+
+Public Sub Inventory_DblClick()
+Dim itemNum As Long, i As Long
+
+ If InTrade > 0 Then Exit Sub
+
+ itemNum = IsItem(Windows(GetWindowIndex("winInventory")).Window.left, Windows(GetWindowIndex("winInventory")).Window.top)
+
+ If itemNum Then
+ SendUseItem itemNum
+ End If
+
+ ' show desc. if needed
+ Inventory_MouseMove
+End Sub
+
+Public Sub Inventory_MouseMove()
+Dim itemNum As Long, x As Long, y As Long, i As Long
+
+ ' exit out early if dragging
+ If DragBox.Type <> part_None Then Exit Sub
+
+ itemNum = IsItem(Windows(GetWindowIndex("winInventory")).Window.left, Windows(GetWindowIndex("winInventory")).Window.top)
+
+ If itemNum Then
+ ' exit out if we're offering that item
+ If InTrade > 0 Then
+ For i = 1 To MAX_INV
+ If TradeYourOffer(i).num = itemNum Then
+ ' is currency?
+ If Item(GetPlayerInvItemNum(MyIndex, TradeYourOffer(i).num)).Type = ITEM_TYPE_CURRENCY Then
+ ' only exit out if we're offering all of it
+ If TradeYourOffer(i).value = GetPlayerInvItemValue(MyIndex, TradeYourOffer(i).num) Then
+ Exit Sub
+ End If
+ Else
+ Exit Sub
+ End If
+ End If
+ Next
+ End If
+ ' make sure we're not dragging the item
+ If DragBox.Type = Part_Item And DragBox.value = itemNum Then Exit Sub
+ ' calc position
+ x = Windows(GetWindowIndex("winInventory")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winInventory")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winInventory")).Window.left + Windows(GetWindowIndex("winInventory")).Window.width
+ End If
+ ' go go go
+ ShowInvDesc x, y, itemNum
+ End If
+End Sub
+
+' ###############
+' ## Character ##
+' ###############
+
+Public Sub Character_MouseDown()
+Dim itemNum As Long
+
+ itemNum = IsEqItem(Windows(GetWindowIndex("winCharacter")).Window.left, Windows(GetWindowIndex("winCharacter")).Window.top)
+
+ If itemNum Then
+ SendUnequip itemNum
+ End If
+
+ ' show desc. if needed
+ Character_MouseMove
+End Sub
+
+Public Sub Character_MouseMove()
+Dim itemNum As Long, x As Long, y As Long
+
+ ' exit out early if dragging
+ If DragBox.Type <> part_None Then Exit Sub
+
+ itemNum = IsEqItem(Windows(GetWindowIndex("winCharacter")).Window.left, Windows(GetWindowIndex("winCharacter")).Window.top)
+
+ If itemNum Then
+ ' calc position
+ x = Windows(GetWindowIndex("winCharacter")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winCharacter")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winCharacter")).Window.left + Windows(GetWindowIndex("winCharacter")).Window.width
+ End If
+ ' go go go
+ ShowEqDesc x, y, itemNum
+ End If
+End Sub
+
+Public Sub Character_SpendPoint1()
+ SendTrainStat 1
+End Sub
+
+Public Sub Character_SpendPoint2()
+ SendTrainStat 2
+End Sub
+
+Public Sub Character_SpendPoint3()
+ SendTrainStat 3
+End Sub
+
+Public Sub Character_SpendPoint4()
+ SendTrainStat 4
+End Sub
+
+Public Sub Character_SpendPoint5()
+ SendTrainStat 5
+End Sub
+
+' #################
+' ## Description ##
+' #################
+
+Public Sub Description_OnDraw()
+Dim xO As Long, yO As Long, texNum As Long, y As Long, i As Long, count As Long
+
+ ' exit out if we don't have a num
+ If descItem = 0 Or descType = 0 Then Exit Sub
+
+ xO = Windows(GetWindowIndex("winDescription")).Window.left
+ yO = Windows(GetWindowIndex("winDescription")).Window.top
+
+ Select Case descType
+ Case 1 ' Inventory Item
+ texNum = Tex_Item(Item(descItem).Pic)
+ Case 2 ' Spell Icon
+ texNum = Tex_Spellicon(Spell(descItem).icon)
+ ' render bar
+ With Windows(GetWindowIndex("winDescription")).Controls(GetControlIndex("winDescription", "picBar"))
+ If .visible Then RenderTexture Tex_GUI(45), xO + .left, yO + .top, 0, 12, .value, 12, .value, 12
+ End With
+ End Select
+
+ ' render sprite
+ RenderTexture texNum, xO + 20, yO + 34, 0, 0, 64, 64, 32, 32
+
+ ' render text array
+ y = 18
+ count = UBound(descText)
+ For i = 1 To count
+ RenderText font(Fonts.verdana_12), descText(i).text, xO + 141 - (TextWidth(font(Fonts.verdana_12), descText(i).text) \ 2), yO + y, descText(i).Colour
+ y = y + 12
+ Next
+
+ ' close
+ HideWindow GetWindowIndex("winDescription")
+End Sub
+
+' ##############
+' ## Drag Box ##
+' ##############
+
+Public Sub DragBox_OnDraw()
+Dim xO As Long, yO As Long, texNum As Long, winIndex As Long
+
+ winIndex = GetWindowIndex("winDragBox")
+ xO = Windows(winIndex).Window.left
+ yO = Windows(winIndex).Window.top
+
+ ' get texture num
+ With DragBox
+ Select Case .Type
+ Case Part_Item
+ If .value Then
+ texNum = Tex_Item(Item(.value).Pic)
+ End If
+ Case Part_spell
+ If .value Then
+ texNum = Tex_Spellicon(Spell(.value).icon)
+ End If
+ End Select
+ End With
+
+ ' draw texture
+ RenderTexture texNum, xO, yO, 0, 0, 32, 32, 32, 32
+End Sub
+
+Public Sub DragBox_Check()
+Dim winIndex As Long, i As Long, curWindow As Long, curControl As Long, tmpRec As RECT
+
+ winIndex = GetWindowIndex("winDragBox")
+
+ ' can't drag nuthin'
+ If DragBox.Type = part_None Then Exit Sub
+
+ ' check for other windows
+ For i = 1 To WindowCount
+ With Windows(i).Window
+ If .visible Then
+ ' can't drag to self
+ If .name <> "winDragBox" Then
+ If currMouseX >= .left And currMouseX <= .left + .width Then
+ If currMouseY >= .top And currMouseY <= .top + .height Then
+ If curWindow = 0 Then curWindow = i
+ If .zOrder > Windows(curWindow).Window.zOrder Then curWindow = i
+ End If
+ End If
+ End If
+ End If
+ End With
+ Next
+
+ ' we have a window - check if we can drop
+ If curWindow Then
+ Select Case Windows(curWindow).Window.name
+ Case "winInventory"
+ If DragBox.Origin = origin_Inventory Then
+ ' it's from the inventory!
+ If DragBox.Type = Part_Item Then
+ ' find the slot to switch with
+ For i = 1 To MAX_INV
+ With tmpRec
+ .top = Windows(curWindow).Window.top + InvTop + ((InvOffsetY + 32) * ((i - 1) \ InvColumns))
+ .bottom = .top + 32
+ .left = Windows(curWindow).Window.left + InvLeft + ((InvOffsetX + 32) * (((i - 1) Mod InvColumns)))
+ .Right = .left + 32
+ End With
+
+ If currMouseX >= tmpRec.left And currMouseX <= tmpRec.Right Then
+ If currMouseY >= tmpRec.top And currMouseY <= tmpRec.bottom Then
+ ' switch the slots
+ If DragBox.Slot <> i Then SendChangeInvSlots DragBox.Slot, i
+ Exit For
+ End If
+ End If
+ Next
+ End If
+ End If
+ Case "winSkills"
+ If DragBox.Origin = origin_Spells Then
+ ' it's from the spells!
+ If DragBox.Type = Part_spell Then
+ ' find the slot to switch with
+ For i = 1 To MAX_PLAYER_SPELLS
+ With tmpRec
+ .top = Windows(curWindow).Window.top + SkillTop + ((SkillOffsetY + 32) * ((i - 1) \ SkillColumns))
+ .bottom = .top + 32
+ .left = Windows(curWindow).Window.left + SkillLeft + ((SkillOffsetX + 32) * (((i - 1) Mod SkillColumns)))
+ .Right = .left + 32
+ End With
+
+ If currMouseX >= tmpRec.left And currMouseX <= tmpRec.Right Then
+ If currMouseY >= tmpRec.top And currMouseY <= tmpRec.bottom Then
+ ' switch the slots
+ If DragBox.Slot <> i Then SendChangeSpellSlots DragBox.Slot, i
+ Exit For
+ End If
+ End If
+ Next
+ End If
+ End If
+ Case "winHotbar"
+ If DragBox.Origin <> origin_None Then
+ If DragBox.Type <> part_None Then
+ ' find the slot
+ For i = 1 To MAX_HOTBAR
+ With tmpRec
+ .top = Windows(curWindow).Window.top + HotbarTop
+ .bottom = .top + 32
+ .left = Windows(curWindow).Window.left + HotbarLeft + ((i - 1) * HotbarOffsetX)
+ .Right = .left + 32
+ End With
+
+ If currMouseX >= tmpRec.left And currMouseX <= tmpRec.Right Then
+ If currMouseY >= tmpRec.top And currMouseY <= tmpRec.bottom Then
+ ' set the hotbar slot
+ If DragBox.Origin <> origin_Hotbar Then
+ If DragBox.Type = Part_Item Then
+ SendHotbarChange 1, DragBox.Slot, i
+ ElseIf DragBox.Type = Part_spell Then
+ SendHotbarChange 2, DragBox.Slot, i
+ End If
+ Else
+ ' SWITCH the hotbar slots
+ If DragBox.Slot <> i Then SwitchHotbar DragBox.Slot, i
+ End If
+ ' exit early
+ Exit For
+ End If
+ End If
+ Next
+ End If
+ End If
+ End Select
+ Else
+ ' no windows found - dropping on bare map
+ Select Case DragBox.Origin
+ Case PartTypeOrigins.origin_Inventory
+ If Item(GetPlayerInvItemNum(MyIndex, DragBox.Slot)).Type <> ITEM_TYPE_CURRENCY Then
+ SendDropItem DragBox.Slot, GetPlayerInvItemNum(MyIndex, DragBox.Slot)
+ Else
+ Dialogue "Drop Item", "Please choose how many to drop", "", TypeDROPITEM, StyleINPUT, GetPlayerInvItemNum(MyIndex, DragBox.Slot)
+ End If
+ Case PartTypeOrigins.origin_Spells
+ ' dialogue
+ Case PartTypeOrigins.origin_Hotbar
+ SendHotbarChange 0, 0, DragBox.Slot
+ End Select
+ End If
+
+ ' close window
+ HideWindow winIndex
+ With DragBox
+ .Type = part_None
+ .Slot = 0
+ .Origin = origin_None
+ .value = 0
+ End With
+End Sub
+
+' ############
+' ## Skills ##
+' ############
+
+Public Sub Skills_MouseDown()
+Dim slotNum As Long, winIndex As Long
+
+ ' is there an item?
+ slotNum = IsSkill(Windows(GetWindowIndex("winSkills")).Window.left, Windows(GetWindowIndex("winSkills")).Window.top)
+
+ If slotNum Then
+ With DragBox
+ .Type = Part_spell
+ .value = PlayerSpells(slotNum).Spell
+ .Origin = origin_Spells
+ .Slot = slotNum
+ End With
+
+ winIndex = GetWindowIndex("winDragBox")
+ With Windows(winIndex).Window
+ .state = MouseDown
+ .left = lastMouseX - 16
+ .top = lastMouseY - 16
+ .movedX = clickedX - .left
+ .movedY = clickedY - .top
+ End With
+ ShowWindow winIndex, , False
+ ' stop dragging inventory
+ Windows(GetWindowIndex("winSkills")).Window.state = Normal
+ End If
+
+ ' show desc. if needed
+ Skills_MouseMove
+End Sub
+
+Public Sub Skills_DblClick()
+Dim slotNum As Long
+
+ slotNum = IsSkill(Windows(GetWindowIndex("winSkills")).Window.left, Windows(GetWindowIndex("winSkills")).Window.top)
+
+ If slotNum Then
+ CastSpell slotNum
+ End If
+
+ ' show desc. if needed
+ Skills_MouseMove
+End Sub
+
+Public Sub Skills_MouseMove()
+Dim slotNum As Long, x As Long, y As Long
+
+ ' exit out early if dragging
+ If DragBox.Type <> part_None Then Exit Sub
+
+ slotNum = IsSkill(Windows(GetWindowIndex("winSkills")).Window.left, Windows(GetWindowIndex("winSkills")).Window.top)
+
+ If slotNum Then
+ ' make sure we're not dragging the item
+ If DragBox.Type = Part_Item And DragBox.value = slotNum Then Exit Sub
+ ' calc position
+ x = Windows(GetWindowIndex("winSkills")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winSkills")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winSkills")).Window.left + Windows(GetWindowIndex("winSkills")).Window.width
+ End If
+ ' go go go
+ ShowPlayerSpellDesc x, y, slotNum
+ End If
+End Sub
+
+' ############
+' ## Hotbar ##
+' ############
+
+Public Sub Hotbar_MouseDown()
+Dim slotNum As Long, winIndex As Long
+
+ ' is there an item?
+ slotNum = IsHotbar(Windows(GetWindowIndex("winHotbar")).Window.left, Windows(GetWindowIndex("winHotbar")).Window.top)
+
+ If slotNum Then
+ With DragBox
+ If Hotbar(slotNum).sType = 1 Then ' inventory
+ .Type = Part_Item
+ ElseIf Hotbar(slotNum).sType = 2 Then ' spell
+ .Type = Part_spell
+ End If
+ .value = Hotbar(slotNum).Slot
+ .Origin = origin_Hotbar
+ .Slot = slotNum
+ End With
+
+ winIndex = GetWindowIndex("winDragBox")
+ With Windows(winIndex).Window
+ .state = MouseDown
+ .left = lastMouseX - 16
+ .top = lastMouseY - 16
+ .movedX = clickedX - .left
+ .movedY = clickedY - .top
+ End With
+ ShowWindow winIndex, , False
+ ' stop dragging inventory
+ Windows(GetWindowIndex("winHotbar")).Window.state = Normal
+ End If
+
+ ' show desc. if needed
+ Hotbar_MouseMove
+End Sub
+
+Public Sub Hotbar_DblClick()
+Dim slotNum As Long
+
+ slotNum = IsHotbar(Windows(GetWindowIndex("winHotbar")).Window.left, Windows(GetWindowIndex("winHotbar")).Window.top)
+
+ If slotNum Then
+ SendHotbarUse slotNum
+ End If
+
+ ' show desc. if needed
+ Hotbar_MouseMove
+End Sub
+
+Public Sub Hotbar_MouseMove()
+Dim slotNum As Long, x As Long, y As Long
+
+ ' exit out early if dragging
+ If DragBox.Type <> part_None Then Exit Sub
+
+ slotNum = IsHotbar(Windows(GetWindowIndex("winHotbar")).Window.left, Windows(GetWindowIndex("winHotbar")).Window.top)
+
+ If slotNum Then
+ ' make sure we're not dragging the item
+ If DragBox.Origin = origin_Hotbar And DragBox.Slot = slotNum Then Exit Sub
+ ' calc position
+ x = Windows(GetWindowIndex("winHotbar")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winHotbar")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winHotbar")).Window.left + Windows(GetWindowIndex("winHotbar")).Window.width
+ End If
+ ' go go go
+ Select Case Hotbar(slotNum).sType
+ Case 1 ' inventory
+ ShowItemDesc x, y, Hotbar(slotNum).Slot, False
+ Case 2 ' spells
+ ShowSpellDesc x, y, Hotbar(slotNum).Slot, 0
+ End Select
+ End If
+End Sub
+
+' Chat
+Public Sub btnSay_Click()
+ HandleKeyPresses vbKeyReturn
+End Sub
+
+Public Sub OnDraw_Chat()
+Dim winIndex As Long, xO As Long, yO As Long
+
+ winIndex = GetWindowIndex("winChat")
+ xO = Windows(winIndex).Window.left
+ yO = Windows(winIndex).Window.top + 16
+
+ ' draw the box
+ RenderDesign DesignTypes.desWin_Desc, xO, yO, 352, 152
+ ' draw the input box
+ RenderTexture Tex_GUI(46), xO + 7, yO + 123, 0, 0, 171, 22, 171, 22
+ RenderTexture Tex_GUI(46), xO + 174, yO + 123, 0, 22, 171, 22, 171, 22
+ ' call the chat render
+ RenderChat
+End Sub
+
+Public Sub OnDraw_ChatSmall()
+Dim winIndex As Long, xO As Long, yO As Long
+
+ winIndex = GetWindowIndex("winChatSmall")
+
+ If actChatWidth < 160 Then actChatWidth = 160
+ If actChatHeight < 10 Then actChatHeight = 10
+
+ xO = Windows(winIndex).Window.left + 10
+ yO = ScreenHeight - 16 - actChatHeight - 8
+
+ ' draw the background
+ RenderDesign DesignTypes.desWin_Shadow, xO, yO, actChatWidth, actChatHeight
+ ' call the chat render
+ RenderChat
+End Sub
+
+Public Sub chkChat_Game()
+ Options.channelState(ChatChannel.chGame) = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "chkGame")).value
+ UpdateChat
+End Sub
+
+Public Sub chkChat_Map()
+ Options.channelState(ChatChannel.chMap) = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "chkMap")).value
+ UpdateChat
+End Sub
+
+Public Sub chkChat_Global()
+ Options.channelState(ChatChannel.chGlobal) = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "chkGlobal")).value
+ UpdateChat
+End Sub
+
+Public Sub chkChat_Party()
+ Options.channelState(ChatChannel.chParty) = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "chkParty")).value
+ UpdateChat
+End Sub
+
+Public Sub chkChat_Guild()
+ Options.channelState(ChatChannel.chGuild) = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "chkGuild")).value
+ UpdateChat
+End Sub
+
+Public Sub chkChat_Private()
+ Options.channelState(ChatChannel.chPrivate) = Windows(GetWindowIndex("winChat")).Controls(GetControlIndex("winChat", "chkPrivate")).value
+ UpdateChat
+End Sub
+
+Public Sub btnChat_Up()
+ ChatButtonUp = True
+End Sub
+
+Public Sub btnChat_Down()
+ ChatButtonDown = True
+End Sub
+
+Public Sub btnChat_Up_MouseUp()
+ ChatButtonUp = False
+End Sub
+
+Public Sub btnChat_Down_MouseUp()
+ ChatButtonDown = False
+End Sub
+
+' Options
+Public Sub btnOptions_Close()
+ HideWindow GetWindowIndex("winOptions")
+ ShowWindow GetWindowIndex("winEscMenu")
+End Sub
+
+Sub btnOptions_Confirm()
+Dim i As Long, value As Long, width As Long, height As Long, message As Boolean, musicFile As String
+
+ ' music
+ value = Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "chkMusic")).value
+ If Options.Music <> value Then
+ Options.Music = value
+ ' let them know
+ If value = 0 Then
+ AddText "Music turned off.", BrightGreen
+ Stop_Music
+ Else
+ AddText "Music tured on.", BrightGreen
+ ' play music
+ If InGame Then musicFile = Trim$(Map.MapData.Music) Else musicFile = Trim$(MenuMusic)
+ If Not musicFile = "None." Then
+ Play_Music musicFile
+ Else
+ Stop_Music
+ End If
+ End If
+ End If
+
+ ' sound
+ value = Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "chkSound")).value
+ If Options.sound <> value Then
+ Options.sound = value
+ ' let them know
+ If value = 0 Then
+ AddText "Sound turned off.", BrightGreen
+ Else
+ AddText "Sound tured on.", BrightGreen
+ End If
+ End If
+
+ ' autotiles
+ value = Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "chkAutotiles")).value
+ If value = 1 Then value = 0 Else value = 1
+ If Options.NoAuto <> value Then
+ Options.NoAuto = value
+ ' let them know
+ If value = 0 Then
+ If InGame Then
+ AddText "Autotiles turned on.", BrightGreen
+ initAutotiles
+ End If
+ Else
+ If InGame Then
+ AddText "Autotiles turned off.", BrightGreen
+ initAutotiles
+ End If
+ End If
+ End If
+
+ ' fullscreen
+ value = Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "chkFullscreen")).value
+ If Options.Fullscreen <> value Then
+ Options.Fullscreen = value
+ message = True
+ End If
+
+ ' resolution
+ With Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "cmbRes"))
+ If .value > 0 And .value <= RES_COUNT Then
+ If Options.Resolution <> .value Then
+ Options.Resolution = .value
+ If Not isFullscreen Then
+ SetResolution
+ Else
+ message = True
+ End If
+ End If
+ End If
+ End With
+
+ ' render
+ With Windows(GetWindowIndex("winOptions")).Controls(GetControlIndex("winOptions", "cmbRender"))
+ If .value > 0 And .value <= 3 Then
+ If Options.Render <> .value - 1 Then
+ Options.Render = .value - 1
+ message = True
+ End If
+ End If
+ End With
+
+ ' save options
+ SaveOptions
+ ' let them know
+ If InGame Then
+ If message Then AddText "Some changes will take effect next time you load the game.", BrightGreen
+ End If
+ ' close
+ btnOptions_Close
+End Sub
+
+' Npc Chat
+Public Sub btnNpcChat_Close()
+ HideWindow GetWindowIndex("winNpcChat")
+End Sub
+
+Public Sub btnOpt1()
+ SendChatOption 1
+End Sub
+Public Sub btnOpt2()
+ SendChatOption 2
+End Sub
+Public Sub btnOpt3()
+ SendChatOption 3
+End Sub
+Public Sub btnOpt4()
+ SendChatOption 4
+End Sub
+
+' Shop
+Public Sub btnShop_Close()
+ CloseShop
+End Sub
+
+Public Sub chkShopBuying()
+ With Windows(GetWindowIndex("winShop"))
+ If .Controls(GetControlIndex("winShop", "chkBuying")).value = 1 Then
+ .Controls(GetControlIndex("winShop", "chkSelling")).value = 0
+ Else
+ .Controls(GetControlIndex("winShop", "chkSelling")).value = 0
+ .Controls(GetControlIndex("winShop", "chkBuying")).value = 1
+ Exit Sub
+ End If
+ End With
+ ' show buy button, hide sell
+ With Windows(GetWindowIndex("winShop"))
+ .Controls(GetControlIndex("winShop", "btnSell")).visible = False
+ .Controls(GetControlIndex("winShop", "btnBuy")).visible = True
+ End With
+ ' update the shop
+ shopIsSelling = False
+ shopSelectedSlot = 1
+ UpdateShop
+End Sub
+
+Public Sub chkShopSelling()
+ With Windows(GetWindowIndex("winShop"))
+ If .Controls(GetControlIndex("winShop", "chkSelling")).value = 1 Then
+ .Controls(GetControlIndex("winShop", "chkBuying")).value = 0
+ Else
+ .Controls(GetControlIndex("winShop", "chkBuying")).value = 0
+ .Controls(GetControlIndex("winShop", "chkSelling")).value = 1
+ Exit Sub
+ End If
+ End With
+ ' show sell button, hide buy
+ With Windows(GetWindowIndex("winShop"))
+ .Controls(GetControlIndex("winShop", "btnBuy")).visible = False
+ .Controls(GetControlIndex("winShop", "btnSell")).visible = True
+ End With
+ ' update the shop
+ shopIsSelling = True
+ shopSelectedSlot = 1
+ UpdateShop
+End Sub
+
+Public Sub btnShopBuy()
+ BuyItem shopSelectedSlot
+End Sub
+
+Public Sub btnShopSell()
+ SellItem shopSelectedSlot
+End Sub
+
+Public Sub Shop_MouseDown()
+Dim shopNum As Long
+
+ ' is there an item?
+ shopNum = IsShopSlot(Windows(GetWindowIndex("winShop")).Window.left, Windows(GetWindowIndex("winShop")).Window.top)
+
+ If shopNum Then
+ ' set the active slot
+ shopSelectedSlot = shopNum
+ UpdateShop
+ End If
+
+ Shop_MouseMove
+End Sub
+
+Public Sub Shop_MouseMove()
+Dim shopSlot As Long, itemNum As Long, x As Long, y As Long
+
+ If InShop = 0 Then Exit Sub
+
+ shopSlot = IsShopSlot(Windows(GetWindowIndex("winShop")).Window.left, Windows(GetWindowIndex("winShop")).Window.top)
+
+ If shopSlot Then
+ ' calc position
+ x = Windows(GetWindowIndex("winShop")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winShop")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winShop")).Window.left + Windows(GetWindowIndex("winShop")).Window.width
+ End If
+ ' selling/buying
+ If Not shopIsSelling Then
+ ' get the itemnum
+ itemNum = Shop(InShop).TradeItem(shopSlot).Item
+ If itemNum = 0 Then Exit Sub
+ ShowShopDesc x, y, itemNum
+ Else
+ ' get the itemnum
+ itemNum = GetPlayerInvItemNum(MyIndex, shopSlot)
+ If itemNum = 0 Then Exit Sub
+ ShowShopDesc x, y, itemNum
+ End If
+ End If
+End Sub
+
+' Right Click Menu
+Sub RightClick_Close()
+ ' close all menus
+ HideWindow GetWindowIndex("winRightClickBG")
+ HideWindow GetWindowIndex("winPlayerMenu")
+End Sub
+
+' Player Menu
+Sub PlayerMenu_Party()
+ RightClick_Close
+ If PlayerMenuIndex = 0 Then Exit Sub
+ SendPartyRequest PlayerMenuIndex
+End Sub
+
+Sub PlayerMenu_Trade()
+ RightClick_Close
+ If PlayerMenuIndex = 0 Then Exit Sub
+ SendTradeRequest PlayerMenuIndex
+End Sub
+
+Sub PlayerMenu_Guild()
+ RightClick_Close
+ If PlayerMenuIndex = 0 Then Exit Sub
+ AddText "System not yet in place.", BrightRed
+End Sub
+
+Sub PlayerMenu_PM()
+ RightClick_Close
+ If PlayerMenuIndex = 0 Then Exit Sub
+ AddText "System not yet in place.", BrightRed
+End Sub
+
+' Invitations
+Sub btnInvite_Party()
+ HideWindow GetWindowIndex("winInvite_Party")
+ Windows(GetWindowIndex("winInvite_Trade")).Window.top = ScreenHeight - 80
+ Dialogue "Party Invitation", diaDataString & " has invited you to a party.", "Would you like to join?", TypePARTY, StyleYESNO
+End Sub
+
+Sub btnInvite_Trade()
+ HideWindow GetWindowIndex("winInvite_Trade")
+ Windows(GetWindowIndex("winInvite_party")).Window.top = ScreenHeight - 80
+ Dialogue "Trade Invitation", diaDataString & " has invited you to trade.", "Would you like to accept?", TypeTRADE, StyleYESNO
+End Sub
+
+' Trade
+Sub btnTrade_Close()
+ HideWindow GetWindowIndex("winTrade")
+ DeclineTrade
+End Sub
+
+Sub btnTrade_Accept()
+ AcceptTrade
+End Sub
+
+Sub TradeMouseDown_Your()
+Dim xO As Long, yO As Long, itemNum As Long
+ xO = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picYour")).left
+ yO = Windows(GetWindowIndex("winTrade")).Window.top + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picYour")).top
+ itemNum = IsTrade(xO, yO)
+
+ ' make sure it exists
+ If itemNum > 0 Then
+ If TradeYourOffer(itemNum).num = 0 Then Exit Sub
+ If GetPlayerInvItemNum(MyIndex, TradeYourOffer(itemNum).num) = 0 Then Exit Sub
+
+ ' unoffer the item
+ UntradeItem itemNum
+ End If
+End Sub
+
+Sub TradeMouseMove_Your()
+Dim xO As Long, yO As Long, itemNum As Long, x As Long, y As Long
+ xO = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picYour")).left
+ yO = Windows(GetWindowIndex("winTrade")).Window.top + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picYour")).top
+ itemNum = IsTrade(xO, yO)
+
+ ' make sure it exists
+ If itemNum > 0 Then
+ If TradeYourOffer(itemNum).num = 0 Then Exit Sub
+ If GetPlayerInvItemNum(MyIndex, TradeYourOffer(itemNum).num) = 0 Then Exit Sub
+
+ ' calc position
+ x = Windows(GetWindowIndex("winTrade")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winTrade")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Window.width
+ End If
+ ' go go go
+ ShowItemDesc x, y, GetPlayerInvItemNum(MyIndex, TradeYourOffer(itemNum).num), False
+ End If
+End Sub
+
+Sub TradeMouseMove_Their()
+Dim xO As Long, yO As Long, itemNum As Long, x As Long, y As Long
+ xO = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picTheir")).left
+ yO = Windows(GetWindowIndex("winTrade")).Window.top + Windows(GetWindowIndex("winTrade")).Controls(GetControlIndex("winTrade", "picTheir")).top
+ itemNum = IsTrade(xO, yO)
+
+ ' make sure it exists
+ If itemNum > 0 Then
+ If TradeTheirOffer(itemNum).num = 0 Then Exit Sub
+
+ ' calc position
+ x = Windows(GetWindowIndex("winTrade")).Window.left - Windows(GetWindowIndex("winDescription")).Window.width
+ y = Windows(GetWindowIndex("winTrade")).Window.top - 4
+ ' offscreen?
+ If x < 0 Then
+ ' switch to right
+ x = Windows(GetWindowIndex("winTrade")).Window.left + Windows(GetWindowIndex("winTrade")).Window.width
+ End If
+ ' go go go
+ ShowItemDesc x, y, TradeTheirOffer(itemNum).num, False
+ End If
+End Sub
+
+' combobox
+Sub CloseComboMenu()
+ HideWindow GetWindowIndex("winComboMenuBG")
+ HideWindow GetWindowIndex("winComboMenu")
+End Sub
diff --git a/client/src/modMusic.bas b/client/src/modMusic.bas
new file mode 100644
index 0000000..8214230
--- /dev/null
+++ b/client/src/modMusic.bas
@@ -0,0 +1,221 @@
+Attribute VB_Name = "modMusic"
+Option Explicit
+
+' FMOD
+Public Enum FSOUND_INITMODES
+ FSOUND_INIT_USEDEFAULTMIDISYNTH = &H1
+End Enum
+
+Public Enum FSOUND_MODES
+ FSOUND_LOOP_OFF = &H1
+ FSOUND_LOOP_NORMAL = &H2
+ FSOUND_16BITS = &H10
+ FSOUND_MONO = &H20
+ FSOUND_SIGNED = &H100
+ FSOUND_NORMAL = FSOUND_16BITS Or FSOUND_SIGNED Or FSOUND_MONO
+End Enum
+
+Public Enum FSOUND_CHANNELSAMPLEMODE
+ FSOUND_FREE = -1
+ FSOUND_STEREOPAN = -1
+End Enum
+
+Public Declare Function FSOUND_Init Lib "fmod.dll" Alias "_FSOUND_Init@12" (ByVal mixrate As Long, ByVal maxchannels As Long, ByVal flags As FSOUND_INITMODES) As Byte
+Public Declare Function FSOUND_Close Lib "fmod.dll" Alias "_FSOUND_Close@0" () As Long
+Public Declare Function FMUSIC_LoadSong Lib "fmod.dll" Alias "_FMUSIC_LoadSong@4" (ByVal name As String) As Long
+Public Declare Function FMUSIC_PlaySong Lib "fmod.dll" Alias "_FMUSIC_PlaySong@4" (ByVal module As Long) As Byte
+Public Declare Function FMUSIC_SetMasterVolume Lib "fmod.dll" Alias "_FMUSIC_SetMasterVolume@8" (ByVal module As Long, ByVal volume As Long) As Byte
+Public Declare Function FSOUND_Stream_Open Lib "fmod.dll" Alias "_FSOUND_Stream_Open@16" (ByVal filename As String, ByVal mode As FSOUND_MODES, ByVal offset As Long, ByVal length As Long) As Long
+Public Declare Function FSOUND_Stream_Play Lib "fmod.dll" Alias "_FSOUND_Stream_Play@8" (ByVal channel As Long, ByVal stream As Long) As Long
+Public Declare Function FSOUND_SetVolume Lib "fmod.dll" Alias "_FSOUND_SetVolume@8" (ByVal channel As Long, ByVal Vol As Long) As Byte
+Public Declare Function FSOUND_Stream_Stop Lib "fmod.dll" Alias "_FSOUND_Stream_Stop@4" (ByVal stream As Long) As Byte
+Public Declare Function FSOUND_Stream_Close Lib "fmod.dll" Alias "_FSOUND_Stream_Close@4" (ByVal stream As Long) As Byte
+Public Declare Function FMUSIC_StopSong Lib "fmod.dll" Alias "_FMUSIC_StopSong@4" (ByVal module As Long) As Byte
+Public Declare Function FMUSIC_FreeSong Lib "fmod.dll" Alias "_FMUSIC_FreeSong@4" (ByVal module As Long) As Byte
+Public Declare Function FSOUND_Sample_SetDefaults Lib "fmod.dll" Alias "_FSOUND_Sample_SetDefaults@20" (ByVal sptr As Long, ByVal deffreq As Long, ByVal defvol As Long, ByVal defpan As Long, ByVal defpri As Long) As Byte
+Public Declare Function FSOUND_PlaySound Lib "fmod.dll" Alias "_FSOUND_PlaySound@8" (ByVal channel As Long, ByVal sptr As Long) As Long
+Public Declare Function FSOUND_Sample_Load Lib "fmod.dll" Alias "_FSOUND_Sample_Load@20" (ByVal index As Long, ByVal name As String, ByVal mode As FSOUND_MODES, ByVal offset As Long, ByVal length As Long) As Long
+' Maximum sounds
+Private Const MAX_SOUNDS = 32
+' Hardcoded sound effects
+Public Const Sound_ButtonHover As String = "Cursor1.wav"
+Public Const Sound_ButtonClick As String = "Decision1.wav"
+' Last sounds played
+Public lastNpcChatsound As Long
+' Init status
+Public bInit_Music As Boolean
+Public curSong As String
+' Music Handlers
+Private songHandle As Long
+Private streamHandle As Long
+' Sound pointer array
+Private soundHandle(1 To MAX_SOUNDS) As Long
+Private soundIndex As Long
+
+Public Function Init_Music() As Boolean
+ Dim result As Boolean
+
+ If inDevelopment Then Exit Function
+
+ On Error GoTo errorhandler
+
+ ' init music engine
+ result = FSOUND_Init(44100, 32, FSOUND_INIT_USEDEFAULTMIDISYNTH)
+
+ If Not result Then GoTo errorhandler
+ ' return positive
+ Init_Music = True
+ bInit_Music = True
+ Exit Function
+errorhandler:
+ Init_Music = False
+ bInit_Music = False
+End Function
+
+Public Sub Destroy_Music()
+ ' destroy music engine
+ Stop_Music
+ FSOUND_Close
+ bInit_Music = False
+ curSong = vbNullString
+End Sub
+
+Public Sub Play_Music(ByVal song As String)
+
+ On Error GoTo errorhandler
+
+ If Not bInit_Music Then Exit Sub
+
+ ' exit out early if we have the system turned off
+ If Options.Music = 0 Then Exit Sub
+
+ ' does it exist?
+ If Not FileExist(App.path & MUSIC_PATH & song) Then Exit Sub
+
+ ' don't re-start currently playing songs
+ If curSong = song Then Exit Sub
+ ' stop the existing music
+ Stop_Music
+
+ ' find the extension
+ Select Case Right$(song, 4)
+
+ Case ".mid", ".s3m", ".mod"
+ ' open the song
+ songHandle = FMUSIC_LoadSong(App.path & MUSIC_PATH & song)
+ ' play it
+ FMUSIC_PlaySong songHandle
+ ' set volume
+ FMUSIC_SetMasterVolume songHandle, 150
+
+ Case ".wav", ".mp3", ".ogg", ".wma"
+ ' open the stream
+ streamHandle = FSOUND_Stream_Open(App.path & MUSIC_PATH & song, FSOUND_LOOP_NORMAL, 0, 0)
+ ' play it
+ FSOUND_Stream_Play FSOUND_FREE, streamHandle
+ ' set volume
+ FSOUND_SetVolume streamHandle, 150
+
+ Case Else
+ Exit Sub
+ End Select
+
+ ' new current song
+ curSong = song
+ Exit Sub
+errorhandler:
+ Destroy_Music
+End Sub
+
+Public Sub Stop_Music()
+
+ On Error GoTo errorhandler
+
+ If Not streamHandle = 0 Then
+ ' stop stream
+ FSOUND_Stream_Stop streamHandle
+ ' destroy
+ FSOUND_Stream_Close streamHandle
+ streamHandle = 0
+ End If
+
+ If Not songHandle = 0 Then
+ ' stop song
+ FMUSIC_StopSong songHandle
+ ' destroy
+ FMUSIC_FreeSong songHandle
+ songHandle = 0
+ End If
+
+ ' no music
+ curSong = vbNullString
+ Exit Sub
+errorhandler:
+ Destroy_Music
+End Sub
+
+Public Sub Play_Sound(ByVal sound As String, Optional ByVal x As Long = -1, Optional ByVal y As Long = -1)
+ Dim dX As Long, dY As Long, volume As Long, distance As Long
+
+ On Error GoTo errorhandler
+
+ If Not bInit_Music Then Exit Sub
+
+ ' exit out early if we have the system turned off
+ If Options.sound = 0 Then Exit Sub
+ If x > -1 And y > -1 Then
+
+ ' x
+ If x < GetPlayerX(MyIndex) Then
+ dX = GetPlayerX(MyIndex) - x
+ ElseIf x > GetPlayerX(MyIndex) Then
+ dX = x - GetPlayerX(MyIndex)
+ End If
+
+ ' y
+ If y < GetPlayerY(MyIndex) Then
+ dY = GetPlayerY(MyIndex) - y
+ ElseIf y > GetPlayerY(MyIndex) Then
+ dY = y - GetPlayerY(MyIndex)
+ End If
+
+ ' distance
+ distance = dX ^ 2 + dY ^ 2
+ volume = 150 - (distance / 2)
+ Else
+ volume = 150
+ End If
+
+ ' cap the volume
+ If volume < 0 Then volume = 0
+ If volume > 256 Then volume = 256
+ ' load the sound
+ Load_Sound sound
+ FSOUND_Sample_SetDefaults soundHandle(soundIndex), -1, volume, FSOUND_STEREOPAN, -1
+ ' play it
+ FSOUND_PlaySound FSOUND_FREE, soundHandle(soundIndex)
+ Exit Sub
+errorhandler:
+ Destroy_Music
+End Sub
+
+Public Sub Load_Sound(ByVal sound As String)
+ Dim bRestart As Boolean
+
+ On Error GoTo errorhandler
+
+ ' next sound buffer
+ soundIndex = soundIndex + 1
+
+ ' reset if we run out
+ If soundIndex > MAX_SOUNDS Or soundIndex < 1 Then
+ bRestart = True
+ soundIndex = 1
+ End If
+
+ ' load the sound
+ soundHandle(soundIndex) = FSOUND_Sample_Load(FSOUND_FREE, App.path & SOUND_PATH & sound, FSOUND_NORMAL, 0, 0)
+ Exit Sub
+errorhandler:
+ Destroy_Music
+End Sub
diff --git a/client/src/modSound.bas b/client/src/modSound.bas
new file mode 100644
index 0000000..046617b
--- /dev/null
+++ b/client/src/modSound.bas
@@ -0,0 +1,43 @@
+Attribute VB_Name = "modSound"
+Option Explicit
+
+' Hardcoded sound effects
+Public Const Sound_ButtonHover As String = "Cursor1.wav"
+Public Const Sound_ButtonClick As String = "Decision1.wav"
+
+Public bInit_Sound As Boolean
+Public lastButtonSound As Long
+Public lastNpcChatsound As Long
+
+Public Function Init_Sound() As Boolean
+ On Error GoTo errorhandler
+
+ ' exit out early if we have the system turned off
+ If Options.sound = 0 Then Exit Function
+
+ ' exit out early if we've already loaded
+ If bInit_Sound Then Exit Function
+
+ ' init sound engine
+
+ ' return positive
+ Init_Sound = True
+ bInit_Sound = True
+ Exit Function
+
+errorhandler:
+ Init_Sound = False
+ bInit_Sound = False
+End Function
+
+Public Sub Destroy_Sound()
+ If Not bInit_Sound Then Exit Sub
+End Sub
+
+Public Sub Play_Sound(ByVal sound As String)
+ If Not bInit_Sound Then Exit Sub
+End Sub
+
+Public Sub Stop_Sound()
+ If Not bInit_Sound Then Exit Sub
+End Sub
diff --git a/client/src/modText.bas b/client/src/modText.bas
new file mode 100644
index 0000000..88cc6a1
--- /dev/null
+++ b/client/src/modText.bas
@@ -0,0 +1,750 @@
+Attribute VB_Name = "modText"
+Option Explicit
+
+'The size of a FVF vertex
+Public Const FVF_Size As Long = 28
+
+'Point API
+Public Type POINTAPI
+ x As Long
+ Y As Long
+End Type
+
+Private Type CharVA
+ Vertex(0 To 3) As Vertex
+End Type
+
+Private Type VFH
+ BitmapWidth As Long
+ BitmapHeight As Long
+ CellWidth As Long
+ CellHeight As Long
+ BaseCharOffset As Byte
+ CharWidth(0 To 255) As Byte
+ CharVA(0 To 255) As CharVA
+End Type
+
+Private Type CustomFont
+ HeaderInfo As VFH
+ Texture As Direct3DTexture8
+ RowPitch As Integer
+ RowFactor As Single
+ ColFactor As Single
+ CharHeight As Byte
+ TextureSize As POINTAPI
+ xOffset As Long
+ yOffset As Long
+End Type
+
+' Fonts
+Public Enum Fonts
+ ' Georgia
+ georgia_16 = 1
+ georgiaBold_16
+ georgiaDec_16
+ ' Rockwell
+ rockwellDec_15
+ rockwell_15
+ rockwellDec_10
+ ' Verdana
+ verdana_12
+ verdanaBold_12
+ verdana_13
+ ' count value
+ Fonts_Count
+End Enum
+
+' Store the fonts
+Public font() As CustomFont
+
+' Chatbox
+Public Type ChatStruct
+ Text As String
+ Color As Long
+ visible As Boolean
+ timer As Long
+ Channel As Byte
+End Type
+Public Const ColourChar As String * 1 = "½"
+Public Const ChatLines As Long = 200
+Public Const ChatWidth As Long = 316
+Public Chat(1 To ChatLines) As ChatStruct
+Public chatLastRemove As Long
+Public Const CHAT_DIFFERENCE_TIMER As Long = 500
+Public Chat_HighIndex As Long
+Public ChatScroll As Long
+
+Sub LoadFonts()
+ 'Check if we have the device
+ If D3DDevice.TestCooperativeLevel <> D3D_OK Then Exit Sub
+ ' re-dim the fonts
+ ReDim font(1 To Fonts.Fonts_Count - 1)
+ ' load the fonts
+ SetFont Fonts.georgia_16, "georgia_16", 256
+ SetFont Fonts.georgiaBold_16, "georgiaBold_16", 256
+ SetFont Fonts.georgiaDec_16, "georgiaDec_16", 256
+ SetFont Fonts.rockwellDec_15, "rockwellDec_15", 256, 2, 2
+ SetFont Fonts.rockwell_15, "rockwell_15", 256, 2, 2
+ SetFont Fonts.verdana_12, "verdana_12", 256
+ SetFont Fonts.verdanaBold_12, "verdanaBold_12", 256
+ SetFont Fonts.rockwellDec_10, "rockwellDec_10", 256, 2, 2
+End Sub
+
+Sub SetFont(ByVal fontNum As Long, ByVal texName As String, ByVal size As Long, Optional ByVal xOffset As Long, Optional ByVal yOffset As Long)
+Dim data() As Byte, f As Long, w As Long, h As Long, path As String
+ ' set the path
+ path = App.path & Path_Font & texName & ".png"
+ ' load the texture
+ f = FreeFile
+ Open path For Binary As #f
+ ReDim data(0 To LOF(f) - 1)
+ Get #f, , data
+ Close #f
+ ' get size
+ font(fontNum).TextureSize.x = ByteToInt(data(18), data(19))
+ font(fontNum).TextureSize.Y = ByteToInt(data(22), data(23))
+ ' set to struct
+ Set font(fontNum).Texture = D3DX.CreateTextureFromFileInMemoryEx(D3DDevice, data(0), AryCount(data), font(fontNum).TextureSize.x, font(fontNum).TextureSize.Y, D3DX_DEFAULT, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, D3DX_FILTER_POINT, D3DX_FILTER_POINT, 0, ByVal 0, ByVal 0)
+ font(fontNum).xOffset = xOffset
+ font(fontNum).yOffset = yOffset
+ LoadFontHeader font(fontNum), texName & ".dat"
+End Sub
+
+Public Function GetColourString(ByVal colourNum As Long) As String
+ Select Case colourNum
+ Case 0 ' Black
+ GetColourString = "Black"
+ Case 1 ' Blue
+ GetColourString = "Blue"
+ Case 2 ' Green
+ GetColourString = "Green"
+ Case 3 ' Cyan
+ GetColourString = "Cyan"
+ Case 4 ' Red
+ GetColourString = "Red"
+ Case 5 ' Magenta
+ GetColourString = "Magenta"
+ Case 6 ' Brown
+ GetColourString = "Brown"
+ Case 7 ' Grey
+ GetColourString = "Grey"
+ Case 8 ' DarkGrey
+ GetColourString = "Dark Grey"
+ Case 9 ' BrightBlue
+ GetColourString = "Bright Blue"
+ Case 10 ' BrightGreen
+ GetColourString = "Bright Green"
+ Case 11 ' BrightCyan
+ GetColourString = "Bright Cyan"
+ Case 12 ' BrightRed
+ GetColourString = "Bright Red"
+ Case 13 ' Pink
+ GetColourString = "Pink"
+ Case 14 ' Yellow
+ GetColourString = "Yellow"
+ Case 15 ' White
+ GetColourString = "White"
+ Case 16 ' dark brown
+ GetColourString = "Dark Brown"
+ Case 17 ' gold
+ GetColourString = "Gold"
+ Case 18 ' light green
+ GetColourString = "Light Green"
+ End Select
+End Function
+
+Public Function DX8Colour(ByVal colourNum As Long, ByVal alpha As Long) As Long
+ Select Case colourNum
+ Case 0 ' Black
+ DX8Colour = D3DColorARGB(alpha, 0, 0, 0)
+ Case 1 ' Blue
+ DX8Colour = D3DColorARGB(alpha, 16, 104, 237)
+ Case 2 ' Green
+ DX8Colour = D3DColorARGB(alpha, 119, 188, 84)
+ Case 3 ' Cyan
+ DX8Colour = D3DColorARGB(alpha, 16, 224, 237)
+ Case 4 ' Red
+ DX8Colour = D3DColorARGB(alpha, 201, 0, 0)
+ Case 5 ' Magenta
+ DX8Colour = D3DColorARGB(alpha, 255, 0, 255)
+ Case 6 ' Brown
+ DX8Colour = D3DColorARGB(alpha, 175, 149, 92)
+ Case 7 ' Grey
+ DX8Colour = D3DColorARGB(alpha, 192, 192, 192)
+ Case 8 ' DarkGrey
+ DX8Colour = D3DColorARGB(alpha, 128, 128, 128)
+ Case 9 ' BrightBlue
+ DX8Colour = D3DColorARGB(alpha, 126, 182, 240)
+ Case 10 ' BrightGreen
+ DX8Colour = D3DColorARGB(alpha, 126, 240, 137)
+ Case 11 ' BrightCyan
+ DX8Colour = D3DColorARGB(alpha, 157, 242, 242)
+ Case 12 ' BrightRed
+ DX8Colour = D3DColorARGB(alpha, 255, 0, 0)
+ Case 13 ' Pink
+ DX8Colour = D3DColorARGB(alpha, 255, 118, 221)
+ Case 14 ' Yellow
+ DX8Colour = D3DColorARGB(alpha, 255, 255, 0)
+ Case 15 ' White
+ DX8Colour = D3DColorARGB(alpha, 255, 255, 255)
+ Case 16 ' dark brown
+ DX8Colour = D3DColorARGB(alpha, 98, 84, 52)
+ Case 17 ' gold
+ DX8Colour = D3DColorARGB(alpha, 255, 215, 0)
+ Case 18 ' light green
+ DX8Colour = D3DColorARGB(alpha, 124, 205, 80)
+ End Select
+End Function
+
+Sub LoadFontHeader(ByRef theFont As CustomFont, ByVal filename As String)
+Dim FileNum As Byte
+Dim LoopChar As Long
+Dim Row As Single
+Dim u As Single
+Dim v As Single
+
+ 'Load the header information
+ FileNum = FreeFile
+ Open App.path & Path_Font & filename For Binary As #FileNum
+ Get #FileNum, , theFont.HeaderInfo
+ Close #FileNum
+
+ 'Calculate some common values
+ theFont.CharHeight = theFont.HeaderInfo.CellHeight - 4
+ theFont.RowPitch = theFont.HeaderInfo.BitmapWidth \ theFont.HeaderInfo.CellWidth
+ theFont.ColFactor = theFont.HeaderInfo.CellWidth / theFont.HeaderInfo.BitmapWidth
+ theFont.RowFactor = theFont.HeaderInfo.CellHeight / theFont.HeaderInfo.BitmapHeight
+
+ 'Cache the verticies used to draw the character (only requires setting the color and adding to the X/Y values)
+ For LoopChar = 0 To 255
+ 'tU and tV value (basically tU = BitmapXPosition / BitmapWidth, and height for tV)
+ Row = (LoopChar - theFont.HeaderInfo.BaseCharOffset) \ theFont.RowPitch
+ u = ((LoopChar - theFont.HeaderInfo.BaseCharOffset) - (Row * theFont.RowPitch)) * theFont.ColFactor
+ v = Row * theFont.RowFactor
+
+ 'Set the verticies
+ With theFont.HeaderInfo.CharVA(LoopChar)
+ .Vertex(0).Colour = D3DColorARGB(255, 0, 0, 0) 'Black is the most common color
+ .Vertex(0).RHW = 1
+ .Vertex(0).tu = u
+ .Vertex(0).tv = v
+ .Vertex(0).x = 0
+ .Vertex(0).Y = 0
+ .Vertex(0).z = 0
+ .Vertex(1).Colour = D3DColorARGB(255, 0, 0, 0)
+ .Vertex(1).RHW = 1
+ .Vertex(1).tu = u + theFont.ColFactor
+ .Vertex(1).tv = v
+ .Vertex(1).x = theFont.HeaderInfo.CellWidth
+ .Vertex(1).Y = 0
+ .Vertex(1).z = 0
+ .Vertex(2).Colour = D3DColorARGB(255, 0, 0, 0)
+ .Vertex(2).RHW = 1
+ .Vertex(2).tu = u
+ .Vertex(2).tv = v + theFont.RowFactor
+ .Vertex(2).x = 0
+ .Vertex(2).Y = theFont.HeaderInfo.CellHeight
+ .Vertex(2).z = 0
+ .Vertex(3).Colour = D3DColorARGB(255, 0, 0, 0)
+ .Vertex(3).RHW = 1
+ .Vertex(3).tu = u + theFont.ColFactor
+ .Vertex(3).tv = v + theFont.RowFactor
+ .Vertex(3).x = theFont.HeaderInfo.CellWidth
+ .Vertex(3).Y = theFont.HeaderInfo.CellHeight
+ .Vertex(3).z = 0
+ End With
+ Next LoopChar
+End Sub
+
+Public Sub RenderText(ByRef UseFont As CustomFont, ByVal Text As String, ByVal x As Long, ByVal Y As Long, ByVal Color As Long, Optional ByVal alpha As Long = 255, Optional Shadow As Boolean = True)
+Dim TempVA(0 To 3) As Vertex, TempStr() As String, count As Long, Ascii() As Byte, i As Long, j As Long, TempColor As Long, yOffset As Single, ignoreChar As Long, resetColor As Long
+Dim tmpNum As Long
+
+ ' set the color
+ Color = DX8Colour(Color, alpha)
+
+ 'Check for valid text to render
+ If LenB(Text) = 0 Then Exit Sub
+ 'Get the text into arrays (split by vbCrLf)
+ TempStr = Split(Text, vbCrLf)
+ 'Set the temp color (or else the first character has no color)
+ TempColor = Color
+ resetColor = TempColor
+ 'Set the texture
+ D3DDevice.SetTexture 0, UseFont.Texture
+ CurrentTexture = -1
+ ' set the position
+ x = x - UseFont.xOffset
+ Y = Y - UseFont.yOffset
+ 'Loop through each line if there are line breaks (vbCrLf)
+ tmpNum = UBound(TempStr)
+
+ For i = 0 To tmpNum
+ If Len(TempStr(i)) > 0 Then
+ yOffset = (i * UseFont.CharHeight) + (i * 3)
+ count = 0
+ 'Convert the characters to the ascii value
+ Ascii() = StrConv(TempStr(i), vbFromUnicode)
+ 'Loop through the characters
+ tmpNum = Len(TempStr(i))
+ For j = 1 To tmpNum
+ ' check for colour change
+ If Mid$(TempStr(i), j, 1) = ColourChar Then
+ Color = Val(Mid$(TempStr(i), j + 1, 2))
+ ' make sure the colour exists
+ If Color = -1 Then
+ TempColor = resetColor
+ Else
+ TempColor = DX8Colour(Color, alpha)
+ End If
+ ignoreChar = 3
+ End If
+ ' check if we're ignoring this character
+ If ignoreChar > 0 Then
+ ignoreChar = ignoreChar - 1
+ Else
+ 'Copy from the cached vertex array to the temp vertex array
+ Call CopyMemory(TempVA(0), UseFont.HeaderInfo.CharVA(Ascii(j - 1)).Vertex(0), FVF_Size * 4)
+ 'Set up the verticies
+ TempVA(0).x = x + count
+ TempVA(0).Y = Y + yOffset
+ TempVA(1).x = TempVA(1).x + x + count
+ TempVA(1).Y = TempVA(0).Y
+ TempVA(2).x = TempVA(0).x
+ TempVA(2).Y = TempVA(2).Y + TempVA(0).Y
+ TempVA(3).x = TempVA(1).x
+ TempVA(3).Y = TempVA(2).Y
+ 'Set the colors
+ TempVA(0).Colour = TempColor
+ TempVA(1).Colour = TempColor
+ TempVA(2).Colour = TempColor
+ TempVA(3).Colour = TempColor
+ 'Draw the verticies
+ Call D3DDevice.DrawPrimitiveUP(D3DPT_TRIANGLESTRIP, 2, TempVA(0), FVF_Size)
+ 'Shift over the the position to render the next character
+ count = count + UseFont.HeaderInfo.CharWidth(Ascii(j - 1))
+ End If
+ Next j
+ End If
+ Next i
+End Sub
+
+Public Function TextWidth(ByRef UseFont As CustomFont, ByVal Text As String) As Long
+Dim LoopI As Integer, tmpNum As Long, skipCount As Long
+
+ 'Make sure we have text
+ If LenB(Text) = 0 Then Exit Function
+
+ 'Loop through the text
+ tmpNum = Len(Text)
+ For LoopI = 1 To tmpNum
+ If Mid$(Text, LoopI, 1) = ColourChar Then skipCount = 3
+ If skipCount > 0 Then
+ skipCount = skipCount - 1
+ Else
+ TextWidth = TextWidth + UseFont.HeaderInfo.CharWidth(Asc(Mid$(Text, LoopI, 1)))
+ End If
+ Next LoopI
+End Function
+
+Public Function TextHeight(ByRef UseFont As CustomFont) As Long
+ TextHeight = UseFont.HeaderInfo.CellHeight
+End Function
+
+Sub DrawActionMsg(ByVal index As Integer)
+ Dim x As Long, Y As Long, i As Long, Time As Long
+ Dim LenMsg As Long
+
+ If ActionMsg(index).message = vbNullString Then Exit Sub
+
+ ' how long we want each message to appear
+ Select Case ActionMsg(index).Type
+
+ Case ACTIONMsgSTATIC
+ Time = 1500
+ LenMsg = TextWidth(font(Fonts.rockwell_15), Trim$(ActionMsg(index).message))
+
+ If ActionMsg(index).Y > 0 Then
+ x = ActionMsg(index).x + Int(PIC_X \ 2) - (LenMsg / 2)
+ Y = ActionMsg(index).Y + PIC_Y
+ Else
+ x = ActionMsg(index).x + Int(PIC_X \ 2) - (LenMsg / 2)
+ Y = ActionMsg(index).Y - Int(PIC_Y \ 2) + 18
+ End If
+
+ Case ACTIONMsgSCROLL
+ Time = 1500
+
+ If ActionMsg(index).Y > 0 Then
+ x = ActionMsg(index).x + Int(PIC_X \ 2) - ((Len(Trim$(ActionMsg(index).message)) \ 2) * 8)
+ Y = ActionMsg(index).Y - Int(PIC_Y \ 2) - 2 - (ActionMsg(index).Scroll * 0.6)
+ ActionMsg(index).Scroll = ActionMsg(index).Scroll + 1
+ Else
+ x = ActionMsg(index).x + Int(PIC_X \ 2) - ((Len(Trim$(ActionMsg(index).message)) \ 2) * 8)
+ Y = ActionMsg(index).Y - Int(PIC_Y \ 2) + 18 + (ActionMsg(index).Scroll * 0.001)
+ ActionMsg(index).Scroll = ActionMsg(index).Scroll + 1
+ End If
+
+ ActionMsg(index).alpha = ActionMsg(index).alpha - 5
+
+ If ActionMsg(index).alpha <= 0 Then ClearActionMsg index: Exit Sub
+
+ Case ACTIONMsgSCREEN
+ Time = 3000
+
+ ' This will kill any action screen messages that there in the system
+ For i = MAX_BYTE To 1 Step -1
+
+ If ActionMsg(i).Type = ACTIONMsgSCREEN Then
+ If i <> index Then
+ ClearActionMsg index
+ index = i
+ End If
+ End If
+
+ Next
+
+ x = (400) - ((TextWidth(font(Fonts.rockwell_15), Trim$(ActionMsg(index).message)) \ 2))
+ Y = 24
+ End Select
+
+ x = ConvertMapX(x)
+ Y = ConvertMapY(Y)
+
+ If ActionMsg(index).Created > 0 Then
+ RenderText font(Fonts.rockwell_15), ActionMsg(index).message, x, Y, ActionMsg(index).Color, ActionMsg(index).alpha
+ End If
+End Sub
+
+Public Function DrawMapEvents()
+Dim x As Long, Y As Long, i As Long
+ If frmEditor_Map.optEvents.value Then
+ If Map.TileData.EventCount > 0 Then
+ For i = 1 To Map.TileData.EventCount
+ With Map.TileData.Events(i)
+ x = ((ConvertMapX(.x * PIC_X)) - 4) + (PIC_X * 0.5)
+ Y = ((ConvertMapY(.Y * PIC_Y)) - 7) + (PIC_Y * 0.5)
+ End With
+ RenderTexture Tex_Event, ConvertMapX(Map.TileData.Events(i).x * PIC_X), ConvertMapY(Map.TileData.Events(i).Y * PIC_Y), 0, 0, 32, 32, 32, 32
+ RenderText font(Fonts.rockwellDec_10), "E", x, Y, BrightBlue
+ Next
+ End If
+ End If
+End Function
+
+Public Function DrawMapAttributes()
+Dim x As Long, Y As Long, tx As Long, ty As Long, theFont As Long
+
+ theFont = Fonts.rockwellDec_10
+
+ If frmEditor_Map.optAttribs.value Then
+ For x = TileView.left To TileView.Right
+ For Y = TileView.top To TileView.bottom
+ If IsValidMapPoint(x, Y) Then
+ With Map.TileData.Tile(x, Y)
+ tx = ((ConvertMapX(x * PIC_X)) - 4) + (PIC_X * 0.5)
+ ty = ((ConvertMapY(Y * PIC_Y)) - 7) + (PIC_Y * 0.5)
+ If .Type > 0 Then RenderTexture Tex_Event, ConvertMapX(x * PIC_X), ConvertMapY(Y * PIC_Y), 0, 0, 32, 32, 32, 32
+ Select Case .Type
+ Case TILE_TYPE_BLOCKED
+ RenderText font(theFont), "B", tx, ty, BrightRed
+ Case TILE_TYPE_WARP
+ RenderText font(theFont), "W", tx, ty, BrightBlue
+ Case TILE_TYPE_ITEM
+ RenderText font(theFont), "I", tx, ty, White
+ Case TILE_TYPE_NPCAVOID
+ RenderText font(theFont), "N", tx, ty, White
+ Case TILE_TYPE_KEY
+ RenderText font(theFont), "K", tx, ty, White
+ Case TILE_TYPE_KEYOPEN
+ RenderText font(theFont), "O", tx, ty, White
+ Case TILE_TYPE_RESOURCE
+ RenderText font(theFont), "R", tx, ty, Green
+ Case TILE_TYPE_DOOR
+ RenderText font(theFont), "D", tx, ty, Brown
+ Case TILE_TYPE_NPCSPAWN
+ RenderText font(theFont), "S", tx, ty, Yellow
+ Case TILE_TYPE_SHOP
+ RenderText font(theFont), "S", tx, ty, BrightBlue
+ Case TILE_TYPE_SLIDE
+ RenderText font(theFont), "S", tx, ty, Pink
+ Case TILE_TYPE_CHAT
+ RenderText font(theFont), "C", tx, ty, Blue
+ End Select
+ End With
+ End If
+ Next
+ Next
+ End If
+End Function
+
+Public Sub AddText(ByVal Text As String, ByVal Color As Long, Optional ByVal alpha As Long = 255, Optional Channel As Byte = 0)
+Dim i As Long
+
+ Chat_HighIndex = 0
+ ' Move the rest of it up
+ For i = (ChatLines - 1) To 1 Step -1
+ If Len(Chat(i).Text) > 0 Then
+ If i > Chat_HighIndex Then Chat_HighIndex = i + 1
+ End If
+ Chat(i + 1) = Chat(i)
+ Next
+
+ Chat(1).Text = Text
+ Chat(1).Color = Color
+ Chat(1).visible = True
+ Chat(1).timer = GetTickCount
+ Chat(1).Channel = Channel
+End Sub
+
+Sub RenderChat()
+Dim xO As Long, yO As Long, Colour As Long, yOffset As Long, rLines As Long, lineCount As Long
+Dim tmpText As String, i As Long, isVisible As Boolean, topWidth As Long, tmpArray() As String, x As Long
+
+ ' set the position
+ xO = 19
+ yO = ScreenHeight - 41 '545 + 14
+
+ ' loop through chat
+ rLines = 1
+ i = 1 + ChatScroll
+ Do While rLines <= 8
+ If i > ChatLines Then Exit Do
+ lineCount = 0
+ ' exit out early if we come to a blank string
+ If Len(Chat(i).Text) = 0 Then Exit Do
+ ' get visible state
+ isVisible = True
+ If inSmallChat Then
+ If Not Chat(i).visible Then isVisible = False
+ End If
+ If Options.channelState(Chat(i).Channel) = 0 Then isVisible = False
+ ' make sure it's visible
+ If isVisible Then
+ ' render line
+ Colour = Chat(i).Color
+ ' check if we need to word wrap
+ If TextWidth(font(Fonts.verdana_12), Chat(i).Text) > ChatWidth Then
+ ' word wrap
+ tmpText = WordWrap(font(Fonts.verdana_12), Chat(i).Text, ChatWidth, lineCount)
+ ' can't have it going offscreen.
+ If rLines + lineCount > 9 Then Exit Do
+ ' continue on
+ yOffset = yOffset - (14 * lineCount)
+ RenderText font(Fonts.verdana_12), tmpText, xO, yO + yOffset, Colour
+ rLines = rLines + lineCount
+ ' set the top width
+ tmpArray = Split(tmpText, vbNewLine)
+ For x = 0 To UBound(tmpArray)
+ If TextWidth(font(Fonts.verdana_12), tmpArray(x)) > topWidth Then topWidth = TextWidth(font(Fonts.verdana_12), tmpArray(x))
+ Next
+ Else
+ ' normal
+ yOffset = yOffset - 14
+ RenderText font(Fonts.verdana_12), Chat(i).Text, xO, yO + yOffset, Colour
+ rLines = rLines + 1
+ ' set the top width
+ If TextWidth(font(Fonts.verdana_12), Chat(i).Text) > topWidth Then topWidth = TextWidth(font(Fonts.verdana_12), Chat(i).Text)
+ End If
+ End If
+ ' increment chat pointer
+ i = i + 1
+ Loop
+
+ ' get the height of the small chat box
+ SetChatHeight rLines * 14
+ SetChatWidth topWidth
+End Sub
+
+Public Sub WordWrap_Array(ByVal Text As String, ByVal MaxLineLen As Long, ByRef theArray() As String)
+ Dim lineCount As Long, i As Long, size As Long, lastSpace As Long, b As Long, tmpNum As Long
+
+ 'Too small of text
+ If Len(Text) < 2 Then
+ ReDim theArray(1 To 1) As String
+ theArray(1) = Text
+ Exit Sub
+ End If
+
+ ' default values
+ b = 1
+ lastSpace = 1
+ size = 0
+ tmpNum = Len(Text)
+
+ For i = 1 To tmpNum
+
+ ' if it's a space, store it
+ Select Case Mid$(Text, i, 1)
+ Case " ": lastSpace = i
+ End Select
+
+ 'Add up the size
+ size = size + font(Fonts.georgiaDec_16).HeaderInfo.CharWidth(Asc(Mid$(Text, i, 1)))
+
+ 'Check for too large of a size
+ If size > MaxLineLen Then
+ 'Check if the last space was too far back
+ If i - lastSpace > 12 Then
+ 'Too far away to the last space, so break at the last character
+ lineCount = lineCount + 1
+ ReDim Preserve theArray(1 To lineCount) As String
+ theArray(lineCount) = Trim$(Mid$(Text, b, (i - 1) - b))
+ b = i - 1
+ size = 0
+ Else
+ 'Break at the last space to preserve the word
+ lineCount = lineCount + 1
+ ReDim Preserve theArray(1 To lineCount) As String
+ theArray(lineCount) = Trim$(Mid$(Text, b, lastSpace - b))
+ b = lastSpace + 1
+ 'Count all the words we ignored (the ones that weren't printed, but are before "i")
+ size = TextWidth(font(Fonts.georgiaDec_16), Mid$(Text, lastSpace, i - lastSpace))
+ End If
+ End If
+
+ ' Remainder
+ If i = Len(Text) Then
+ If b <> i Then
+ lineCount = lineCount + 1
+ ReDim Preserve theArray(1 To lineCount) As String
+ theArray(lineCount) = theArray(lineCount) & Mid$(Text, b, i)
+ End If
+ End If
+ Next
+End Sub
+
+Public Function WordWrap(theFont As CustomFont, ByVal Text As String, ByVal MaxLineLen As Integer, Optional ByRef lineCount As Long) As String
+ Dim TempSplit() As String, TSLoop As Long, lastSpace As Long, size As Long, i As Long, b As Long, tmpNum As Long, skipCount As Long
+
+ 'Too small of text
+ If Len(Text) < 2 Then
+ WordWrap = Text
+ Exit Function
+ End If
+
+ 'Check if there are any line breaks - if so, we will support them
+ TempSplit = Split(Text, vbNewLine)
+ tmpNum = UBound(TempSplit)
+
+ For TSLoop = 0 To tmpNum
+ 'Clear the values for the new line
+ size = 0
+ b = 1
+ lastSpace = 1
+
+ 'Add back in the vbNewLines
+ If TSLoop < UBound(TempSplit()) Then TempSplit(TSLoop) = TempSplit(TSLoop) & vbNewLine
+
+ 'Only check lines with a space
+ If InStr(1, TempSplit(TSLoop), " ") Then
+ 'Loop through all the characters
+ tmpNum = Len(TempSplit(TSLoop))
+
+ For i = 1 To tmpNum
+ 'If it is a space, store it so we can easily break at it
+ Select Case Mid$(TempSplit(TSLoop), i, 1)
+ Case " "
+ lastSpace = i
+ Case ColourChar
+ skipCount = 3
+ End Select
+
+ If skipCount > 0 Then
+ skipCount = skipCount - 1
+ Else
+ 'Add up the size
+ size = size + theFont.HeaderInfo.CharWidth(Asc(Mid$(TempSplit(TSLoop), i, 1)))
+ 'Check for too large of a size
+ If size > MaxLineLen Then
+ 'Check if the last space was too far back
+ If i - lastSpace > 12 Then
+ 'Too far away to the last space, so break at the last character
+ WordWrap = WordWrap & Trim$(Mid$(TempSplit(TSLoop), b, (i - 1) - b)) & vbNewLine
+ lineCount = lineCount + 1
+ b = i - 1
+ size = 0
+ Else
+ 'Break at the last space to preserve the word
+ WordWrap = WordWrap & Trim$(Mid$(TempSplit(TSLoop), b, lastSpace - b)) & vbNewLine
+ lineCount = lineCount + 1
+ b = lastSpace + 1
+ 'Count all the words we ignored (the ones that weren't printed, but are before "i")
+ size = TextWidth(theFont, Mid$(TempSplit(TSLoop), lastSpace, i - lastSpace))
+ End If
+ End If
+
+ 'This handles the remainder
+ If i = Len(TempSplit(TSLoop)) Then
+ If b <> i Then
+ WordWrap = WordWrap & Mid$(TempSplit(TSLoop), b, i)
+ lineCount = lineCount + 1
+ End If
+ End If
+ End If
+ Next i
+ Else
+ WordWrap = WordWrap & TempSplit(TSLoop)
+ End If
+ Next TSLoop
+End Function
+
+Public Sub DrawPlayerName(ByVal index As Long)
+ Dim textX As Long, textY As Long, Text As String, textSize As Long, Colour As Long
+
+ Text = Trim$(GetPlayerName(index))
+ textSize = TextWidth(font(Fonts.rockwell_15), Text)
+ ' get the colour
+ Colour = White
+
+ If Player(index).usergroup = 10 Or Player(index).usergroup = 11 Then Colour = Gold
+ If GetPlayerAccess(index) > 0 Then Colour = Pink
+ If GetPlayerPK(index) > 0 Then Colour = BrightRed
+ textX = Player(index).x * PIC_X + Player(index).xOffset + (PIC_X \ 2) - (textSize \ 2)
+ textY = Player(index).Y * PIC_Y + Player(index).yOffset - 32
+
+ If GetPlayerSprite(index) >= 1 And GetPlayerSprite(index) <= Count_Char Then
+ textY = GetPlayerY(index) * PIC_Y + Player(index).yOffset - (mTexture(Tex_Char(GetPlayerSprite(index))).h / 4) + 12
+ End If
+
+ Call RenderText(font(Fonts.rockwell_15), Text, ConvertMapX(textX), ConvertMapY(textY), Colour)
+End Sub
+
+Public Sub DrawNpcName(ByVal index As Long)
+ Dim textX As Long, textY As Long, Text As String, textSize As Long, npcNum As Long, Colour As Long
+ npcNum = MapNpc(index).num
+ Text = Trim$(Npc(npcNum).name)
+ textSize = TextWidth(font(Fonts.rockwell_15), Text)
+
+ If Npc(npcNum).Behaviour = NPC_BEHAVIOUR_ATTACKONSIGHT Or Npc(npcNum).Behaviour = NPC_BEHAVIOUR_ATTACKWHENATTACKED Then
+ ' get the colour
+ If Npc(npcNum).Level <= GetPlayerLevel(MyIndex) - 3 Then
+ Colour = Grey
+ ElseIf Npc(npcNum).Level <= GetPlayerLevel(MyIndex) - 2 Then
+ Colour = Green
+ ElseIf Npc(npcNum).Level > GetPlayerLevel(MyIndex) Then
+ Colour = Red
+ Else
+ Colour = White
+ End If
+ Else
+ Colour = White
+ End If
+
+ textX = MapNpc(index).x * PIC_X + MapNpc(index).xOffset + (PIC_X \ 2) - (textSize \ 2)
+ textY = MapNpc(index).Y * PIC_Y + MapNpc(index).yOffset - 32
+
+ If Npc(npcNum).sprite >= 1 And Npc(npcNum).sprite <= Count_Char Then
+ textY = MapNpc(index).Y * PIC_Y + MapNpc(index).yOffset - (mTexture(Tex_Char(Npc(npcNum).sprite)).h / 4) + 12
+ End If
+
+ Call RenderText(font(Fonts.rockwell_15), Text, ConvertMapX(textX), ConvertMapY(textY), Colour)
+End Sub
+
+Function GetColStr(Colour As Long)
+ If Colour < 10 Then
+ GetColStr = "0" & Colour
+ Else
+ GetColStr = Colour
+ End If
+End Function
diff --git a/client/src/modTypes.bas b/client/src/modTypes.bas
new file mode 100644
index 0000000..d5633bd
--- /dev/null
+++ b/client/src/modTypes.bas
@@ -0,0 +1,491 @@
+Attribute VB_Name = "modTypes"
+Option Explicit
+
+' Public data structures
+Public map As MapRec
+Public MapCRC32(1 To MAX_MAPS) As MapCRCStruct
+Public Bank As BankRec
+Public TempTile() As TempTileRec
+Public Player(1 To MAX_PLAYERS) As PlayerRec
+Public Class() As ClassRec
+Public Item(1 To MAX_ITEMS) As ItemRec
+Public Npc(1 To MAX_NPCS) As NpcRec
+Public MapItem(1 To MAX_MAP_ITEMS) As MapItemRec
+Public MapNpc(1 To MAX_MAP_NPCS) As MapNpcRec
+Public Shop(1 To MAX_SHOPS) As ShopRec
+Public Spell(1 To MAX_SPELLS) As SpellRec
+Public Resource(1 To MAX_RESOURCES) As ResourceRec
+Public Animation(1 To MAX_ANIMATIONS) As AnimationRec
+Public Conv(1 To MAX_CONVS) As ConvWrapperRec
+Public ActionMsg(1 To MAX_BYTE) As ActionMsgRec
+Public Blood(1 To MAX_BYTE) As BloodRec
+Public AnimInstance(1 To MAX_BYTE) As AnimInstanceRec
+Public Party As PartyRec
+Public Autotile() As AutotileRec
+Public Options As OptionsRec
+
+' Type recs
+Public Type MapCRCStruct
+ MapDataCRC As Long
+ MapTileCRC As Long
+End Type
+
+Private Type OptionsRec
+ Music As Byte
+ sound As Byte
+ NoAuto As Byte
+ Render As Byte
+ Username As String
+ SaveUser As Long
+ channelState(0 To Channel_Count - 1) As Byte
+ PlayIntro As Byte
+ Resolution As Byte
+ Fullscreen As Byte
+End Type
+
+Public Type PartyRec
+ Leader As Long
+ Member(1 To MAX_PARTY_MEMBERS) As Long
+ MemberCount As Long
+End Type
+
+Public Type PlayerInvRec
+ num As Long
+ value As Long
+ bound As Byte
+End Type
+
+Public Type PlayerSpellRec
+ Spell As Long
+ Uses As Long
+End Type
+
+Private Type BankRec
+ Item(1 To MAX_BANK) As PlayerInvRec
+End Type
+
+Private Type PlayerRec
+ ' General
+ name As String
+ Class As Long
+ sprite As Long
+ Level As Byte
+ EXP As Long
+ Access As Byte
+ PK As Byte
+ ' Vitals
+ Vital(1 To Vitals.Vital_Count - 1) As Long
+ MaxVital(1 To Vitals.Vital_Count - 1) As Long
+ ' Stats
+ Stat(1 To Stats.Stat_Count - 1) As Byte
+ POINTS As Long
+ ' Worn equipment
+ Equipment(1 To Equipment.Equipment_Count - 1) As Long
+ ' Position
+ map As Long
+ x As Byte
+ y As Byte
+ dir As Byte
+ ' Variables
+ Variable(1 To MAX_BYTE) As Long
+ ' Client use only
+ xOffset As Integer
+ yOffset As Integer
+ Moving As Byte
+ Attacking As Byte
+ AttackTimer As Long
+ MapGetTimer As Long
+ Step As Byte
+ Anim As Long
+ AnimTimer As Long
+ usergroup As Long
+End Type
+
+Private Type EventCommandRec
+ Type As Byte
+ text As String
+ Colour As Long
+ channel As Byte
+ TargetType As Byte
+ target As Long
+ x As Long
+ y As Long
+End Type
+
+Public Type EventPageRec
+ chkPlayerVar As Byte
+ chkSelfSwitch As Byte
+ chkHasItem As Byte
+
+ PlayerVarNum As Long
+ SelfSwitchNum As Long
+ HasItemNum As Long
+
+ PlayerVariable As Long
+
+ GraphicType As Byte
+ Graphic As Long
+ GraphicX As Long
+ GraphicY As Long
+
+ MoveType As Byte
+ MoveSpeed As Byte
+ MoveFreq As Byte
+
+ WalkAnim As Byte
+ StepAnim As Byte
+ DirFix As Byte
+ WalkThrough As Byte
+
+ Priority As Byte
+ Trigger As Byte
+
+ CommandCount As Long
+ Commands() As EventCommandRec
+End Type
+
+Public Type EventRec
+ name As String
+ x As Long
+ y As Long
+ pageCount As Long
+ EventPage() As EventPageRec
+End Type
+
+Private Type MapDataRec
+ name As String
+ Music As String
+ Moral As Byte
+
+ Up As Long
+ Down As Long
+ left As Long
+ Right As Long
+
+ BootMap As Long
+ BootX As Byte
+ BootY As Byte
+
+ MaxX As Byte
+ MaxY As Byte
+
+ BossNpc As Long
+
+ Npc(1 To MAX_MAP_NPCS) As Long
+End Type
+
+Private Type TileDataRec
+ x As Long
+ y As Long
+ tileSet As Long
+End Type
+
+Public Type TileRec
+ Layer(1 To MapLayer.Layer_Count - 1) As TileDataRec
+ Autotile(1 To MapLayer.Layer_Count - 1) As Byte
+
+ Type As Byte
+ Data1 As Long
+ Data2 As Long
+ Data3 As Long
+ Data4 As Long
+ Data5 As Long
+ DirBlock As Byte
+End Type
+
+Private Type MapTileRec
+ EventCount As Long
+ Tile() As TileRec
+ Events() As EventRec
+End Type
+
+Private Type MapRec
+ MapData As MapDataRec
+ TileData As MapTileRec
+End Type
+
+Private Type ClassRec
+ name As String * NAME_LENGTH
+ Stat(1 To Stats.Stat_Count - 1) As Byte
+ MaleSprite() As Long
+ FemaleSprite() As Long
+ ' For client use
+ Vital(1 To Vitals.Vital_Count - 1) As Long
+End Type
+
+Public Type ItemRec
+ name As String * NAME_LENGTH
+ Desc As String * 255
+ sound As String * NAME_LENGTH
+ Pic As Long
+
+ Type As Byte
+ Data1 As Long
+ Data2 As Long
+ Data3 As Long
+ ClassReq As Long
+ AccessReq As Long
+ LevelReq As Long
+ Mastery As Byte
+ Price As Long
+ Add_Stat(1 To Stats.Stat_Count - 1) As Byte
+ Rarity As Byte
+ speed As Long
+ Handed As Long
+ BindType As Byte
+ Stat_Req(1 To Stats.Stat_Count - 1) As Byte
+ Animation As Long
+ Paperdoll As Long
+ ' consume
+ AddHP As Long
+ AddMP As Long
+ AddEXP As Long
+ CastSpell As Long
+ instaCast As Byte
+ ' food
+ HPorSP As Long
+ FoodPerTick As Long
+ FoodTickCount As Long
+ FoodInterval As Long
+ ' requirements
+ proficiency As Long
+End Type
+
+Private Type MapItemRec
+ playerName As String
+ num As Long
+ value As Long
+ Frame As Byte
+ x As Byte
+ y As Byte
+ bound As Boolean
+End Type
+
+Public Type NpcRec
+ name As String * NAME_LENGTH
+ AttackSay As String * 100
+ sound As String * NAME_LENGTH
+ sprite As Long
+ SpawnSecs As Long
+ Behaviour As Byte
+ Range As Byte
+ Stat(1 To Stats.Stat_Count - 1) As Byte
+ HP As Long
+ EXP As Long
+ Animation As Long
+ Damage As Long
+ Level As Long
+ Conv As Long
+ ' Npc drops
+ DropChance(1 To MAX_NPC_DROPS) As Double
+ DropItem(1 To MAX_NPC_DROPS) As Byte
+ DropItemValue(1 To MAX_NPC_DROPS) As Integer
+ ' Casting
+ Spirit As Long
+ Spell(1 To MAX_NPC_SPELLS) As Long
+End Type
+
+Private Type MapNpcRec
+ num As Long
+ target As Long
+ TargetType As Byte
+ Vital(1 To Vitals.Vital_Count - 1) As Long
+ map As Long
+ x As Byte
+ y As Byte
+ dir As Byte
+ ' Client use only
+ xOffset As Long
+ yOffset As Long
+ Moving As Byte
+ Attacking As Byte
+ AttackTimer As Long
+ Step As Byte
+ Anim As Long
+ AnimTimer As Long
+End Type
+
+Public Type TradeItemRec
+ Item As Long
+ ItemValue As Long
+ CostItem As Long
+ CostValue As Long
+End Type
+
+Private Type ShopRec
+ name As String * NAME_LENGTH
+ BuyRate As Long
+ TradeItem(1 To MAX_TRADES) As TradeItemRec
+End Type
+
+Public Type SpellRec
+ name As String * NAME_LENGTH
+ Desc As String * 255
+ sound As String * NAME_LENGTH
+
+ Type As Byte
+ MPCost As Long
+ LevelReq As Long
+ AccessReq As Long
+ ClassReq As Long
+ CastTime As Long
+ CDTime As Long
+ icon As Long
+ map As Long
+ x As Long
+ y As Long
+ dir As Byte
+ Vital As Long
+ Duration As Long
+ Interval As Long
+ Range As Byte
+ IsAoE As Boolean
+ AoE As Long
+ CastAnim As Long
+ SpellAnim As Long
+ StunDuration As Long
+ ' ranking
+ UniqueIndex As Long
+ NextRank As Long
+ NextUses As Long
+
+End Type
+
+Private Type TempTileRec
+ ' doors... obviously
+ DoorOpen As Byte
+ DoorFrame As Byte
+ DoorTimer As Long
+ DoorAnimate As Byte ' 0 = nothing| 1 = opening | 2 = closing
+ ' fading appear tiles
+ isFading(1 To MapLayer.Layer_Count - 1) As Boolean
+ fadeAlpha(1 To MapLayer.Layer_Count - 1) As Long
+ FadeTimer(1 To MapLayer.Layer_Count - 1) As Long
+ FadeDir(1 To MapLayer.Layer_Count - 1) As Byte
+End Type
+
+Public Type MapResourceRec
+ x As Long
+ y As Long
+ ResourceState As Byte
+End Type
+
+Private Type ResourceRec
+ name As String * NAME_LENGTH
+ SuccessMessage As String * NAME_LENGTH
+ EmptyMessage As String * NAME_LENGTH
+ sound As String * NAME_LENGTH
+ ResourceType As Byte
+ ResourceImage As Long
+ ExhaustedImage As Long
+ ItemReward As Long
+ ToolRequired As Long
+ health As Long
+ RespawnTime As Long
+ WalkThrough As Boolean
+ Animation As Long
+End Type
+
+Private Type ActionMsgRec
+ message As String
+ Created As Long
+
+ Type As Long
+ Color As Long
+ Scroll As Long
+ x As Long
+ y As Long
+ timer As Long
+ alpha As Long
+End Type
+
+Private Type BloodRec
+ sprite As Long
+ timer As Long
+ x As Long
+ y As Long
+End Type
+
+Private Type AnimationRec
+ name As String * NAME_LENGTH
+ sound As String * NAME_LENGTH
+ sprite(0 To 1) As Long
+ Frames(0 To 1) As Long
+ LoopCount(0 To 1) As Long
+ looptime(0 To 1) As Long
+End Type
+
+Private Type AnimInstanceRec
+ Animation As Long
+ x As Long
+ y As Long
+ ' used for locking to players/npcs
+ lockindex As Long
+ LockType As Byte
+ isCasting As Byte
+ ' timing
+ timer(0 To 1) As Long
+ ' rendering check
+ Used(0 To 1) As Boolean
+ ' counting the loop
+ LoopIndex(0 To 1) As Long
+ FrameIndex(0 To 1) As Long
+End Type
+
+Public Type HotbarRec
+ Slot As Long
+ sType As Byte
+End Type
+
+Public Type PointRec
+ x As Long
+ y As Long
+End Type
+
+Public Type QuarterTileRec
+ QuarterTile(1 To 4) As PointRec
+ renderState As Byte
+ srcX(1 To 4) As Long
+ srcY(1 To 4) As Long
+End Type
+
+Public Type AutotileRec
+ Layer(1 To MapLayer.Layer_Count - 1) As QuarterTileRec
+End Type
+
+Public Type ConvRec
+ Conv As String
+ rText(1 To 4) As String
+ rTarget(1 To 4) As Long
+ Event As Long
+ Data1 As Long
+ Data2 As Long
+ Data3 As Long
+End Type
+
+Private Type ConvWrapperRec
+ name As String * NAME_LENGTH
+ chatCount As Long
+ Conv() As ConvRec
+End Type
+
+Public Type ChatBubbleRec
+ Msg As String
+ Colour As Long
+ target As Long
+ TargetType As Byte
+ timer As Long
+ active As Boolean
+End Type
+
+Public Type TextColourRec
+ text As String
+ Colour As Long
+End Type
+
+Public Type GeomRec
+ top As Long
+ left As Long
+ height As Long
+ width As Long
+End Type
diff --git a/client/src/modVideo.bas b/client/src/modVideo.bas
new file mode 100644
index 0000000..d47b452
--- /dev/null
+++ b/client/src/modVideo.bas
@@ -0,0 +1,105 @@
+Attribute VB_Name = "modVideo"
+Option Explicit
+
+Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
+Public Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
+
+Public BasicAudio As IBasicAudio
+Public BasicVideo As IBasicVideo
+Public MediaEvent As IMediaEvent
+Public MediaPosition As IMediaPosition
+Public VideoWindow As IVideoWindow
+Public MediaControl As IMediaControl
+Public BasicVideo2 As IBasicVideo2
+
+Public videoPlaying As Boolean
+
+Public Sub VideoLoop()
+
+ ' if it's finished then set it finished
+ If MediaPosition.CurrentPosition >= MediaPosition.Duration - 1 Then
+ ' stop the video playing
+ videoPlaying = False
+
+ ' the fade alpha
+ fadeAlpha = 255
+
+ ' set menu loop going
+ frmMain.picIntro.visible = False
+
+ ' exited out of playing video - shut down
+ StopIntro
+ End If
+End Sub
+
+Public Sub PlayIntro()
+Dim handle As Long
+
+ Exit Sub
+
+ On Error GoTo errorhandler
+
+ ' late binding
+ Set MediaControl = New FilgraphManager
+
+ ' set the size
+ frmMain.picIntro.width = 800
+ frmMain.picIntro.height = 600
+
+ ' render the file
+ MediaControl.RenderFile App.path & "\data files\video\intro.mp4"
+
+ ' bind
+ Set BasicAudio = MediaControl
+ Set BasicVideo = MediaControl
+ Set VideoWindow = MediaControl
+ Set MediaPosition = MediaControl
+ Set MediaEvent = MediaControl
+ Set BasicVideo2 = MediaControl
+
+ ' hack the window
+ VideoWindow.WindowStyle = &H6000000
+ handle = frmMain.picIntro.hWnd
+ VideoWindow.Owner = handle
+
+ ' turn off music if need be
+ If Options.Music = False Then
+ BasicAudio.volume = -10000
+ Else
+ BasicAudio.volume = 0
+ End If
+
+ ' resize
+ VideoWindow.left = 0
+ VideoWindow.top = 0
+ VideoWindow.width = 800
+ VideoWindow.height = 600
+
+ ' run the video
+ MediaControl.Run
+
+ ' set the loop going
+ videoPlaying = True
+ VideoLoop
+
+ Exit Sub
+errorhandler:
+ Exit Sub
+End Sub
+
+Public Sub StopIntro()
+ If MediaControl Is Nothing Then Exit Sub
+
+ MediaControl.Stop
+
+ Set BasicAudio = Nothing
+ Set BasicVideo = Nothing
+ Set MediaEvent = Nothing
+ Set MediaPosition = Nothing
+ Set VideoWindow = Nothing
+ Set MediaControl = Nothing
+ Set BasicVideo2 = Nothing
+
+ ' play the menu music
+ If Len(Trim$(MenuMusic)) > 0 Then Play_Music Trim$(MenuMusic)
+End Sub
diff --git a/server/server.vbp b/server/server.vbp
new file mode 100644
index 0000000..06d8fa3
--- /dev/null
+++ b/server/server.vbp
@@ -0,0 +1,54 @@
+Type=Exe
+Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; Mswinsck.ocx
+Object={BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0; Tabctl32.ocx
+Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
+Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; Richtx32.ocx
+Module=modConstants; Src\modConstants.bas
+Module=modDatabase; Src\modDatabase.bas
+Module=modGameLogic; Src\modGameLogic.bas
+Module=modGeneral; Src\modGeneral.bas
+Module=modGlobals; Src\modGlobals.bas
+Module=modHandleData; Src\modHandleData.bas
+Module=modServerTCP; Src\modServerTCP.bas
+Module=modSysTray; Src\modSysTray.bas
+Module=modTypes; Src\modTypes.bas
+Form=Src\frmServer.frm
+Module=modServerLoop; Src\modServerLoop.bas
+Module=modEnumerations; Src\modEnumerations.bas
+Module=modPlayer; Src\modPlayer.bas
+Class=clsBuffer; Src\clsBuffer.cls
+Module=modCombat; src\modCombat.bas
+Module=modAuthentication; src\modAuthentication.bas
+IconForm="frmServer"
+Startup="Sub Main"
+HelpFile=""
+Title="Server"
+ExeName32="Server.exe"
+Command32=""
+Name="Server"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Robin Perris Corp."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+
+[MS Transaction Server]
+AutoRefresh=1
diff --git a/server/src/clsBuffer.cls b/server/src/clsBuffer.cls
new file mode 100644
index 0000000..75e8e49
--- /dev/null
+++ b/server/src/clsBuffer.cls
@@ -0,0 +1,177 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+ Persistable = 0 'NotPersistable
+ DataBindingBehavior = 0 'vbNone
+ DataSourceBehavior = 0 'vbNone
+ MTSTransactionMode = 0 'NotAnMTSObject
+END
+Attribute VB_Name = "clsBuffer"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Buffer() As Byte
+Private BufferSize As Long
+Private WriteHead As Long
+Private ReadHead As Long
+
+Private Sub Class_Initialize()
+ Flush
+End Sub
+
+Public Sub PreAllocate(ByVal nLength As Long)
+ WriteHead = 0
+ ReadHead = 0
+ BufferSize = nLength - 1
+ ReDim Buffer(0 To BufferSize)
+End Sub
+
+Public Sub Allocate(ByVal nLength As Long)
+ If BufferSize = 0 And nLength > 1 Then nLength = nLength - 1
+ BufferSize = BufferSize + nLength
+ ReDim Preserve Buffer(0 To BufferSize)
+End Sub
+
+Public Sub Flush()
+ WriteHead = 0
+ ReadHead = 0
+ BufferSize = 0
+ ReDim Buffer(0)
+End Sub
+
+Public Sub Trim()
+ ' If the readhead is past the buffersize, this means everything has been read in the array, flush it
+ If ReadHead >= Count Then Flush
+End Sub
+
+Public Sub WriteByte(ByVal nByte As Byte)
+
+ If WriteHead > BufferSize Then Allocate 1
+
+ Buffer(WriteHead) = nByte
+ WriteHead = WriteHead + 1
+End Sub
+
+Public Sub WriteBytes(ByRef nByte() As Byte)
+Dim nLength As Long
+
+ On Error GoTo errorhandler
+
+ nLength = (UBound(nByte) - LBound(nByte)) + 1
+
+ If WriteHead + nLength - 1 > BufferSize Then Allocate nLength
+
+ CopyMemory Buffer(WriteHead), nByte(0), nLength
+ WriteHead = WriteHead + nLength
+
+errorhandler:
+ Exit Sub
+End Sub
+
+Public Sub WriteInteger(ByVal nInteger As Integer)
+
+ If WriteHead + 1 > BufferSize Then Allocate 2
+
+ CopyMemory Buffer(WriteHead), nInteger, 2
+ WriteHead = WriteHead + 2
+End Sub
+
+Public Sub WriteLong(ByVal nLong As Long)
+
+ If WriteHead + 3 > BufferSize Then Allocate 4
+
+ CopyMemory Buffer(WriteHead), nLong, 4
+ WriteHead = WriteHead + 4
+End Sub
+
+Public Sub WriteString(ByRef nString As String)
+Dim sBytes() As Byte
+Dim sLength As Long
+
+ sLength = Len(nString)
+ sBytes = StrConv(nString, vbFromUnicode)
+
+ WriteLong sLength
+
+ If sLength <= 0 Then Exit Sub
+
+ If WriteHead + sLength - 1 > BufferSize Then Allocate sLength
+
+ CopyMemory Buffer(WriteHead), sBytes(0), sLength
+ WriteHead = WriteHead + sLength
+End Sub
+
+Public Function ReadByte(Optional MoveReadHead As Boolean = True) As Byte
+
+ If ReadHead > BufferSize Then Exit Function
+
+ ReadByte = Buffer(ReadHead)
+ If MoveReadHead Then ReadHead = ReadHead + 1
+End Function
+
+Public Function ReadBytes(ByVal nLength As Long, Optional MoveReadHead As Boolean = True) As Byte()
+Dim Data() As Byte
+
+ If nLength = 0 Then Exit Function
+ If ReadHead + nLength - 1 > BufferSize Then Exit Function
+
+ ReDim Data(nLength - 1)
+
+ CopyMemory Data(0), Buffer(ReadHead), nLength
+ If MoveReadHead Then ReadHead = ReadHead + nLength
+
+ ReadBytes = Data
+End Function
+
+Public Function ReadInteger(Optional MoveReadHead As Boolean = True) As Integer
+
+ If ReadHead + 1 > BufferSize Then Exit Function
+
+ CopyMemory ReadInteger, Buffer(ReadHead), 2
+ If MoveReadHead Then ReadHead = ReadHead + 2
+End Function
+
+Public Function ReadLong(Optional MoveReadHead As Boolean = True) As Long
+
+ If ReadHead + 3 > BufferSize Then Exit Function
+
+ CopyMemory ReadLong, Buffer(ReadHead), 4
+ If MoveReadHead Then ReadHead = ReadHead + 4
+End Function
+
+Public Function ReadString(Optional MoveReadHead As Boolean = True) As String
+Dim sLength As Long
+Dim sBytes() As Byte
+
+ sLength = ReadLong(False)
+ If sLength <= 0 Then
+ If MoveReadHead Then ReadHead = ReadHead + 4
+ Exit Function
+ End If
+
+ ReDim sBytes(sLength - 1)
+
+ CopyMemory sBytes(0), Buffer(ReadHead + 4), sLength
+
+ ReadString = StrConv(sBytes, vbUnicode)
+ If MoveReadHead Then ReadHead = ReadHead + sLength + 4
+End Function
+
+Public Function Count() As Long
+ Count = (UBound(Buffer) - LBound(Buffer)) + 1
+End Function
+
+Public Function Length() As Long
+ Length = Count - ReadHead
+End Function
+
+Public Function ToArray() As Byte()
+ ToArray = Buffer()
+End Function
+
+Public Function ToString() As String
+ ToString = StrConv(Buffer, vbUnicode)
+End Function
diff --git a/server/src/frmServer.frm b/server/src/frmServer.frm
new file mode 100644
index 0000000..8bb34de
--- /dev/null
+++ b/server/src/frmServer.frm
@@ -0,0 +1,622 @@
+VERSION 5.00
+Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "Mswinsck.ocx"
+Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "Tabctl32.ocx"
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
+Begin VB.Form frmServer
+ BorderStyle = 1 'Fixed Single
+ Caption = "Loading..."
+ ClientHeight = 3615
+ ClientLeft = 45
+ ClientTop = 330
+ ClientWidth = 6720
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Icon = "frmServer.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ ScaleHeight = 3615
+ ScaleWidth = 6720
+ StartUpPosition = 2 'CenterScreen
+ Begin MSWinsockLib.Winsock AuthSocket
+ Left = 480
+ Top = 0
+ _ExtentX = 741
+ _ExtentY = 741
+ _Version = 393216
+ End
+ Begin MSWinsockLib.Winsock Socket
+ Index = 0
+ Left = 0
+ Top = 0
+ _ExtentX = 741
+ _ExtentY = 741
+ _Version = 393216
+ End
+ Begin TabDlg.SSTab SSTab1
+ Height = 3375
+ Left = 120
+ TabIndex = 0
+ Top = 120
+ Width = 6495
+ _ExtentX = 11456
+ _ExtentY = 5953
+ _Version = 393216
+ Style = 1
+ TabHeight = 503
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ TabCaption(0) = "Console"
+ TabPicture(0) = "frmServer.frx":1708A
+ Tab(0).ControlEnabled= -1 'True
+ Tab(0).Control(0)= "lblCPS"
+ Tab(0).Control(0).Enabled= 0 'False
+ Tab(0).Control(1)= "lblCpsLock"
+ Tab(0).Control(1).Enabled= 0 'False
+ Tab(0).Control(2)= "txtText"
+ Tab(0).Control(2).Enabled= 0 'False
+ Tab(0).Control(3)= "txtChat"
+ Tab(0).Control(3).Enabled= 0 'False
+ Tab(0).ControlCount= 4
+ TabCaption(1) = "Players"
+ TabPicture(1) = "frmServer.frx":170A6
+ Tab(1).ControlEnabled= 0 'False
+ Tab(1).Control(0)= "lvwInfo"
+ Tab(1).ControlCount= 1
+ TabCaption(2) = "Control "
+ TabPicture(2) = "frmServer.frx":170C2
+ Tab(2).ControlEnabled= 0 'False
+ Tab(2).Control(0)= "fraDatabase"
+ Tab(2).Control(1)= "fraServer"
+ Tab(2).ControlCount= 2
+ Begin VB.Frame fraServer
+ Caption = "Server"
+ Height = 1575
+ Left = -71880
+ TabIndex = 1
+ Top = 360
+ Width = 1815
+ Begin VB.CheckBox chkServerLog
+ Caption = "Server Log"
+ Height = 255
+ Left = 120
+ TabIndex = 7
+ Top = 1200
+ Value = 1 'Checked
+ Width = 1575
+ End
+ Begin VB.CommandButton cmdExit
+ Caption = "Exit"
+ Height = 375
+ Left = 120
+ TabIndex = 6
+ Top = 720
+ Width = 1575
+ End
+ Begin VB.CommandButton cmdShutDown
+ Caption = "Shut Down"
+ Height = 375
+ Left = 120
+ TabIndex = 5
+ Top = 240
+ Width = 1575
+ End
+ End
+ Begin VB.Frame fraDatabase
+ Caption = "Reload"
+ Height = 2775
+ Left = -74880
+ TabIndex = 8
+ Top = 360
+ Width = 2895
+ Begin VB.CommandButton cmdReloadAnimations
+ Caption = "Animations"
+ Height = 375
+ Left = 1440
+ TabIndex = 16
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdReloadResources
+ Caption = "Resources"
+ Height = 375
+ Left = 1440
+ TabIndex = 15
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdReloadItems
+ Caption = "Items"
+ Height = 375
+ Left = 1440
+ TabIndex = 14
+ Top = 240
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdReloadNPCs
+ Caption = "Npcs"
+ Height = 375
+ Left = 120
+ TabIndex = 13
+ Top = 2160
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdReloadShops
+ Caption = "Shops"
+ Height = 375
+ Left = 120
+ TabIndex = 12
+ Top = 1680
+ Width = 1215
+ End
+ Begin VB.CommandButton CmdReloadSpells
+ Caption = "Spells"
+ Height = 375
+ Left = 120
+ TabIndex = 11
+ Top = 1200
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdReloadMaps
+ Caption = "Maps"
+ Height = 375
+ Left = 120
+ TabIndex = 10
+ Top = 720
+ Width = 1215
+ End
+ Begin VB.CommandButton cmdReloadClasses
+ Caption = "Classes"
+ Height = 375
+ Left = 120
+ TabIndex = 9
+ Top = 240
+ Width = 1215
+ End
+ End
+ Begin VB.TextBox txtChat
+ Height = 375
+ Left = 120
+ TabIndex = 3
+ Top = 2880
+ Width = 6255
+ End
+ Begin VB.TextBox txtText
+ Height = 2175
+ Left = 120
+ MultiLine = -1 'True
+ ScrollBars = 2 'Vertical
+ TabIndex = 2
+ Top = 600
+ Width = 6255
+ End
+ Begin MSComctlLib.ListView lvwInfo
+ Height = 2775
+ Left = -74880
+ TabIndex = 4
+ Top = 480
+ Width = 6255
+ _ExtentX = 11033
+ _ExtentY = 4895
+ View = 3
+ Arrange = 1
+ LabelWrap = -1 'True
+ HideSelection = 0 'False
+ AllowReorder = -1 'True
+ FullRowSelect = -1 'True
+ GridLines = -1 'True
+ _Version = 393217
+ ForeColor = -2147483640
+ BackColor = -2147483643
+ BorderStyle = 1
+ Appearance = 1
+ BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ NumItems = 4
+ BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ Text = "Index"
+ Object.Width = 1147
+ EndProperty
+ BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ SubItemIndex = 1
+ Text = "IP Address"
+ Object.Width = 3175
+ EndProperty
+ BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ SubItemIndex = 2
+ Text = "Account"
+ Object.Width = 3175
+ EndProperty
+ BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
+ SubItemIndex = 3
+ Text = "Character"
+ Object.Width = 2999
+ EndProperty
+ End
+ Begin VB.Label lblCpsLock
+ Alignment = 2 'Center
+ AutoSize = -1 'True
+ Caption = "[Unlock]"
+ ForeColor = &H00FF0000&
+ Height = 195
+ Left = 120
+ TabIndex = 18
+ Top = 360
+ Width = 720
+ End
+ Begin VB.Label lblCPS
+ Caption = "CPS: 0"
+ Height = 255
+ Left = 960
+ TabIndex = 17
+ Top = 360
+ Width = 1815
+ End
+ End
+ Begin VB.Menu mnuKick
+ Caption = "&Kick"
+ Visible = 0 'False
+ Begin VB.Menu mnuKickPlayer
+ Caption = "Kick"
+ End
+ Begin VB.Menu mnuDisconnectPlayer
+ Caption = "Disconnect"
+ End
+ Begin VB.Menu mnuBanPlayer
+ Caption = "Ban"
+ End
+ Begin VB.Menu mnuAdminPlayer
+ Caption = "Make Admin"
+ End
+ Begin VB.Menu mnuRemoveAdmin
+ Caption = "Remove Admin"
+ End
+ Begin VB.Menu mnuMute
+ Caption = "Toggle Mute"
+ End
+ End
+End
+Attribute VB_Name = "frmServer"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub lblCPSLock_Click()
+ If CPSUnlock Then
+ CPSUnlock = False
+ lblCpsLock.Caption = "[Unlock]"
+ Else
+ CPSUnlock = True
+ lblCpsLock.Caption = "[Lock]"
+ End If
+End Sub
+
+' ********************
+' ** Winsock object **
+' ********************
+Private Sub Socket_ConnectionRequest(index As Integer, ByVal requestID As Long)
+ Call AcceptConnection(index, requestID)
+End Sub
+
+Private Sub Socket_Accept(index As Integer, SocketId As Integer)
+ Call AcceptConnection(index, SocketId)
+End Sub
+
+Private Sub Socket_DataArrival(index As Integer, ByVal bytesTotal As Long)
+
+ If IsConnected(index) Then
+ Call IncomingData(index, bytesTotal)
+ End If
+
+End Sub
+
+Private Sub Socket_Close(index As Integer)
+ Call CloseSocket(index)
+End Sub
+
+' auth socket
+Private Sub AuthSocket_ConnectionRequest(ByVal requestID As Long)
+ Call Auth_AcceptConnection(requestID)
+End Sub
+
+Private Sub AuthSocket_Accept(SocketId As Integer)
+ Call Auth_AcceptConnection(SocketId)
+End Sub
+
+Private Sub AuthSocket_DataArrival(ByVal bytesTotal As Long)
+ Auth_IncomingData bytesTotal
+End Sub
+
+Private Sub AuthSocket_Close()
+ frmServer.AuthSocket.Close
+ frmServer.AuthSocket.Listen
+End Sub
+
+' ********************
+Private Sub chkServerLog_Click()
+
+ ' if its not 0, then its true
+ If Not chkServerLog.Value Then
+ ServerLog = True
+ End If
+
+End Sub
+
+Private Sub cmdExit_Click()
+ Call DestroyServer
+End Sub
+
+Private Sub cmdReloadClasses_Click()
+Dim i As Long
+ Call LoadClasses
+ Call TextAdd("All classes reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendClasses i
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadItems_Click()
+Dim i As Long
+ Call LoadItems
+ Call TextAdd("All items reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendItems i
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadMaps_Click()
+Dim i As Long
+ Call LoadMaps
+ Call TextAdd("All maps reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ PlayerWarp i, GetPlayerMap(i), GetPlayerX(i), GetPlayerY(i)
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadNPCs_Click()
+Dim i As Long
+ Call LoadNpcs
+ Call TextAdd("All npcs reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendNpcs i
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadShops_Click()
+Dim i As Long
+ Call LoadShops
+ Call TextAdd("All shops reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendShops i
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadSpells_Click()
+Dim i As Long
+ Call LoadSpells
+ Call TextAdd("All spells reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendSpells i
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadResources_Click()
+Dim i As Long
+ Call LoadResources
+ Call TextAdd("All Resources reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendResources i
+ End If
+ Next
+End Sub
+
+Private Sub cmdReloadAnimations_Click()
+Dim i As Long
+ Call LoadAnimations
+ Call TextAdd("All Animations reloaded.")
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ SendAnimations i
+ End If
+ Next
+End Sub
+
+Private Sub cmdShutDown_Click()
+ If isShuttingDown Then
+ isShuttingDown = False
+ cmdShutDown.Caption = "Shutdown"
+ GlobalMsg "Shutdown canceled.", BrightBlue
+ Else
+ isShuttingDown = True
+ cmdShutDown.Caption = "Cancel"
+ End If
+End Sub
+
+Private Sub Form_Load()
+ Call UsersOnline_Start
+End Sub
+
+Private Sub Form_Resize()
+
+ If frmServer.WindowState = vbMinimized Then
+ frmServer.Hide
+ End If
+
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+ Cancel = True
+ Call DestroyServer
+End Sub
+
+Private Sub lvwInfo_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
+
+ 'When a ColumnHeader object is clicked, the ListView control is sorted by the subitems of that column.
+ 'Set the SortKey to the Index of the ColumnHeader - 1
+ 'Set Sorted to True to sort the list.
+ If lvwInfo.SortOrder = lvwAscending Then
+ lvwInfo.SortOrder = lvwDescending
+ Else
+ lvwInfo.SortOrder = lvwAscending
+ End If
+
+ lvwInfo.SortKey = ColumnHeader.index - 1
+ lvwInfo.Sorted = True
+End Sub
+
+Private Sub txtText_GotFocus()
+ txtChat.SetFocus
+End Sub
+
+Private Sub txtChat_KeyPress(KeyAscii As Integer)
+
+ If KeyAscii = vbKeyReturn Then
+ If LenB(Trim$(txtChat.Text)) > 0 Then
+ Call GlobalMsg(txtChat.Text, BrightRed)
+ Call TextAdd("Server: " & txtChat.Text)
+ txtChat.Text = vbNullString
+ End If
+
+ KeyAscii = 0
+ End If
+
+End Sub
+
+Sub UsersOnline_Start()
+ Dim i As Long
+
+ For i = 1 To MAX_PLAYERS
+ frmServer.lvwInfo.ListItems.Add (i)
+
+ If i < 10 Then
+ frmServer.lvwInfo.ListItems(i).Text = "00" & i
+ ElseIf i < 100 Then
+ frmServer.lvwInfo.ListItems(i).Text = "0" & i
+ Else
+ frmServer.lvwInfo.ListItems(i).Text = i
+ End If
+
+ frmServer.lvwInfo.ListItems(i).SubItems(1) = vbNullString
+ frmServer.lvwInfo.ListItems(i).SubItems(2) = vbNullString
+ frmServer.lvwInfo.ListItems(i).SubItems(3) = vbNullString
+ Next
+
+End Sub
+
+Private Sub lvwInfo_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
+
+ If Button = vbRightButton Then
+ PopupMenu mnuKick
+ End If
+
+End Sub
+
+Private Sub mnuKickPlayer_Click()
+ Dim Name As String
+ Name = frmServer.lvwInfo.SelectedItem.SubItems(3)
+
+ If Not Name = "Not Playing" Then
+ Call AlertMsg(FindPlayer(Name), DIALOGUE_MSG_KICKED)
+ End If
+
+End Sub
+
+Sub mnuDisconnectPlayer_Click()
+ Dim Name As String
+ Name = frmServer.lvwInfo.SelectedItem.SubItems(3)
+
+ If Not Name = "Not Playing" Then
+ CloseSocket (FindPlayer(Name))
+ End If
+End Sub
+
+Sub mnuMute_Click()
+ Dim Name As String
+ Name = frmServer.lvwInfo.SelectedItem.SubItems(3)
+
+ If Not Name = "Not Playing" Then
+ Call ToggleMute(FindPlayer(Name))
+ End If
+End Sub
+
+Sub mnuBanPlayer_click()
+ Dim Name As String
+ Name = frmServer.lvwInfo.SelectedItem.SubItems(3)
+
+ If Not Name = "Not Playing" Then
+ Call BanIndex(FindPlayer(Name))
+ End If
+
+End Sub
+
+Sub mnuAdminPlayer_click()
+ Dim Name As String
+ Name = frmServer.lvwInfo.SelectedItem.SubItems(3)
+
+ If Not Name = "Not Playing" Then
+ Call SetPlayerAccess(FindPlayer(Name), 4)
+ Call SendPlayerData(FindPlayer(Name))
+ Call PlayerMsg(FindPlayer(Name), "You have been granted administrator access.", BrightCyan)
+ End If
+
+End Sub
+
+Sub mnuRemoveAdmin_click()
+ Dim Name As String
+ Name = frmServer.lvwInfo.SelectedItem.SubItems(3)
+
+ If Not Name = "Not Playing" Then
+ Call SetPlayerAccess(FindPlayer(Name), 0)
+ Call SendPlayerData(FindPlayer(Name))
+ Call PlayerMsg(FindPlayer(Name), "You have had your administrator access revoked.", BrightRed)
+ End If
+
+End Sub
+
+Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+ Dim lmsg As Long
+ lmsg = x / Screen.TwipsPerPixelX
+
+ Select Case lmsg
+ Case WM_LBUTTONDBLCLK
+ frmServer.WindowState = vbNormal
+ frmServer.Show
+ txtText.SelStart = Len(txtText.Text)
+ End Select
+
+End Sub
diff --git a/server/src/frmServer.frx b/server/src/frmServer.frx
new file mode 100644
index 0000000..d3dc8cc
Binary files /dev/null and b/server/src/frmServer.frx differ
diff --git a/server/src/modAuthentication.bas b/server/src/modAuthentication.bas
new file mode 100644
index 0000000..1b6171b
--- /dev/null
+++ b/server/src/modAuthentication.bas
@@ -0,0 +1,136 @@
+Attribute VB_Name = "modAuthentication"
+Option Explicit
+
+Private Auth_Buffer As New clsBuffer
+Private Auth_DataTimer As Long
+Private Auth_DataBytes As Long
+Private Auth_DataPackets As Long
+
+Private Type LoginTokenRec
+ user As String
+ Token As String
+ TimeCreated As Long
+ Active As Boolean
+End Type
+
+Public LoginToken(1 To MAX_PLAYERS) As LoginTokenRec
+Public Const LoginTimer As Long = 60000 ' 60 seconds
+
+Private Function Auth_GetAddress(FunAddr As Long) As Long
+ Auth_GetAddress = FunAddr
+End Function
+
+Public Sub Auth_InitMessages()
+ Auth_HandleDataSub(ASetPlayerLoginToken) = Auth_GetAddress(AddressOf HandleSetPlayerLoginToken)
+ Auth_HandleDataSub(ASetUsergroup) = Auth_GetAddress(AddressOf HandleSetUsergroup)
+End Sub
+
+Sub HandleSetPlayerLoginToken(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, user As String, tLoginToken As String, i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ user = Buffer.ReadString
+ tLoginToken = Buffer.ReadString
+
+ Set Buffer = Nothing
+
+ ' find an inactive slot
+ For i = 1 To MAX_PLAYERS
+ If Not LoginToken(i).Active Then
+ ' timed out
+ LoginToken(i).user = user
+ LoginToken(i).Token = tLoginToken
+ LoginToken(i).TimeCreated = GetTickCount
+ LoginToken(i).Active = True
+ End If
+ Next
+End Sub
+
+Sub HandleSetUsergroup(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, user As String, Usergroup As Long, filename As String
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ user = Buffer.ReadString
+ Usergroup = Buffer.ReadLong
+
+ Set Buffer = Nothing
+
+ ' find the file
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim$(user)) & ".ini"
+ If FileExist(filename, True) Then
+ PutVar filename, "ACCOUNT", "Usergroup", STR(Usergroup)
+ End If
+End Sub
+
+Sub Auth_HandleData(ByRef Data() As Byte)
+Dim Buffer As clsBuffer
+Dim MsgType As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ MsgType = Buffer.ReadLong
+
+ If MsgType < 0 Then
+ Exit Sub
+ End If
+
+ If MsgType >= AMSG_COUNT Then
+ Exit Sub
+ End If
+
+ CallWindowProc Auth_HandleDataSub(MsgType), 0, Buffer.ReadBytes(Buffer.Length), 0, 0
+End Sub
+
+Sub Auth_IncomingData(ByVal DataLength As Long)
+Dim Buffer() As Byte
+Dim pLength As Long
+
+ ' Check if elapsed time has passed
+ Auth_DataBytes = Auth_DataBytes + DataLength
+ If GetTickCount >= Auth_DataTimer Then
+ Auth_DataTimer = GetTickCount + 1000
+ Auth_DataBytes = 0
+ Auth_DataPackets = 0
+ End If
+
+ ' Get the data from the socket now
+ frmServer.AuthSocket.GetData Buffer(), vbUnicode, DataLength
+ Auth_Buffer.WriteBytes Buffer()
+
+ If Auth_Buffer.Length >= 4 Then
+ pLength = Auth_Buffer.ReadLong(False)
+
+ If pLength < 0 Then
+ Exit Sub
+ End If
+ End If
+
+ Do While pLength > 0 And pLength <= Auth_Buffer.Length - 4
+ If pLength <= Auth_Buffer.Length - 4 Then
+ Auth_DataPackets = Auth_DataPackets + 1
+ Auth_Buffer.ReadLong
+ Auth_HandleData Auth_Buffer.ReadBytes(pLength)
+ End If
+
+ pLength = 0
+ If Auth_Buffer.Length >= 4 Then
+ pLength = Auth_Buffer.ReadLong(False)
+
+ If pLength < 0 Then
+ Exit Sub
+ End If
+ End If
+ Loop
+
+ Auth_Buffer.Trim
+End Sub
+
+Public Sub Auth_AcceptConnection(ByVal SocketId As Long)
+ frmServer.AuthSocket.Close
+ frmServer.AuthSocket.Accept SocketId
+End Sub
diff --git a/server/src/modCombat.bas b/server/src/modCombat.bas
new file mode 100644
index 0000000..e93244f
--- /dev/null
+++ b/server/src/modCombat.bas
@@ -0,0 +1,2078 @@
+Attribute VB_Name = "modCombat"
+Option Explicit
+
+' ################################
+' ## Basic Calculations ##
+' ################################
+
+Function GetPlayerMaxVital(ByVal index As Long, ByVal Vital As Vitals) As Long
+ If index > MAX_PLAYERS Then Exit Function
+ Select Case Vital
+ Case HP
+ Select Case GetPlayerClass(index)
+ Case 1 ' Warrior
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Endurance) / 2)) * 15 + 150
+ Case 2 ' Wizard
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Endurance) / 2)) * 5 + 65
+ Case 3 ' Whisperer
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Endurance) / 2)) * 5 + 65
+ Case Else ' Anything else - Warrior by default
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Endurance) / 2)) * 15 + 150
+ End Select
+ Case MP
+ Select Case GetPlayerClass(index)
+ Case 1 ' Warrior
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Intelligence) / 2)) * 5 + 25
+ Case 2 ' Wizard
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Intelligence) / 2)) * 30 + 85
+ Case 3 ' Whisperer
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Intelligence) / 2)) * 30 + 85
+ Case Else ' Anything else - Warrior by default
+ GetPlayerMaxVital = ((GetPlayerLevel(index) / 2) + (GetPlayerStat(index, Intelligence) / 2)) * 5 + 25
+ End Select
+ End Select
+End Function
+
+Function GetPlayerVitalRegen(ByVal index As Long, ByVal Vital As Vitals) As Long
+ Dim i As Long
+
+ ' Prevent subscript out of range
+ If IsPlaying(index) = False Or index <= 0 Or index > MAX_PLAYERS Then
+ GetPlayerVitalRegen = 0
+ Exit Function
+ End If
+
+ Select Case Vital
+ Case HP
+ i = 10 '(GetPlayerStat(index, Stats.Willpower) * 0.8) + 6
+ Case MP
+ i = 10 '(GetPlayerStat(index, Stats.Willpower) / 4) + 12.5
+ End Select
+
+ If i < 2 Then i = 2
+ GetPlayerVitalRegen = i
+End Function
+
+Function GetPlayerDamage(ByVal index As Long) As Long
+Dim weaponNum As Long
+
+ GetPlayerDamage = 0
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or index <= 0 Or index > MAX_PLAYERS Then
+ Exit Function
+ End If
+ If GetPlayerEquipment(index, Weapon) > 0 Then
+ weaponNum = GetPlayerEquipment(index, Weapon)
+ GetPlayerDamage = Item(weaponNum).Data2 + (((Item(weaponNum).Data2 / 100) * 5) * GetPlayerStat(index, Strength))
+ Else
+ GetPlayerDamage = 1 + (((0.01) * 5) * GetPlayerStat(index, Strength))
+ End If
+
+End Function
+
+Function GetPlayerDefence(ByVal index As Long) As Long
+Dim Defence As Long, i As Long, itemNum As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or index <= 0 Or index > MAX_PLAYERS Then
+ Exit Function
+ End If
+
+ ' base defence
+ For i = 1 To Equipment.Equipment_Count - 1
+ If i <> Equipment.Weapon Then
+ itemNum = GetPlayerEquipment(index, i)
+ If itemNum > 0 Then
+ If Item(itemNum).Data2 > 0 Then
+ Defence = Defence + Item(itemNum).Data2
+ End If
+ End If
+ End If
+ Next
+
+ ' divide by 3
+ Defence = Defence / 3
+
+ ' floor it at 1
+ If Defence < 1 Then Defence = 1
+
+ ' add in a player's agility
+ GetPlayerDefence = Defence + (((Defence / 100) * 2.5) * (GetPlayerStat(index, Agility) / 2))
+End Function
+
+Function GetPlayerSpellDamage(ByVal index As Long, ByVal spellNum As Long) As Long
+Dim damage As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or index <= 0 Or index > MAX_PLAYERS Then
+ Exit Function
+ End If
+
+ ' return damage
+ damage = Spell(spellNum).Vital
+ ' 10% modifier
+ If damage <= 0 Then damage = 1
+ GetPlayerSpellDamage = RAND(damage - ((damage / 100) * 10), damage + ((damage / 100) * 10))
+End Function
+
+Function GetNpcSpellDamage(ByVal npcNum As Long, ByVal spellNum As Long) As Long
+Dim damage As Long
+
+ ' Check for subscript out of range
+ If npcNum <= 0 Or npcNum > MAX_NPCS Then Exit Function
+
+ ' return damage
+ damage = Spell(spellNum).Vital
+ ' 10% modifier
+ If damage <= 0 Then damage = 1
+ GetNpcSpellDamage = RAND(damage - ((damage / 100) * 10), damage + ((damage / 100) * 10))
+End Function
+
+Function GetNpcMaxVital(ByVal npcNum As Long, ByVal Vital As Vitals) As Long
+ Dim x As Long
+
+ ' Prevent subscript out of range
+ If npcNum <= 0 Or npcNum > MAX_NPCS Then
+ GetNpcMaxVital = 0
+ Exit Function
+ End If
+
+ Select Case Vital
+ Case HP
+ GetNpcMaxVital = Npc(npcNum).HP
+ Case MP
+ GetNpcMaxVital = 30 + (Npc(npcNum).Stat(Intelligence) * 10) + 2
+ End Select
+
+End Function
+
+Function GetNpcVitalRegen(ByVal npcNum As Long, ByVal Vital As Vitals) As Long
+ Dim i As Long
+
+ 'Prevent subscript out of range
+ If npcNum <= 0 Or npcNum > MAX_NPCS Then
+ GetNpcVitalRegen = 0
+ Exit Function
+ End If
+
+ Select Case Vital
+ Case HP
+ i = (Npc(npcNum).Stat(Stats.Willpower) * 0.8) + 6
+ Case MP
+ i = (Npc(npcNum).Stat(Stats.Willpower) / 4) + 12.5
+ End Select
+
+ GetNpcVitalRegen = i
+
+End Function
+
+Function GetNpcDamage(ByVal npcNum As Long) As Long
+ ' return the calculation
+ GetNpcDamage = Npc(npcNum).damage + (((Npc(npcNum).damage / 100) * 5) * Npc(npcNum).Stat(Stats.Strength))
+End Function
+
+Function GetNpcDefence(ByVal npcNum As Long) As Long
+Dim Defence As Long
+
+ ' base defence
+ Defence = 2
+
+ ' add in a player's agility
+ GetNpcDefence = Defence + (((Defence / 100) * 2.5) * (Npc(npcNum).Stat(Stats.Agility) / 2))
+End Function
+
+' ###############################
+' ## Luck-based rates ##
+' ###############################
+Public Function CanPlayerBlock(ByVal index As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanPlayerBlock = False
+
+ rate = 0
+ ' TODO : make it based on shield lulz
+End Function
+
+Public Function CanPlayerCrit(ByVal index As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanPlayerCrit = False
+
+ rate = GetPlayerStat(index, Agility) / 52.08
+ rndNum = RAND(1, 100)
+ If rndNum <= rate Then
+ CanPlayerCrit = True
+ End If
+End Function
+
+Public Function CanPlayerDodge(ByVal index As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanPlayerDodge = False
+
+ rate = GetPlayerStat(index, Agility) / 83.3
+ rndNum = RAND(1, 100)
+ If rndNum <= rate Then
+ CanPlayerDodge = True
+ End If
+End Function
+
+Public Function CanPlayerParry(ByVal index As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanPlayerParry = False
+
+ rate = GetPlayerStat(index, Strength) * 0.25
+ rndNum = RAND(1, 100)
+ If rndNum <= rate Then
+ CanPlayerParry = True
+ End If
+End Function
+
+Public Function CanNpcBlock(ByVal npcNum As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanNpcBlock = False
+
+ rate = 0
+ ' TODO : make it based on shield lol
+End Function
+
+Public Function CanNpcCrit(ByVal npcNum As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanNpcCrit = False
+
+ rate = Npc(npcNum).Stat(Stats.Agility) / 52.08
+ rndNum = RAND(1, 100)
+ If rndNum <= rate Then
+ CanNpcCrit = True
+ End If
+End Function
+
+Public Function CanNpcDodge(ByVal npcNum As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanNpcDodge = False
+
+ rate = Npc(npcNum).Stat(Stats.Agility) / 83.3
+ rndNum = RAND(1, 100)
+ If rndNum <= rate Then
+ CanNpcDodge = True
+ End If
+End Function
+
+Public Function CanNpcParry(ByVal npcNum As Long) As Boolean
+Dim rate As Long
+Dim rndNum As Long
+
+ CanNpcParry = False
+
+ rate = Npc(npcNum).Stat(Stats.Strength) * 0.25
+ rndNum = RAND(1, 100)
+ If rndNum <= rate Then
+ CanNpcParry = True
+ End If
+End Function
+
+' ###################################
+' ## Player Attacking NPC ##
+' ###################################
+Public Sub TryPlayerAttackNpc(ByVal index As Long, ByVal mapNpcNum As Long)
+Dim blockAmount As Long
+Dim npcNum As Long
+Dim mapnum As Long
+Dim damage As Long
+
+ damage = 0
+
+ ' Can we attack the npc?
+ If CanPlayerAttackNpc(index, mapNpcNum) Then
+
+ mapnum = GetPlayerMap(index)
+ npcNum = MapNpc(mapnum).Npc(mapNpcNum).Num
+
+ ' check if NPC can avoid the attack
+ If CanNpcDodge(npcNum) Then
+ SendActionMsg mapnum, "Dodge!", Pink, 1, (MapNpc(mapnum).Npc(mapNpcNum).x * 32), (MapNpc(mapnum).Npc(mapNpcNum).y * 32)
+ Exit Sub
+ End If
+ If CanNpcParry(npcNum) Then
+ SendActionMsg mapnum, "Parry!", Pink, 1, (MapNpc(mapnum).Npc(mapNpcNum).x * 32), (MapNpc(mapnum).Npc(mapNpcNum).y * 32)
+ Exit Sub
+ End If
+
+ ' Get the damage we can do
+ damage = GetPlayerDamage(index)
+
+ ' if the npc blocks, take away the block amount
+ blockAmount = CanNpcBlock(mapNpcNum)
+ damage = damage - blockAmount
+
+ ' take away armour
+ 'damage = damage - RAND(1, (Npc(NpcNum).Stat(Stats.Agility) * 2))
+ damage = damage - RAND((GetNpcDefence(npcNum) / 100) * 10, (GetNpcDefence(npcNum) / 100) * 10)
+ ' randomise from 1 to max hit
+ damage = RAND(damage - ((damage / 100) * 10), damage + ((damage / 100) * 10))
+
+ ' * 1.5 if it's a crit!
+ If CanPlayerCrit(index) Then
+ damage = damage * 1.5
+ SendActionMsg mapnum, "Critical!", BrightCyan, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
+ End If
+
+ If damage > 0 Then
+ Call PlayerAttackNpc(index, mapNpcNum, damage)
+ Else
+ Call PlayerMsg(index, "Your attack does nothing.", BrightRed)
+ End If
+ End If
+End Sub
+
+Public Function CanPlayerAttackNpc(ByVal attacker As Long, ByVal mapNpcNum As Long, Optional ByVal isSpell As Boolean = False) As Boolean
+ Dim mapnum As Long
+ Dim npcNum As Long
+ Dim NpcX As Long
+ Dim NpcY As Long
+ Dim attackspeed As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(attacker) = False Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Then
+ Exit Function
+ End If
+
+ ' Check for subscript out of range
+ If MapNpc(GetPlayerMap(attacker)).Npc(mapNpcNum).Num <= 0 Then
+ Exit Function
+ End If
+
+ mapnum = GetPlayerMap(attacker)
+ npcNum = MapNpc(mapnum).Npc(mapNpcNum).Num
+
+ ' Make sure the npc isn't already dead
+ If MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP) <= 0 Then
+ Exit Function
+ End If
+
+ ' Make sure they are on the same map
+ If IsPlaying(attacker) Then
+
+ ' exit out early
+ If isSpell Then
+ If npcNum > 0 Then
+ If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER Then
+ CanPlayerAttackNpc = True
+ Exit Function
+ End If
+ End If
+ End If
+
+ ' attack speed from weapon
+ If GetPlayerEquipment(attacker, Weapon) > 0 Then
+ attackspeed = Item(GetPlayerEquipment(attacker, Weapon)).Speed
+ Else
+ attackspeed = 1000
+ End If
+
+ If npcNum > 0 And GetTickCount > TempPlayer(attacker).AttackTimer + attackspeed Then
+ ' Check if at same coordinates
+ Select Case GetPlayerDir(attacker)
+ Case DIR_UP
+ NpcX = MapNpc(mapnum).Npc(mapNpcNum).x
+ NpcY = MapNpc(mapnum).Npc(mapNpcNum).y + 1
+ Case DIR_DOWN
+ NpcX = MapNpc(mapnum).Npc(mapNpcNum).x
+ NpcY = MapNpc(mapnum).Npc(mapNpcNum).y - 1
+ Case DIR_LEFT
+ NpcX = MapNpc(mapnum).Npc(mapNpcNum).x + 1
+ NpcY = MapNpc(mapnum).Npc(mapNpcNum).y
+ Case DIR_RIGHT
+ NpcX = MapNpc(mapnum).Npc(mapNpcNum).x - 1
+ NpcY = MapNpc(mapnum).Npc(mapNpcNum).y
+ End Select
+
+ If NpcX = GetPlayerX(attacker) Then
+ If NpcY = GetPlayerY(attacker) Then
+ If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER Then
+ CanPlayerAttackNpc = True
+ ElseIf Npc(npcNum).Behaviour = NPC_BEHAVIOUR_FRIENDLY Then
+ ' init conversation if it's friendly
+ InitChat attacker, mapnum, mapNpcNum
+ End If
+ End If
+ End If
+ End If
+ End If
+
+End Function
+
+Public Sub PlayerAttackNpc(ByVal attacker As Long, ByVal mapNpcNum As Long, ByVal damage As Long, Optional ByVal spellNum As Long, Optional ByVal overTime As Boolean = False)
+ Dim Name As String
+ Dim exp As Long
+ Dim n As Long
+ Dim i As Long
+ Dim STR As Long
+ Dim DEF As Long
+ Dim mapnum As Long
+ Dim npcNum As Long
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If IsPlaying(attacker) = False Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or damage < 0 Then
+ Exit Sub
+ End If
+
+ mapnum = GetPlayerMap(attacker)
+ npcNum = MapNpc(mapnum).Npc(mapNpcNum).Num
+ Name = Trim$(Npc(npcNum).Name)
+
+ ' Check for weapon
+ n = 0
+
+ If GetPlayerEquipment(attacker, Weapon) > 0 Then
+ n = GetPlayerEquipment(attacker, Weapon)
+ End If
+
+ ' set the regen timer
+ TempPlayer(attacker).stopRegen = True
+ TempPlayer(attacker).stopRegenTimer = GetTickCount
+
+ If damage >= MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP) Then
+
+ SendActionMsg GetPlayerMap(attacker), "-" & MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP), BrightRed, 1, (MapNpc(mapnum).Npc(mapNpcNum).x * 32), (MapNpc(mapnum).Npc(mapNpcNum).y * 32)
+ SendBlood GetPlayerMap(attacker), MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y
+
+ ' send the sound
+ If spellNum > 0 Then SendMapSound attacker, MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y, SoundEntity.seSpell, spellNum
+
+ ' send animation
+ If n > 0 Then
+ If Not overTime Then
+ If spellNum = 0 Then Call SendAnimation(mapnum, Item(GetPlayerEquipment(attacker, Weapon)).Animation, MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y)
+ End If
+ End If
+
+ ' Calculate exp to give attacker
+ exp = Npc(npcNum).exp
+
+ ' Make sure we dont get less then 0
+ If exp < 0 Then
+ exp = 1
+ End If
+
+ ' in party?
+ If TempPlayer(attacker).inParty > 0 Then
+ ' pass through party sharing function
+ Party_ShareExp TempPlayer(attacker).inParty, exp, attacker, Npc(npcNum).Level
+ Else
+ ' no party - keep exp for self
+ GivePlayerEXP attacker, exp, Npc(npcNum).Level
+ End If
+
+ 'Drop the goods if they get it
+ For n = 1 To MAX_NPC_DROPS
+ If Npc(npcNum).DropItem(n) = 0 Then Exit For
+ If Rnd <= Npc(npcNum).DropChance(n) Then
+ Call SpawnItem(Npc(npcNum).DropItem(n), Npc(npcNum).DropItemValue(n), mapnum, MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y, GetPlayerName(attacker))
+ End If
+ Next
+
+ ' destroy map npcs
+ If Map(mapnum).MapData.Moral = MAP_MORAL_BOSS Then
+ If mapNpcNum = Map(mapnum).MapData.BossNpc Then
+ ' kill all the other npcs
+ For i = 1 To MAX_MAP_NPCS
+ If Map(mapnum).MapData.Npc(i) > 0 Then
+ ' only kill dangerous npcs
+ If Npc(Map(mapnum).MapData.Npc(i)).Behaviour <> NPC_BEHAVIOUR_FRIENDLY And Npc(Map(mapnum).MapData.Npc(i)).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER Then
+ ' kill!
+ MapNpc(mapnum).Npc(i).Num = 0
+ MapNpc(mapnum).Npc(i).SpawnWait = GetTickCount
+ MapNpc(mapnum).Npc(i).Vital(Vitals.HP) = 0
+ ' send kill command
+ SendNpcDeath mapnum, i
+ End If
+ End If
+ Next
+ End If
+ End If
+
+ ' Now set HP to 0 so we know to actually kill them in the server loop (this prevents subscript out of range)
+ MapNpc(mapnum).Npc(mapNpcNum).Num = 0
+ MapNpc(mapnum).Npc(mapNpcNum).SpawnWait = GetTickCount
+ MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP) = 0
+
+ ' clear DoTs and HoTs
+ For i = 1 To MAX_DOTS
+ With MapNpc(mapnum).Npc(mapNpcNum).DoT(i)
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ .Used = False
+ End With
+
+ With MapNpc(mapnum).Npc(mapNpcNum).HoT(i)
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ .Used = False
+ End With
+ Next
+
+ ' send death to the map
+ SendNpcDeath mapnum, mapNpcNum
+
+ 'Loop through entire map and purge NPC from targets
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And IsConnected(i) Then
+ If Player(i).Map = mapnum Then
+ If TempPlayer(i).targetType = TARGET_TYPE_NPC Then
+ If TempPlayer(i).target = mapNpcNum Then
+ TempPlayer(i).target = 0
+ TempPlayer(i).targetType = TARGET_TYPE_NONE
+ SendTarget i
+ End If
+ End If
+ End If
+ End If
+ Next
+ Else
+ ' NPC not dead, just do the damage
+ MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP) = MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP) - damage
+
+ ' Check for a weapon and say damage
+ SendActionMsg mapnum, "-" & damage, BrightRed, 1, (MapNpc(mapnum).Npc(mapNpcNum).x * 32), (MapNpc(mapnum).Npc(mapNpcNum).y * 32)
+ SendBlood GetPlayerMap(attacker), MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y
+
+ ' send the sound
+ If spellNum > 0 Then SendMapSound attacker, MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y, SoundEntity.seSpell, spellNum
+
+ ' send animation
+ If n > 0 Then
+ If Not overTime Then
+ If spellNum = 0 Then Call SendAnimation(mapnum, Item(GetPlayerEquipment(attacker, Weapon)).Animation, 0, 0, TARGET_TYPE_NPC, mapNpcNum)
+ End If
+ End If
+
+ ' Set the NPC target to the player
+ MapNpc(mapnum).Npc(mapNpcNum).targetType = 1 ' player
+ MapNpc(mapnum).Npc(mapNpcNum).target = attacker
+
+ ' Now check for guard ai and if so have all onmap guards come after'm
+ If Npc(MapNpc(mapnum).Npc(mapNpcNum).Num).Behaviour = NPC_BEHAVIOUR_GUARD Then
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(mapnum).Npc(i).Num = MapNpc(mapnum).Npc(mapNpcNum).Num Then
+ MapNpc(mapnum).Npc(i).target = attacker
+ MapNpc(mapnum).Npc(i).targetType = 1 ' player
+ End If
+ Next
+ End If
+
+ ' set the regen timer
+ MapNpc(mapnum).Npc(mapNpcNum).stopRegen = True
+ MapNpc(mapnum).Npc(mapNpcNum).stopRegenTimer = GetTickCount
+
+ ' if stunning spell, stun the npc
+ If spellNum > 0 Then
+ If Spell(spellNum).StunDuration > 0 Then StunNPC mapNpcNum, mapnum, spellNum
+ ' DoT
+ If Spell(spellNum).Duration > 0 Then
+ AddDoT_Npc mapnum, mapNpcNum, spellNum, attacker
+ End If
+ End If
+
+ SendMapNpcVitals mapnum, mapNpcNum
+
+ ' set the player's target if they don't have one
+ If TempPlayer(attacker).target = 0 Then
+ TempPlayer(attacker).targetType = TARGET_TYPE_NPC
+ TempPlayer(attacker).target = mapNpcNum
+ SendTarget attacker
+ End If
+ End If
+
+ If spellNum = 0 Then
+ ' Reset attack timer
+ TempPlayer(attacker).AttackTimer = GetTickCount
+ End If
+End Sub
+
+' ###################################
+' ## NPC Attacking Player ##
+' ###################################
+
+Public Sub TryNpcAttackPlayer(ByVal mapNpcNum As Long, ByVal index As Long)
+Dim mapnum As Long, npcNum As Long, blockAmount As Long, damage As Long, Defence As Long
+
+ ' Can the npc attack the player?
+ If CanNpcAttackPlayer(mapNpcNum, index) Then
+ mapnum = GetPlayerMap(index)
+ npcNum = MapNpc(mapnum).Npc(mapNpcNum).Num
+
+ ' check if PLAYER can avoid the attack
+ If CanPlayerDodge(index) Then
+ SendActionMsg mapnum, "Dodge!", Pink, 1, (Player(index).x * 32), (Player(index).y * 32)
+ Exit Sub
+ End If
+ If CanPlayerParry(index) Then
+ SendActionMsg mapnum, "Parry!", Pink, 1, (Player(index).x * 32), (Player(index).y * 32)
+ Exit Sub
+ End If
+
+ ' Get the damage we can do
+ damage = GetNpcDamage(npcNum)
+
+ ' if the player blocks, take away the block amount
+ blockAmount = CanPlayerBlock(index)
+ damage = damage - blockAmount
+
+ ' take away armour
+ Defence = GetPlayerDefence(index)
+ If Defence > 0 Then
+ damage = damage - RAND(Defence - ((Defence / 100) * 10), Defence + ((Defence / 100) * 10))
+ End If
+
+ ' randomise for up to 10% lower than max hit
+ If damage <= 0 Then damage = 1
+ damage = RAND(damage - ((damage / 100) * 10), damage + ((damage / 100) * 10))
+
+ ' * 1.5 if crit hit
+ If CanNpcCrit(index) Then
+ damage = damage * 1.5
+ SendActionMsg mapnum, "Critical!", BrightCyan, 1, (MapNpc(mapnum).Npc(mapNpcNum).x * 32), (MapNpc(mapnum).Npc(mapNpcNum).y * 32)
+ End If
+
+ If damage > 0 Then
+ Call NpcAttackPlayer(mapNpcNum, index, damage)
+ End If
+ End If
+End Sub
+
+Function CanNpcAttackPlayer(ByVal mapNpcNum As Long, ByVal index As Long, Optional ByVal isSpell As Boolean = False) As Boolean
+ Dim mapnum As Long
+ Dim npcNum As Long
+
+ ' Check for subscript out of range
+ If mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or Not IsPlaying(index) Then
+ Exit Function
+ End If
+
+ ' Check for subscript out of range
+ If MapNpc(GetPlayerMap(index)).Npc(mapNpcNum).Num <= 0 Then
+ Exit Function
+ End If
+
+ mapnum = GetPlayerMap(index)
+ npcNum = MapNpc(mapnum).Npc(mapNpcNum).Num
+
+ ' Make sure the npc isn't already dead
+ If MapNpc(mapnum).Npc(mapNpcNum).Vital(Vitals.HP) <= 0 Then
+ Exit Function
+ End If
+
+ ' Make sure we dont attack the player if they are switching maps
+ If TempPlayer(index).GettingMap = YES Then
+ Exit Function
+ End If
+
+ ' exit out early if it's a spell
+ If isSpell Then
+ If IsPlaying(index) Then
+ If npcNum > 0 Then
+ CanNpcAttackPlayer = True
+ Exit Function
+ End If
+ End If
+ End If
+
+ ' Make sure npcs dont attack more then once a second
+ If GetTickCount < MapNpc(mapnum).Npc(mapNpcNum).AttackTimer + 1000 Then
+ Exit Function
+ End If
+ MapNpc(mapnum).Npc(mapNpcNum).AttackTimer = GetTickCount
+
+ ' Make sure they are on the same map
+ If IsPlaying(index) Then
+ If npcNum > 0 Then
+
+ ' Check if at same coordinates
+ If (GetPlayerY(index) + 1 = MapNpc(mapnum).Npc(mapNpcNum).y) And (GetPlayerX(index) = MapNpc(mapnum).Npc(mapNpcNum).x) Then
+ CanNpcAttackPlayer = True
+ Else
+ If (GetPlayerY(index) - 1 = MapNpc(mapnum).Npc(mapNpcNum).y) And (GetPlayerX(index) = MapNpc(mapnum).Npc(mapNpcNum).x) Then
+ CanNpcAttackPlayer = True
+ Else
+ If (GetPlayerY(index) = MapNpc(mapnum).Npc(mapNpcNum).y) And (GetPlayerX(index) + 1 = MapNpc(mapnum).Npc(mapNpcNum).x) Then
+ CanNpcAttackPlayer = True
+ Else
+ If (GetPlayerY(index) = MapNpc(mapnum).Npc(mapNpcNum).y) And (GetPlayerX(index) - 1 = MapNpc(mapnum).Npc(mapNpcNum).x) Then
+ CanNpcAttackPlayer = True
+ End If
+ End If
+ End If
+ End If
+ End If
+ End If
+End Function
+
+Sub NpcAttackPlayer(ByVal mapNpcNum As Long, ByVal victim As Long, ByVal damage As Long, Optional ByVal spellNum As Long, Optional ByVal overTime As Boolean = False)
+ Dim Name As String
+ Dim exp As Long
+ Dim mapnum As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or IsPlaying(victim) = False Then
+ Exit Sub
+ End If
+
+ ' Check for subscript out of range
+ If MapNpc(GetPlayerMap(victim)).Npc(mapNpcNum).Num <= 0 Then
+ Exit Sub
+ End If
+
+ mapnum = GetPlayerMap(victim)
+ Name = Trim$(Npc(MapNpc(mapnum).Npc(mapNpcNum).Num).Name)
+
+ ' Send this packet so they can see the npc attacking
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcAttack
+ Buffer.WriteLong mapNpcNum
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+
+ If damage <= 0 Then
+ Exit Sub
+ End If
+
+ ' set the regen timer
+ MapNpc(mapnum).Npc(mapNpcNum).stopRegen = True
+ MapNpc(mapnum).Npc(mapNpcNum).stopRegenTimer = GetTickCount
+
+ If damage >= GetPlayerVital(victim, Vitals.HP) Then
+ ' Say damage
+ SendActionMsg GetPlayerMap(victim), "-" & GetPlayerVital(victim, Vitals.HP), BrightRed, 1, (GetPlayerX(victim) * 32), (GetPlayerY(victim) * 32)
+
+ ' send the sound
+ If spellNum > 0 Then
+ SendMapSound victim, MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y, SoundEntity.seSpell, spellNum
+ Else
+ SendMapSound victim, GetPlayerX(victim), GetPlayerY(victim), SoundEntity.seNpc, MapNpc(mapnum).Npc(mapNpcNum).Num
+ End If
+
+ ' send animation
+ If Not overTime Then
+ If spellNum = 0 Then Call SendAnimation(mapnum, Npc(MapNpc(mapnum).Npc(mapNpcNum).Num).Animation, GetPlayerX(victim), GetPlayerY(victim))
+ End If
+
+ ' kill player
+ KillPlayer victim
+
+ ' Player is dead
+ Call GlobalMsg(GetPlayerName(victim) & " has been killed by " & Name, BrightRed)
+
+ ' Set NPC target to 0
+ MapNpc(mapnum).Npc(mapNpcNum).target = 0
+ MapNpc(mapnum).Npc(mapNpcNum).targetType = 0
+ Else
+ ' Player not dead, just do the damage
+ Call SetPlayerVital(victim, Vitals.HP, GetPlayerVital(victim, Vitals.HP) - damage)
+ Call SendVital(victim, Vitals.HP)
+
+ ' send the sound
+ If spellNum > 0 Then
+ SendMapSound victim, MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y, SoundEntity.seSpell, spellNum
+ Else
+ SendMapSound victim, GetPlayerX(victim), GetPlayerY(victim), SoundEntity.seNpc, MapNpc(mapnum).Npc(mapNpcNum).Num
+ End If
+
+ ' send animation
+ If Not overTime Then
+ If spellNum = 0 Then Call SendAnimation(mapnum, Npc(MapNpc(GetPlayerMap(victim)).Npc(mapNpcNum).Num).Animation, 0, 0, TARGET_TYPE_PLAYER, victim)
+ End If
+
+ ' if stunning spell, stun the npc
+ If spellNum > 0 Then
+ If Spell(spellNum).StunDuration > 0 Then StunPlayer victim, spellNum
+ ' DoT
+ If Spell(spellNum).Duration > 0 Then
+ ' TODO: Add Npc vs Player DOTs
+ End If
+ End If
+
+ ' send vitals to party if in one
+ If TempPlayer(victim).inParty > 0 Then SendPartyVitals TempPlayer(victim).inParty, victim
+
+ ' send the sound
+ SendMapSound victim, GetPlayerX(victim), GetPlayerY(victim), SoundEntity.seNpc, MapNpc(mapnum).Npc(mapNpcNum).Num
+
+ ' Say damage
+ SendActionMsg GetPlayerMap(victim), "-" & damage, BrightRed, 1, (GetPlayerX(victim) * 32), (GetPlayerY(victim) * 32)
+ SendBlood GetPlayerMap(victim), GetPlayerX(victim), GetPlayerY(victim)
+
+ ' set the regen timer
+ TempPlayer(victim).stopRegen = True
+ TempPlayer(victim).stopRegenTimer = GetTickCount
+ End If
+
+End Sub
+
+' ###################################
+' ## Player Attacking Player ##
+' ###################################
+
+Public Sub TryPlayerAttackPlayer(ByVal attacker As Long, ByVal victim As Long)
+Dim blockAmount As Long, npcNum As Long, mapnum As Long, damage As Long, Defence As Long
+
+ damage = 0
+
+ ' Can we attack the npc?
+ If CanPlayerAttackPlayer(attacker, victim) Then
+
+ mapnum = GetPlayerMap(attacker)
+
+ ' check if NPC can avoid the attack
+ If CanPlayerDodge(victim) Then
+ SendActionMsg mapnum, "Dodge!", Pink, 1, (GetPlayerX(victim) * 32), (GetPlayerY(victim) * 32)
+ Exit Sub
+ End If
+ If CanPlayerParry(victim) Then
+ SendActionMsg mapnum, "Parry!", Pink, 1, (GetPlayerX(victim) * 32), (GetPlayerY(victim) * 32)
+ Exit Sub
+ End If
+
+ ' Get the damage we can do
+ damage = GetPlayerDamage(attacker)
+
+ ' if the npc blocks, take away the block amount
+ blockAmount = CanPlayerBlock(victim)
+ damage = damage - blockAmount
+
+ ' take away armour
+ Defence = GetPlayerDefence(victim)
+ If Defence > 0 Then
+ damage = damage - RAND(Defence - ((Defence / 100) * 10), Defence + ((Defence / 100) * 10))
+ End If
+
+ ' randomise for up to 10% lower than max hit
+ If damage <= 0 Then damage = 1
+ damage = RAND(damage - ((damage / 100) * 10), damage + ((damage / 100) * 10))
+
+ ' * 1.5 if can crit
+ If CanPlayerCrit(attacker) Then
+ damage = damage * 1.5
+ SendActionMsg mapnum, "Critical!", BrightCyan, 1, (GetPlayerX(attacker) * 32), (GetPlayerY(attacker) * 32)
+ End If
+
+ If damage > 0 Then
+ Call PlayerAttackPlayer(attacker, victim, damage)
+ Else
+ Call PlayerMsg(attacker, "Your attack does nothing.", BrightRed)
+ End If
+ End If
+End Sub
+
+Function CanPlayerAttackPlayer(ByVal attacker As Long, ByVal victim As Long, Optional ByVal isSpell As Boolean = False) As Boolean
+Dim partynum As Long, i As Long
+
+ If Not isSpell 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
+
+ ' make sure it's not you
+ If victim = attacker Then
+ PlayerMsg attacker, "Cannot attack yourself.", BrightRed
+ Exit Function
+ End If
+
+ ' check co-ordinates if not spell
+ If Not isSpell 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)).MapData.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) < 5 Then
+ Call PlayerMsg(attacker, "You are below level 5, you cannot attack another player yet!", BrightRed)
+ Exit Function
+ End If
+
+ ' Make sure victim is high enough level
+ If GetPlayerLevel(victim) < 5 Then
+ Call PlayerMsg(attacker, GetPlayerName(victim) & " is below level 5, you cannot attack this player yet!", BrightRed)
+ Exit Function
+ End If
+
+ ' make sure not in your party
+ partynum = TempPlayer(attacker).inParty
+ If partynum > 0 Then
+ For i = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(i) > 0 Then
+ If victim = Party(partynum).Member(i) Then
+ PlayerMsg attacker, "Cannot attack party members.", BrightRed
+ Exit Function
+ End If
+ End If
+ Next
+ End If
+
+ CanPlayerAttackPlayer = True
+End Function
+
+Sub PlayerAttackPlayer(ByVal attacker As Long, ByVal victim As Long, ByVal damage As Long, Optional ByVal spellNum As Long = 0)
+ Dim exp As Long
+ Dim n As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If IsPlaying(attacker) = False Or IsPlaying(victim) = False Or damage < 0 Then
+ Exit Sub
+ End If
+
+ ' Check for weapon
+ n = 0
+
+ If GetPlayerEquipment(attacker, Weapon) > 0 Then
+ n = GetPlayerEquipment(attacker, Weapon)
+ End If
+
+ ' set the regen timer
+ TempPlayer(attacker).stopRegen = True
+ TempPlayer(attacker).stopRegenTimer = GetTickCount
+
+ If damage >= GetPlayerVital(victim, Vitals.HP) Then
+ SendActionMsg GetPlayerMap(victim), "-" & GetPlayerVital(victim, Vitals.HP), BrightRed, 1, (GetPlayerX(victim) * 32), (GetPlayerY(victim) * 32)
+
+ ' send the sound
+ If spellNum > 0 Then SendMapSound victim, GetPlayerX(victim), GetPlayerY(victim), SoundEntity.seSpell, spellNum
+
+ ' Player is dead
+ Call GlobalMsg(GetPlayerName(victim) & " has been killed by " & GetPlayerName(attacker), BrightRed)
+ ' Calculate exp to give attacker
+ exp = (GetPlayerExp(victim) \ 10)
+
+ ' Make sure we dont get less then 0
+ If exp < 0 Then
+ exp = 0
+ End If
+
+ If exp = 0 Then
+ Call PlayerMsg(victim, "You lost no exp.", BrightRed)
+ Call PlayerMsg(attacker, "You received no exp.", BrightBlue)
+ Else
+ Call SetPlayerExp(victim, GetPlayerExp(victim) - exp)
+ SendEXP victim
+ Call PlayerMsg(victim, "You lost " & exp & " exp.", BrightRed)
+
+ ' check if we're in a party
+ If TempPlayer(attacker).inParty > 0 Then
+ ' pass through party exp share function
+ Party_ShareExp TempPlayer(attacker).inParty, exp, attacker, GetPlayerLevel(victim)
+ Else
+ ' not in party, get exp for self
+ GivePlayerEXP attacker, exp, GetPlayerLevel(victim)
+ End If
+ End If
+
+ ' purge target info of anyone who targetted dead guy
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And IsConnected(i) Then
+ If Player(i).Map = GetPlayerMap(attacker) Then
+ If TempPlayer(i).target = TARGET_TYPE_PLAYER Then
+ If TempPlayer(i).target = victim Then
+ TempPlayer(i).target = 0
+ TempPlayer(i).targetType = TARGET_TYPE_NONE
+ SendTarget i
+ End If
+ End If
+ End If
+ End If
+ Next
+
+ If GetPlayerPK(victim) = NO Then
+ If GetPlayerPK(attacker) = NO Then
+ Call SetPlayerPK(attacker, YES)
+ Call SendPlayerData(attacker)
+ Call GlobalMsg(GetPlayerName(attacker) & " has been deemed a Player Killer!!!", BrightRed)
+ End If
+
+ Else
+ Call GlobalMsg(GetPlayerName(victim) & " has paid the price for being a Player Killer!!!", BrightRed)
+ End If
+
+ Call OnDeath(victim)
+ Else
+ ' Player not dead, just do the damage
+ Call SetPlayerVital(victim, Vitals.HP, GetPlayerVital(victim, Vitals.HP) - damage)
+ Call SendVital(victim, Vitals.HP)
+
+ ' send vitals to party if in one
+ If TempPlayer(victim).inParty > 0 Then SendPartyVitals TempPlayer(victim).inParty, victim
+
+ ' send the sound
+ If spellNum > 0 Then SendMapSound victim, GetPlayerX(victim), GetPlayerY(victim), SoundEntity.seSpell, spellNum
+
+ SendActionMsg GetPlayerMap(victim), "-" & damage, BrightRed, 1, (GetPlayerX(victim) * 32), (GetPlayerY(victim) * 32)
+ SendBlood GetPlayerMap(victim), GetPlayerX(victim), GetPlayerY(victim)
+
+ ' set the regen timer
+ TempPlayer(victim).stopRegen = True
+ TempPlayer(victim).stopRegenTimer = GetTickCount
+
+ 'if a stunning spell, stun the player
+ If spellNum > 0 Then
+ If Spell(spellNum).StunDuration > 0 Then StunPlayer victim, spellNum
+ ' DoT
+ If Spell(spellNum).Duration > 0 Then
+ AddDoT_Player victim, spellNum, attacker
+ End If
+ End If
+
+ ' change target if need be
+ If TempPlayer(attacker).target = 0 Then
+ TempPlayer(attacker).targetType = TARGET_TYPE_PLAYER
+ TempPlayer(attacker).target = victim
+ SendTarget attacker
+ End If
+ End If
+
+ ' Reset attack timer
+ TempPlayer(attacker).AttackTimer = GetTickCount
+End Sub
+
+' ############
+' ## Spells ##
+' ############
+Public Sub BufferSpell(ByVal index As Long, ByVal spellSlot As Long)
+Dim spellNum As Long, mpCost As Long, LevelReq As Long, mapnum As Long, spellCastType As Long, ClassReq As Long
+Dim AccessReq As Long, Range As Long, HasBuffered As Boolean, targetType As Byte, target As Long
+
+ ' Prevent subscript out of range
+ If spellSlot <= 0 Or spellSlot > MAX_PLAYER_SPELLS Then Exit Sub
+
+ spellNum = Player(index).Spell(spellSlot).Spell
+ mapnum = GetPlayerMap(index)
+
+ If spellNum <= 0 Or spellNum > MAX_SPELLS Then Exit Sub
+
+ ' Make sure player has the spell
+ If Not HasSpell(index, spellNum) Then Exit Sub
+
+ ' make sure we're not buffering already
+ If TempPlayer(index).spellBuffer.Spell = spellSlot Then Exit Sub
+
+ ' see if cooldown has finished
+ If TempPlayer(index).SpellCD(spellSlot) > GetTickCount Then
+ PlayerMsg index, "Spell hasn't cooled down yet!", BrightRed
+ Exit Sub
+ End If
+
+ mpCost = Spell(spellNum).mpCost
+
+ ' Check if they have enough MP
+ If GetPlayerVital(index, Vitals.MP) < mpCost Then
+ Call PlayerMsg(index, "Not enough mana!", BrightRed)
+ Exit Sub
+ End If
+
+ LevelReq = Spell(spellNum).LevelReq
+
+ ' Make sure they are the right level
+ If LevelReq > GetPlayerLevel(index) Then
+ Call PlayerMsg(index, "You must be level " & LevelReq & " to cast this spell.", BrightRed)
+ Exit Sub
+ End If
+
+ AccessReq = Spell(spellNum).AccessReq
+
+ ' make sure they have the right access
+ If AccessReq > GetPlayerAccess(index) Then
+ Call PlayerMsg(index, "You must be an administrator to cast this spell.", BrightRed)
+ Exit Sub
+ End If
+
+ ClassReq = Spell(spellNum).ClassReq
+
+ ' make sure the classreq > 0
+ If ClassReq > 0 Then ' 0 = no req
+ If ClassReq <> GetPlayerClass(index) Then
+ Call PlayerMsg(index, "Only " & CheckGrammar(Trim$(Class(ClassReq).Name)) & " can use this spell.", BrightRed)
+ Exit Sub
+ End If
+ End If
+
+ ' find out what kind of spell it is! self cast, target or AOE
+ If Spell(spellNum).Range > 0 Then
+ ' ranged attack, single target or aoe?
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 2 ' targetted
+ Else
+ spellCastType = 3 ' targetted aoe
+ End If
+ Else
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 0 ' self-cast
+ Else
+ spellCastType = 1 ' self-cast AoE
+ End If
+ End If
+
+ targetType = TempPlayer(index).targetType
+ target = TempPlayer(index).target
+ Range = Spell(spellNum).Range
+ HasBuffered = False
+
+ Select Case spellCastType
+ Case 0, 1 ' self-cast & self-cast AOE
+ HasBuffered = True
+ Case 2, 3 ' targeted & targeted AOE
+ ' check if have target
+ If Not target > 0 Then
+ PlayerMsg index, "You do not have a target.", BrightRed
+ End If
+ If targetType = TARGET_TYPE_PLAYER Then
+ ' if have target, check in range
+ If Not isInRange(Range, GetPlayerX(index), GetPlayerY(index), GetPlayerX(target), GetPlayerY(target)) Then
+ PlayerMsg index, "Target not in range.", BrightRed
+ Else
+ ' go through spell types
+ If Spell(spellNum).Type <> SPELL_TYPE_DAMAGEHP And Spell(spellNum).Type <> SPELL_TYPE_DAMAGEMP Then
+ HasBuffered = True
+ Else
+ If CanPlayerAttackPlayer(index, target, True) Then
+ HasBuffered = True
+ End If
+ End If
+ End If
+ ElseIf targetType = TARGET_TYPE_NPC Then
+ ' if beneficial magic then self-cast it instead
+ If Spell(spellNum).Type = SPELL_TYPE_HEALHP Or Spell(spellNum).Type = SPELL_TYPE_HEALMP Then
+ target = index
+ targetType = TARGET_TYPE_PLAYER
+ HasBuffered = True
+ Else
+ ' if have target, check in range
+ If Not isInRange(Range, GetPlayerX(index), GetPlayerY(index), MapNpc(mapnum).Npc(target).x, MapNpc(mapnum).Npc(target).y) Then
+ PlayerMsg index, "Target not in range.", BrightRed
+ HasBuffered = False
+ Else
+ ' go through spell types
+ If Spell(spellNum).Type <> SPELL_TYPE_DAMAGEHP And Spell(spellNum).Type <> SPELL_TYPE_DAMAGEMP Then
+ HasBuffered = True
+ Else
+ If CanPlayerAttackNpc(index, target, True) Then
+ HasBuffered = True
+ End If
+ End If
+ End If
+ End If
+ End If
+ End Select
+
+ If HasBuffered Then
+ SendAnimation mapnum, Spell(spellNum).CastAnim, 0, 0, TARGET_TYPE_PLAYER, index, 1
+ TempPlayer(index).spellBuffer.Spell = spellSlot
+ TempPlayer(index).spellBuffer.Timer = GetTickCount
+ TempPlayer(index).spellBuffer.target = target
+ TempPlayer(index).spellBuffer.tType = targetType
+ Exit Sub
+ Else
+ SendClearSpellBuffer index
+ End If
+End Sub
+
+Public Sub NpcBufferSpell(ByVal mapnum As Long, ByVal mapNpcNum As Long, ByVal npcSpellSlot As Long)
+Dim spellNum As Long, mpCost As Long, Range As Long, HasBuffered As Boolean, targetType As Byte, target As Long, spellCastType As Long, i As Long
+
+ ' prevent rte9
+ If npcSpellSlot <= 0 Or npcSpellSlot > MAX_NPC_SPELLS Then Exit Sub
+
+ With MapNpc(mapnum).Npc(mapNpcNum)
+ ' set the spell number
+ spellNum = Npc(.Num).Spell(npcSpellSlot)
+
+ ' prevent rte9
+ If spellNum <= 0 Or spellNum > MAX_SPELLS Then Exit Sub
+
+ ' make sure we're not already buffering
+ If .spellBuffer.Spell > 0 Then Exit Sub
+
+ ' see if cooldown as finished
+ If .SpellCD(npcSpellSlot) > GetTickCount Then Exit Sub
+
+ ' Set the MP Cost
+ mpCost = Spell(spellNum).mpCost
+
+ ' have they got enough mp?
+ If .Vital(Vitals.MP) < mpCost Then Exit Sub
+
+ ' find out what kind of spell it is! self cast, target or AOE
+ If Spell(spellNum).Range > 0 Then
+ ' ranged attack, single target or aoe?
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 2 ' targetted
+ Else
+ spellCastType = 3 ' targetted aoe
+ End If
+ Else
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 0 ' self-cast
+ Else
+ spellCastType = 1 ' self-cast AoE
+ End If
+ End If
+
+ targetType = .targetType
+ target = .target
+ Range = Spell(spellNum).Range
+ HasBuffered = False
+
+ ' make sure on the map
+ If GetPlayerMap(target) <> mapnum Then Exit Sub
+
+ Select Case spellCastType
+ Case 0, 1 ' self-cast & self-cast AOE
+ HasBuffered = True
+ Case 2, 3 ' targeted & targeted AOE
+ ' if it's a healing spell then heal a friend
+ If Spell(spellNum).Type = SPELL_TYPE_HEALHP Then
+ ' find a friend who needs healing
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(mapnum).Npc(i).Num > 0 Then
+ If MapNpc(mapnum).Npc(i).Vital(Vitals.HP) < Npc(MapNpc(mapnum).Npc(i).Num).HP Then
+ targetType = TARGET_TYPE_NPC
+ target = i
+ HasBuffered = True
+ End If
+ End If
+ Next
+ Else
+ ' check if have target
+ If Not target > 0 Then Exit Sub
+ ' make sure it's a player
+ If targetType = TARGET_TYPE_PLAYER Then
+ ' if have target, check in range
+ If Not isInRange(Range, .x, .y, GetPlayerX(target), GetPlayerY(target)) Then
+ Exit Sub
+ Else
+ If CanNpcAttackPlayer(mapNpcNum, target, True) Then
+ HasBuffered = True
+ End If
+ End If
+ End If
+ End If
+ End Select
+
+ If HasBuffered Then
+ SendAnimation mapnum, Spell(spellNum).CastAnim, 0, 0, TARGET_TYPE_NPC, mapNpcNum
+ .spellBuffer.Spell = npcSpellSlot
+ .spellBuffer.Timer = GetTickCount
+ .spellBuffer.target = target
+ .spellBuffer.tType = targetType
+ End If
+ End With
+End Sub
+
+Public Sub NpcCastSpell(ByVal mapnum As Long, ByVal mapNpcNum As Long, ByVal spellSlot As Long, ByVal target As Long, ByVal targetType As Long)
+Dim spellNum As Long, mpCost As Long, Vital As Long, DidCast As Boolean, i As Long, AoE As Long, Range As Long, vitalType As Byte, increment As Boolean, x As Long, y As Long, spellCastType As Long
+
+ DidCast = False
+
+ ' rte9
+ If spellSlot <= 0 Or spellSlot > MAX_NPC_SPELLS Then Exit Sub
+
+ With MapNpc(mapnum).Npc(mapNpcNum)
+ ' cache spell num
+ spellNum = Npc(.Num).Spell(spellSlot)
+
+ ' cache mp cost
+ mpCost = Spell(spellNum).mpCost
+
+ ' make sure still got enough mp
+ If .Vital(Vitals.MP) < mpCost Then Exit Sub
+
+ ' find out what kind of spell it is! self cast, target or AOE
+ If Spell(spellNum).Range > 0 Then
+ ' ranged attack, single target or aoe?
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 2 ' targetted
+ Else
+ spellCastType = 3 ' targetted aoe
+ End If
+ Else
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 0 ' self-cast
+ Else
+ spellCastType = 1 ' self-cast AoE
+ End If
+ End If
+
+ ' get damage
+ Vital = GetNpcSpellDamage(.Num, spellNum) 'GetPlayerSpellDamage(index, spellNum)
+
+ ' store data
+ AoE = Spell(spellNum).AoE
+ Range = Spell(spellNum).Range
+
+ Select Case spellCastType
+ Case 0 ' self-cast target
+ Select Case Spell(spellNum).Type
+ Case SPELL_TYPE_HEALHP
+ SpellNpc_Effect Vitals.HP, True, mapNpcNum, Vital, spellNum, mapnum
+ DidCast = True
+ Case SPELL_TYPE_HEALMP
+ SpellNpc_Effect Vitals.MP, True, mapNpcNum, Vital, spellNum, mapnum
+ DidCast = True
+ End Select
+ Case 1, 3 ' self-cast AOE & targetted AOE
+ If spellCastType = 1 Then
+ x = .x
+ y = .y
+ ElseIf spellCastType = 3 Then
+ If targetType = 0 Then Exit Sub
+ If target = 0 Then Exit Sub
+
+ If targetType = TARGET_TYPE_PLAYER Then
+ x = GetPlayerX(target)
+ y = GetPlayerY(target)
+ Else
+ x = MapNpc(mapnum).Npc(target).x
+ y = MapNpc(mapnum).Npc(target).y
+ End If
+
+ If Not isInRange(Range, .x, .y, x, y) Then Exit Sub
+ End If
+ Select Case Spell(spellNum).Type
+ Case SPELL_TYPE_DAMAGEHP
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = mapnum Then
+ If isInRange(AoE, .x, .y, GetPlayerX(i), GetPlayerY(i)) Then
+ If CanNpcAttackPlayer(mapNpcNum, i, True) Then
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, i
+ NpcAttackPlayer mapNpcNum, i, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ End If
+ End If
+ Next
+ Case SPELL_TYPE_HEALHP, SPELL_TYPE_HEALMP
+ If Spell(spellNum).Type = SPELL_TYPE_HEALHP Then
+ vitalType = Vitals.HP
+ increment = True
+ ElseIf Spell(spellNum).Type = SPELL_TYPE_HEALMP Then
+ vitalType = Vitals.MP
+ increment = True
+ End If
+
+ If Spell(spellNum).Type = SPELL_TYPE_HEALHP Or Spell(spellNum).Type = SPELL_TYPE_HEALMP Then
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(mapnum).Npc(i).Num > 0 Then
+ If MapNpc(mapnum).Npc(i).Vital(HP) > 0 Then
+ If isInRange(AoE, x, y, MapNpc(mapnum).Npc(i).x, MapNpc(mapnum).Npc(i).y) Then
+ SpellNpc_Effect vitalType, increment, i, Vital, spellNum, mapnum
+ DidCast = True
+ End If
+ End If
+ End If
+ Next
+ End If
+ End Select
+ Case 2 ' targetted
+ If targetType = 0 Then Exit Sub
+ If target = 0 Then Exit Sub
+
+ If targetType = TARGET_TYPE_PLAYER Then
+ x = GetPlayerX(target)
+ y = GetPlayerY(target)
+ Else
+ x = MapNpc(mapnum).Npc(target).x
+ y = MapNpc(mapnum).Npc(target).y
+ End If
+
+ If Not isInRange(Range, .x, .y, x, y) Then Exit Sub
+
+ Select Case Spell(spellNum).Type
+ Case SPELL_TYPE_DAMAGEHP
+ If targetType = TARGET_TYPE_PLAYER Then
+ If CanNpcAttackPlayer(mapNpcNum, target, True) Then
+ If Vital > 0 Then
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, target
+ NpcAttackPlayer mapNpcNum, target, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ End If
+ Case SPELL_TYPE_HEALMP, SPELL_TYPE_HEALHP
+ If Spell(spellNum).Type = SPELL_TYPE_HEALMP Then
+ vitalType = Vitals.MP
+ increment = True
+ ElseIf Spell(spellNum).Type = SPELL_TYPE_HEALHP Then
+ vitalType = Vitals.HP
+ increment = True
+ End If
+
+ If targetType = TARGET_TYPE_NPC Then
+ SpellNpc_Effect vitalType, increment, target, Vital, spellNum, mapnum
+ DidCast = True
+ End If
+ End Select
+ End Select
+
+ If DidCast Then
+ .Vital(Vitals.MP) = .Vital(Vitals.MP) - mpCost
+ .SpellCD(spellSlot) = GetTickCount + (Spell(spellNum).CDTime * 1000)
+ End If
+ End With
+End Sub
+
+Public Sub CastSpell(ByVal index As Long, ByVal spellSlot As Long, ByVal target As Long, ByVal targetType As Byte)
+Dim spellNum As Long, mpCost As Long, LevelReq As Long, mapnum As Long, Vital As Long, DidCast As Boolean, ClassReq As Long
+Dim AccessReq As Long, i As Long, AoE As Long, Range As Long, vitalType As Byte, increment As Boolean, x As Long, y As Long
+Dim Buffer As clsBuffer, spellCastType As Long
+
+ DidCast = False
+
+ ' Prevent subscript out of range
+ If spellSlot <= 0 Or spellSlot > MAX_PLAYER_SPELLS Then Exit Sub
+
+ spellNum = Player(index).Spell(spellSlot).Spell
+ mapnum = GetPlayerMap(index)
+
+ ' Make sure player has the spell
+ If Not HasSpell(index, spellNum) Then Exit Sub
+
+ mpCost = Spell(spellNum).mpCost
+
+ ' Check if they have enough MP
+ If GetPlayerVital(index, Vitals.MP) < mpCost Then
+ Call PlayerMsg(index, "Not enough mana!", BrightRed)
+ Exit Sub
+ End If
+
+ LevelReq = Spell(spellNum).LevelReq
+
+ ' Make sure they are the right level
+ If LevelReq > GetPlayerLevel(index) Then
+ Call PlayerMsg(index, "You must be level " & LevelReq & " to cast this spell.", BrightRed)
+ Exit Sub
+ End If
+
+ AccessReq = Spell(spellNum).AccessReq
+
+ ' make sure they have the right access
+ If AccessReq > GetPlayerAccess(index) Then
+ Call PlayerMsg(index, "You must be an administrator to cast this spell.", BrightRed)
+ Exit Sub
+ End If
+
+ ClassReq = Spell(spellNum).ClassReq
+
+ ' make sure the classreq > 0
+ If ClassReq > 0 Then ' 0 = no req
+ If ClassReq <> GetPlayerClass(index) Then
+ Call PlayerMsg(index, "Only " & CheckGrammar(Trim$(Class(ClassReq).Name)) & " can use this spell.", BrightRed)
+ Exit Sub
+ End If
+ End If
+
+ ' find out what kind of spell it is! self cast, target or AOE
+ If Spell(spellNum).Range > 0 Then
+ ' ranged attack, single target or aoe?
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 2 ' targetted
+ Else
+ spellCastType = 3 ' targetted aoe
+ End If
+ Else
+ If Not Spell(spellNum).IsAoE Then
+ spellCastType = 0 ' self-cast
+ Else
+ spellCastType = 1 ' self-cast AoE
+ End If
+ End If
+
+ ' get damage
+ Vital = GetPlayerSpellDamage(index, spellNum)
+
+ ' store data
+ AoE = Spell(spellNum).AoE
+ Range = Spell(spellNum).Range
+
+ Select Case spellCastType
+ Case 0 ' self-cast target
+ Select Case Spell(spellNum).Type
+ Case SPELL_TYPE_HEALHP
+ SpellPlayer_Effect Vitals.HP, True, index, Vital, spellNum
+ DidCast = True
+ Case SPELL_TYPE_HEALMP
+ SpellPlayer_Effect Vitals.MP, True, index, Vital, spellNum
+ DidCast = True
+ Case SPELL_TYPE_WARP
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, index
+ PlayerWarp index, Spell(spellNum).Map, Spell(spellNum).x, Spell(spellNum).y
+ SendAnimation GetPlayerMap(index), Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, index
+ DidCast = True
+ End Select
+ Case 1, 3 ' self-cast AOE & targetted AOE
+ If spellCastType = 1 Then
+ x = GetPlayerX(index)
+ y = GetPlayerY(index)
+ ElseIf spellCastType = 3 Then
+ If targetType = 0 Then Exit Sub
+ If target = 0 Then Exit Sub
+
+ If targetType = TARGET_TYPE_PLAYER Then
+ x = GetPlayerX(target)
+ y = GetPlayerY(target)
+ Else
+ x = MapNpc(mapnum).Npc(target).x
+ y = MapNpc(mapnum).Npc(target).y
+ End If
+
+ If Not isInRange(Range, GetPlayerX(index), GetPlayerY(index), x, y) Then
+ PlayerMsg index, "Target not in range.", BrightRed
+ SendClearSpellBuffer index
+ End If
+ End If
+ Select Case Spell(spellNum).Type
+ Case SPELL_TYPE_DAMAGEHP
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If i <> index Then
+ If GetPlayerMap(i) = GetPlayerMap(index) Then
+ If isInRange(AoE, x, y, GetPlayerX(i), GetPlayerY(i)) Then
+ If CanPlayerAttackPlayer(index, i, True) Then
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, i
+ PlayerAttackPlayer index, i, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ End If
+ End If
+ End If
+ Next
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(mapnum).Npc(i).Num > 0 Then
+ If MapNpc(mapnum).Npc(i).Vital(HP) > 0 Then
+ If isInRange(AoE, x, y, MapNpc(mapnum).Npc(i).x, MapNpc(mapnum).Npc(i).y) Then
+ If CanPlayerAttackNpc(index, i, True) Then
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_NPC, i
+ PlayerAttackNpc index, i, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ End If
+ End If
+ Next
+ Case SPELL_TYPE_HEALHP, SPELL_TYPE_HEALMP, SPELL_TYPE_DAMAGEMP
+ If Spell(spellNum).Type = SPELL_TYPE_HEALHP Then
+ vitalType = Vitals.HP
+ increment = True
+ ElseIf Spell(spellNum).Type = SPELL_TYPE_HEALMP Then
+ vitalType = Vitals.MP
+ increment = True
+ ElseIf Spell(spellNum).Type = SPELL_TYPE_DAMAGEMP Then
+ vitalType = Vitals.MP
+ increment = False
+ End If
+
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = GetPlayerMap(index) Then
+ If isInRange(AoE, x, y, GetPlayerX(i), GetPlayerY(i)) Then
+ SpellPlayer_Effect vitalType, increment, i, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ End If
+ Next
+
+ If Spell(spellNum).Type = SPELL_TYPE_DAMAGEMP Then
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(mapnum).Npc(i).Num > 0 Then
+ If MapNpc(mapnum).Npc(i).Vital(HP) > 0 Then
+ If isInRange(AoE, x, y, MapNpc(mapnum).Npc(i).x, MapNpc(mapnum).Npc(i).y) Then
+ SpellNpc_Effect vitalType, increment, i, Vital, spellNum, mapnum
+ DidCast = True
+ End If
+ End If
+ End If
+ Next
+ End If
+ End Select
+ Case 2 ' targetted
+ If targetType = 0 Then Exit Sub
+ If target = 0 Then Exit Sub
+
+ If targetType = TARGET_TYPE_PLAYER Then
+ x = GetPlayerX(target)
+ y = GetPlayerY(target)
+ Else
+ x = MapNpc(mapnum).Npc(target).x
+ y = MapNpc(mapnum).Npc(target).y
+ End If
+
+ If Not isInRange(Range, GetPlayerX(index), GetPlayerY(index), x, y) Then
+ PlayerMsg index, "Target not in range.", BrightRed
+ SendClearSpellBuffer index
+ Exit Sub
+ End If
+
+ Select Case Spell(spellNum).Type
+ Case SPELL_TYPE_DAMAGEHP
+ If targetType = TARGET_TYPE_PLAYER Then
+ If CanPlayerAttackPlayer(index, target, True) Then
+ If Vital > 0 Then
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, target
+ PlayerAttackPlayer index, target, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ Else
+ If CanPlayerAttackNpc(index, target, True) Then
+ If Vital > 0 Then
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_NPC, target
+ PlayerAttackNpc index, target, Vital, spellNum
+ DidCast = True
+ End If
+ End If
+ End If
+
+ Case SPELL_TYPE_DAMAGEMP, SPELL_TYPE_HEALMP, SPELL_TYPE_HEALHP
+ If Spell(spellNum).Type = SPELL_TYPE_DAMAGEMP Then
+ vitalType = Vitals.MP
+ increment = False
+ ElseIf Spell(spellNum).Type = SPELL_TYPE_HEALMP Then
+ vitalType = Vitals.MP
+ increment = True
+ ElseIf Spell(spellNum).Type = SPELL_TYPE_HEALHP Then
+ vitalType = Vitals.HP
+ increment = True
+ End If
+
+ If targetType = TARGET_TYPE_PLAYER Then
+ If Spell(spellNum).Type = SPELL_TYPE_DAMAGEMP Then
+ If CanPlayerAttackPlayer(index, target, True) Then
+ SpellPlayer_Effect vitalType, increment, target, Vital, spellNum
+ DidCast = True
+ End If
+ Else
+ SpellPlayer_Effect vitalType, increment, target, Vital, spellNum
+ DidCast = True
+ End If
+ Else
+ If Spell(spellNum).Type = SPELL_TYPE_DAMAGEMP Then
+ If CanPlayerAttackNpc(index, target, True) Then
+ SpellNpc_Effect vitalType, increment, target, Vital, spellNum, mapnum
+ DidCast = True
+ End If
+ Else
+ SpellNpc_Effect vitalType, increment, target, Vital, spellNum, mapnum
+ DidCast = True
+ End If
+ End If
+ End Select
+ End Select
+
+ If DidCast Then
+ Call SetPlayerVital(index, Vitals.MP, GetPlayerVital(index, Vitals.MP) - mpCost)
+ Call SendVital(index, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+
+ TempPlayer(index).SpellCD(spellSlot) = GetTickCount + (Spell(spellNum).CDTime * 1000)
+ Call SendCooldown(index, spellSlot)
+
+ ' if has a next rank then increment usage
+ SetPlayerSpellUsage index, spellSlot
+ End If
+End Sub
+
+Public Sub SetPlayerSpellUsage(ByVal index As Long, ByVal spellSlot As Long)
+Dim spellNum As Long, i As Long
+ spellNum = Player(index).Spell(spellSlot).Spell
+ ' if has a next rank then increment usage
+ If Spell(spellNum).NextRank > 0 Then
+ If Player(index).Spell(spellSlot).Uses < Spell(spellNum).NextUses - 1 Then
+ Player(index).Spell(spellSlot).Uses = Player(index).Spell(spellSlot).Uses + 1
+ Else
+ If GetPlayerLevel(index) >= Spell(Spell(spellNum).NextRank).LevelReq Then
+ Player(index).Spell(spellSlot).Spell = Spell(spellNum).NextRank
+ Player(index).Spell(spellSlot).Uses = 0
+ PlayerMsg index, "Your spell has ranked up!", Blue
+ ' update hotbar
+ For i = 1 To MAX_HOTBAR
+ If Player(index).Hotbar(i).Slot > 0 Then
+ If Player(index).Hotbar(i).sType = 2 Then ' spell
+ If Spell(Player(index).Hotbar(i).Slot).UniqueIndex = Spell(Spell(spellNum).NextRank).UniqueIndex Then
+ Player(index).Hotbar(i).Slot = Spell(spellNum).NextRank
+ SendHotbar index
+ End If
+ End If
+ End If
+ Next
+ Else
+ Player(index).Spell(spellSlot).Uses = Spell(spellNum).NextUses
+ End If
+ End If
+ SendPlayerSpells index
+ End If
+End Sub
+
+Public Sub SpellPlayer_Effect(ByVal Vital As Byte, ByVal increment As Boolean, ByVal index As Long, ByVal damage As Long, ByVal spellNum As Long)
+Dim sSymbol As String * 1
+Dim colour As Long
+
+ If damage > 0 Then
+ If increment Then
+ sSymbol = "+"
+ If Vital = Vitals.HP Then colour = BrightGreen
+ If Vital = Vitals.MP Then colour = BrightBlue
+ Else
+ sSymbol = "-"
+ colour = Blue
+ End If
+
+ SendAnimation GetPlayerMap(index), Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_PLAYER, index
+ SendActionMsg GetPlayerMap(index), sSymbol & damage, colour, ACTIONMSG_SCROLL, GetPlayerX(index) * 32, GetPlayerY(index) * 32
+
+ ' send the sound
+ SendMapSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seSpell, spellNum
+
+ If increment Then
+ SetPlayerVital index, Vital, GetPlayerVital(index, Vital) + damage
+ If Spell(spellNum).Duration > 0 Then
+ AddHoT_Player index, spellNum
+ End If
+ ElseIf Not increment Then
+ SetPlayerVital index, Vital, GetPlayerVital(index, Vital) - damage
+ End If
+
+ ' send update
+ SendVital index, Vital
+ End If
+End Sub
+
+Public Sub SpellNpc_Effect(ByVal Vital As Byte, ByVal increment As Boolean, ByVal index As Long, ByVal damage As Long, ByVal spellNum As Long, ByVal mapnum As Long)
+Dim sSymbol As String * 1
+Dim colour As Long
+Dim npcNum As Long
+
+ If damage > 0 Then
+ If increment Then
+ sSymbol = "+"
+ If Vital = Vitals.HP Then colour = BrightGreen
+ If Vital = Vitals.MP Then colour = BrightBlue
+ Else
+ sSymbol = "-"
+ colour = Blue
+ End If
+
+ SendAnimation mapnum, Spell(spellNum).SpellAnim, 0, 0, TARGET_TYPE_NPC, index
+ SendActionMsg mapnum, sSymbol & damage, colour, ACTIONMSG_SCROLL, MapNpc(mapnum).Npc(index).x * 32, MapNpc(mapnum).Npc(index).y * 32
+
+ ' send the sound
+ SendMapSound index, MapNpc(mapnum).Npc(index).x, MapNpc(mapnum).Npc(index).y, SoundEntity.seSpell, spellNum
+
+ npcNum = MapNpc(mapnum).Npc(index).Num
+ If increment Then
+ MapNpc(mapnum).Npc(index).Vital(Vital) = MapNpc(mapnum).Npc(index).Vital(Vital) + damage
+ ' make sure doesn't go over max
+ With MapNpc(mapnum).Npc(index)
+ If .Vital(Vital) > GetNpcMaxVital(npcNum, Vital) Then
+ .Vital(Vital) = GetNpcMaxVital(npcNum, Vital)
+ End If
+ End With
+ If Spell(spellNum).Duration > 0 Then
+ AddHoT_Npc mapnum, index, spellNum
+ End If
+ ElseIf Not increment Then
+ MapNpc(mapnum).Npc(index).Vital(Vital) = MapNpc(mapnum).Npc(index).Vital(Vital) - damage
+ End If
+ End If
+End Sub
+
+Public Sub AddDoT_Player(ByVal index As Long, ByVal spellNum As Long, ByVal Caster As Long)
+Dim i As Long
+
+ For i = 1 To MAX_DOTS
+ With TempPlayer(index).DoT(i)
+ If .Spell = spellNum Then
+ .Timer = GetTickCount
+ .Caster = Caster
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+
+ If .Used = False Then
+ .Spell = spellNum
+ .Timer = GetTickCount
+ .Caster = Caster
+ .Used = True
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+ End With
+ Next
+End Sub
+
+Public Sub AddHoT_Player(ByVal index As Long, ByVal spellNum As Long)
+Dim i As Long
+
+ For i = 1 To MAX_DOTS
+ With TempPlayer(index).HoT(i)
+ If .Spell = spellNum Then
+ .Timer = GetTickCount
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+
+ If .Used = False Then
+ .Spell = spellNum
+ .Timer = GetTickCount
+ .Used = True
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+ End With
+ Next
+End Sub
+
+Public Sub AddDoT_Npc(ByVal mapnum As Long, ByVal index As Long, ByVal spellNum As Long, ByVal Caster As Long)
+Dim i As Long
+
+ For i = 1 To MAX_DOTS
+ With MapNpc(mapnum).Npc(index).DoT(i)
+ If .Spell = spellNum Then
+ .Timer = GetTickCount
+ .Caster = Caster
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+
+ If .Used = False Then
+ .Spell = spellNum
+ .Timer = GetTickCount
+ .Caster = Caster
+ .Used = True
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+ End With
+ Next
+End Sub
+
+Public Sub AddHoT_Npc(ByVal mapnum As Long, ByVal index As Long, ByVal spellNum As Long)
+Dim i As Long
+
+ For i = 1 To MAX_DOTS
+ With MapNpc(mapnum).Npc(index).HoT(i)
+ If .Spell = spellNum Then
+ .Timer = GetTickCount
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+
+ If .Used = False Then
+ .Spell = spellNum
+ .Timer = GetTickCount
+ .Used = True
+ .StartTime = GetTickCount
+ Exit Sub
+ End If
+ End With
+ Next
+End Sub
+
+Public Sub HandleDoT_Player(ByVal index As Long, ByVal dotNum As Long)
+ With TempPlayer(index).DoT(dotNum)
+ If .Used And .Spell > 0 Then
+ ' time to tick?
+ If GetTickCount > .Timer + (Spell(.Spell).Interval * 1000) Then
+ If CanPlayerAttackPlayer(.Caster, index, True) Then
+ PlayerAttackPlayer .Caster, index, GetPlayerSpellDamage(.Caster, .Spell)
+ End If
+ .Timer = GetTickCount
+ ' check if DoT is still active - if player died it'll have been purged
+ If .Used And .Spell > 0 Then
+ ' destroy DoT if finished
+ If GetTickCount - .StartTime >= (Spell(.Spell).Duration * 1000) Then
+ .Used = False
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ End If
+ End If
+ End If
+ End If
+ End With
+End Sub
+
+Public Sub HandleHoT_Player(ByVal index As Long, ByVal hotNum As Long)
+ With TempPlayer(index).HoT(hotNum)
+ If .Used And .Spell > 0 Then
+ ' time to tick?
+ If GetTickCount > .Timer + (Spell(.Spell).Interval * 1000) Then
+ SendActionMsg Player(index).Map, "+" & GetPlayerSpellDamage(.Caster, .Spell), BrightGreen, ACTIONMSG_SCROLL, Player(index).x * 32, Player(index).y * 32
+ Player(index).Vital(Vitals.HP) = Player(index).Vital(Vitals.HP) + GetPlayerSpellDamage(.Caster, .Spell)
+ .Timer = GetTickCount
+ ' check if DoT is still active - if player died it'll have been purged
+ If .Used And .Spell > 0 Then
+ ' destroy hoT if finished
+ If GetTickCount - .StartTime >= (Spell(.Spell).Duration * 1000) Then
+ .Used = False
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ End If
+ End If
+ End If
+ End If
+ End With
+End Sub
+
+Public Sub HandleDoT_Npc(ByVal mapnum As Long, ByVal index As Long, ByVal dotNum As Long)
+ With MapNpc(mapnum).Npc(index).DoT(dotNum)
+ If .Used And .Spell > 0 Then
+ ' time to tick?
+ If GetTickCount > .Timer + (Spell(.Spell).Interval * 1000) Then
+ If CanPlayerAttackNpc(.Caster, index, True) Then
+ PlayerAttackNpc .Caster, index, GetPlayerSpellDamage(.Caster, .Spell), , True
+ End If
+ .Timer = GetTickCount
+ ' check if DoT is still active - if NPC died it'll have been purged
+ If .Used And .Spell > 0 Then
+ ' destroy DoT if finished
+ If GetTickCount - .StartTime >= (Spell(.Spell).Duration * 1000) Then
+ .Used = False
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ End If
+ End If
+ End If
+ End If
+ End With
+End Sub
+
+Public Sub HandleHoT_Npc(ByVal mapnum As Long, ByVal index As Long, ByVal hotNum As Long)
+Dim npcNum As Long
+
+ With MapNpc(mapnum).Npc(index).HoT(hotNum)
+ If .Used And .Spell > 0 Then
+ ' time to tick?
+ If GetTickCount > .Timer + (Spell(.Spell).Interval * 1000) Then
+ SendActionMsg mapnum, "+" & GetPlayerSpellDamage(.Caster, .Spell), BrightGreen, ACTIONMSG_SCROLL, MapNpc(mapnum).Npc(index).x * 32, MapNpc(mapnum).Npc(index).y * 32
+ MapNpc(mapnum).Npc(index).Vital(Vitals.HP) = MapNpc(mapnum).Npc(index).Vital(Vitals.HP) + GetPlayerSpellDamage(.Caster, .Spell)
+ ' make sure not over max
+ npcNum = MapNpc(mapnum).Npc(index).Num
+ If MapNpc(mapnum).Npc(index).Vital(Vitals.HP) > GetNpcMaxVital(npcNum, Vitals.HP) Then
+ MapNpc(mapnum).Npc(index).Vital(Vitals.HP) = GetNpcMaxVital(npcNum, Vitals.HP)
+ End If
+ .Timer = GetTickCount
+ ' check if DoT is still active - if NPC died it'll have been purged
+ If .Used And .Spell > 0 Then
+ ' destroy hoT if finished
+ If GetTickCount - .StartTime >= (Spell(.Spell).Duration * 1000) Then
+ .Used = False
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ End If
+ End If
+ End If
+ End If
+ End With
+End Sub
+
+Public Sub StunPlayer(ByVal index As Long, ByVal spellNum As Long)
+ ' check if it's a stunning spell
+ If Spell(spellNum).StunDuration > 0 Then
+ ' set the values on index
+ TempPlayer(index).StunDuration = Spell(spellNum).StunDuration
+ TempPlayer(index).StunTimer = GetTickCount
+ ' send it to the index
+ SendStunned index
+ ' tell him he's stunned
+ PlayerMsg index, "You have been stunned.", BrightRed
+ End If
+End Sub
+
+Public Sub StunNPC(ByVal index As Long, ByVal mapnum As Long, ByVal spellNum As Long)
+ ' check if it's a stunning spell
+ If Spell(spellNum).StunDuration > 0 Then
+ ' set the values on index
+ MapNpc(mapnum).Npc(index).StunDuration = Spell(spellNum).StunDuration
+ MapNpc(mapnum).Npc(index).StunTimer = GetTickCount
+ End If
+End Sub
diff --git a/server/src/modConstants.bas b/server/src/modConstants.bas
new file mode 100644
index 0000000..4294036
--- /dev/null
+++ b/server/src/modConstants.bas
@@ -0,0 +1,229 @@
+Attribute VB_Name = "modConstants"
+Option Explicit
+
+' Connection details
+Public Const GAME_SERVER_IP As String = "127.0.0.1" ' "46.23.70.66"
+Public Const AUTH_SERVER_IP As String = "127.0.0.1" ' "46.23.70.66"
+Public Const GAME_SERVER_PORT As Long = 7001 ' the port used by the main game server
+Public Const AUTH_SERVER_PORT As Long = 7002 ' the port used for people to connect to auth server
+Public Const SERVER_AUTH_PORT As Long = 7003 ' the portal used for server to talk to auth server
+
+Public Const GAME_NAME As String = "Crystalshire"
+Public Const GAME_WEBSITE As String = "http://www.crystalshire.com"
+
+' API
+Public Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
+Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByRef Msg() As Byte, ByVal wParam As Long, ByVal lParam As Long) As Long
+
+' path constants
+Public Const ADMIN_LOG As String = "admin.log"
+Public Const PLAYER_LOG As String = "player.log"
+
+' Version constants
+Public Const CLIENT_MAJOR As Byte = 1
+Public Const CLIENT_MINOR As Byte = 8
+Public Const CLIENT_REVISION As Byte = 0
+Public Const MAX_LINES As Long = 500 ' Used for frmServer.txtText
+
+' ********************************************************
+' * The values below must match with the client's values *
+' ********************************************************
+' General constants
+Public Const MAX_PLAYERS As Long = 200
+Public Const MAX_ITEMS As Long = 255
+Public Const MAX_NPCS As Long = 255
+Public Const MAX_ANIMATIONS As Long = 255
+Public Const MAX_INV As Long = 35
+Public Const MAX_MAP_ITEMS As Long = 255
+Public Const MAX_MAP_NPCS As Long = 30
+Public Const MAX_SHOPS As Long = 50
+Public Const MAX_PLAYER_SPELLS As Long = 35
+Public Const MAX_SPELLS As Long = 255
+Public Const MAX_TRADES As Long = 35
+Public Const MAX_RESOURCES As Long = 100
+Public Const MAX_LEVELS As Long = 20
+Public Const MAX_BANK As Long = 99
+Public Const MAX_HOTBAR As Long = 12
+Public Const MAX_PARTYS As Long = 35
+Public Const MAX_PARTY_MEMBERS As Long = 4
+Public Const MAX_CONVS As Byte = 255
+Public Const MAX_NPC_DROPS As Byte = 30
+Public Const MAX_NPC_SPELLS As Byte = 10
+Public Const MAX_CHARS As Byte = 3
+
+' server-side stuff
+Public Const ITEM_SPAWN_TIME As Long = 30000 ' 30 seconds
+Public Const ITEM_DESPAWN_TIME As Long = 600000 ' 10 minutes
+Public Const MAX_DOTS As Long = 30
+
+' text color constants
+Public Const Black As Byte = 0
+Public Const Blue As Byte = 1
+Public Const Green As Byte = 2
+Public Const Cyan As Byte = 3
+Public Const Red As Byte = 4
+Public Const Magenta As Byte = 5
+Public Const Brown As Byte = 6
+Public Const Grey As Byte = 7
+Public Const DarkGrey As Byte = 8
+Public Const BrightBlue As Byte = 9
+Public Const BrightGreen As Byte = 10
+Public Const BrightCyan As Byte = 11
+Public Const BrightRed As Byte = 12
+Public Const Pink As Byte = 13
+Public Const Yellow As Byte = 14
+Public Const White As Byte = 15
+Public Const DarkBrown As Byte = 16
+Public Const Gold As Byte = 17
+
+Public Const SayColor As Byte = White
+Public Const GlobalColor As Byte = BrightBlue
+Public Const BroadcastColor As Byte = White
+Public Const TellColor As Byte = BrightGreen
+Public Const EmoteColor As Byte = BrightCyan
+Public Const AdminColor As Byte = BrightCyan
+Public Const HelpColor As Byte = BrightBlue
+Public Const WhoColor As Byte = BrightBlue
+Public Const JoinLeftColor As Byte = DarkGrey
+Public Const NpcColor As Byte = Brown
+Public Const AlertColor As Byte = Red
+Public Const NewMapColor As Byte = BrightBlue
+
+' Boolean constants
+Public Const NO As Byte = 0
+Public Const YES As Byte = 1
+
+' String constants
+Public Const NAME_LENGTH As Byte = 20
+Public Const ACCOUNT_LENGTH As Byte = 12
+
+' Sex constants
+Public Const SEX_MALE As Byte = 0
+Public Const SEX_FEMALE As Byte = 1
+
+' Map constants
+Public Const MAX_MAPS As Long = 100
+Public Const MAX_MAPX As Byte = 24
+Public Const MAX_MAPY As Byte = 18
+Public Const MAP_MORAL_NONE As Byte = 0
+Public Const MAP_MORAL_SAFE As Byte = 1
+Public Const MAP_MORAL_BOSS As Byte = 2
+
+' Tile consants
+Public Const TILE_TYPE_WALKABLE As Byte = 0
+Public Const TILE_TYPE_BLOCKED As Byte = 1
+Public Const TILE_TYPE_WARP As Byte = 2
+Public Const TILE_TYPE_ITEM As Byte = 3
+Public Const TILE_TYPE_NPCAVOID As Byte = 4
+Public Const TILE_TYPE_KEY As Byte = 5
+Public Const TILE_TYPE_KEYOPEN As Byte = 6
+Public Const TILE_TYPE_RESOURCE As Byte = 7
+Public Const TILE_TYPE_DOOR As Byte = 8
+Public Const TILE_TYPE_NPCSPAWN As Byte = 9
+Public Const TILE_TYPE_SHOP As Byte = 10
+Public Const TILE_TYPE_BANK As Byte = 11
+Public Const TILE_TYPE_HEAL As Byte = 12
+Public Const TILE_TYPE_TRAP As Byte = 13
+Public Const TILE_TYPE_SLIDE As Byte = 14
+Public Const TILE_TYPE_CHAT As Byte = 15
+
+' Item constants
+Public Const ITEM_TYPE_NONE As Byte = 0
+Public Const ITEM_TYPE_WEAPON As Byte = 1
+Public Const ITEM_TYPE_ARMOR As Byte = 2
+Public Const ITEM_TYPE_HELMET As Byte = 3
+Public Const ITEM_TYPE_SHIELD As Byte = 4
+Public Const ITEM_TYPE_CONSUME As Byte = 5
+Public Const ITEM_TYPE_KEY As Byte = 6
+Public Const ITEM_TYPE_CURRENCY As Byte = 7
+Public Const ITEM_TYPE_SPELL As Byte = 8
+Public Const ITEM_TYPE_UNIQUE As Byte = 9
+Public Const ITEM_TYPE_FOOD As Byte = 10
+
+' Direction constants
+Public Const DIR_UP As Byte = 0
+Public Const DIR_DOWN As Byte = 1
+Public Const DIR_LEFT As Byte = 2
+Public Const DIR_RIGHT As Byte = 3
+
+' Constants for player movement
+Public Const MOVING_WALKING As Byte = 1
+Public Const MOVING_RUNNING As Byte = 2
+
+' Admin constants
+Public Const ADMIN_MONITOR As Byte = 1
+Public Const ADMIN_MAPPER As Byte = 2
+Public Const ADMIN_DEVELOPER As Byte = 3
+Public Const ADMIN_CREATOR As Byte = 4
+
+' NPC constants
+Public Const NPC_BEHAVIOUR_ATTACKONSIGHT As Byte = 0
+Public Const NPC_BEHAVIOUR_ATTACKWHENATTACKED As Byte = 1
+Public Const NPC_BEHAVIOUR_FRIENDLY As Byte = 2
+Public Const NPC_BEHAVIOUR_SHOPKEEPER As Byte = 3
+Public Const NPC_BEHAVIOUR_GUARD As Byte = 4
+
+' Spell constants
+Public Const SPELL_TYPE_DAMAGEHP As Byte = 0
+Public Const SPELL_TYPE_DAMAGEMP As Byte = 1
+Public Const SPELL_TYPE_HEALHP As Byte = 2
+Public Const SPELL_TYPE_HEALMP As Byte = 3
+Public Const SPELL_TYPE_WARP As Byte = 4
+
+' Game editor constants
+Public Const EDITOR_ITEM As Byte = 1
+Public Const EDITOR_NPC As Byte = 2
+Public Const EDITOR_SPELL As Byte = 3
+Public Const EDITOR_SHOP As Byte = 4
+
+' Target type constants
+Public Const TARGET_TYPE_NONE As Byte = 0
+Public Const TARGET_TYPE_PLAYER As Byte = 1
+Public Const TARGET_TYPE_NPC As Byte = 2
+
+' Default starting location [Server Only]
+Public Const START_MAP As Long = 1
+Public Const START_X As Long = 30
+Public Const START_Y As Long = 10
+
+' Scrolling action message constants
+Public Const ACTIONMSG_STATIC As Long = 0
+Public Const ACTIONMSG_SCROLL As Long = 1
+Public Const ACTIONMSG_SCREEN As Long = 2
+
+' Do Events
+Public Const nLng As Long = (&H80 Or &H1 Or &H4 Or &H20) + (&H8 Or &H40)
+
+' dialogue alert strings
+Public Const DIALOGUE_MSG_CONNECTION As Byte = 1
+Public Const DIALOGUE_MSG_BANNED As Byte = 2
+Public Const DIALOGUE_MSG_KICKED As Byte = 3
+Public Const DIALOGUE_MSG_OUTDATED As Byte = 4
+Public Const DIALOGUE_MSG_USERLENGTH As Byte = 5
+Public Const DIALOGUE_MSG_ILLEGALNAME As Byte = 6
+Public Const DIALOGUE_MSG_REBOOTING As Byte = 7
+Public Const DIALOGUE_MSG_NAMETAKEN As Byte = 8
+Public Const DIALOGUE_MSG_NAMELENGTH As Byte = 9
+Public Const DIALOGUE_MSG_NAMEILLEGAL As Byte = 10
+Public Const DIALOGUE_MSG_MYSQL As Byte = 11
+Public Const DIALOGUE_MSG_WRONGPASS As Byte = 12
+Public Const DIALOGUE_MSG_ACTIVATED As Byte = 13
+Public Const DIALOGUE_MSG_MERGE As Byte = 14
+Public Const DIALOGUE_MSG_MAXCHARS As Byte = 15
+Public Const DIALOGUE_MSG_MERGENAME As Byte = 16
+Public Const DIALOGUE_MSG_DELCHAR As Byte = 17
+
+' Menu
+Public Const MENU_MAIN As Byte = 1
+Public Const MENU_LOGIN As Byte = 2
+Public Const MENU_REGISTER As Byte = 3
+Public Const MENU_CREDITS As Byte = 4
+Public Const MENU_CLASS As Byte = 5
+Public Const MENU_NEWCHAR As Byte = 6
+Public Const MENU_CHARS As Byte = 7
+Public Const MENU_MERGE As Byte = 8
+
+' values
+Public Const MAX_BYTE As Byte = 255
+Public Const MAX_INTEGER As Integer = 32767
+Public Const MAX_LONG As Long = 2147483647
diff --git a/server/src/modDatabase.bas b/server/src/modDatabase.bas
new file mode 100644
index 0000000..1080852
--- /dev/null
+++ b/server/src/modDatabase.bas
@@ -0,0 +1,1844 @@
+Attribute VB_Name = "modDatabase"
+Option Explicit
+
+' Text API
+Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpString As String, ByVal lpfilename As String) As Long
+Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpdefault As String, ByVal lpreturnedstring As String, ByVal nsize As Long, ByVal lpfilename As String) As Long
+
+'For Clear functions
+Private Declare Sub ZeroMemory Lib "Kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
+
+Private crcTable(0 To 255) As Long
+
+Public Sub InitCRC32()
+Dim i As Long, n As Long, CRC As Long
+
+ For i = 0 To 255
+ CRC = i
+ For n = 0 To 7
+ If CRC And 1 Then
+ CRC = (((CRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor &HEDB88320
+ Else
+ CRC = ((CRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF
+ End If
+ Next
+ crcTable(i) = CRC
+ Next
+End Sub
+
+Public Function CRC32(ByRef Data() As Byte) As Long
+Dim lCurPos As Long
+Dim lLen As Long
+
+ lLen = AryCount(Data) - 1
+ CRC32 = &HFFFFFFFF
+
+ For lCurPos = 0 To lLen
+ CRC32 = (((CRC32 And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (crcTable((CRC32 And 255) Xor Data(lCurPos)))
+ Next
+
+ CRC32 = CRC32 Xor &HFFFFFFFF
+End Function
+
+Public Sub HandleError(ByVal procName As String, ByVal contName As String, ByVal erNumber, ByVal erDesc, ByVal erSource, ByVal erHelpContext)
+Dim filename As String
+ filename = App.Path & "\data files\logs\errors.txt"
+ Open filename For Append As #1
+ Print #1, "The following error occured at '" & procName & "' in '" & contName & "'."
+ Print #1, "Run-time error '" & erNumber & "': " & erDesc & "."
+ Print #1, ""
+ Close #1
+End Sub
+
+Public Sub ChkDir(ByVal tDir As String, ByVal tName As String)
+ If LCase$(dir(tDir & tName, vbDirectory)) <> tName Then Call MkDir(tDir & tName)
+End Sub
+
+' Outputs string to text file
+Sub AddLog(ByVal Text As String, ByVal FN As String)
+ Dim filename As String
+ Dim f As Long
+
+ If ServerLog Then
+ filename = App.Path & "\data\logs\" & FN
+
+ If Not FileExist(filename, True) Then
+ f = FreeFile
+ Open filename For Output As #f
+ Close #f
+ End If
+
+ f = FreeFile
+ Open filename For Append As #f
+ Print #f, DateValue(Now) & " " & Time & ": " & Text
+ Close #f
+ End If
+
+End Sub
+
+' gets a string from a text file
+Public Function GetVar(File As String, Header As String, Var As String) As String
+ Dim sSpaces As String ' Max string length
+ Dim szReturn As String ' Return default value if not found
+ szReturn = vbNullString
+ sSpaces = Space$(5000)
+ Call GetPrivateProfileString$(Header, Var, szReturn, sSpaces, Len(sSpaces), File)
+ GetVar = RTrim$(sSpaces)
+ GetVar = left$(GetVar, Len(GetVar) - 1)
+End Function
+
+' writes a variable to a text file
+Public Sub PutVar(File As String, Header As String, Var As String, Value As String)
+ Call WritePrivateProfileString$(Header, Var, Value, File)
+End Sub
+
+Public Function FileExist(ByVal filename As String, Optional RAW As Boolean = False) As Boolean
+
+ If Not RAW Then
+ If LenB(dir(App.Path & "\" & filename)) > 0 Then
+ FileExist = True
+ End If
+
+ Else
+
+ If LenB(dir(filename)) > 0 Then
+ FileExist = True
+ End If
+ End If
+
+End Function
+
+Public Sub SaveOptions()
+ PutVar App.Path & "\data\options.ini", "OPTIONS", "MOTD", Options.MOTD
+End Sub
+
+Public Sub LoadOptions()
+ Options.MOTD = GetVar(App.Path & "\data\options.ini", "OPTIONS", "MOTD")
+End Sub
+
+Public Sub ToggleMute(ByVal index As Long)
+ ' exit out for rte9
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Sub
+
+ ' toggle the player's mute
+ If Player(index).isMuted = 1 Then
+ Player(index).isMuted = 0
+ ' Let them know
+ PlayerMsg index, "You have been unmuted and can now talk in global.", BrightGreen
+ TextAdd GetPlayerName(index) & " has been unmuted."
+ Else
+ Player(index).isMuted = 1
+ ' Let them know
+ PlayerMsg index, "You have been muted and can no longer talk in global.", BrightRed
+ TextAdd GetPlayerName(index) & " has been muted."
+ End If
+
+ ' save the player
+ SavePlayer index
+End Sub
+
+Public Sub BanIndex(ByVal BanPlayerIndex As Long)
+Dim filename As String, IP As String, f As Long, i As Long
+
+ ' Add banned to the player's index
+ Player(BanPlayerIndex).isBanned = 1
+ SavePlayer BanPlayerIndex
+
+ ' IP banning
+ filename = App.Path & "\data\banlist_ip.txt"
+
+ ' Make sure the file exists
+ If Not FileExist(filename, True) Then
+ f = FreeFile
+ Open filename For Output As #f
+ Close #f
+ End If
+
+ ' Print the IP in the ip ban list
+ IP = GetPlayerIP(BanPlayerIndex)
+ f = FreeFile
+ Open filename For Append As #f
+ Print #f, IP
+ Close #f
+
+ ' Tell them they're banned
+ Call GlobalMsg(GetPlayerName(BanPlayerIndex) & " has been banned from " & GAME_NAME & ".", White)
+ Call AddLog(GetPlayerName(BanPlayerIndex) & " has been banned.", ADMIN_LOG)
+ Call AlertMsg(BanPlayerIndex, DIALOGUE_MSG_BANNED)
+End Sub
+
+Public Function isBanned_IP(ByVal IP As String) As Boolean
+Dim filename As String, fIP As String, f As Long
+
+ filename = App.Path & "\data\banlist_ip.txt"
+
+ ' Check if file exists
+ If Not FileExist(filename, True) Then
+ f = FreeFile
+ Open filename For Output As #f
+ Close #f
+ End If
+
+ f = FreeFile
+ Open filename For Input As #f
+
+ Do While Not EOF(f)
+ Input #f, fIP
+
+ ' Is banned?
+ If Trim$(LCase$(fIP)) = Trim$(LCase$(Mid$(IP, 1, Len(fIP)))) Then
+ isBanned_IP = True
+ Close #f
+ Exit Function
+ End If
+ Loop
+
+ Close #f
+End Function
+
+Public Function isBanned_Account(ByVal index As Long) As Boolean
+ If Player(index).isBanned = 1 Then
+ isBanned_Account = True
+ Else
+ isBanned_Account = False
+ End If
+End Function
+
+' **************
+' ** Accounts **
+' **************
+Function AccountExist(ByVal Name As String) As Boolean
+ Dim filename As String
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim(Name)) & ".ini"
+
+ If FileExist(filename, True) Then
+ AccountExist = True
+ End If
+
+End Function
+
+Function PasswordOK(ByVal Name As String, ByVal password As String) As Boolean
+Dim filename As String
+Dim RightPassword As String
+
+ If AccountExist(Name) Then
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim$(Name)) & ".ini"
+
+ RightPassword = GetVar(filename, "ACCOUNT", "Password")
+
+ If UCase$(Trim$(password)) = UCase$(Trim$(RightPassword)) Then
+ PasswordOK = True
+ End If
+ End If
+
+End Function
+
+Sub AddAccount(ByVal index As Long, ByVal Name As String)
+ Dim i As Long
+
+ ClearPlayer index
+
+ Player(index).Login = Name
+
+ For i = 1 To MAX_CHARS
+ Player(index).charNum = i
+ Call SavePlayer(index)
+ Next
+End Sub
+
+Sub DeleteName(ByVal Name As String)
+ Dim f1 As Long
+ Dim f2 As Long
+ Dim s As String
+ Call FileCopy(App.Path & "\data\accounts\_charlist.txt", App.Path & "\data\accounts\_chartemp.txt")
+ ' Destroy name from charlist
+ f1 = FreeFile
+ Open App.Path & "\data\accounts\_chartemp.txt" For Input As #f1
+ f2 = FreeFile
+ Open App.Path & "\data\accounts\_charlist.txt" For Output As #f2
+
+ Do While Not EOF(f1)
+ Input #f1, s
+
+ If Trim$(LCase$(s)) <> Trim$(LCase$(Name)) Then
+ Print #f2, s
+ End If
+
+ Loop
+
+ Close #f1
+ Close #f2
+ Call Kill(App.Path & "\data\accounts\_chartemp.txt")
+End Sub
+
+' ****************
+' ** Characters **
+' ****************
+Function CharExist(ByVal index As Long, ByVal charNum As Long) As Boolean
+Dim theName As String
+ theName = GetVar(App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini", "CHAR" & charNum, "Name")
+ 'If LenB(Trim$(Player(index).Name)) > 0 Then
+ If LenB(theName) > 0 Then
+ CharExist = True
+ End If
+End Function
+
+Sub AddChar(ByVal index As Long, ByVal Name As String, ByVal Sex As Byte, ByVal ClassNum As Long, ByVal Sprite As Long, ByVal charNum As Long)
+ Dim f As Long
+ Dim n As Long
+ Dim spritecheck As Boolean
+
+ If LenB(Trim$(Player(index).Name)) = 0 Then
+
+ spritecheck = False
+
+ If charNum < 1 Or charNum > MAX_CHARS Then Exit Sub
+ Player(index).charNum = charNum
+
+ Player(index).Name = Name
+ Player(index).Sex = Sex
+ Player(index).Class = ClassNum
+
+ If Player(index).Sex = SEX_MALE Then
+ Player(index).Sprite = Class(ClassNum).MaleSprite(Sprite)
+ Else
+ Player(index).Sprite = Class(ClassNum).FemaleSprite(Sprite)
+ End If
+
+ Player(index).Level = 1
+
+ For n = 1 To Stats.Stat_Count - 1
+ Player(index).Stat(n) = Class(ClassNum).Stat(n)
+ Next n
+
+ Player(index).dir = DIR_DOWN
+ Player(index).Map = START_MAP
+ Player(index).x = START_X
+ Player(index).y = START_Y
+ Player(index).dir = DIR_DOWN
+ Player(index).Vital(Vitals.HP) = GetPlayerMaxVital(index, Vitals.HP)
+ Player(index).Vital(Vitals.MP) = GetPlayerMaxVital(index, Vitals.MP)
+
+ ' set starter equipment
+ If Class(ClassNum).startItemCount > 0 Then
+ For n = 1 To Class(ClassNum).startItemCount
+ If Class(ClassNum).StartItem(n) > 0 Then
+ ' item exist?
+ If Len(Trim$(Item(Class(ClassNum).StartItem(n)).Name)) > 0 Then
+ Player(index).Inv(n).Num = Class(ClassNum).StartItem(n)
+ Player(index).Inv(n).Value = Class(ClassNum).StartValue(n)
+ End If
+ End If
+ Next
+ End If
+
+ ' set start spells
+ If Class(ClassNum).startSpellCount > 0 Then
+ For n = 1 To Class(ClassNum).startSpellCount
+ If Class(ClassNum).StartSpell(n) > 0 Then
+ ' spell exist?
+ If Len(Trim$(Spell(Class(ClassNum).StartItem(n)).Name)) > 0 Then
+ Player(index).Spell(n).Spell = Class(ClassNum).StartSpell(n)
+ Player(index).Hotbar(n).Slot = Class(ClassNum).StartSpell(n)
+ Player(index).Hotbar(n).sType = 2 ' spells
+ End If
+ End If
+ Next
+ End If
+
+ ' Append name to file
+ f = FreeFile
+ Open App.Path & "\data\accounts\_charlist.txt" For Append As #f
+ Print #f, Name
+ Close #f
+ Call SavePlayer(index)
+ Exit Sub
+ End If
+
+End Sub
+
+Function FindChar(ByVal Name As String) As Boolean
+ Dim f As Long
+ Dim s As String
+ f = FreeFile
+ Open App.Path & "\data\accounts\_charlist.txt" For Input As #f
+
+ Do While Not EOF(f)
+ Input #f, s
+
+ If Trim$(LCase$(s)) = Trim$(LCase$(Name)) Then
+ FindChar = True
+ Close #f
+ Exit Function
+ End If
+
+ Loop
+
+ Close #f
+End Function
+
+' *************
+' ** Players **
+' *************
+Sub SaveAllPlayersOnline()
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ Call SavePlayer(i)
+ End If
+ Next
+End Sub
+
+Sub SavePlayer(ByVal index As Long)
+Dim filename As String, i As Long, charHeader As String
+
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Sub
+
+ ' the file
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini"
+
+ ' General
+ PutVar filename, "ACCOUNT", "Login", Trim$(Player(index).Login)
+ ' Banned
+ PutVar filename, "ACCOUNT", "isBanned", Val(Player(index).isBanned)
+ PutVar filename, "ACCOUNT", "isMuted", Val(Player(index).isMuted)
+ PutVar filename, "ACCOUNT", "Usergroup", Val(Player(index).Usergroup)
+
+ ' exit out early if invalid char
+ If Player(index).charNum < 1 Or Player(index).charNum > MAX_CHARS Then Exit Sub
+
+ ' the char header
+ charHeader = "CHAR" & Player(index).charNum
+
+ ' character
+ PutVar filename, charHeader, "Name", Trim$(Player(index).Name)
+ PutVar filename, charHeader, "Sex", Val(Player(index).Sex)
+ PutVar filename, charHeader, "Class", Val(Player(index).Class)
+ PutVar filename, charHeader, "Sprite", Val(Player(index).Sprite)
+ PutVar filename, charHeader, "Level", Val(Player(index).Level)
+ PutVar filename, charHeader, "exp", Val(Player(index).exp)
+ PutVar filename, charHeader, "Access", Val(Player(index).Access)
+ PutVar filename, charHeader, "PK", Val(Player(index).PK)
+
+ ' Vitals
+ For i = 1 To Vitals.Vital_Count - 1
+ PutVar filename, charHeader, "Vital" & i, Val(Player(index).Vital(i))
+ Next
+
+ ' Stats
+ For i = 1 To Stats.Stat_Count - 1
+ PutVar filename, charHeader, "Stat" & i, Val(Player(index).Stat(i))
+ Next
+ PutVar filename, charHeader, "Points", Val(Player(index).POINTS)
+
+ ' Equipment
+ For i = 1 To Equipment.Equipment_Count - 1
+ PutVar filename, charHeader, "Equipment" & i, Val(Player(index).Equipment(i))
+ Next
+
+ ' Inventory
+ For i = 1 To MAX_INV
+ PutVar filename, charHeader, "InvNum" & i, Val(Player(index).Inv(i).Num)
+ PutVar filename, charHeader, "InvValue" & i, Val(Player(index).Inv(i).Value)
+ PutVar filename, charHeader, "InvBound" & i, Val(Player(index).Inv(i).Bound)
+ Next
+
+ ' Spells
+ For i = 1 To MAX_PLAYER_SPELLS
+ PutVar filename, charHeader, "Spell" & i, Val(Player(index).Spell(i).Spell)
+ PutVar filename, charHeader, "SpellUses" & i, Val(Player(index).Spell(i).Uses)
+ Next
+
+ ' Hotbar
+ For i = 1 To MAX_HOTBAR
+ PutVar filename, charHeader, "HotbarSlot" & i, Val(Player(index).Hotbar(i).Slot)
+ PutVar filename, charHeader, "HotbarType" & i, Val(Player(index).Hotbar(i).sType)
+ Next
+
+ ' Position
+ PutVar filename, charHeader, "Map", Val(Player(index).Map)
+ PutVar filename, charHeader, "X", Val(Player(index).x)
+ PutVar filename, charHeader, "Y", Val(Player(index).y)
+ PutVar filename, charHeader, "Dir", Val(Player(index).dir)
+
+ ' Tutorial
+ PutVar filename, charHeader, "TutorialState", Val(Player(index).TutorialState)
+
+ ' Bank
+ For i = 1 To MAX_BANK
+ PutVar filename, charHeader, "BankNum" & i, Val(Player(index).Bank(i).Num)
+ PutVar filename, charHeader, "BankValue" & i, Val(Player(index).Bank(i).Value)
+ PutVar filename, charHeader, "BankBound" & i, Val(Player(index).Bank(i).Bound)
+ Next
+
+ ' variables
+ For i = 1 To MAX_BYTE
+ PutVar filename, charHeader, "Var" & i, Val(Player(index).Variable(i))
+ Next
+End Sub
+
+Sub LoadPlayer(ByVal index As Long, ByVal Name As String, ByVal charNum As Long)
+Dim filename As String, i As Long, charHeader As String
+
+ If Trim$(Name) = vbNullString Then Exit Sub
+ ' clear player
+ Call ClearPlayer(index)
+
+ ' the file
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim$(Name)) & ".ini"
+
+ ' General
+ Player(index).Login = Name
+ ' Banned
+ Player(index).isBanned = Val(GetVar(filename, "ACCOUNT", "isBanned"))
+ Player(index).isMuted = Val(GetVar(filename, "ACCOUNT", "isMuted"))
+ Player(index).Usergroup = Val(GetVar(filename, "ACCOUNT", "Usergroup"))
+
+ ' exit out early if not a valid char num
+ If charNum < 1 Or charNum > MAX_CHARS Then Exit Sub
+
+ ' the char header
+ charNum = charNum
+ charHeader = "CHAR" & charNum
+
+ ' character
+ Player(index).Name = GetVar(filename, charHeader, "Name")
+ Player(index).Sex = Val(GetVar(filename, charHeader, "Sex"))
+ Player(index).Class = Val(GetVar(filename, charHeader, "Class"))
+ Player(index).Sprite = Val(GetVar(filename, charHeader, "Sprite"))
+ Player(index).Level = Val(GetVar(filename, charHeader, "Level"))
+ Player(index).exp = Val(GetVar(filename, charHeader, "Exp"))
+ Player(index).Access = Val(GetVar(filename, charHeader, "Access"))
+ Player(index).PK = Val(GetVar(filename, charHeader, "PK"))
+
+ ' Vitals
+ For i = 1 To Vitals.Vital_Count - 1
+ Player(index).Vital(i) = Val(GetVar(filename, charHeader, "Vital" & i))
+ Next
+
+ ' Stats
+ For i = 1 To Stats.Stat_Count - 1
+ Player(index).Stat(i) = Val(GetVar(filename, charHeader, "Stat" & i))
+ Next
+ Player(index).POINTS = Val(GetVar(filename, charHeader, "Points"))
+
+ ' Equipment
+ For i = 1 To Equipment.Equipment_Count - 1
+ Player(index).Equipment(i) = Val(GetVar(filename, charHeader, "Equipment" & i))
+ Next
+
+ ' Inventory
+ For i = 1 To MAX_INV
+ Player(index).Inv(i).Num = Val(GetVar(filename, charHeader, "InvNum" & i))
+ Player(index).Inv(i).Value = Val(GetVar(filename, charHeader, "InvValue" & i))
+ Player(index).Inv(i).Bound = Val(GetVar(filename, charHeader, "InvBound" & i))
+ Next
+
+ ' Spells
+ For i = 1 To MAX_PLAYER_SPELLS
+ Player(index).Spell(i).Spell = Val(GetVar(filename, charHeader, "Spell" & i))
+ Player(index).Spell(i).Uses = Val(GetVar(filename, charHeader, "SpellUses" & i))
+ Next
+
+ ' Hotbar
+ For i = 1 To MAX_HOTBAR
+ Player(index).Hotbar(i).Slot = Val(GetVar(filename, charHeader, "HotbarSlot" & i))
+ Player(index).Hotbar(i).sType = Val(GetVar(filename, charHeader, "HotbarType" & i))
+ Next
+
+ ' Position
+ Player(index).Map = Val(GetVar(filename, charHeader, "Map"))
+ Player(index).x = Val(GetVar(filename, charHeader, "X"))
+ Player(index).y = Val(GetVar(filename, charHeader, "Y"))
+ Player(index).dir = Val(GetVar(filename, charHeader, "Dir"))
+
+ ' Tutorial
+ Player(index).TutorialState = Val(GetVar(filename, charHeader, "TutorialState"))
+
+ ' Bank
+ For i = 1 To MAX_BANK
+ Player(index).Bank(i).Num = Val(GetVar(filename, charHeader, "BankNum" & i))
+ Player(index).Bank(i).Value = Val(GetVar(filename, charHeader, "BankValue" & i))
+ Player(index).Bank(i).Bound = Val(GetVar(filename, charHeader, "BankBound" & i))
+ Next
+
+ ' variables
+ For i = 1 To MAX_BYTE
+ Player(index).Variable(i) = Val(GetVar(filename, charHeader, "Var" & i))
+ Next
+
+ ' set the character number
+ Player(index).charNum = charNum
+End Sub
+
+Sub DeleteCharacter(Login As String, charNum As Long)
+Dim filename As String, charHeader As String, i As Long
+
+ Login = Trim$(Login)
+ If Login = vbNullString Then Exit Sub
+
+ ' the file
+ filename = App.Path & "\data\accounts\" & SanitiseString(Login) & ".ini"
+
+ ' exit out early if invalid char
+ If charNum < 1 Or charNum > MAX_CHARS Then Exit Sub
+
+ ' the char header
+ charHeader = "CHAR" & charNum
+
+ ' character
+ PutVar filename, charHeader, "Name", vbNullString
+ PutVar filename, charHeader, "Sex", 0
+ PutVar filename, charHeader, "Class", 0
+ PutVar filename, charHeader, "Sprite", 0
+ PutVar filename, charHeader, "Level", 0
+ PutVar filename, charHeader, "exp", 0
+ PutVar filename, charHeader, "Access", 0
+ PutVar filename, charHeader, "PK", 0
+
+ ' Vitals
+ For i = 1 To Vitals.Vital_Count - 1
+ PutVar filename, charHeader, "Vital" & i, 0
+ Next
+
+ ' Stats
+ For i = 1 To Stats.Stat_Count - 1
+ PutVar filename, charHeader, "Stat" & i, 0
+ Next
+ PutVar filename, charHeader, "Points", 0
+
+ ' Equipment
+ For i = 1 To Equipment.Equipment_Count - 1
+ PutVar filename, charHeader, "Equipment" & i, 0
+ Next
+
+ ' Inventory
+ For i = 1 To MAX_INV
+ PutVar filename, charHeader, "InvNum" & i, 0
+ PutVar filename, charHeader, "InvValue" & i, 0
+ PutVar filename, charHeader, "InvBound" & i, 0
+ Next
+
+ ' Spells
+ For i = 1 To MAX_PLAYER_SPELLS
+ PutVar filename, charHeader, "Spell" & i, 0
+ PutVar filename, charHeader, "SpellUses" & i, 0
+ Next
+
+ ' Hotbar
+ For i = 1 To MAX_HOTBAR
+ PutVar filename, charHeader, "HotbarSlot" & i, 0
+ PutVar filename, charHeader, "HotbarType" & i, 0
+ Next
+
+ ' Position
+ PutVar filename, charHeader, "Map", 0
+ PutVar filename, charHeader, "X", 0
+ PutVar filename, charHeader, "Y", 0
+ PutVar filename, charHeader, "Dir", 0
+
+ ' Tutorial
+ PutVar filename, charHeader, "TutorialState", 0
+
+ ' Bank
+ For i = 1 To MAX_BANK
+ PutVar filename, charHeader, "BankNum" & i, 0
+ PutVar filename, charHeader, "BankValue" & i, 0
+ PutVar filename, charHeader, "BankBound" & i, 0
+ Next
+End Sub
+
+Sub ClearPlayer(ByVal index As Long)
+ Dim i As Long
+
+ Call ZeroMemory(ByVal VarPtr(TempPlayer(index)), LenB(TempPlayer(index)))
+ Set TempPlayer(index).Buffer = New clsBuffer
+
+ Call ZeroMemory(ByVal VarPtr(Player(index)), LenB(Player(index)))
+ Player(index).Login = vbNullString
+ Player(index).Name = vbNullString
+ Player(index).Class = 1
+
+ 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)
+Dim tmpName As String, tmpChar As Long
+
+ tmpName = Player(index).Login
+ tmpChar = Player(index).charNum
+
+ Call ZeroMemory(ByVal VarPtr(Player(index)), LenB(Player(index)))
+
+ Player(index).Login = tmpName
+ Player(index).charNum = tmpChar
+End Sub
+
+' *************
+' ** Classes **
+' *************
+Public Sub CreateClassesINI()
+ Dim filename As String
+ Dim File As String
+ filename = App.Path & "\data\classes.ini"
+ Max_Classes = 2
+
+ If Not FileExist(filename, True) Then
+ File = FreeFile
+ Open filename For Output As File
+ Print #File, "[INIT]"
+ Print #File, "MaxClasses=" & Max_Classes
+ Close File
+ End If
+
+End Sub
+
+Sub LoadClasses()
+ Dim filename As String
+ Dim i As Long, n As Long
+ Dim tmpSprite As String
+ Dim tmpArray() As String
+ Dim startItemCount As Long, startSpellCount As Long
+ Dim x As Long
+
+ If CheckClasses Then
+ ReDim Class(1 To Max_Classes)
+ Call SaveClasses
+ Else
+ filename = App.Path & "\data\classes.ini"
+ Max_Classes = Val(GetVar(filename, "INIT", "MaxClasses"))
+ ReDim Class(1 To Max_Classes)
+ End If
+
+ Call ClearClasses
+
+ For i = 1 To Max_Classes
+ Class(i).Name = GetVar(filename, "CLASS" & i, "Name")
+
+ ' read string of sprites
+ tmpSprite = GetVar(filename, "CLASS" & i, "MaleSprite")
+ ' split into an array of strings
+ tmpArray() = Split(tmpSprite, ",")
+ ' redim the class sprite array
+ ReDim Class(i).MaleSprite(0 To UBound(tmpArray))
+ ' loop through converting strings to values and store in the sprite array
+ For n = 0 To UBound(tmpArray)
+ Class(i).MaleSprite(n) = Val(tmpArray(n))
+ Next
+
+ ' read string of sprites
+ tmpSprite = GetVar(filename, "CLASS" & i, "FemaleSprite")
+ ' split into an array of strings
+ tmpArray() = Split(tmpSprite, ",")
+ ' redim the class sprite array
+ ReDim Class(i).FemaleSprite(0 To UBound(tmpArray))
+ ' loop through converting strings to values and store in the sprite array
+ For n = 0 To UBound(tmpArray)
+ Class(i).FemaleSprite(n) = Val(tmpArray(n))
+ Next
+
+ ' continue
+ Class(i).Stat(Stats.Strength) = Val(GetVar(filename, "CLASS" & i, "Strength"))
+ Class(i).Stat(Stats.Endurance) = Val(GetVar(filename, "CLASS" & i, "Endurance"))
+ Class(i).Stat(Stats.Intelligence) = Val(GetVar(filename, "CLASS" & i, "Intelligence"))
+ Class(i).Stat(Stats.Agility) = Val(GetVar(filename, "CLASS" & i, "Agility"))
+ Class(i).Stat(Stats.Willpower) = Val(GetVar(filename, "CLASS" & i, "Willpower"))
+
+ ' how many starting items?
+ startItemCount = Val(GetVar(filename, "CLASS" & i, "StartItemCount"))
+ If startItemCount > 0 Then ReDim Class(i).StartItem(1 To startItemCount)
+ If startItemCount > 0 Then ReDim Class(i).StartValue(1 To startItemCount)
+
+ ' loop for items & values
+ Class(i).startItemCount = startItemCount
+ If startItemCount >= 1 And startItemCount <= MAX_INV Then
+ For x = 1 To startItemCount
+ Class(i).StartItem(x) = Val(GetVar(filename, "CLASS" & i, "StartItem" & x))
+ Class(i).StartValue(x) = Val(GetVar(filename, "CLASS" & i, "StartValue" & x))
+ Next
+ End If
+
+ ' how many starting spells?
+ startSpellCount = Val(GetVar(filename, "CLASS" & i, "StartSpellCount"))
+ If startSpellCount > 0 Then ReDim Class(i).StartSpell(1 To startSpellCount)
+
+ ' loop for spells
+ Class(i).startSpellCount = startSpellCount
+ If startSpellCount >= 1 And startSpellCount <= MAX_INV Then
+ For x = 1 To startSpellCount
+ Class(i).StartSpell(x) = Val(GetVar(filename, "CLASS" & i, "StartSpell" & x))
+ Next
+ End If
+ Next
+
+End Sub
+
+Sub SaveClasses()
+ Dim filename As String
+ Dim i As Long
+ Dim x As Long
+
+ filename = App.Path & "\data\classes.ini"
+
+ For i = 1 To Max_Classes
+ Call PutVar(filename, "CLASS" & i, "Name", Trim$(Class(i).Name))
+ Call PutVar(filename, "CLASS" & i, "Maleprite", "1")
+ Call PutVar(filename, "CLASS" & i, "Femaleprite", "1")
+ Call PutVar(filename, "CLASS" & i, "Strength", STR(Class(i).Stat(Stats.Strength)))
+ Call PutVar(filename, "CLASS" & i, "Endurance", STR(Class(i).Stat(Stats.Endurance)))
+ Call PutVar(filename, "CLASS" & i, "Intelligence", STR(Class(i).Stat(Stats.Intelligence)))
+ Call PutVar(filename, "CLASS" & i, "Agility", STR(Class(i).Stat(Stats.Agility)))
+ Call PutVar(filename, "CLASS" & i, "Willpower", STR(Class(i).Stat(Stats.Willpower)))
+ ' loop for items & values
+ For x = 1 To UBound(Class(i).StartItem)
+ Call PutVar(filename, "CLASS" & i, "StartItem" & x, STR(Class(i).StartItem(x)))
+ Call PutVar(filename, "CLASS" & i, "StartValue" & x, STR(Class(i).StartValue(x)))
+ Next
+ ' loop for spells
+ For x = 1 To UBound(Class(i).StartSpell)
+ Call PutVar(filename, "CLASS" & i, "StartSpell" & x, STR(Class(i).StartSpell(x)))
+ Next
+ Next
+
+End Sub
+
+Function CheckClasses() As Boolean
+ Dim filename As String
+ filename = App.Path & "\data\classes.ini"
+
+ If Not FileExist(filename, True) Then
+ Call CreateClassesINI
+ CheckClasses = True
+ End If
+
+End Function
+
+Sub ClearClasses()
+ Dim i As Long
+
+ For i = 1 To Max_Classes
+ Call ZeroMemory(ByVal VarPtr(Class(i)), LenB(Class(i)))
+ Class(i).Name = vbNullString
+ Next
+
+End Sub
+
+' ***********
+' ** Items **
+' ***********
+Sub SaveItems()
+ Dim i As Long
+
+ For i = 1 To MAX_ITEMS
+ Call SaveItem(i)
+ Next
+
+End Sub
+
+Sub SaveItem(ByVal itemNum As Long)
+ Dim filename As String
+ Dim f As Long
+ filename = App.Path & "\data\items\item" & itemNum & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Put #f, , Item(itemNum)
+ Close #f
+End Sub
+
+Sub LoadItems()
+ Dim filename As String
+ Dim i As Long
+ Dim f As Long
+ Call CheckItems
+
+ For i = 1 To MAX_ITEMS
+ filename = App.Path & "\data\Items\Item" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Get #f, , Item(i)
+ Close #f
+ Next
+
+End Sub
+
+Sub CheckItems()
+ Dim i As Long
+
+ For i = 1 To MAX_ITEMS
+
+ If Not FileExist("\Data\Items\Item" & i & ".dat") Then
+ Call SaveItem(i)
+ End If
+
+ Next
+
+End Sub
+
+Sub ClearItem(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Item(index)), LenB(Item(index)))
+ Item(index).Name = vbNullString
+ Item(index).Desc = vbNullString
+ Item(index).Sound = "None."
+End Sub
+
+Sub ClearItems()
+ Dim i As Long
+
+ For i = 1 To MAX_ITEMS
+ Call ClearItem(i)
+ Next
+
+End Sub
+
+' ***********
+' ** Shops **
+' ***********
+Sub SaveShops()
+ Dim i As Long
+
+ For i = 1 To MAX_SHOPS
+ Call SaveShop(i)
+ Next
+
+End Sub
+
+Sub SaveShop(ByVal shopNum As Long)
+ Dim filename As String
+ Dim f As Long
+ filename = App.Path & "\data\shops\shop" & shopNum & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Put #f, , Shop(shopNum)
+ Close #f
+End Sub
+
+Sub LoadShops()
+ Dim filename As String
+ Dim i As Long
+ Dim f As Long
+ Call CheckShops
+
+ For i = 1 To MAX_SHOPS
+ filename = App.Path & "\data\shops\shop" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Get #f, , Shop(i)
+ Close #f
+ Next
+
+End Sub
+
+Sub CheckShops()
+ Dim i As Long
+
+ For i = 1 To MAX_SHOPS
+
+ If Not FileExist("\Data\shops\shop" & i & ".dat") Then
+ Call SaveShop(i)
+ End If
+
+ Next
+
+End Sub
+
+Sub ClearShop(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Shop(index)), LenB(Shop(index)))
+ Shop(index).Name = vbNullString
+End Sub
+
+Sub ClearShops()
+ Dim i As Long
+
+ For i = 1 To MAX_SHOPS
+ Call ClearShop(i)
+ Next
+
+End Sub
+
+' ************
+' ** Spells **
+' ************
+Sub SaveSpell(ByVal spellNum As Long)
+ Dim filename As String
+ Dim f As Long
+ filename = App.Path & "\data\spells\spells" & spellNum & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Put #f, , Spell(spellNum)
+ Close #f
+End Sub
+
+Sub SaveSpells()
+ Dim i As Long
+ Call SetStatus("Saving spells... ")
+
+ For i = 1 To MAX_SPELLS
+ Call SaveSpell(i)
+ Next
+
+End Sub
+
+Sub LoadSpells()
+ Dim filename As String
+ Dim i As Long
+ Dim f As Long
+ Call CheckSpells
+
+ For i = 1 To MAX_SPELLS
+ filename = App.Path & "\data\spells\spells" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Get #f, , Spell(i)
+ Close #f
+ Next
+
+End Sub
+
+Sub CheckSpells()
+ Dim i As Long
+
+ For i = 1 To MAX_SPELLS
+
+ If Not FileExist("\Data\spells\spells" & i & ".dat") Then
+ Call SaveSpell(i)
+ End If
+
+ Next
+
+End Sub
+
+Sub ClearSpell(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Spell(index)), LenB(Spell(index)))
+ Spell(index).Name = vbNullString
+ Spell(index).LevelReq = 1 'Needs to be 1 for the spell editor
+ Spell(index).Desc = vbNullString
+ Spell(index).Sound = "None."
+End Sub
+
+Sub ClearSpells()
+ Dim i As Long
+
+ For i = 1 To MAX_SPELLS
+ Call ClearSpell(i)
+ Next
+
+End Sub
+
+' **********
+' ** NPCs **
+' **********
+Sub SaveNpcs()
+ Dim i As Long
+
+ For i = 1 To MAX_NPCS
+ Call SaveNpc(i)
+ Next
+
+End Sub
+
+Sub SaveNpc(ByVal npcNum As Long)
+ Dim filename As String
+ Dim f As Long
+ filename = App.Path & "\data\npcs\npc" & npcNum & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Put #f, , Npc(npcNum)
+ Close #f
+End Sub
+
+Sub LoadNpcs()
+ Dim filename As String
+ Dim i As Long
+ Dim f As Long
+ Call CheckNpcs
+
+ For i = 1 To MAX_NPCS
+ filename = App.Path & "\data\npcs\npc" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Get #f, , Npc(i)
+ Close #f
+ Next
+
+End Sub
+
+Sub CheckNpcs()
+ Dim i As Long
+
+ For i = 1 To MAX_NPCS
+
+ If Not FileExist("\Data\npcs\npc" & i & ".dat") Then
+ Call SaveNpc(i)
+ End If
+
+ Next
+
+End Sub
+
+Sub ClearNpc(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Npc(index)), LenB(Npc(index)))
+ Npc(index).Name = vbNullString
+ Npc(index).AttackSay = vbNullString
+ Npc(index).Sound = "None."
+End Sub
+
+Sub ClearNpcs()
+ Dim i As Long
+
+ For i = 1 To MAX_NPCS
+ Call ClearNpc(i)
+ Next
+
+End Sub
+
+' **********
+' ** Resources **
+' **********
+Sub SaveResources()
+ Dim i As Long
+
+ For i = 1 To MAX_RESOURCES
+ Call SaveResource(i)
+ Next
+
+End Sub
+
+Sub SaveResource(ByVal ResourceNum As Long)
+ Dim filename As String
+ Dim f As Long
+ filename = App.Path & "\data\resources\resource" & ResourceNum & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Put #f, , Resource(ResourceNum)
+ Close #f
+End Sub
+
+Sub LoadResources()
+ Dim filename As String
+ Dim i As Long
+ Dim f As Long
+ Dim sLen As Long
+
+ Call CheckResources
+
+ For i = 1 To MAX_RESOURCES
+ filename = App.Path & "\data\resources\resource" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Get #f, , Resource(i)
+ Close #f
+ Next
+
+End Sub
+
+Sub CheckResources()
+ Dim i As Long
+
+ For i = 1 To MAX_RESOURCES
+ If Not FileExist("\Data\Resources\Resource" & i & ".dat") Then
+ Call SaveResource(i)
+ End If
+ Next
+
+End Sub
+
+Sub ClearResource(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Resource(index)), LenB(Resource(index)))
+ Resource(index).Name = vbNullString
+ Resource(index).SuccessMessage = vbNullString
+ Resource(index).EmptyMessage = vbNullString
+ Resource(index).Sound = "None."
+End Sub
+
+Sub ClearResources()
+ Dim i As Long
+
+ For i = 1 To MAX_RESOURCES
+ Call ClearResource(i)
+ Next
+End Sub
+
+' **********
+' ** animations **
+' **********
+Sub SaveAnimations()
+ Dim i As Long
+
+ For i = 1 To MAX_ANIMATIONS
+ Call SaveAnimation(i)
+ Next
+
+End Sub
+
+Sub SaveAnimation(ByVal AnimationNum As Long)
+ Dim filename As String
+ Dim f As Long
+ filename = App.Path & "\data\animations\animation" & AnimationNum & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Put #f, , Animation(AnimationNum)
+ Close #f
+End Sub
+
+Sub LoadAnimations()
+ Dim filename As String
+ Dim i As Long
+ Dim f As Long
+ Dim sLen As Long
+
+ Call CheckAnimations
+
+ For i = 1 To MAX_ANIMATIONS
+ filename = App.Path & "\data\animations\animation" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ Get #f, , Animation(i)
+ Close #f
+ Next
+
+End Sub
+
+Sub CheckAnimations()
+ Dim i As Long
+
+ For i = 1 To MAX_ANIMATIONS
+
+ If Not FileExist("\Data\animations\animation" & i & ".dat") Then
+ Call SaveAnimation(i)
+ End If
+
+ Next
+
+End Sub
+
+Sub ClearAnimation(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Animation(index)), LenB(Animation(index)))
+ Animation(index).Name = vbNullString
+ Animation(index).Sound = "None."
+End Sub
+
+Sub ClearAnimations()
+ Dim i As Long
+
+ For i = 1 To MAX_ANIMATIONS
+ Call ClearAnimation(i)
+ Next
+End Sub
+
+' **********
+' ** Maps **
+' **********
+Sub SaveMap(ByVal mapnum As Long)
+ Dim filename As String, f As Long, x As Long, y As Long, i As Long
+
+ ' save map data
+ filename = App.Path & "\data\maps\map" & mapnum & ".ini"
+
+ ' if it exists then kill the ini
+ If FileExist(filename, True) Then Kill filename
+
+ ' General
+ With Map(mapnum).MapData
+ PutVar filename, "General", "Name", .Name
+ PutVar filename, "General", "Music", .Music
+ PutVar filename, "General", "Moral", Val(.Moral)
+ PutVar filename, "General", "Up", Val(.Up)
+ PutVar filename, "General", "Down", Val(.Down)
+ PutVar filename, "General", "Left", Val(.left)
+ PutVar filename, "General", "Right", Val(.Right)
+ PutVar filename, "General", "BootMap", Val(.BootMap)
+ PutVar filename, "General", "BootX", Val(.BootX)
+ PutVar filename, "General", "BootY", Val(.BootY)
+ PutVar filename, "General", "MaxX", Val(.MaxX)
+ PutVar filename, "General", "MaxY", Val(.MaxY)
+ PutVar filename, "General", "BossNpc", Val(.BossNpc)
+ For i = 1 To MAX_MAP_NPCS
+ PutVar filename, "General", "Npc" & i, Val(.Npc(i))
+ Next
+ End With
+
+ ' Events
+ PutVar filename, "Events", "EventCount", Val(Map(mapnum).TileData.EventCount)
+
+ If Map(mapnum).TileData.EventCount > 0 Then
+ For i = 1 To Map(mapnum).TileData.EventCount
+ With Map(mapnum).TileData.Events(i)
+ PutVar filename, "Event" & i, "Name", .Name
+ PutVar filename, "Event" & i, "x", Val(.x)
+ PutVar filename, "Event" & i, "y", Val(.y)
+ PutVar filename, "Event" & i, "PageCount", Val(.PageCount)
+ End With
+ If Map(mapnum).TileData.Events(i).PageCount > 0 Then
+ For x = 1 To Map(mapnum).TileData.Events(i).PageCount
+ With Map(mapnum).TileData.Events(i).EventPage(x)
+ PutVar filename, "Event" & i & "Page" & x, "chkPlayerVar", Val(.chkPlayerVar)
+ PutVar filename, "Event" & i & "Page" & x, "chkSelfSwitch", Val(.chkSelfSwitch)
+ PutVar filename, "Event" & i & "Page" & x, "chkHasItem", Val(.chkHasItem)
+ PutVar filename, "Event" & i & "Page" & x, "PlayerVarNum", Val(.PlayerVarNum)
+ PutVar filename, "Event" & i & "Page" & x, "SelfSwitchNum", Val(.SelfSwitchNum)
+ PutVar filename, "Event" & i & "Page" & x, "HasItemNum", Val(.HasItemNum)
+ PutVar filename, "Event" & i & "Page" & x, "PlayerVariable", Val(.PlayerVariable)
+ PutVar filename, "Event" & i & "Page" & x, "GraphicType", Val(.GraphicType)
+ PutVar filename, "Event" & i & "Page" & x, "Graphic", Val(.Graphic)
+ PutVar filename, "Event" & i & "Page" & x, "GraphicX", Val(.GraphicX)
+ PutVar filename, "Event" & i & "Page" & x, "GraphicY", Val(.GraphicY)
+ PutVar filename, "Event" & i & "Page" & x, "MoveType", Val(.MoveType)
+ PutVar filename, "Event" & i & "Page" & x, "MoveSpeed", Val(.MoveSpeed)
+ PutVar filename, "Event" & i & "Page" & x, "MoveFreq", Val(.MoveFreq)
+ PutVar filename, "Event" & i & "Page" & x, "WalkAnim", Val(.WalkAnim)
+ PutVar filename, "Event" & i & "Page" & x, "StepAnim", Val(.StepAnim)
+ PutVar filename, "Event" & i & "Page" & x, "DirFix", Val(.DirFix)
+ PutVar filename, "Event" & i & "Page" & x, "WalkThrough", Val(.WalkThrough)
+ PutVar filename, "Event" & i & "Page" & x, "Priority", Val(.Priority)
+ PutVar filename, "Event" & i & "Page" & x, "Trigger", Val(.Trigger)
+ PutVar filename, "Event" & i & "Page" & x, "CommandCount", Val(.CommandCount)
+ End With
+ If Map(mapnum).TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ For y = 1 To Map(mapnum).TileData.Events(i).EventPage(x).CommandCount
+ With Map(mapnum).TileData.Events(i).EventPage(x).Commands(y)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Type", Val(.Type)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Text", .Text
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Colour", Val(.colour)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Channel", Val(.Channel)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "TargetType", Val(.targetType)
+ PutVar filename, "Event" & i & "Page" & x & "Command" & y, "Target", Val(.target)
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ ' dump tile data
+ filename = App.Path & "\data\maps\map" & mapnum & ".dat"
+ f = FreeFile
+
+ With Map(mapnum)
+ Open filename For Binary As #f
+ For x = 0 To .MapData.MaxX
+ For y = 0 To .MapData.MaxY
+ Put #f, , .TileData.Tile(x, y).Type
+ Put #f, , .TileData.Tile(x, y).Data1
+ Put #f, , .TileData.Tile(x, y).Data2
+ Put #f, , .TileData.Tile(x, y).Data3
+ Put #f, , .TileData.Tile(x, y).Data4
+ Put #f, , .TileData.Tile(x, y).Data5
+ Put #f, , .TileData.Tile(x, y).Autotile
+ Put #f, , .TileData.Tile(x, y).DirBlock
+ For i = 1 To MapLayer.Layer_Count - 1
+ Put #f, , .TileData.Tile(x, y).Layer(i).Tileset
+ Put #f, , .TileData.Tile(x, y).Layer(i).x
+ Put #f, , .TileData.Tile(x, y).Layer(i).y
+ Next
+ Next
+ Next
+ Close #f
+ End With
+
+ DoEvents
+End Sub
+
+Sub SaveMaps()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+ Call SaveMap(i)
+ Next
+
+End Sub
+
+Sub LoadMaps()
+ Dim filename As String, mapnum As Long
+
+ Call CheckMaps
+
+ For mapnum = 1 To MAX_MAPS
+ LoadMap mapnum
+ ClearTempTile mapnum
+ CacheResources mapnum
+ DoEvents
+ Next
+End Sub
+
+Sub GetMapCRC32(mapnum As Long)
+Dim Data() As Byte, filename As String, f As Long
+ ' map data
+ filename = App.Path & "\data\maps\map" & mapnum & ".ini"
+ If FileExist(filename, True) Then
+ f = FreeFile
+ Open filename For Binary As #f
+ Data = Space$(LOF(f))
+ Get #f, , Data
+ Close #f
+ MapCRC32(mapnum).MapDataCRC = CRC32(Data)
+ Else
+ MapCRC32(mapnum).MapDataCRC = 0
+ End If
+ ' clear
+ Erase Data
+ ' tile data
+ filename = App.Path & "\data\maps\map" & mapnum & ".dat"
+ If FileExist(filename, True) Then
+ f = FreeFile
+ Open filename For Binary As #f
+ Data = Space$(LOF(f))
+ Get #f, , Data
+ Close #f
+ MapCRC32(mapnum).MapTileCRC = CRC32(Data)
+ Else
+ MapCRC32(mapnum).MapTileCRC = 0
+ End If
+End Sub
+
+Sub LoadMap(mapnum As Long)
+ Dim filename As String, i As Long, f As Long, x As Long, y As Long
+
+ ' load map data
+ filename = App.Path & "\data\maps\map" & mapnum & ".ini"
+
+ ' General
+ With Map(mapnum).MapData
+ .Name = GetVar(filename, "General", "Name")
+ .Music = GetVar(filename, "General", "Music")
+ .Moral = Val(GetVar(filename, "General", "Moral"))
+ .Up = Val(GetVar(filename, "General", "Up"))
+ .Down = Val(GetVar(filename, "General", "Down"))
+ .left = Val(GetVar(filename, "General", "Left"))
+ .Right = Val(GetVar(filename, "General", "Right"))
+ .BootMap = Val(GetVar(filename, "General", "BootMap"))
+ .BootX = Val(GetVar(filename, "General", "BootX"))
+ .BootY = Val(GetVar(filename, "General", "BootY"))
+ .MaxX = Val(GetVar(filename, "General", "MaxX"))
+ .MaxY = Val(GetVar(filename, "General", "MaxY"))
+ .BossNpc = Val(GetVar(filename, "General", "BossNpc"))
+ For i = 1 To MAX_MAP_NPCS
+ .Npc(i) = Val(GetVar(filename, "General", "Npc" & i))
+ Next
+ End With
+
+ ' Events
+ Map(mapnum).TileData.EventCount = Val(GetVar(filename, "Events", "EventCount"))
+
+ If Map(mapnum).TileData.EventCount > 0 Then
+ ReDim Preserve Map(mapnum).TileData.Events(1 To Map(mapnum).TileData.EventCount)
+ For i = 1 To Map(mapnum).TileData.EventCount
+ With Map(mapnum).TileData.Events(i)
+ .Name = GetVar(filename, "Event" & i, "Name")
+ .x = Val(GetVar(filename, "Event" & i, "x"))
+ .y = Val(GetVar(filename, "Event" & i, "y"))
+ .PageCount = Val(GetVar(filename, "Event" & i, "PageCount"))
+ End With
+ If Map(mapnum).TileData.Events(i).PageCount > 0 Then
+ ReDim Preserve Map(mapnum).TileData.Events(i).EventPage(1 To Map(mapnum).TileData.Events(i).PageCount)
+ For x = 1 To Map(mapnum).TileData.Events(i).PageCount
+ With Map(mapnum).TileData.Events(i).EventPage(x)
+ .chkPlayerVar = Val(GetVar(filename, "Event" & i & "Page" & x, "chkPlayerVar"))
+ .chkSelfSwitch = Val(GetVar(filename, "Event" & i & "Page" & x, "chkSelfSwitch"))
+ .chkHasItem = Val(GetVar(filename, "Event" & i & "Page" & x, "chkHasItem"))
+ .PlayerVarNum = Val(GetVar(filename, "Event" & i & "Page" & x, "PlayerVarNum"))
+ .SelfSwitchNum = Val(GetVar(filename, "Event" & i & "Page" & x, "SelfSwitchNum"))
+ .HasItemNum = Val(GetVar(filename, "Event" & i & "Page" & x, "HasItemNum"))
+ .PlayerVariable = Val(GetVar(filename, "Event" & i & "Page" & x, "PlayerVariable"))
+ .GraphicType = Val(GetVar(filename, "Event" & i & "Page" & x, "GraphicType"))
+ .Graphic = Val(GetVar(filename, "Event" & i & "Page" & x, "Graphic"))
+ .GraphicX = Val(GetVar(filename, "Event" & i & "Page" & x, "GraphicX"))
+ .GraphicY = Val(GetVar(filename, "Event" & i & "Page" & x, "GraphicY"))
+ .MoveType = Val(GetVar(filename, "Event" & i & "Page" & x, "MoveType"))
+ .MoveSpeed = Val(GetVar(filename, "Event" & i & "Page" & x, "MoveSpeed"))
+ .MoveFreq = Val(GetVar(filename, "Event" & i & "Page" & x, "MoveFreq"))
+ .WalkAnim = Val(GetVar(filename, "Event" & i & "Page" & x, "WalkAnim"))
+ .StepAnim = Val(GetVar(filename, "Event" & i & "Page" & x, "StepAnim"))
+ .DirFix = Val(GetVar(filename, "Event" & i & "Page" & x, "DirFix"))
+ .WalkThrough = Val(GetVar(filename, "Event" & i & "Page" & x, "WalkThrough"))
+ .Priority = Val(GetVar(filename, "Event" & i & "Page" & x, "Priority"))
+ .Trigger = Val(GetVar(filename, "Event" & i & "Page" & x, "Trigger"))
+ .CommandCount = Val(GetVar(filename, "Event" & i & "Page" & x, "CommandCount"))
+ End With
+ If Map(mapnum).TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ ReDim Preserve Map(mapnum).TileData.Events(i).EventPage(x).Commands(1 To Map(mapnum).TileData.Events(i).EventPage(x).CommandCount)
+ For y = 1 To Map(mapnum).TileData.Events(i).EventPage(x).CommandCount
+ With Map(mapnum).TileData.Events(i).EventPage(x).Commands(y)
+ .Type = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Type"))
+ .Text = GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Text")
+ .colour = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Colour"))
+ .Channel = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Channel"))
+ .targetType = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "TargetType"))
+ .target = Val(GetVar(filename, "Event" & i & "Page" & x & "Command" & y, "Target"))
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ ' dump tile data
+ filename = App.Path & "\data\maps\map" & mapnum & ".dat"
+ f = FreeFile
+
+ ' redim the map
+ ReDim Map(mapnum).TileData.Tile(0 To Map(mapnum).MapData.MaxX, 0 To Map(mapnum).MapData.MaxY) As TileRec
+
+ With Map(mapnum)
+ Open filename For Binary As #f
+ For x = 0 To .MapData.MaxX
+ For y = 0 To .MapData.MaxY
+ Get #f, , .TileData.Tile(x, y).Type
+ Get #f, , .TileData.Tile(x, y).Data1
+ Get #f, , .TileData.Tile(x, y).Data2
+ Get #f, , .TileData.Tile(x, y).Data3
+ Get #f, , .TileData.Tile(x, y).Data4
+ Get #f, , .TileData.Tile(x, y).Data5
+ Get #f, , .TileData.Tile(x, y).Autotile
+ Get #f, , .TileData.Tile(x, y).DirBlock
+ For i = 1 To MapLayer.Layer_Count - 1
+ Get #f, , .TileData.Tile(x, y).Layer(i).Tileset
+ Get #f, , .TileData.Tile(x, y).Layer(i).x
+ Get #f, , .TileData.Tile(x, y).Layer(i).y
+ Next
+ Next
+ Next
+ Close #f
+ End With
+End Sub
+
+Sub CheckMaps()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+
+ If Not FileExist("\Data\maps\map" & i & ".dat") Or Not FileExist("\Data\maps\map" & i & ".ini") Then
+ Call SaveMap(i)
+ End If
+
+ Next
+
+End Sub
+
+Sub ClearMapItem(ByVal index As Long, ByVal mapnum As Long)
+ Call ZeroMemory(ByVal VarPtr(MapItem(mapnum, index)), LenB(MapItem(mapnum, index)))
+ MapItem(mapnum, index).playerName = vbNullString
+End Sub
+
+Sub ClearMapItems()
+ Dim x As Long
+ Dim y As Long
+
+ For y = 1 To MAX_MAPS
+ For x = 1 To MAX_MAP_ITEMS
+ Call ClearMapItem(x, y)
+ Next
+ Next
+
+End Sub
+
+Sub ClearMapNpc(ByVal index As Long, ByVal mapnum As Long)
+ 'ReDim MapNpc(mapnum).Npc(1 To MAX_MAP_NPCS)
+ Call ZeroMemory(ByVal VarPtr(MapNpc(mapnum).Npc(index)), LenB(MapNpc(mapnum).Npc(index)))
+End Sub
+
+Sub ClearMapNpcs()
+ Dim x As Long
+ Dim y As Long
+
+ For y = 1 To MAX_MAPS
+ For x = 1 To MAX_MAP_NPCS
+ Call ClearMapNpc(x, y)
+ Next
+ Next
+
+End Sub
+
+Sub ClearMap(ByVal mapnum As Long)
+ Call ZeroMemory(ByVal VarPtr(Map(mapnum)), LenB(Map(mapnum)))
+ Map(mapnum).MapData.Name = vbNullString
+ Map(mapnum).MapData.MaxX = MAX_MAPX
+ Map(mapnum).MapData.MaxY = MAX_MAPY
+ ReDim Map(mapnum).TileData.Tile(0 To Map(mapnum).MapData.MaxX, 0 To Map(mapnum).MapData.MaxY)
+ ' Reset the values for if a player is on the map or not
+ PlayersOnMap(mapnum) = NO
+ ' Reset the map cache array for this map.
+ MapCache(mapnum).Data = vbNullString
+End Sub
+
+Sub ClearMaps()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+ Call ClearMap(i)
+ Next
+
+End Sub
+
+Function GetClassName(ByVal ClassNum As Long) As String
+ GetClassName = Trim$(Class(ClassNum).Name)
+End Function
+
+Function GetClassMaxVital(ByVal ClassNum As Long, ByVal Vital As Vitals) As Long
+ Select Case Vital
+ Case HP
+ With Class(ClassNum)
+ GetClassMaxVital = 100 + (.Stat(Endurance) * 5) + 2
+ End With
+ Case MP
+ With Class(ClassNum)
+ GetClassMaxVital = 30 + (.Stat(Intelligence) * 10) + 2
+ End With
+ End Select
+End Function
+
+Function GetClassStat(ByVal ClassNum As Long, ByVal Stat As Stats) As Long
+ GetClassStat = Class(ClassNum).Stat(Stat)
+End Function
+
+Sub ClearParty(ByVal partynum As Long)
+ Call ZeroMemory(ByVal VarPtr(Party(partynum)), LenB(Party(partynum)))
+End Sub
+
+' ***********
+' ** Convs **
+' ***********
+Sub SaveConvs()
+Dim i As Long
+
+ For i = 1 To MAX_CONVS
+ Call SaveConv(i)
+ Next
+End Sub
+
+Sub SaveConv(ByVal convNum As Long)
+Dim filename As String
+Dim i As Long, x As Long, f As Long
+
+ filename = App.Path & "\data\convs\conv" & convNum & ".dat"
+ f = FreeFile
+
+ Open filename For Binary As #f
+ With Conv(convNum)
+ Put #f, , .Name
+ Put #f, , .chatCount
+ For i = 1 To .chatCount
+ Put #f, , CLng(Len(.Conv(i).Conv))
+ Put #f, , .Conv(i).Conv
+ For x = 1 To 4
+ Put #f, , CLng(Len(.Conv(i).rText(x)))
+ Put #f, , .Conv(i).rText(x)
+ Put #f, , .Conv(i).rTarget(x)
+ Next
+ Put #f, , .Conv(i).Event
+ Put #f, , .Conv(i).Data1
+ Put #f, , .Conv(i).Data2
+ Put #f, , .Conv(i).Data3
+ Next
+ End With
+ Close #f
+End Sub
+
+Sub LoadConvs()
+Dim filename As String
+Dim i As Long, n As Long, x As Long, f As Long
+Dim sLen As Long
+
+ Call CheckConvs
+
+ For i = 1 To MAX_CONVS
+ filename = App.Path & "\data\convs\conv" & i & ".dat"
+ f = FreeFile
+ Open filename For Binary As #f
+ With Conv(i)
+ Get #f, , .Name
+ Get #f, , .chatCount
+ If .chatCount > 0 Then ReDim .Conv(1 To .chatCount)
+ For n = 1 To .chatCount
+ Get #f, , sLen
+ .Conv(n).Conv = Space$(sLen)
+ Get #f, , .Conv(n).Conv
+ For x = 1 To 4
+ Get #f, , sLen
+ .Conv(n).rText(x) = Space$(sLen)
+ Get #f, , .Conv(n).rText(x)
+ Get #f, , .Conv(n).rTarget(x)
+ Next
+ Get #f, , .Conv(n).Event
+ Get #f, , .Conv(n).Data1
+ Get #f, , .Conv(n).Data2
+ Get #f, , .Conv(n).Data3
+ Next
+ End With
+ Close #f
+ Next
+End Sub
+
+Sub CheckConvs()
+Dim i As Long
+
+ For i = 1 To MAX_CONVS
+ If Not FileExist("\data\convs\conv" & i & ".dat") Then
+ Call SaveConv(i)
+ End If
+ Next
+End Sub
+
+Sub ClearConv(ByVal index As Long)
+ Call ZeroMemory(ByVal VarPtr(Conv(index)), LenB(Conv(index)))
+ Conv(index).Name = vbNullString
+ ReDim Conv(index).Conv(1)
+End Sub
+
+Sub ClearConvs()
+Dim i As Long
+
+ For i = 1 To MAX_CONVS
+ Call ClearConv(i)
+ Next
+
+End Sub
+
+Function OldAccount_Exist(ByVal username As String) As Boolean
+Dim filename As String
+
+ filename = App.Path & "\data\accounts\old\" & SanitiseString(username) & ".ini"
+ If FileExist(filename, True) Then
+ If LenB(Trim$(GetVar(filename, "ACCOUNT", "Name"))) > 0 Then
+ OldAccount_Exist = True
+ End If
+ End If
+End Function
+
+Public Sub MergeAccount(ByVal index As Long, ByVal charNum As Long, ByVal oldAccount As String)
+Dim tempChar As PlayerRec, charHeader As String, filename As String, i As Long
+
+ ' set the filename
+ filename = App.Path & "\data\accounts\old\" & SanitiseString(oldAccount) & ".ini"
+ charHeader = "ACCOUNT"
+
+ ' load the old account shit
+ With tempChar
+ .Name = Trim$(GetVar(filename, charHeader, "Name"))
+ .Sex = Val(GetVar(filename, charHeader, "Sex"))
+ .Class = Val(GetVar(filename, charHeader, "Class"))
+ .Sprite = Val(GetVar(filename, charHeader, "Sprite"))
+ .Level = Val(GetVar(filename, charHeader, "Level"))
+ .exp = Val(GetVar(filename, charHeader, "Exp"))
+ .Access = Val(GetVar(filename, charHeader, "Access"))
+ .PK = Val(GetVar(filename, charHeader, "PK"))
+
+ ' Vitals
+ For i = 1 To Vitals.Vital_Count - 1
+ .Vital(i) = Val(GetVar(filename, charHeader, "Vital" & i))
+ Next
+
+ ' Stats
+ For i = 1 To Stats.Stat_Count - 1
+ .Stat(i) = Val(GetVar(filename, charHeader, "Stat" & i))
+ Next
+ .POINTS = Val(GetVar(filename, charHeader, "Points"))
+
+ ' Equipment
+ For i = 1 To Equipment.Equipment_Count - 1
+ .Equipment(i) = Val(GetVar(filename, charHeader, "Equipment" & i))
+ Next
+
+ ' Inventory
+ For i = 1 To MAX_INV
+ .Inv(i).Num = Val(GetVar(filename, charHeader, "InvNum" & i))
+ .Inv(i).Value = Val(GetVar(filename, charHeader, "InvValue" & i))
+ .Inv(i).Bound = Val(GetVar(filename, charHeader, "InvBound" & i))
+ Next
+
+ ' Spells
+ For i = 1 To MAX_PLAYER_SPELLS
+ .Spell(i).Spell = Val(GetVar(filename, charHeader, "Spell" & i))
+ .Spell(i).Uses = Val(GetVar(filename, charHeader, "SpellUses" & i))
+ Next
+
+ ' Hotbar
+ For i = 1 To MAX_HOTBAR
+ .Hotbar(i).Slot = Val(GetVar(filename, charHeader, "HotbarSlot" & i))
+ .Hotbar(i).sType = Val(GetVar(filename, charHeader, "HotbarType" & i))
+ Next
+
+ ' Position
+ .Map = Val(GetVar(filename, charHeader, "Map"))
+ .x = Val(GetVar(filename, charHeader, "X"))
+ .y = Val(GetVar(filename, charHeader, "Y"))
+ .dir = Val(GetVar(filename, charHeader, "Dir"))
+
+ ' Tutorial
+ .TutorialState = Val(GetVar(filename, charHeader, "TutorialState"))
+ End With
+
+ ' set the filename
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini"
+ charHeader = "CHAR" & charNum
+
+ ' save it in the new account's character slot
+ With tempChar
+ PutVar filename, charHeader, "Name", Trim$(.Name)
+ PutVar filename, charHeader, "Sex", Val(.Sex)
+ PutVar filename, charHeader, "Class", Val(.Class)
+ PutVar filename, charHeader, "Sprite", Val(.Sprite)
+ PutVar filename, charHeader, "Level", Val(.Level)
+ PutVar filename, charHeader, "exp", Val(.exp)
+ PutVar filename, charHeader, "Access", Val(.Access)
+ PutVar filename, charHeader, "PK", Val(.PK)
+
+ ' Vitals
+ For i = 1 To Vitals.Vital_Count - 1
+ PutVar filename, charHeader, "Vital" & i, Val(.Vital(i))
+ Next
+
+ ' Stats
+ For i = 1 To Stats.Stat_Count - 1
+ PutVar filename, charHeader, "Stat" & i, Val(.Stat(i))
+ Next
+ PutVar filename, charHeader, "Points", Val(.POINTS)
+
+ ' Equipment
+ For i = 1 To Equipment.Equipment_Count - 1
+ PutVar filename, charHeader, "Equipment" & i, Val(.Equipment(i))
+ Next
+
+ ' Inventory
+ For i = 1 To MAX_INV
+ PutVar filename, charHeader, "InvNum" & i, Val(.Inv(i).Num)
+ PutVar filename, charHeader, "InvValue" & i, Val(.Inv(i).Value)
+ PutVar filename, charHeader, "InvBound" & i, Val(.Inv(i).Bound)
+ Next
+
+ ' Spells
+ For i = 1 To MAX_PLAYER_SPELLS
+ PutVar filename, charHeader, "Spell" & i, Val(.Spell(i).Spell)
+ PutVar filename, charHeader, "SpellUses" & i, Val(.Spell(i).Uses)
+ Next
+
+ ' Hotbar
+ For i = 1 To MAX_HOTBAR
+ PutVar filename, charHeader, "HotbarSlot" & i, Val(.Hotbar(i).Slot)
+ PutVar filename, charHeader, "HotbarType" & i, Val(.Hotbar(i).sType)
+ Next
+
+ ' Position
+ PutVar filename, charHeader, "Map", Val(.Map)
+ PutVar filename, charHeader, "X", Val(.x)
+ PutVar filename, charHeader, "Y", Val(.y)
+ PutVar filename, charHeader, "Dir", Val(.dir)
+
+ ' Tutorial
+ PutVar filename, charHeader, "TutorialState", Val(.TutorialState)
+ End With
+
+ ' kill the old account - permanently
+ Kill App.Path & "\data\accounts\old\" & SanitiseString(oldAccount) & ".ini"
+
+ ' send to portal again
+ SendPlayerChars index
+
+ ' confirmation message
+ AlertMsg index, DIALOGUE_MSG_MERGE, MENU_CHARS, False
+End Sub
diff --git a/server/src/modEnumerations.bas b/server/src/modEnumerations.bas
new file mode 100644
index 0000000..3bd29cb
--- /dev/null
+++ b/server/src/modEnumerations.bas
@@ -0,0 +1,303 @@
+Attribute VB_Name = "modEnumerations"
+Option Explicit
+
+' The order of the packets must match with the client's packet enumeration
+
+' Packets sent by server to client
+Public Enum ServerPackets
+ SAlertMsg = 1
+ SLoginOk
+ SNewCharClasses
+ SClassesData
+ SInGame
+ SPlayerInv
+ SPlayerInvUpdate
+ SPlayerWornEq
+ SPlayerHp
+ SPlayerMp
+ SPlayerStats
+ SPlayerData
+ SPlayerMove
+ SNpcMove
+ SPlayerDir
+ SNpcDir
+ SPlayerXY
+ SPlayerXYMap
+ SAttack
+ SNpcAttack
+ SCheckForMap
+ SMapData
+ SMapItemData
+ SMapNpcData
+ SMapDone
+ SGlobalMsg
+ SAdminMsg
+ SPlayerMsg
+ SMapMsg
+ SSpawnItem
+ SItemEditor
+ SUpdateItem
+ SREditor
+ SSpawnNpc
+ SNpcDead
+ SNpcEditor
+ SUpdateNpc
+ SMapKey
+ SEditMap
+ SShopEditor
+ SUpdateShop
+ SSpellEditor
+ SUpdateSpell
+ SSpells
+ SLeft
+ SResourceCache
+ SResourceEditor
+ SUpdateResource
+ SSendPing
+ SDoorAnimation
+ SActionMsg
+ SPlayerEXP
+ SBlood
+ SAnimationEditor
+ SUpdateAnimation
+ SAnimation
+ SMapNpcVitals
+ SCooldown
+ SClearSpellBuffer
+ SSayMsg
+ SOpenShop
+ SResetShopAction
+ SStunned
+ SMapWornEq
+ SBank
+ STrade
+ SCloseTrade
+ STradeUpdate
+ STradeStatus
+ STarget
+ SHotbar
+ SHighIndex
+ SSound
+ STradeRequest
+ SPartyInvite
+ SPartyUpdate
+ SPartyVitals
+ SChatUpdate
+ SConvEditor
+ SUpdateConv
+ SStartTutorial
+ SChatBubble
+ SSetPlayerLoginToken
+ SPlayerChars
+ SCancelAnimation
+ SPlayerVariables
+ SEvent
+ ' Make sure SMSG_COUNT is below everything else
+ SMSG_COUNT
+End Enum
+
+' Packets sent by client to server
+Public Enum ClientPackets
+ CNewAccount = 1
+ CDelChar
+ CLogin
+ CAddChar
+ CUseChar
+ CSayMsg
+ CEmoteMsg
+ CBroadcastMsg
+ CPlayerMsg
+ CPlayerMove
+ CPlayerDir
+ CUseItem
+ CAttack
+ CUseStatPoint
+ CPlayerInfoRequest
+ CWarpMeTo
+ CWarpToMe
+ CWarpTo
+ CSetSprite
+ CGetStats
+ CRequestNewMap
+ CMapData
+ CNeedMap
+ CMapGetItem
+ CMapDropItem
+ CMapRespawn
+ CMapReport
+ CKickPlayer
+ CBanList
+ CBanDestroy
+ CBanPlayer
+ CRequestEditMap
+ CRequestEditItem
+ CSaveItem
+ CRequestEditNpc
+ CSaveNpc
+ CRequestEditShop
+ CSaveShop
+ CRequestEditSpell
+ CSaveSpell
+ CSetAccess
+ CWhosOnline
+ CSetMotd
+ CTarget
+ CSpells
+ CCast
+ CQuit
+ CSwapInvSlots
+ CRequestEditResource
+ CSaveResource
+ CCheckPing
+ CUnequip
+ CRequestPlayerData
+ CRequestItems
+ CRequestNPCS
+ CRequestResources
+ CSpawnItem
+ CRequestEditAnimation
+ CSaveAnimation
+ CRequestAnimations
+ CRequestSpells
+ CRequestShops
+ CRequestLevelUp
+ CForgetSpell
+ CCloseShop
+ CBuyItem
+ CSellItem
+ CChangeBankSlots
+ CDepositItem
+ CWithdrawItem
+ CCloseBank
+ CAdminWarp
+ CTradeRequest
+ CAcceptTrade
+ CDeclineTrade
+ CTradeItem
+ CUntradeItem
+ CHotbarChange
+ CHotbarUse
+ CSwapSpellSlots
+ CAcceptTradeRequest
+ CDeclineTradeRequest
+ CPartyRequest
+ CAcceptParty
+ CDeclineParty
+ CPartyLeave
+ CChatOption
+ CRequestEditConv
+ CSaveConv
+ CRequestConvs
+ CFinishTutorial
+ CAuthLogin
+ ' Make sure CMSG_COUNT is below everything else
+ CMSG_COUNT
+End Enum
+
+' Packets sent by authentication server to game server
+Public Enum AuthPackets
+ ASetPlayerLoginToken
+ ASetUsergroup
+ ' Make sure AMSG_COUNT is below everything else
+ AMSG_COUNT
+End Enum
+
+Public HandleDataSub(CMSG_COUNT) As Long
+Public Auth_HandleDataSub(AMSG_COUNT) As Long
+
+' Stats used by Players, Npcs and Classes
+Public Enum Stats
+ Strength = 1
+ Endurance
+ Intelligence
+ Agility
+ Willpower
+ ' Make sure Stat_Count is below everything else
+ Stat_Count
+End Enum
+
+' Vitals used by Players, Npcs and Classes
+Public Enum Vitals
+ HP = 1
+ MP
+ ' Make sure Vital_Count is below everything else
+ Vital_Count
+End Enum
+
+' Equipment used by Players
+Public Enum Equipment
+ Weapon = 1
+ Armor
+ Helmet
+ Shield
+ ' Make sure Equipment_Count is below everything else
+ Equipment_Count
+End Enum
+
+' Layers in a map
+Public Enum MapLayer
+ Ground = 1
+ Mask
+ Mask2
+ Fringe
+ Fringe2
+ ' Make sure Layer_Count is below everything else
+ Layer_Count
+End Enum
+
+' Sound entities
+Public Enum SoundEntity
+ seAnimation = 1
+ seItem
+ seNpc
+ seResource
+ seSpell
+ ' Make sure SoundEntity_Count is below everything else
+ SoundEntity_Count
+End Enum
+
+' Event Types
+Public Enum EventType
+ ' Message
+ evAddText = 1
+ evShowText
+ evShowChatBubble
+ evShowChoices
+ evInputNumber
+ ' Game Progression
+ evPlayerVar
+ evEventSwitch
+ ' Flow Control
+ evIfElse
+ evExitProcess
+ ' Player
+ evChangeGold
+ evChangeItems
+ evChangeHP
+ evChangeMP
+ evChangeEXP
+ evChangeLevel
+ evChangeSkills
+ evChangeClass
+ evChangeSprite
+ evChangeSex
+ ' Movement
+ evWarpPlayer
+ evScrollMap
+ ' Character
+ evShowAnimation
+ evShowEmoticon
+ ' Screen Controls
+ evFadeout
+ evFadein
+ evTintScreen
+ evFlashScreen
+ evShakeScreen
+ ' Music and Sounds
+ evPlayBGM
+ evFadeoutBGM
+ evPlayBGS
+ evFadeoutBGS
+ evPlaySound
+ evStopSound
+End Enum
diff --git a/server/src/modGameLogic.bas b/server/src/modGameLogic.bas
new file mode 100644
index 0000000..b77cebf
--- /dev/null
+++ b/server/src/modGameLogic.bas
@@ -0,0 +1,1208 @@
+Attribute VB_Name = "modGameLogic"
+Option Explicit
+
+Function FindOpenPlayerSlot() As Long
+ Dim i As Long
+ FindOpenPlayerSlot = 0
+
+ For i = 1 To MAX_PLAYERS
+
+ If Not IsConnected(i) Then
+ FindOpenPlayerSlot = i
+ Exit Function
+ End If
+
+ Next
+
+End Function
+
+Function FindOpenMapItemSlot(ByVal mapnum As Long) As Long
+ Dim i As Long
+ FindOpenMapItemSlot = 0
+
+ ' Check for subscript out of range
+ If mapnum <= 0 Or mapnum > MAX_MAPS Then
+ Exit Function
+ End If
+
+ For i = 1 To MAX_MAP_ITEMS
+
+ If MapItem(mapnum, i).Num = 0 Then
+ FindOpenMapItemSlot = i
+ Exit Function
+ End If
+
+ Next
+
+End Function
+
+Function TotalOnlinePlayers() As Long
+ Dim i As Long
+ TotalOnlinePlayers = 0
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ TotalOnlinePlayers = TotalOnlinePlayers + 1
+ End If
+
+ Next
+
+End Function
+
+Function FindPlayer(ByVal Name As String) As Long
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+
+ ' Make sure we dont try to check a name thats to small
+ If Len(GetPlayerName(i)) >= Len(Trim$(Name)) Then
+ If UCase$(Mid$(GetPlayerName(i), 1, Len(Trim$(Name)))) = UCase$(Trim$(Name)) Then
+ FindPlayer = i
+ Exit Function
+ End If
+ End If
+ End If
+
+ Next
+
+ FindPlayer = 0
+End Function
+
+Sub SpawnItem(ByVal itemNum As Long, ByVal ItemVal As Long, ByVal mapnum As Long, ByVal x As Long, ByVal y As Long, Optional ByVal playerName As String = vbNullString)
+ Dim i As Long
+
+ ' Check for subscript out of range
+ If itemNum < 1 Or itemNum > MAX_ITEMS Or mapnum <= 0 Or mapnum > MAX_MAPS Then
+ Exit Sub
+ End If
+
+ ' Find open map item slot
+ i = FindOpenMapItemSlot(mapnum)
+ Call SpawnItemSlot(i, itemNum, ItemVal, mapnum, x, y, playerName)
+End Sub
+
+Sub SpawnItemSlot(ByVal MapItemSlot As Long, ByVal itemNum As Long, ByVal ItemVal As Long, ByVal mapnum As Long, ByVal x As Long, ByVal y As Long, Optional ByVal playerName As String = vbNullString, Optional ByVal canDespawn As Boolean = True, Optional ByVal isSB As Boolean = False)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If MapItemSlot <= 0 Or MapItemSlot > MAX_MAP_ITEMS Or itemNum < 0 Or itemNum > MAX_ITEMS Or mapnum <= 0 Or mapnum > MAX_MAPS Then
+ Exit Sub
+ End If
+
+ i = MapItemSlot
+
+ If i <> 0 Then
+ If itemNum >= 0 And itemNum <= MAX_ITEMS Then
+ MapItem(mapnum, i).playerName = playerName
+ MapItem(mapnum, i).playerTimer = GetTickCount + ITEM_SPAWN_TIME
+ MapItem(mapnum, i).canDespawn = canDespawn
+ MapItem(mapnum, i).despawnTimer = GetTickCount + ITEM_DESPAWN_TIME
+ MapItem(mapnum, i).Num = itemNum
+ MapItem(mapnum, i).Value = ItemVal
+ MapItem(mapnum, i).x = x
+ MapItem(mapnum, i).y = y
+ MapItem(mapnum, i).Bound = isSB
+ ' send to map
+ SendSpawnItemToMap mapnum, i
+ End If
+ End If
+
+End Sub
+
+Sub SpawnAllMapsItems()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+ Call SpawnMapItems(i)
+ Next
+
+End Sub
+
+Sub SpawnMapItems(ByVal mapnum As Long)
+ Dim x As Long
+ Dim y As Long
+
+ ' Check for subscript out of range
+ If mapnum <= 0 Or mapnum > MAX_MAPS Then
+ Exit Sub
+ End If
+
+ ' Spawn what we have
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+
+ ' Check if the tile type is an item or a saved tile incase someone drops something
+ If (Map(mapnum).TileData.Tile(x, y).Type = TILE_TYPE_ITEM) Then
+
+ ' Check to see if its a currency and if they set the value to 0 set it to 1 automatically
+ If Item(Map(mapnum).TileData.Tile(x, y).Data1).Type = ITEM_TYPE_CURRENCY And Map(mapnum).TileData.Tile(x, y).Data2 <= 0 Then
+ Call SpawnItem(Map(mapnum).TileData.Tile(x, y).Data1, 1, mapnum, x, y)
+ Else
+ Call SpawnItem(Map(mapnum).TileData.Tile(x, y).Data1, Map(mapnum).TileData.Tile(x, y).Data2, mapnum, x, y)
+ End If
+ End If
+
+ Next
+ Next
+
+End Sub
+
+Function Random(ByVal Low As Long, ByVal High As Long) As Long
+ Random = ((High - Low + 1) * Rnd) + Low
+End Function
+
+Public Sub SpawnNpc(ByVal mapNpcNum As Long, ByVal mapnum As Long)
+ Dim Buffer As clsBuffer
+ Dim npcNum As Long
+ Dim i As Long
+ Dim x As Long
+ Dim y As Long
+ Dim Spawned As Boolean
+
+ ' Check for subscript out of range
+ If mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or mapnum <= 0 Or mapnum > MAX_MAPS Then Exit Sub
+ npcNum = Map(mapnum).MapData.Npc(mapNpcNum)
+
+ If npcNum > 0 Then
+
+ With MapNpc(mapnum).Npc(mapNpcNum)
+ .Num = npcNum
+ .target = 0
+ .targetType = 0 ' clear
+ .Vital(Vitals.HP) = GetNpcMaxVital(npcNum, Vitals.HP)
+ .Vital(Vitals.MP) = GetNpcMaxVital(npcNum, Vitals.MP)
+ .dir = Int(Rnd * 4)
+ .spellBuffer.Spell = 0
+ .spellBuffer.Timer = 0
+ .spellBuffer.target = 0
+ .spellBuffer.tType = 0
+
+ 'Check if theres a spawn tile for the specific npc
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+ If Map(mapnum).TileData.Tile(x, y).Type = TILE_TYPE_NPCSPAWN Then
+ If Map(mapnum).TileData.Tile(x, y).Data1 = mapNpcNum Then
+ .x = x
+ .y = y
+ .dir = Map(mapnum).TileData.Tile(x, y).Data2
+ Spawned = True
+ Exit For
+ End If
+ End If
+ Next y
+ Next x
+
+ If Not Spawned Then
+
+ ' Well try 100 times to randomly place the sprite
+ For i = 1 To 100
+ x = Random(0, Map(mapnum).MapData.MaxX)
+ y = Random(0, Map(mapnum).MapData.MaxY)
+
+ If x > Map(mapnum).MapData.MaxX Then x = Map(mapnum).MapData.MaxX
+ If y > Map(mapnum).MapData.MaxY Then y = Map(mapnum).MapData.MaxY
+
+ ' Check if the tile is walkable
+ If NpcTileIsOpen(mapnum, x, y) Then
+ .x = x
+ .y = y
+ Spawned = True
+ Exit For
+ End If
+
+ Next
+
+ End If
+
+ ' Didn't spawn, so now we'll just try to find a free tile
+ If Not Spawned Then
+
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+
+ If NpcTileIsOpen(mapnum, x, y) Then
+ .x = x
+ .y = y
+ Spawned = True
+ End If
+
+ Next
+ Next
+
+ End If
+
+ ' If we suceeded in spawning then send it to everyone
+ If Spawned Then
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSpawnNpc
+ Buffer.WriteLong mapNpcNum
+ Buffer.WriteLong .Num
+ Buffer.WriteLong .x
+ Buffer.WriteLong .y
+ Buffer.WriteLong .dir
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+ End If
+
+ SendMapNpcVitals mapnum, mapNpcNum
+ End With
+ End If
+End Sub
+
+Public Function NpcTileIsOpen(ByVal mapnum As Long, ByVal x As Long, ByVal y As Long) As Boolean
+ Dim LoopI As Long
+ NpcTileIsOpen = True
+
+ If PlayersOnMap(mapnum) Then
+
+ For LoopI = 1 To Player_HighIndex
+
+ If GetPlayerMap(LoopI) = mapnum Then
+ If GetPlayerX(LoopI) = x Then
+ If GetPlayerY(LoopI) = y Then
+ NpcTileIsOpen = False
+ Exit Function
+ End If
+ End If
+ End If
+
+ Next
+
+ End If
+
+ For LoopI = 1 To MAX_MAP_NPCS
+
+ If MapNpc(mapnum).Npc(LoopI).Num > 0 Then
+ If MapNpc(mapnum).Npc(LoopI).x = x Then
+ If MapNpc(mapnum).Npc(LoopI).y = y Then
+ NpcTileIsOpen = False
+ Exit Function
+ End If
+ End If
+ End If
+
+ Next
+
+ If Map(mapnum).TileData.Tile(x, y).Type <> TILE_TYPE_WALKABLE Then
+ If Map(mapnum).TileData.Tile(x, y).Type <> TILE_TYPE_NPCSPAWN Then
+ If Map(mapnum).TileData.Tile(x, y).Type <> TILE_TYPE_ITEM Then
+ NpcTileIsOpen = False
+ End If
+ End If
+ End If
+End Function
+
+Sub SpawnMapNpcs(ByVal mapnum As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_MAP_NPCS
+ Call SpawnNpc(i, mapnum)
+ Next
+
+End Sub
+
+Sub SpawnAllMapNpcs()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+ Call SpawnMapNpcs(i)
+ Next
+
+End Sub
+
+Function CanNpcMove(ByVal mapnum As Long, ByVal mapNpcNum As Long, ByVal dir As Byte) As Boolean
+ Dim i As Long
+ Dim n As Long
+ Dim x As Long
+ Dim y As Long
+
+ ' Check for subscript out of range
+ If mapnum <= 0 Or mapnum > MAX_MAPS Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or dir < DIR_UP Or dir > DIR_RIGHT Then
+ Exit Function
+ End If
+
+ x = MapNpc(mapnum).Npc(mapNpcNum).x
+ y = MapNpc(mapnum).Npc(mapNpcNum).y
+ CanNpcMove = True
+
+ Select Case dir
+ Case DIR_UP
+
+ ' Check to make sure not outside of boundries
+ If y > 0 Then
+ n = Map(mapnum).TileData.Tile(x, y - 1).Type
+
+ ' Check to make sure that the tile is walkable
+ If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
+ CanNpcMove = False
+ Exit Function
+ End If
+
+ ' Check to make sure that there is not a player in the way
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If (GetPlayerMap(i) = mapnum) And (GetPlayerX(i) = MapNpc(mapnum).Npc(mapNpcNum).x) And (GetPlayerY(i) = MapNpc(mapnum).Npc(mapNpcNum).y - 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ End If
+ Next
+
+ ' Check to make sure that there is not another npc in the way
+ For i = 1 To MAX_MAP_NPCS
+ If (i <> mapNpcNum) And (MapNpc(mapnum).Npc(i).Num > 0) And (MapNpc(mapnum).Npc(i).x = MapNpc(mapnum).Npc(mapNpcNum).x) And (MapNpc(mapnum).Npc(i).y = MapNpc(mapnum).Npc(mapNpcNum).y - 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Next
+
+ ' Directional blocking
+ If isDirBlocked(Map(mapnum).TileData.Tile(MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y).DirBlock, DIR_UP + 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Else
+ CanNpcMove = False
+ End If
+
+ Case DIR_DOWN
+
+ ' Check to make sure not outside of boundries
+ If y < Map(mapnum).MapData.MaxY Then
+ n = Map(mapnum).TileData.Tile(x, y + 1).Type
+
+ ' Check to make sure that the tile is walkable
+ If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
+ CanNpcMove = False
+ Exit Function
+ End If
+
+ ' Check to make sure that there is not a player in the way
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If (GetPlayerMap(i) = mapnum) And (GetPlayerX(i) = MapNpc(mapnum).Npc(mapNpcNum).x) And (GetPlayerY(i) = MapNpc(mapnum).Npc(mapNpcNum).y + 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ End If
+ Next
+
+ ' Check to make sure that there is not another npc in the way
+ For i = 1 To MAX_MAP_NPCS
+ If (i <> mapNpcNum) And (MapNpc(mapnum).Npc(i).Num > 0) And (MapNpc(mapnum).Npc(i).x = MapNpc(mapnum).Npc(mapNpcNum).x) And (MapNpc(mapnum).Npc(i).y = MapNpc(mapnum).Npc(mapNpcNum).y + 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Next
+
+ ' Directional blocking
+ If isDirBlocked(Map(mapnum).TileData.Tile(MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y).DirBlock, DIR_DOWN + 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Else
+ CanNpcMove = False
+ End If
+
+ Case DIR_LEFT
+
+ ' Check to make sure not outside of boundries
+ If x > 0 Then
+ n = Map(mapnum).TileData.Tile(x - 1, y).Type
+
+ ' Check to make sure that the tile is walkable
+ If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
+ CanNpcMove = False
+ Exit Function
+ End If
+
+ ' Check to make sure that there is not a player in the way
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If (GetPlayerMap(i) = mapnum) And (GetPlayerX(i) = MapNpc(mapnum).Npc(mapNpcNum).x - 1) And (GetPlayerY(i) = MapNpc(mapnum).Npc(mapNpcNum).y) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ End If
+ Next
+
+ ' Check to make sure that there is not another npc in the way
+ For i = 1 To MAX_MAP_NPCS
+ If (i <> mapNpcNum) And (MapNpc(mapnum).Npc(i).Num > 0) And (MapNpc(mapnum).Npc(i).x = MapNpc(mapnum).Npc(mapNpcNum).x - 1) And (MapNpc(mapnum).Npc(i).y = MapNpc(mapnum).Npc(mapNpcNum).y) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Next
+
+ ' Directional blocking
+ If isDirBlocked(Map(mapnum).TileData.Tile(MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y).DirBlock, DIR_LEFT + 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Else
+ CanNpcMove = False
+ End If
+
+ Case DIR_RIGHT
+
+ ' Check to make sure not outside of boundries
+ If x < Map(mapnum).MapData.MaxX Then
+ n = Map(mapnum).TileData.Tile(x + 1, y).Type
+
+ ' Check to make sure that the tile is walkable
+ If n <> TILE_TYPE_WALKABLE And n <> TILE_TYPE_ITEM And n <> TILE_TYPE_NPCSPAWN Then
+ CanNpcMove = False
+ Exit Function
+ End If
+
+ ' Check to make sure that there is not a player in the way
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If (GetPlayerMap(i) = mapnum) And (GetPlayerX(i) = MapNpc(mapnum).Npc(mapNpcNum).x + 1) And (GetPlayerY(i) = MapNpc(mapnum).Npc(mapNpcNum).y) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ End If
+ Next
+
+ ' Check to make sure that there is not another npc in the way
+ For i = 1 To MAX_MAP_NPCS
+ If (i <> mapNpcNum) And (MapNpc(mapnum).Npc(i).Num > 0) And (MapNpc(mapnum).Npc(i).x = MapNpc(mapnum).Npc(mapNpcNum).x + 1) And (MapNpc(mapnum).Npc(i).y = MapNpc(mapnum).Npc(mapNpcNum).y) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Next
+
+ ' Directional blocking
+ If isDirBlocked(Map(mapnum).TileData.Tile(MapNpc(mapnum).Npc(mapNpcNum).x, MapNpc(mapnum).Npc(mapNpcNum).y).DirBlock, DIR_RIGHT + 1) Then
+ CanNpcMove = False
+ Exit Function
+ End If
+ Else
+ CanNpcMove = False
+ End If
+
+ End Select
+
+End Function
+
+Sub NpcMove(ByVal mapnum As Long, ByVal mapNpcNum As Long, ByVal dir As Long, ByVal movement As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If mapnum <= 0 Or mapnum > MAX_MAPS Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or dir < DIR_UP Or dir > DIR_RIGHT Or movement < 1 Or movement > 2 Then
+ Exit Sub
+ End If
+
+ MapNpc(mapnum).Npc(mapNpcNum).dir = dir
+
+ Select Case dir
+ Case DIR_UP
+ MapNpc(mapnum).Npc(mapNpcNum).y = MapNpc(mapnum).Npc(mapNpcNum).y - 1
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcMove
+ Buffer.WriteLong mapNpcNum
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).x
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).y
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).dir
+ Buffer.WriteLong movement
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+ Case DIR_DOWN
+ MapNpc(mapnum).Npc(mapNpcNum).y = MapNpc(mapnum).Npc(mapNpcNum).y + 1
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcMove
+ Buffer.WriteLong mapNpcNum
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).x
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).y
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).dir
+ Buffer.WriteLong movement
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+ Case DIR_LEFT
+ MapNpc(mapnum).Npc(mapNpcNum).x = MapNpc(mapnum).Npc(mapNpcNum).x - 1
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcMove
+ Buffer.WriteLong mapNpcNum
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).x
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).y
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).dir
+ Buffer.WriteLong movement
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+ Case DIR_RIGHT
+ MapNpc(mapnum).Npc(mapNpcNum).x = MapNpc(mapnum).Npc(mapNpcNum).x + 1
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcMove
+ Buffer.WriteLong mapNpcNum
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).x
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).y
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).dir
+ Buffer.WriteLong movement
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+ End Select
+
+End Sub
+
+Sub NpcDir(ByVal mapnum As Long, ByVal mapNpcNum As Long, ByVal dir As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If mapnum <= 0 Or mapnum > MAX_MAPS Or mapNpcNum <= 0 Or mapNpcNum > MAX_MAP_NPCS Or dir < DIR_UP Or dir > DIR_RIGHT Then
+ Exit Sub
+ End If
+
+ MapNpc(mapnum).Npc(mapNpcNum).dir = dir
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcDir
+ Buffer.WriteLong mapNpcNum
+ Buffer.WriteLong dir
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Function GetTotalMapPlayers(ByVal mapnum As Long) As Long
+ Dim i As Long
+ Dim n As Long
+ n = 0
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) And GetPlayerMap(i) = mapnum Then
+ n = n + 1
+ End If
+
+ Next
+
+ GetTotalMapPlayers = n
+End Function
+
+Sub ClearTempTiles()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+ ClearTempTile i
+ Next
+
+End Sub
+
+Sub ClearTempTile(ByVal mapnum As Long)
+ Dim y As Long
+ Dim x As Long
+ TempTile(mapnum).DoorTimer = 0
+ ReDim TempTile(mapnum).DoorOpen(0 To Map(mapnum).MapData.MaxX, 0 To Map(mapnum).MapData.MaxY)
+
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+ TempTile(mapnum).DoorOpen(x, y) = NO
+ Next
+ Next
+
+End Sub
+
+Public Sub CacheResources(ByVal mapnum As Long)
+ Dim x As Long, y As Long, Resource_Count As Long
+ Resource_Count = 0
+
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+
+ If Map(mapnum).TileData.Tile(x, y).Type = TILE_TYPE_RESOURCE Then
+ Resource_Count = Resource_Count + 1
+ ReDim Preserve ResourceCache(mapnum).ResourceData(0 To Resource_Count)
+ ResourceCache(mapnum).ResourceData(Resource_Count).x = x
+ ResourceCache(mapnum).ResourceData(Resource_Count).y = y
+ ResourceCache(mapnum).ResourceData(Resource_Count).cur_health = Resource(Map(mapnum).TileData.Tile(x, y).Data1).health
+ End If
+
+ Next
+ Next
+
+ ResourceCache(mapnum).Resource_Count = Resource_Count
+End Sub
+
+Sub PlayerSwitchBankSlots(ByVal index As Long, ByVal oldSlot As Long, ByVal newSlot As Long)
+Dim OldNum As Long
+Dim OldValue As Long
+Dim NewNum As Long
+Dim NewValue As Long
+
+ If oldSlot = 0 Or newSlot = 0 Then
+ Exit Sub
+ End If
+
+ OldNum = GetPlayerBankItemNum(index, oldSlot)
+ OldValue = GetPlayerBankItemValue(index, oldSlot)
+ NewNum = GetPlayerBankItemNum(index, newSlot)
+ NewValue = GetPlayerBankItemValue(index, newSlot)
+
+ SetPlayerBankItemNum index, newSlot, OldNum
+ SetPlayerBankItemValue index, newSlot, OldValue
+
+ SetPlayerBankItemNum index, oldSlot, NewNum
+ SetPlayerBankItemValue index, oldSlot, NewValue
+
+ SendBank index
+End Sub
+
+Sub PlayerSwitchInvSlots(ByVal index As Long, ByVal oldSlot As Long, ByVal newSlot As Long)
+Dim OldNum As Long, OldValue As Long, oldBound As Byte
+Dim NewNum As Long, NewValue As Long, newBound As Byte
+
+ If oldSlot = 0 Or newSlot = 0 Then
+ Exit Sub
+ End If
+
+ OldNum = GetPlayerInvItemNum(index, oldSlot)
+ OldValue = GetPlayerInvItemValue(index, oldSlot)
+ oldBound = Player(index).Inv(oldSlot).Bound
+ NewNum = GetPlayerInvItemNum(index, newSlot)
+ NewValue = GetPlayerInvItemValue(index, newSlot)
+ newBound = Player(index).Inv(newSlot).Bound
+
+ SetPlayerInvItemNum index, newSlot, OldNum
+ SetPlayerInvItemValue index, newSlot, OldValue
+ Player(index).Inv(newSlot).Bound = oldBound
+
+ SetPlayerInvItemNum index, oldSlot, NewNum
+ SetPlayerInvItemValue index, oldSlot, NewValue
+ Player(index).Inv(oldSlot).Bound = newBound
+
+ SendInventory index
+End Sub
+
+Sub PlayerSwitchSpellSlots(ByVal index As Long, ByVal oldSlot As Long, ByVal newSlot As Long)
+Dim OldNum As Long, NewNum As Long, OldUses As Long, NewUses As Long
+
+ If oldSlot = 0 Or newSlot = 0 Then
+ Exit Sub
+ End If
+
+ OldNum = Player(index).Spell(oldSlot).Spell
+ NewNum = Player(index).Spell(newSlot).Spell
+ OldUses = Player(index).Spell(oldSlot).Uses
+ NewUses = Player(index).Spell(newSlot).Uses
+
+ Player(index).Spell(oldSlot).Spell = NewNum
+ Player(index).Spell(oldSlot).Uses = NewUses
+ Player(index).Spell(newSlot).Spell = OldNum
+ Player(index).Spell(newSlot).Uses = OldUses
+ SendPlayerSpells index
+End Sub
+
+Sub PlayerUnequipItem(ByVal index As Long, ByVal EqSlot As Long)
+
+ If EqSlot <= 0 Or EqSlot > Equipment.Equipment_Count - 1 Then Exit Sub ' exit out early if error'd
+ If FindOpenInvSlot(index, GetPlayerEquipment(index, EqSlot)) > 0 Then
+ GiveInvItem index, GetPlayerEquipment(index, EqSlot), 0, , True
+ PlayerMsg index, "You unequip " & CheckGrammar(Item(GetPlayerEquipment(index, EqSlot)).Name), Yellow
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, GetPlayerEquipment(index, EqSlot)
+ ' remove equipment
+ SetPlayerEquipment index, 0, EqSlot
+ SendWornEquipment index
+ SendMapEquipment index
+ SendStats index
+ ' send vitals
+ Call SendVital(index, Vitals.HP)
+ Call SendVital(index, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+ Else
+ PlayerMsg index, "Your inventory is full.", BrightRed
+ End If
+
+End Sub
+
+Public Function CheckGrammar(ByVal Word As String, Optional ByVal Caps As Byte = 0) As String
+Dim FirstLetter As String * 1
+
+ FirstLetter = LCase$(left$(Word, 1))
+
+ If FirstLetter = "$" Then
+ CheckGrammar = (Mid$(Word, 2, Len(Word) - 1))
+ Exit Function
+ End If
+
+ If FirstLetter Like "*[aeiou]*" Then
+ If Caps Then CheckGrammar = "An " & Word Else CheckGrammar = "an " & Word
+ Else
+ If Caps Then CheckGrammar = "A " & Word Else CheckGrammar = "a " & Word
+ End If
+End Function
+
+Function isInRange(ByVal Range As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Boolean
+Dim nVal As Long
+ isInRange = False
+ nVal = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
+ If nVal <= Range Then isInRange = True
+End Function
+
+Public Function isDirBlocked(ByRef blockvar As Byte, ByRef dir As Byte) As Boolean
+ If Not blockvar And (2 ^ dir) Then
+ isDirBlocked = False
+ Else
+ isDirBlocked = True
+ End If
+End Function
+
+Public Function RAND(ByVal Low As Long, ByVal High As Long) As Long
+ Randomize
+ RAND = Int((High - Low + 1) * Rnd) + Low
+End Function
+
+' #####################
+' ## Party functions ##
+' #####################
+Public Sub Party_PlayerLeave(ByVal index As Long)
+Dim partynum As Long, i As Long
+
+ partynum = TempPlayer(index).inParty
+ If partynum > 0 Then
+ ' find out how many members we have
+ Party_CountMembers partynum
+ ' make sure there's more than 2 people
+ If Party(partynum).MemberCount > 2 Then
+ ' check if leader
+ If Party(partynum).Leader = index Then
+ ' set next person down as leader
+ For i = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(i) > 0 And Party(partynum).Member(i) <> index Then
+ Party(partynum).Leader = Party(partynum).Member(i)
+ PartyMsg partynum, GetPlayerName(i) & " is now the party leader.", BrightBlue
+ Exit For
+ End If
+ Next
+ ' leave party
+ PartyMsg partynum, GetPlayerName(index) & " has left the party.", BrightRed
+ ' remove from array
+ For i = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(i) = index Then
+ Party(partynum).Member(i) = 0
+ Exit For
+ End If
+ Next
+ ' recount party
+ Party_CountMembers partynum
+ ' set update to all
+ SendPartyUpdate partynum
+ ' send clear to player
+ SendPartyUpdateTo index
+ Else
+ ' not the leader, just leave
+ PartyMsg partynum, GetPlayerName(index) & " has left the party.", BrightRed
+ ' remove from array
+ For i = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(i) = index Then
+ Party(partynum).Member(i) = 0
+ Exit For
+ End If
+ Next
+ ' recount party
+ Party_CountMembers partynum
+ ' set update to all
+ SendPartyUpdate partynum
+ ' send clear to player
+ SendPartyUpdateTo index
+ End If
+ Else
+ ' find out how many members we have
+ Party_CountMembers partynum
+ ' only 2 people, disband
+ PartyMsg partynum, "Party disbanded.", BrightRed
+ ' clear out everyone's party
+ For i = 1 To MAX_PARTY_MEMBERS
+ index = Party(partynum).Member(i)
+ ' player exist?
+ If index > 0 Then
+ ' remove them
+ TempPlayer(index).inParty = 0
+ ' send clear to players
+ SendPartyUpdateTo index
+ End If
+ Next
+ ' clear out the party itself
+ ClearParty partynum
+ End If
+ End If
+End Sub
+
+Public Sub Party_Invite(ByVal index As Long, ByVal targetPlayer As Long)
+Dim partynum As Long, i As Long
+
+ ' check if the person is a valid target
+ If Not IsConnected(targetPlayer) Or Not IsPlaying(targetPlayer) Then Exit Sub
+
+ ' make sure they're not busy
+ If TempPlayer(targetPlayer).partyInvite > 0 Then
+ ' they've already got a request for trade/party
+ PlayerMsg index, "This player has an outstanding party invitation already.", BrightRed
+ ' exit out early
+ Exit Sub
+ End If
+ ' make syure they're not in a party
+ If TempPlayer(targetPlayer).inParty > 0 Then
+ ' they're already in a party
+ PlayerMsg index, "This player is already in a party.", BrightRed
+ 'exit out early
+ Exit Sub
+ End If
+
+ ' check if we're in a party
+ If TempPlayer(index).inParty > 0 Then
+ partynum = TempPlayer(index).inParty
+ ' make sure we're the leader
+ If Party(partynum).Leader = index Then
+ ' got a blank slot?
+ For i = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(i) = 0 Then
+ ' send the invitation
+ SendPartyInvite targetPlayer, index
+ ' set the invite target
+ TempPlayer(targetPlayer).partyInvite = index
+ ' let them know
+ PlayerMsg index, "Invitation sent.", Green
+ Exit Sub
+ End If
+ Next
+ ' no room
+ PlayerMsg index, "Party is full.", BrightRed
+ Exit Sub
+ Else
+ ' not the leader
+ PlayerMsg index, "You are not the party leader.", BrightRed
+ Exit Sub
+ End If
+ Else
+ ' not in a party - doesn't matter!
+ SendPartyInvite targetPlayer, index
+ ' set the invite target
+ TempPlayer(targetPlayer).partyInvite = index
+ ' let them know
+ PlayerMsg index, "Invitation sent.", Green
+ Exit Sub
+ End If
+End Sub
+
+Public Sub Party_InviteAccept(ByVal index As Long, ByVal targetPlayer As Long)
+Dim partynum As Long, i As Long, x As Long
+
+ If index = 0 Then Exit Sub
+
+ If Not IsConnected(index) Or Not IsPlaying(index) Then
+ TempPlayer(targetPlayer).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If Not IsConnected(targetPlayer) Or Not IsPlaying(targetPlayer) Then
+ TempPlayer(targetPlayer).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If TempPlayer(targetPlayer).inParty > 0 Then
+ PlayerMsg index, Trim$(GetPlayerName(targetPlayer)) & " is already in a party.", BrightRed
+ PlayerMsg targetPlayer, "You're already in a party.", BrightRed
+ Exit Sub
+ End If
+
+ ' check if already in a party
+ If TempPlayer(index).inParty > 0 Then
+ ' get the partynumber
+ partynum = TempPlayer(index).inParty
+ ' got a blank slot?
+ For i = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(i) = 0 Then
+ 'add to the party
+ Party(partynum).Member(i) = targetPlayer
+ ' recount party
+ Party_CountMembers partynum
+ ' send everyone's data to everyone
+ SendPlayerData_Party partynum
+ ' send update to all - including new player
+ SendPartyUpdate partynum
+ ' Send party vitals to everyone again
+ For x = 1 To MAX_PARTY_MEMBERS
+ If Party(partynum).Member(x) > 0 Then
+ SendPartyVitals partynum, Party(partynum).Member(x)
+ End If
+ Next
+ ' let everyone know they've joined
+ PartyMsg partynum, GetPlayerName(targetPlayer) & " has joined the party.", Pink
+ ' add them in
+ TempPlayer(targetPlayer).inParty = partynum
+ Exit Sub
+ End If
+ Next
+ ' no empty slots - let them know
+ PlayerMsg index, "Party is full.", BrightRed
+ PlayerMsg targetPlayer, "Party is full.", BrightRed
+ Exit Sub
+ Else
+ ' not in a party. Create one with the new person.
+ For i = 1 To MAX_PARTYS
+ ' find blank party
+ If Not Party(i).Leader > 0 Then
+ partynum = i
+ Exit For
+ End If
+ Next
+ ' create the party
+ Party(partynum).MemberCount = 2
+ Party(partynum).Leader = index
+ Party(partynum).Member(1) = index
+ Party(partynum).Member(2) = targetPlayer
+ SendPlayerData_Party partynum
+ SendPartyUpdate partynum
+ SendPartyVitals partynum, index
+ SendPartyVitals partynum, targetPlayer
+ ' let them know it's created
+ PartyMsg partynum, "Party created.", BrightGreen
+ PartyMsg partynum, GetPlayerName(index) & " has joined the party.", Pink
+ PartyMsg partynum, GetPlayerName(targetPlayer) & " has joined the party.", Pink
+ ' clear the invitation
+ TempPlayer(targetPlayer).partyInvite = 0
+ ' add them to the party
+ TempPlayer(index).inParty = partynum
+ TempPlayer(targetPlayer).inParty = partynum
+ Exit Sub
+ End If
+End Sub
+
+Public Sub Party_InviteDecline(ByVal index As Long, ByVal targetPlayer As Long)
+ If Not IsConnected(index) Or Not IsPlaying(index) Then
+ TempPlayer(targetPlayer).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If Not IsConnected(targetPlayer) Or Not IsPlaying(targetPlayer) Then
+ TempPlayer(targetPlayer).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ PlayerMsg index, GetPlayerName(targetPlayer) & " has declined to join the party.", BrightRed
+ PlayerMsg targetPlayer, "You declined to join the party.", BrightRed
+ ' clear the invitation
+ TempPlayer(targetPlayer).partyInvite = 0
+End Sub
+
+Public Sub Party_CountMembers(ByVal partynum As Long)
+Dim i As Long, highIndex As Long, x As Long
+ ' find the high index
+ For i = MAX_PARTY_MEMBERS To 1 Step -1
+ If Party(partynum).Member(i) > 0 Then
+ highIndex = i
+ Exit For
+ End If
+ Next
+ ' count the members
+ For i = 1 To MAX_PARTY_MEMBERS
+ ' we've got a blank member
+ If Party(partynum).Member(i) = 0 Then
+ ' is it lower than the high index?
+ If i < highIndex Then
+ ' move everyone down a slot
+ For x = i To MAX_PARTY_MEMBERS - 1
+ Party(partynum).Member(x) = Party(partynum).Member(x + 1)
+ Party(partynum).Member(x + 1) = 0
+ Next
+ Else
+ ' not lower - highindex is count
+ Party(partynum).MemberCount = highIndex
+ Exit Sub
+ End If
+ End If
+ ' check if we've reached the max
+ If i = MAX_PARTY_MEMBERS Then
+ If highIndex = i Then
+ Party(partynum).MemberCount = MAX_PARTY_MEMBERS
+ Exit Sub
+ End If
+ End If
+ Next
+ ' if we're here it means that we need to re-count again
+ Party_CountMembers partynum
+End Sub
+
+Public Sub Party_ShareExp(ByVal partynum As Long, ByVal exp As Long, ByVal index As Long, Optional ByVal enemyLevel As Long = 0)
+Dim expShare As Long, leftOver As Long, i As Long, tmpIndex As Long
+
+ If Party(partynum).MemberCount <= 0 Then Exit Sub
+
+ ' check if it's worth sharing
+ If Not exp >= Party(partynum).MemberCount Then
+ ' no party - keep exp for self
+ GivePlayerEXP index, exp, enemyLevel
+ Exit Sub
+ End If
+
+ ' find out the equal share
+ expShare = exp \ Party(partynum).MemberCount
+ leftOver = exp Mod Party(partynum).MemberCount
+
+ ' loop through and give everyone exp
+ For i = 1 To MAX_PARTY_MEMBERS
+ tmpIndex = Party(partynum).Member(i)
+ ' existing member?Kn
+ If tmpIndex > 0 Then
+ ' playing?
+ If IsConnected(tmpIndex) And IsPlaying(tmpIndex) Then
+ ' give them their share
+ GivePlayerEXP tmpIndex, expShare, enemyLevel
+ End If
+ End If
+ Next
+
+ ' give the remainder to a random member
+ tmpIndex = Party(partynum).Member(RAND(1, Party(partynum).MemberCount))
+ ' give the exp
+ If leftOver > 0 Then GivePlayerEXP tmpIndex, leftOver, enemyLevel
+End Sub
+
+Public Sub GivePlayerEXP(ByVal index As Long, ByVal exp As Long, Optional ByVal enemyLevel As Long = 0)
+Dim multiplier As Long, partynum As Long, expBonus As Long
+ ' no exp
+ If exp = 0 Then Exit Sub
+ ' rte9
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Sub
+ ' make sure we're not max level
+ If Not GetPlayerLevel(index) >= MAX_LEVELS Then
+ ' check for exp deduction
+ If enemyLevel > 0 Then
+ ' exp deduction
+ If enemyLevel <= GetPlayerLevel(index) - 3 Then
+ ' 3 levels lower, exit out
+ Exit Sub
+ ElseIf enemyLevel <= GetPlayerLevel(index) - 2 Then
+ ' half exp if enemy is 2 levels lower
+ exp = exp / 2
+ End If
+ End If
+ ' check if in party
+ partynum = TempPlayer(index).inParty
+ If partynum > 0 Then
+ If Party(partynum).MemberCount > 1 Then
+ multiplier = Party(partynum).MemberCount - 1
+ ' multiply the exp
+ expBonus = (exp / 100) * (multiplier * 3) ' 3 = 3% per party member
+ ' Modify the exp
+ exp = exp + expBonus
+ End If
+ End If
+ ' give the exp
+ Call SetPlayerExp(index, GetPlayerExp(index) + exp)
+ SendEXP index
+ SendActionMsg GetPlayerMap(index), "+" & exp & " EXP", White, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
+ ' check if we've leveled
+ CheckPlayerLevelUp index
+ Else
+ Call SetPlayerExp(index, 0)
+ SendEXP index
+ End If
+End Sub
+
+Public Sub Unique_Item(ByVal index As Long, ByVal itemNum As Long)
+Dim ClassNum As Long, i As Long
+
+ Select Case Item(itemNum).Data1
+ Case 1 ' Reset Stats
+ ClassNum = GetPlayerClass(index)
+ If ClassNum <= 0 Or ClassNum > Max_Classes Then Exit Sub
+ ' re-set the actual stats to class defaults
+ For i = 1 To Stats.Stat_Count - 1
+ SetPlayerStat index, i, Class(ClassNum).Stat(i)
+ Next
+ ' give player their points back
+ SetPlayerPOINTS index, (GetPlayerLevel(index) - 1) * 3
+ ' take item
+ TakeInvItem index, itemNum, 1
+ ' let them know we've done it
+ PlayerMsg index, "Your stats have been reset.", BrightGreen
+ ' send them their new stats
+ SendPlayerData index
+ Case Else ' Exit out otherwise
+ Exit Sub
+ End Select
+End Sub
+
+Public Function loginTokenOk(ByVal user As String, ByVal tLoginToken As String) As Boolean
+Dim i As Long
+ loginTokenOk = False
+ For i = 1 To MAX_PLAYERS
+ If LoginToken(i).Active Then
+ If LoginToken(i).user = user And LoginToken(i).Token = tLoginToken Then
+ ' return true
+ loginTokenOk = True
+ ' clear the token
+ LoginToken(i).Active = False
+ LoginToken(i).user = vbNullString
+ LoginToken(i).Token = vbNullString
+ LoginToken(i).TimeCreated = 0
+ ' exit out
+ Exit Function
+ End If
+ End If
+ Next
+End Function
+
+Public Function hasProficiency(ByVal index As Long, ByVal proficiency As Long) As Boolean
+ Select Case proficiency
+ Case 0 ' None
+ hasProficiency = True
+ Exit Function
+ Case 1 ' Heavy
+ If GetPlayerClass(index) = 1 Then
+ hasProficiency = True
+ Exit Function
+ End If
+ Case 2 ' Light
+ If GetPlayerClass(index) = 2 Or GetPlayerClass(index) = 3 Then
+ hasProficiency = True
+ Exit Function
+ End If
+ End Select
+ hasProficiency = False
+End Function
+
+Function ActiveEventPage(ByVal index As Long, ByVal eventNum As Long) As Long
+Dim x As Long, mapnum As Long, process As Boolean
+ mapnum = GetPlayerMap(index)
+ For x = Map(mapnum).TileData.Events(eventNum).PageCount To 1 Step -1
+ ' check if we match
+ With Map(mapnum).TileData.Events(eventNum).EventPage(x)
+ process = True
+ ' player var check
+ If .chkPlayerVar Then
+ If .PlayerVarNum > 0 Then
+ If Player(index).Variable(.PlayerVarNum) < .PlayerVariable Then
+ process = False
+ End If
+ End If
+ End If
+ ' has item check
+ If .chkHasItem Then
+ If .HasItemNum > 0 Then
+ If HasItem(index, .HasItemNum) = 0 Then
+ process = False
+ End If
+ End If
+ End If
+ ' this page
+ If process = True Then
+ ActiveEventPage = x
+ Exit Function
+ End If
+ End With
+ Next
+End Function
diff --git a/server/src/modGeneral.bas b/server/src/modGeneral.bas
new file mode 100644
index 0000000..ee038ad
--- /dev/null
+++ b/server/src/modGeneral.bas
@@ -0,0 +1,205 @@
+Attribute VB_Name = "modGeneral"
+Option Explicit
+' Get system uptime in milliseconds
+Public Declare Function GetTickCount Lib "kernel32" () As Long
+
+Public Sub Main()
+ Call InitServer
+End Sub
+
+Public Sub InitServer()
+ Dim i As Long
+ Dim f As Long
+ Dim time1 As Long
+ Dim time2 As Long
+
+ ' log on by default
+ ServerLog = True
+
+ InitCRC32
+
+ ' cache packet pointers
+ Call InitMessages
+ Call Auth_InitMessages
+
+ ' time the load
+ time1 = GetTickCount
+ frmServer.Show
+
+ ' Initialize the random-number generator
+ Randomize ', seed
+
+ ' highindexing turned off
+ Player_HighIndex = MAX_PLAYERS
+
+ ' Check if the directory is there, if its not make it
+ ChkDir App.Path & "\Data\", "accounts"
+ ChkDir App.Path & "\Data\", "animations"
+ ChkDir App.Path & "\Data\", "items"
+ ChkDir App.Path & "\Data\", "logs"
+ ChkDir App.Path & "\Data\", "maps"
+ ChkDir App.Path & "\Data\", "npcs"
+ ChkDir App.Path & "\Data\", "resources"
+ ChkDir App.Path & "\Data\", "shops"
+ ChkDir App.Path & "\Data\", "spells"
+ ChkDir App.Path & "\Data\", "convs"
+
+ ' set quote character
+ vbQuote = ChrW$(34) ' "
+
+ ' load options, set if they dont exist
+ If Not FileExist(App.Path & "\data\options.ini", True) Then
+ Options.MOTD = "Welcome to Crystalshire."
+ SaveOptions
+ Else
+ LoadOptions
+ End If
+
+ ' Get the listening socket ready to go
+ frmServer.Socket(0).RemoteHost = frmServer.Socket(0).LocalIP
+ frmServer.Socket(0).LocalPort = GAME_SERVER_PORT
+
+ ' Get the authentication socket going
+ frmServer.AuthSocket.RemoteHost = AUTH_SERVER_IP
+ frmServer.AuthSocket.LocalPort = SERVER_AUTH_PORT
+
+ ' Init all the player sockets
+ Call SetStatus("Initializing player array...")
+
+ For i = 1 To MAX_PLAYERS
+ Call ClearPlayer(i)
+ Load frmServer.Socket(i)
+ Next
+
+ ' Serves as a constructor
+ Call ClearGameData
+ Call LoadGameData
+ Call SetStatus("Spawning map items...")
+ Call SpawnAllMapsItems
+ Call SetStatus("Spawning map npcs...")
+ Call SpawnAllMapNpcs
+ Call SetStatus("Creating map cache...")
+ Call CreateFullMapCache
+ Call SetStatus("Loading System Tray...")
+ Call LoadSystemTray
+
+ ' Check if the master charlist file exists for checking duplicate names, and if it doesnt make it
+ If Not FileExist("data\accounts\_charlist.txt") Then
+ f = FreeFile
+ Open App.Path & "\data\accounts\_charlist.txt" For Output As #f
+ Close #f
+ End If
+
+ SetStatus "Caching map CRC32 checksums..."
+ ' cache map crc32s
+ For i = 1 To MAX_MAPS
+ GetMapCRC32 i
+ Next
+
+ ' Start listening
+ frmServer.Socket(0).Listen
+ frmServer.AuthSocket.Listen
+ Call UpdateCaption
+ time2 = GetTickCount
+ Call SetStatus("Initialization complete. Server loaded in " & time2 - time1 & "ms.")
+
+ ' reset shutdown value
+ isShuttingDown = False
+
+ ' Starts the server loop
+ ServerLoop
+End Sub
+
+Public Sub DestroyServer()
+ Dim i As Long
+ ServerOnline = False
+ Call SetStatus("Destroying System Tray...")
+ Call DestroySystemTray
+ Call SetStatus("Saving players online...")
+ Call SaveAllPlayersOnline
+ Call ClearGameData
+ Call SetStatus("Unloading sockets...")
+
+ For i = 1 To MAX_PLAYERS
+ Unload frmServer.Socket(i)
+ Next
+ End
+End Sub
+
+Public Sub SetStatus(ByVal Status As String)
+ Call TextAdd(Status)
+ DoEvents
+End Sub
+
+Public Sub ClearGameData()
+ Call SetStatus("Clearing temp tile fields...")
+ Call ClearTempTiles
+ Call SetStatus("Clearing maps...")
+ Call ClearMaps
+ Call SetStatus("Clearing map items...")
+ Call ClearMapItems
+ Call SetStatus("Clearing map npcs...")
+ Call ClearMapNpcs
+ Call SetStatus("Clearing npcs...")
+ Call ClearNpcs
+ Call SetStatus("Clearing Resources...")
+ Call ClearResources
+ Call SetStatus("Clearing items...")
+ Call ClearItems
+ Call SetStatus("Clearing shops...")
+ Call ClearShops
+ Call SetStatus("Clearing spells...")
+ Call ClearSpells
+ Call SetStatus("Clearing animations...")
+ Call ClearAnimations
+ Call SetStatus("Clearing conversations...")
+ Call ClearConvs
+End Sub
+
+Private Sub LoadGameData()
+ Call SetStatus("Loading classes...")
+ Call LoadClasses
+ Call SetStatus("Loading maps...")
+ Call LoadMaps
+ Call SetStatus("Loading items...")
+ Call LoadItems
+ Call SetStatus("Loading npcs...")
+ Call LoadNpcs
+ Call SetStatus("Loading Resources...")
+ Call LoadResources
+ Call SetStatus("Loading shops...")
+ Call LoadShops
+ Call SetStatus("Loading spells...")
+ Call LoadSpells
+ Call SetStatus("Loading animations...")
+ Call LoadAnimations
+ Call SetStatus("Loading conversations...")
+ Call LoadConvs
+End Sub
+
+Public Sub TextAdd(Msg As String)
+ NumLines = NumLines + 1
+
+ If NumLines >= MAX_LINES Then
+ frmServer.txtText.Text = vbNullString
+ NumLines = 0
+ End If
+
+ frmServer.txtText.Text = frmServer.txtText.Text & vbNewLine & Msg
+ frmServer.txtText.SelStart = Len(frmServer.txtText.Text)
+End Sub
+
+' Used for checking validity of names
+Function isNameLegal(ByVal sInput As Integer) As Boolean
+
+ If (sInput >= 65 And sInput <= 90) Or (sInput >= 97 And sInput <= 122) Or (sInput = 95) Or (sInput = 32) Or (sInput >= 48 And sInput <= 57) Then
+ isNameLegal = True
+ End If
+
+End Function
+
+Public Function AryCount(ByRef Ary() As Byte) As Long
+On Error Resume Next
+
+ AryCount = UBound(Ary) + 1
+End Function
diff --git a/server/src/modGlobals.bas b/server/src/modGlobals.bas
new file mode 100644
index 0000000..9e58829
--- /dev/null
+++ b/server/src/modGlobals.bas
@@ -0,0 +1,38 @@
+Attribute VB_Name = "modGlobals"
+Option Explicit
+
+' Used for closing key doors again
+Public KeyTimer As Long
+
+' Used for gradually giving back npcs hp
+Public GiveNPCHPTimer As Long
+
+' Used for logging
+Public ServerLog As Boolean
+
+' Text vars
+Public vbQuote As String
+
+' Maximum classes
+Public Max_Classes As Long
+
+' Used for server loop
+Public ServerOnline As Boolean
+
+' Used for outputting text
+Public NumLines As Long
+
+' Used to handle shutting down server with countdown.
+Public isShuttingDown As Boolean
+Public Secs As Long
+Public TotalPlayersOnline As Long
+
+' GameCPS
+Public GameCPS As Long
+Public ElapsedTime As Long
+
+' high indexing
+Public Player_HighIndex As Long
+
+' lock the CPS?
+Public CPSUnlock As Boolean
diff --git a/server/src/modHandleData.bas b/server/src/modHandleData.bas
new file mode 100644
index 0000000..2d408f5
--- /dev/null
+++ b/server/src/modHandleData.bas
@@ -0,0 +1,2701 @@
+Attribute VB_Name = "modHandleData"
+Option Explicit
+
+Private Function GetAddress(FunAddr As Long) As Long
+ GetAddress = FunAddr
+End Function
+
+Public Sub InitMessages()
+ HandleDataSub(CNewAccount) = GetAddress(AddressOf HandleNewAccount)
+ HandleDataSub(CDelChar) = GetAddress(AddressOf HandleDelChar)
+ HandleDataSub(CLogin) = GetAddress(AddressOf HandleLogin)
+ HandleDataSub(CAddChar) = GetAddress(AddressOf HandleAddChar)
+ HandleDataSub(CUseChar) = GetAddress(AddressOf HandleUseChar)
+ HandleDataSub(CSayMsg) = GetAddress(AddressOf HandleSayMsg)
+ HandleDataSub(CEmoteMsg) = GetAddress(AddressOf HandleEmoteMsg)
+ HandleDataSub(CBroadcastMsg) = GetAddress(AddressOf HandleBroadcastMsg)
+ HandleDataSub(CPlayerMsg) = GetAddress(AddressOf HandlePlayerMsg)
+ HandleDataSub(CPlayerMove) = GetAddress(AddressOf HandlePlayerMove)
+ HandleDataSub(CPlayerDir) = GetAddress(AddressOf HandlePlayerDir)
+ HandleDataSub(CUseItem) = GetAddress(AddressOf HandleUseItem)
+ HandleDataSub(CAttack) = GetAddress(AddressOf HandleAttack)
+ HandleDataSub(CUseStatPoint) = GetAddress(AddressOf HandleUseStatPoint)
+ HandleDataSub(CPlayerInfoRequest) = GetAddress(AddressOf HandlePlayerInfoRequest)
+ HandleDataSub(CWarpMeTo) = GetAddress(AddressOf HandleWarpMeTo)
+ HandleDataSub(CWarpToMe) = GetAddress(AddressOf HandleWarpToMe)
+ HandleDataSub(CWarpTo) = GetAddress(AddressOf HandleWarpTo)
+ HandleDataSub(CSetSprite) = GetAddress(AddressOf HandleSetSprite)
+ HandleDataSub(CGetStats) = GetAddress(AddressOf HandleGetStats)
+ HandleDataSub(CRequestNewMap) = GetAddress(AddressOf HandleRequestNewMap)
+ HandleDataSub(CMapData) = GetAddress(AddressOf HandleMapData)
+ HandleDataSub(CNeedMap) = GetAddress(AddressOf HandleNeedMap)
+ HandleDataSub(CMapGetItem) = GetAddress(AddressOf HandleMapGetItem)
+ HandleDataSub(CMapDropItem) = GetAddress(AddressOf HandleMapDropItem)
+ HandleDataSub(CMapRespawn) = GetAddress(AddressOf HandleMapRespawn)
+ HandleDataSub(CMapReport) = GetAddress(AddressOf HandleMapReport)
+ HandleDataSub(CKickPlayer) = GetAddress(AddressOf HandleKickPlayer)
+ HandleDataSub(CBanList) = GetAddress(AddressOf HandleBanlist)
+ HandleDataSub(CBanDestroy) = GetAddress(AddressOf HandleBanDestroy)
+ HandleDataSub(CBanPlayer) = GetAddress(AddressOf HandleBanPlayer)
+ HandleDataSub(CRequestEditMap) = GetAddress(AddressOf HandleRequestEditMap)
+ HandleDataSub(CRequestEditItem) = GetAddress(AddressOf HandleRequestEditItem)
+ HandleDataSub(CSaveItem) = GetAddress(AddressOf HandleSaveItem)
+ HandleDataSub(CRequestEditNpc) = GetAddress(AddressOf HandleRequestEditNpc)
+ HandleDataSub(CSaveNpc) = GetAddress(AddressOf HandleSaveNpc)
+ HandleDataSub(CRequestEditShop) = GetAddress(AddressOf HandleRequestEditShop)
+ HandleDataSub(CSaveShop) = GetAddress(AddressOf HandleSaveShop)
+ HandleDataSub(CRequestEditSpell) = GetAddress(AddressOf HandleRequestEditspell)
+ HandleDataSub(CSaveSpell) = GetAddress(AddressOf HandleSaveSpell)
+ HandleDataSub(CSetAccess) = GetAddress(AddressOf HandleSetAccess)
+ HandleDataSub(CWhosOnline) = GetAddress(AddressOf HandleWhosOnline)
+ HandleDataSub(CSetMotd) = GetAddress(AddressOf HandleSetMotd)
+ HandleDataSub(CTarget) = GetAddress(AddressOf HandleTarget)
+ HandleDataSub(CSpells) = GetAddress(AddressOf HandleSpells)
+ HandleDataSub(CCast) = GetAddress(AddressOf HandleCast)
+ HandleDataSub(CQuit) = GetAddress(AddressOf HandleQuit)
+ HandleDataSub(CSwapInvSlots) = GetAddress(AddressOf HandleSwapInvSlots)
+ HandleDataSub(CRequestEditResource) = GetAddress(AddressOf HandleRequestEditResource)
+ HandleDataSub(CSaveResource) = GetAddress(AddressOf HandleSaveResource)
+ HandleDataSub(CCheckPing) = GetAddress(AddressOf HandleCheckPing)
+ HandleDataSub(CUnequip) = GetAddress(AddressOf HandleUnequip)
+ HandleDataSub(CRequestPlayerData) = GetAddress(AddressOf HandleRequestPlayerData)
+ HandleDataSub(CRequestItems) = GetAddress(AddressOf HandleRequestItems)
+ HandleDataSub(CRequestNPCS) = GetAddress(AddressOf HandleRequestNPCS)
+ HandleDataSub(CRequestResources) = GetAddress(AddressOf HandleRequestResources)
+ HandleDataSub(CSpawnItem) = GetAddress(AddressOf HandleSpawnItem)
+ HandleDataSub(CRequestEditAnimation) = GetAddress(AddressOf HandleRequestEditAnimation)
+ HandleDataSub(CSaveAnimation) = GetAddress(AddressOf HandleSaveAnimation)
+ HandleDataSub(CRequestAnimations) = GetAddress(AddressOf HandleRequestAnimations)
+ HandleDataSub(CRequestSpells) = GetAddress(AddressOf HandleRequestSpells)
+ HandleDataSub(CRequestShops) = GetAddress(AddressOf HandleRequestShops)
+ HandleDataSub(CRequestLevelUp) = GetAddress(AddressOf HandleRequestLevelUp)
+ HandleDataSub(CForgetSpell) = GetAddress(AddressOf HandleForgetSpell)
+ HandleDataSub(CCloseShop) = GetAddress(AddressOf HandleCloseShop)
+ HandleDataSub(CBuyItem) = GetAddress(AddressOf HandleBuyItem)
+ HandleDataSub(CSellItem) = GetAddress(AddressOf HandleSellItem)
+ HandleDataSub(CChangeBankSlots) = GetAddress(AddressOf HandleChangeBankSlots)
+ HandleDataSub(CDepositItem) = GetAddress(AddressOf HandleDepositItem)
+ HandleDataSub(CWithdrawItem) = GetAddress(AddressOf HandleWithdrawItem)
+ HandleDataSub(CCloseBank) = GetAddress(AddressOf HandleCloseBank)
+ HandleDataSub(CAdminWarp) = GetAddress(AddressOf HandleAdminWarp)
+ HandleDataSub(CTradeRequest) = GetAddress(AddressOf HandleTradeRequest)
+ HandleDataSub(CAcceptTrade) = GetAddress(AddressOf HandleAcceptTrade)
+ HandleDataSub(CDeclineTrade) = GetAddress(AddressOf HandleDeclineTrade)
+ HandleDataSub(CTradeItem) = GetAddress(AddressOf HandleTradeItem)
+ HandleDataSub(CUntradeItem) = GetAddress(AddressOf HandleUntradeItem)
+ HandleDataSub(CHotbarChange) = GetAddress(AddressOf HandleHotbarChange)
+ HandleDataSub(CHotbarUse) = GetAddress(AddressOf HandleHotbarUse)
+ HandleDataSub(CSwapSpellSlots) = GetAddress(AddressOf HandleSwapSpellSlots)
+ HandleDataSub(CAcceptTradeRequest) = GetAddress(AddressOf HandleAcceptTradeRequest)
+ HandleDataSub(CDeclineTradeRequest) = GetAddress(AddressOf HandleDeclineTradeRequest)
+ HandleDataSub(CPartyRequest) = GetAddress(AddressOf HandlePartyRequest)
+ HandleDataSub(CAcceptParty) = GetAddress(AddressOf HandleAcceptParty)
+ HandleDataSub(CDeclineParty) = GetAddress(AddressOf HandleDeclineParty)
+ HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
+ HandleDataSub(CChatOption) = GetAddress(AddressOf HandleChatOption)
+ HandleDataSub(CRequestEditConv) = GetAddress(AddressOf HandleRequestEditConv)
+ HandleDataSub(CSaveConv) = GetAddress(AddressOf HandleSaveConv)
+ HandleDataSub(CRequestConvs) = GetAddress(AddressOf HandleRequestConvs)
+ HandleDataSub(CFinishTutorial) = GetAddress(AddressOf HandleFinishTutorial)
+End Sub
+
+Sub HandleData(ByVal index As Long, ByRef Data() As Byte)
+Dim Buffer As clsBuffer
+Dim MsgType As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ MsgType = Buffer.ReadLong
+
+ If MsgType < 0 Then
+ Exit Sub
+ End If
+
+ If MsgType >= CMSG_COUNT Then
+ Exit Sub
+ End If
+
+ CallWindowProc HandleDataSub(MsgType), index, Buffer.ReadBytes(Buffer.Length), 0, 0
+End Sub
+
+Private Sub HandleNewAccount(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+End Sub
+
+' :::::::::::::::::::::::::::
+' :: Delete account packet ::
+' :::::::::::::::::::::::::::
+Private Sub HandleDelAccount(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ ' No deleting accounts lOL
+End Sub
+
+' ::::::::::::::::::
+' :: Login packet ::
+' ::::::::::::::::::
+Private Sub HandleLogin(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, Name As String, i As Long, n As Long, LoginToken As String, charNum As Long
+
+ If Not IsPlaying(index) Then
+ If Not IsLoggedIn(index) Then
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ ' Get the data
+ Name = Buffer.ReadString
+ LoginToken = Buffer.ReadString
+
+ ' Check versions
+ If Buffer.ReadLong <> CLIENT_MAJOR Or Buffer.ReadLong <> CLIENT_MINOR Or Buffer.ReadLong <> CLIENT_REVISION Then
+ Call AlertMsg(index, DIALOGUE_MSG_OUTDATED)
+ Exit Sub
+ End If
+
+ If isShuttingDown Then
+ Call AlertMsg(index, DIALOGUE_MSG_REBOOTING)
+ Exit Sub
+ End If
+
+ If Len(Trim$(Name)) < 3 Then
+ Call AlertMsg(index, DIALOGUE_MSG_USERLENGTH, MENU_LOGIN)
+ Exit Sub
+ End If
+
+ If Not loginTokenOk(Name, LoginToken) Then
+ Call AlertMsg(index, DIALOGUE_MSG_CONNECTION, MENU_LOGIN)
+ Exit Sub
+ End If
+
+ If IsMultiAccounts(Name) Then
+ Call AlertMsg(index, DIALOGUE_MSG_CONNECTION, MENU_LOGIN)
+ Exit Sub
+ End If
+
+ If Not AccountExist(Name) Then
+ ' if we've logged on and there isn't an account then there should be
+ Call AddAccount(index, Name)
+ End If
+
+ ' Load the player
+ Call LoadPlayer(index, Name, 0)
+
+ ' make sure they're not banned
+ If isBanned_Account(index) Then
+ Call AlertMsg(index, DIALOGUE_MSG_BANNED)
+ Exit Sub
+ End If
+
+ ' send them to the character portal
+ If Not IsPlaying(index) Then
+ Call SendPlayerChars(index)
+ Call SendNewCharClasses(index)
+ End If
+
+ ' Show the player up on the socket status
+ Call AddLog(GetPlayerLogin(index) & " has logged in from " & GetPlayerIP(index) & ".", PLAYER_LOG)
+ Call TextAdd(GetPlayerLogin(index) & " has logged in from " & GetPlayerIP(index) & ".")
+
+ Set Buffer = Nothing
+ End If
+ End If
+
+End Sub
+
+' ::::::::::::::::::::::::::
+' :: Add character packet ::
+' ::::::::::::::::::::::::::
+Private Sub HandleAddChar(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Name As String
+ Dim password As String
+ Dim Sex As Long
+ Dim Class As Long
+ Dim Sprite As Long
+ Dim i As Long
+ Dim n As Long
+ Dim charNum As Long
+
+ If Not IsPlaying(index) Then
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ Name = Buffer.ReadString
+ Sex = Buffer.ReadLong
+ Class = Buffer.ReadLong
+ Sprite = Buffer.ReadLong
+ charNum = Buffer.ReadLong
+
+ ' Prevent hacking
+ If Len(Trim$(Name)) < 3 Then
+ Call AlertMsg(index, DIALOGUE_MSG_NAMELENGTH, MENU_NEWCHAR, False)
+ Exit Sub
+ End If
+
+ ' Prevent hacking
+ For i = 1 To Len(Name)
+ n = AscW(Mid$(Name, i, 1))
+
+ If Not isNameLegal(n) Then
+ Call AlertMsg(index, DIALOGUE_MSG_NAMEILLEGAL, MENU_NEWCHAR, False)
+ Exit Sub
+ End If
+
+ Next
+
+ ' Prevent hacking
+ If (Sex < SEX_MALE) Or (Sex > SEX_FEMALE) Then
+ Call AlertMsg(index, DIALOGUE_MSG_CONNECTION)
+ Exit Sub
+ End If
+
+ ' Prevent hacking
+ If Class < 1 Or Class > Max_Classes Then
+ Exit Sub
+ End If
+
+ ' Check if char already exists in slot
+ If CharExist(index, charNum) Then
+ Call AlertMsg(index, DIALOGUE_MSG_CONNECTION)
+ Exit Sub
+ End If
+
+ ' Check if name is already in use
+ If FindChar(Name) Then
+ Call AlertMsg(index, DIALOGUE_MSG_NAMETAKEN, MENU_NEWCHAR, False)
+ Exit Sub
+ End If
+
+ ' Everything went ok, add the character
+ Call AddChar(index, Name, Sex, Class, Sprite, charNum)
+ Call AddLog("Character " & Name & " added to " & GetPlayerLogin(index) & "'s account.", PLAYER_LOG)
+ ' log them in!!
+ UseChar index, charNum
+
+ Set Buffer = Nothing
+ End If
+
+End Sub
+
+' ::::::::::::::::::::
+' :: Social packets ::
+' ::::::::::::::::::::
+Private Sub HandleSayMsg(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Msg As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ Msg = Buffer.ReadString
+
+ ' Prevent hacking
+ For i = 1 To Len(Msg)
+ ' limit the ASCII
+ If AscW(Mid$(Msg, i, 1)) < 32 Or AscW(Mid$(Msg, i, 1)) > 126 Then
+ ' limit the extended ASCII
+ If AscW(Mid$(Msg, i, 1)) < 128 Or AscW(Mid$(Msg, i, 1)) > 168 Then
+ ' limit the extended ASCII
+ If AscW(Mid$(Msg, i, 1)) < 224 Or AscW(Mid$(Msg, i, 1)) > 253 Then
+ Mid$(Msg, i, 1) = ""
+ End If
+ End If
+ End If
+ Next
+
+ Call AddLog("Map #" & GetPlayerMap(index) & ": " & GetPlayerName(index) & " says, '" & Msg & "'", PLAYER_LOG)
+ Call SayMsg_Map(GetPlayerMap(index), index, Msg, QBColor(White))
+ Call SendChatBubble(GetPlayerMap(index), index, TARGET_TYPE_PLAYER, Msg, White)
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleEmoteMsg(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Msg As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ Msg = Buffer.ReadString
+
+ ' Prevent hacking
+ For i = 1 To Len(Msg)
+
+ If AscW(Mid$(Msg, i, 1)) < 32 Or AscW(Mid$(Msg, i, 1)) > 126 Then
+ Exit Sub
+ End If
+
+ Next
+
+ Call AddLog("Map #" & GetPlayerMap(index) & ": " & GetPlayerName(index) & " " & Msg, PLAYER_LOG)
+ Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & " " & Right$(Msg, Len(Msg) - 1), EmoteColor)
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandleBroadcastMsg(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Msg As String
+ Dim s As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ Msg = Buffer.ReadString
+
+ If Player(index).isMuted Then
+ PlayerMsg index, "You have been muted and cannot talk in global.", BrightRed
+ Exit Sub
+ End If
+
+ ' Prevent hacking
+ For i = 1 To Len(Msg)
+
+ If AscW(Mid$(Msg, i, 1)) < 32 Or AscW(Mid$(Msg, i, 1)) > 126 Then
+ Exit Sub
+ End If
+
+ Next
+
+ s = "[Global]" & GetPlayerName(index) & ": " & Msg
+ Call SayMsg_Global(index, Msg, QBColor(White))
+ Call AddLog(s, PLAYER_LOG)
+ Call TextAdd(s)
+
+ Set Buffer = Nothing
+End Sub
+
+Private Sub HandlePlayerMsg(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Msg As String
+ Dim i As Long
+ Dim MsgTo As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ MsgTo = FindPlayer(Buffer.ReadString)
+ Msg = Buffer.ReadString
+
+ ' Prevent hacking
+ For i = 1 To Len(Msg)
+
+ If AscW(Mid$(Msg, i, 1)) < 32 Or AscW(Mid$(Msg, i, 1)) > 126 Then
+ Exit Sub
+ End If
+
+ Next
+
+ ' Check if they are trying to talk to themselves
+ If MsgTo <> index Then
+ If MsgTo > 0 Then
+ Call AddLog(GetPlayerName(index) & " tells " & GetPlayerName(MsgTo) & ", " & Msg & "'", PLAYER_LOG)
+ Call PlayerMsg(MsgTo, GetPlayerName(index) & " tells you, '" & Msg & "'", TellColor)
+ Call PlayerMsg(index, "You tell " & GetPlayerName(MsgTo) & ", '" & Msg & "'", TellColor)
+ Else
+ Call PlayerMsg(index, "Player is not online.", White)
+ End If
+
+ Else
+ Call PlayerMsg(GetPlayerName(index), "Cannot message yourself.", BrightRed)
+ End If
+
+ Set Buffer = Nothing
+
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Moving character packet ::
+' :::::::::::::::::::::::::::::
+Sub HandlePlayerMove(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim dir As Long
+ Dim movement As Long
+ Dim Buffer As clsBuffer
+ Dim tmpX As Long, tmpY As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ If TempPlayer(index).GettingMap = YES Then
+ Exit Sub
+ End If
+
+ dir = Buffer.ReadLong 'CLng(Parse(1))
+ movement = Buffer.ReadLong 'CLng(Parse(2))
+ tmpX = Buffer.ReadLong
+ tmpY = Buffer.ReadLong
+ Set Buffer = Nothing
+
+ ' Prevent hacking
+ If dir < DIR_UP Or dir > DIR_RIGHT Then
+ Exit Sub
+ End If
+
+ ' Prevent hacking
+ If movement < 1 Or movement > 2 Then
+ Exit Sub
+ End If
+
+ ' Prevent player from moving if they have casted a spell
+ 'If TempPlayer(index).spellBuffer.Spell > 0 Then
+ ' Call SendPlayerXY(index)
+ ' Exit Sub
+ 'End If
+
+ 'Cant move if in the bank!
+ If TempPlayer(index).InBank Then
+ 'Call SendPlayerXY(Index)
+ 'Exit Sub
+ TempPlayer(index).InBank = False
+ End If
+
+ ' if stunned, stop them moving
+ If TempPlayer(index).StunDuration > 0 Then
+ Call SendPlayerXY(index)
+ Exit Sub
+ End If
+
+ ' Prever player from moving if in shop
+ If TempPlayer(index).InShop > 0 Then
+ Call SendPlayerXY(index)
+ Exit Sub
+ End If
+
+ ' Desynced
+ If GetPlayerX(index) <> tmpX Then
+ SendPlayerXY (index)
+ Exit Sub
+ End If
+
+ If GetPlayerY(index) <> tmpY Then
+ SendPlayerXY (index)
+ Exit Sub
+ End If
+
+ ' cant move if chatting
+ If TempPlayer(index).inChatWith > 0 Then
+ ClosePlayerChat index
+ End If
+
+ Call PlayerMove(index, dir, movement)
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Moving character packet ::
+' :::::::::::::::::::::::::::::
+Sub HandlePlayerDir(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim dir As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ If TempPlayer(index).GettingMap = YES Then
+ Exit Sub
+ End If
+
+ dir = Buffer.ReadLong 'CLng(Parse(1))
+ Set Buffer = Nothing
+
+ ' Prevent hacking
+ If dir < DIR_UP Or dir > DIR_RIGHT Then
+ Exit Sub
+ End If
+
+ Call SetPlayerDir(index, dir)
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerDir
+ Buffer.WriteLong index
+ Buffer.WriteLong GetPlayerDir(index)
+ SendDataToMapBut index, GetPlayerMap(index), Buffer.ToArray()
+End Sub
+
+' :::::::::::::::::::::
+' :: Use item packet ::
+' :::::::::::::::::::::
+Sub HandleUseItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim invNum As Long
+Dim Buffer As clsBuffer
+
+ ' get inventory slot number
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ invNum = Buffer.ReadLong
+ Set Buffer = Nothing
+
+ UseItem index, invNum
+End Sub
+
+' ::::::::::::::::::::::::::
+' :: Player attack packet ::
+' ::::::::::::::::::::::::::
+Sub HandleAttack(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim i As Long, n As Long, damage As Long, TempIndex As Long, x As Long, y As Long, mapnum As Long, dirReq As Long
+
+ ' can't attack whilst casting
+ If TempPlayer(index).spellBuffer.Spell > 0 Then Exit Sub
+
+ ' can't attack whilst stunned
+ If TempPlayer(index).StunDuration > 0 Then Exit Sub
+
+ ' Send this packet so they can see the person attacking
+ SendAttack index
+
+ ' Try to attack a player
+ For i = 1 To Player_HighIndex
+ TempIndex = i
+
+ ' Make sure we dont try to attack ourselves
+ If TempIndex <> index Then
+ TryPlayerAttackPlayer index, i
+ End If
+ Next
+
+ ' Try to attack a npc
+ For i = 1 To MAX_MAP_NPCS
+ TryPlayerAttackNpc index, i
+ Next
+
+ ' check if we've got a remote chat tile
+ mapnum = GetPlayerMap(index)
+ x = GetPlayerX(index)
+ y = GetPlayerY(index)
+ If Map(mapnum).TileData.Tile(x, y).Type = TILE_TYPE_CHAT Then
+ dirReq = Map(mapnum).TileData.Tile(x, y).Data2
+ If Player(index).dir = dirReq Then
+ InitChat index, mapnum, Map(mapnum).TileData.Tile(x, y).Data1, True
+ Exit Sub
+ End If
+ End If
+
+ ' Check tradeskills
+ Select Case GetPlayerDir(index)
+ Case DIR_UP
+
+ If GetPlayerY(index) = 0 Then Exit Sub
+ x = GetPlayerX(index)
+ y = GetPlayerY(index) - 1
+ Case DIR_DOWN
+
+ If GetPlayerY(index) = Map(GetPlayerMap(index)).MapData.MaxY Then Exit Sub
+ x = GetPlayerX(index)
+ y = GetPlayerY(index) + 1
+ Case DIR_LEFT
+
+ If GetPlayerX(index) = 0 Then Exit Sub
+ x = GetPlayerX(index) - 1
+ y = GetPlayerY(index)
+ Case DIR_RIGHT
+
+ If GetPlayerX(index) = Map(GetPlayerMap(index)).MapData.MaxX Then Exit Sub
+ x = GetPlayerX(index) + 1
+ y = GetPlayerY(index)
+ End Select
+
+ CheckResource index, x, y
+End Sub
+
+' ::::::::::::::::::::::
+' :: Use stats packet ::
+' ::::::::::::::::::::::
+Sub HandleUseStatPoint(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim PointType As Byte
+Dim Buffer As clsBuffer
+Dim sMes As String
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ PointType = Buffer.ReadByte 'CLng(Parse(1))
+ Set Buffer = Nothing
+
+ ' Prevent hacking
+ If (PointType < 0) Or (PointType > Stats.Stat_Count) Then
+ Exit Sub
+ End If
+
+ ' Make sure they have points
+ If GetPlayerPOINTS(index) > 0 Then
+ ' make sure they're not maxed
+ If GetPlayerRawStat(index, PointType) >= 255 Then
+ PlayerMsg index, "You cannot spend any more points on that stat.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure they're not spending too much
+ If GetPlayerRawStat(index, PointType) - Class(GetPlayerClass(index)).Stat(PointType) >= (GetPlayerLevel(index) * 2) - 1 Then
+ PlayerMsg index, "You cannot spend any more points on that stat.", BrightRed
+ Exit Sub
+ End If
+
+ ' Take away a stat point
+ Call SetPlayerPOINTS(index, GetPlayerPOINTS(index) - 1)
+
+ ' Everything is ok
+ Select Case PointType
+ Case Stats.Strength
+ Call SetPlayerStat(index, Stats.Strength, GetPlayerRawStat(index, Stats.Strength) + 1)
+ sMes = "Strength"
+ Case Stats.Endurance
+ Call SetPlayerStat(index, Stats.Endurance, GetPlayerRawStat(index, Stats.Endurance) + 1)
+ sMes = "Endurance"
+ Case Stats.Intelligence
+ Call SetPlayerStat(index, Stats.Intelligence, GetPlayerRawStat(index, Stats.Intelligence) + 1)
+ sMes = "Intelligence"
+ Case Stats.Agility
+ Call SetPlayerStat(index, Stats.Agility, GetPlayerRawStat(index, Stats.Agility) + 1)
+ sMes = "Agility"
+ Case Stats.Willpower
+ Call SetPlayerStat(index, Stats.Willpower, GetPlayerRawStat(index, Stats.Willpower) + 1)
+ sMes = "Willpower"
+ End Select
+
+ SendActionMsg GetPlayerMap(index), "+1 " & sMes, White, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
+ Else
+ Exit Sub
+ End If
+
+ ' Send the update
+ SendPlayerData index
+End Sub
+
+' ::::::::::::::::::::::::::::::::
+' :: Player info request packet ::
+' ::::::::::::::::::::::::::::::::
+Sub HandlePlayerInfoRequest(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Name As String
+ Dim i As Long
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ Name = Buffer.ReadString 'Parse(1)
+ Set Buffer = Nothing
+ i = FindPlayer(Name)
+End Sub
+
+' :::::::::::::::::::::::
+' :: Warp me to packet ::
+' :::::::::::::::::::::::
+Sub HandleWarpMeTo(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ ' The player
+ n = FindPlayer(Buffer.ReadString) 'Parse(1))
+ Set Buffer = Nothing
+
+ If n <> index Then
+ If n > 0 Then
+ Call PlayerWarp(index, GetPlayerMap(n), GetPlayerX(n), GetPlayerY(n))
+ Call PlayerMsg(n, GetPlayerName(index) & " has warped to you.", BrightBlue)
+ Call PlayerMsg(index, "You have been warped to " & GetPlayerName(n) & ".", BrightBlue)
+ Call AddLog(GetPlayerName(index) & " has warped to " & GetPlayerName(n) & ", map #" & GetPlayerMap(n) & ".", ADMIN_LOG)
+ Else
+ Call PlayerMsg(index, "Player is not online.", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "You cannot warp to yourself!", White)
+ End If
+
+End Sub
+
+' :::::::::::::::::::::::
+' :: Warp to me packet ::
+' :::::::::::::::::::::::
+Sub HandleWarpToMe(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ ' The player
+ n = FindPlayer(Buffer.ReadString) 'Parse(1))
+ Set Buffer = Nothing
+
+ If n <> index Then
+ If n > 0 Then
+ Call PlayerWarp(n, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index))
+ Call PlayerMsg(n, "You have been summoned by " & GetPlayerName(index) & ".", BrightBlue)
+ Call PlayerMsg(index, GetPlayerName(n) & " has been summoned.", BrightBlue)
+ Call AddLog(GetPlayerName(index) & " has warped " & GetPlayerName(n) & " to self, map #" & GetPlayerMap(index) & ".", ADMIN_LOG)
+ Else
+ Call PlayerMsg(index, "Player is not online.", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "You cannot warp yourself to yourself!", White)
+ End If
+
+End Sub
+
+' ::::::::::::::::::::::::
+' :: Warp to map packet ::
+' ::::::::::::::::::::::::
+Sub HandleWarpTo(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ ' The map
+ n = Buffer.ReadLong 'CLng(Parse(1))
+ Set Buffer = Nothing
+
+ ' Prevent hacking
+ If n < 0 Or n > MAX_MAPS Then
+ Exit Sub
+ End If
+
+ Call PlayerWarp(index, n, GetPlayerX(index), GetPlayerY(index))
+ Call PlayerMsg(index, "You have been warped to map #" & n, BrightBlue)
+ Call AddLog(GetPlayerName(index) & " warped to map #" & n & ".", ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::::::
+' :: Set sprite packet ::
+' :::::::::::::::::::::::
+Sub HandleSetSprite(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ ' The sprite
+ n = Buffer.ReadLong 'CLng(Parse(1))
+ Set Buffer = Nothing
+ Call SetPlayerSprite(index, n)
+ Call SendPlayerData(index)
+ Exit Sub
+End Sub
+
+' ::::::::::::::::::::::::::
+' :: Stats request packet ::
+' ::::::::::::::::::::::::::
+Sub HandleGetStats(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+
+End Sub
+
+' ::::::::::::::::::::::::::::::::::
+' :: Player request for a new map ::
+' ::::::::::::::::::::::::::::::::::
+Sub HandleRequestNewMap(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim dir As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ dir = Buffer.ReadLong 'CLng(Parse(1))
+ Set Buffer = Nothing
+
+ ' Prevent hacking
+ If dir < DIR_UP Or dir > DIR_RIGHT Then
+ Exit Sub
+ End If
+
+ Call PlayerMove(index, dir, 1)
+End Sub
+
+' :::::::::::::::::::::
+' :: Map data packet ::
+' :::::::::::::::::::::
+Sub HandleMapData(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+ Dim mapnum As Long
+ Dim x As Long
+ Dim y As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ mapnum = GetPlayerMap(index)
+
+ Call ClearMap(mapnum)
+
+ With Map(mapnum).MapData
+ .Name = Buffer.ReadString
+ .Music = Buffer.ReadString
+ .Moral = Buffer.ReadByte
+ .Up = Buffer.ReadLong
+ .Down = Buffer.ReadLong
+ .left = Buffer.ReadLong
+ .Right = Buffer.ReadLong
+ .BootMap = Buffer.ReadLong
+ .BootX = Buffer.ReadByte
+ .BootY = Buffer.ReadByte
+ .MaxX = Buffer.ReadByte
+ .MaxY = Buffer.ReadByte
+ .BossNpc = Buffer.ReadLong
+ For i = 1 To MAX_MAP_NPCS
+ .Npc(i) = Buffer.ReadLong
+ Call ClearMapNpc(i, mapnum)
+ Next
+ End With
+
+ Map(mapnum).TileData.EventCount = Buffer.ReadLong
+ If Map(mapnum).TileData.EventCount > 0 Then
+ ReDim Preserve Map(mapnum).TileData.Events(1 To Map(mapnum).TileData.EventCount)
+ For i = 1 To Map(mapnum).TileData.EventCount
+ With Map(mapnum).TileData.Events(i)
+ .Name = Buffer.ReadString
+ .x = Buffer.ReadLong
+ .y = Buffer.ReadLong
+ .PageCount = Buffer.ReadLong
+ End With
+ If Map(mapnum).TileData.Events(i).PageCount > 0 Then
+ ReDim Preserve Map(mapnum).TileData.Events(i).EventPage(1 To Map(mapnum).TileData.Events(i).PageCount)
+ For x = 1 To Map(mapnum).TileData.Events(i).PageCount
+ With Map(mapnum).TileData.Events(i).EventPage(x)
+ .chkPlayerVar = Buffer.ReadByte
+ .chkSelfSwitch = Buffer.ReadByte
+ .chkHasItem = Buffer.ReadByte
+ .PlayerVarNum = Buffer.ReadLong
+ .SelfSwitchNum = Buffer.ReadLong
+ .HasItemNum = Buffer.ReadLong
+ .PlayerVariable = Buffer.ReadLong
+ .GraphicType = Buffer.ReadByte
+ .Graphic = Buffer.ReadLong
+ .GraphicX = Buffer.ReadLong
+ .GraphicY = Buffer.ReadLong
+ .MoveType = Buffer.ReadByte
+ .MoveSpeed = Buffer.ReadByte
+ .MoveFreq = Buffer.ReadByte
+ .WalkAnim = Buffer.ReadByte
+ .StepAnim = Buffer.ReadByte
+ .DirFix = Buffer.ReadByte
+ .WalkThrough = Buffer.ReadByte
+ .Priority = Buffer.ReadByte
+ .Trigger = Buffer.ReadByte
+ .CommandCount = Buffer.ReadLong
+ End With
+ If Map(mapnum).TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ ReDim Preserve Map(mapnum).TileData.Events(i).EventPage(x).Commands(1 To Map(mapnum).TileData.Events(i).EventPage(x).CommandCount)
+ For y = 1 To Map(mapnum).TileData.Events(i).EventPage(x).CommandCount
+ With Map(mapnum).TileData.Events(i).EventPage(x).Commands(y)
+ .Type = Buffer.ReadByte
+ .Text = Buffer.ReadString
+ .colour = Buffer.ReadLong
+ .Channel = Buffer.ReadByte
+ .targetType = Buffer.ReadByte
+ .target = Buffer.ReadLong
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ ReDim Map(mapnum).TileData.Tile(0 To Map(mapnum).MapData.MaxX, 0 To Map(mapnum).MapData.MaxY)
+
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+ For i = 1 To MapLayer.Layer_Count - 1
+ Map(mapnum).TileData.Tile(x, y).Layer(i).x = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Layer(i).y = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Layer(i).Tileset = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Autotile(i) = Buffer.ReadByte
+ Next
+ Map(mapnum).TileData.Tile(x, y).Type = Buffer.ReadByte
+ Map(mapnum).TileData.Tile(x, y).Data1 = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Data2 = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Data3 = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Data4 = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).Data5 = Buffer.ReadLong
+ Map(mapnum).TileData.Tile(x, y).DirBlock = Buffer.ReadByte
+ Next
+ Next
+
+ Call SendMapNpcsToMap(mapnum)
+ Call SpawnMapNpcs(mapnum)
+
+ ' Clear out it all
+ For i = 1 To MAX_MAP_ITEMS
+ Call SpawnItemSlot(i, 0, 0, GetPlayerMap(index), MapItem(GetPlayerMap(index), i).x, MapItem(GetPlayerMap(index), i).y)
+ Call ClearMapItem(i, GetPlayerMap(index))
+ Next
+
+ ' Respawn
+ Call SpawnMapItems(GetPlayerMap(index))
+ ' Save the map
+ Call SaveMap(mapnum)
+ Call MapCache_Create(mapnum)
+ Call ClearTempTile(mapnum)
+ Call CacheResources(mapnum)
+ Call GetMapCRC32(mapnum)
+
+ ' Refresh map for everyone online
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And GetPlayerMap(i) = mapnum Then
+ Call PlayerWarp(i, mapnum, GetPlayerX(i), GetPlayerY(i))
+ End If
+ Next i
+
+ Set Buffer = Nothing
+End Sub
+
+' ::::::::::::::::::::::::::::
+' :: Need map yes/no packet ::
+' ::::::::::::::::::::::::::::
+Sub HandleNeedMap(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim s As String
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ ' Get yes/no value
+ s = Buffer.ReadLong 'Parse(1)
+ Set Buffer = Nothing
+
+ ' Check if map data is needed to be sent
+ If s = 1 Then
+ Call SendMap(index, GetPlayerMap(index))
+ End If
+
+ Call SendMapItemsTo(index, GetPlayerMap(index))
+ Call SendMapNpcsTo(index, GetPlayerMap(index))
+ Call SendJoinMap(index)
+
+ 'send Resource cache
+ For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count
+ SendResourceCacheTo index, i
+ Next
+
+ TempPlayer(index).GettingMap = NO
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SMapDone
+ SendDataTo index, Buffer.ToArray()
+End Sub
+
+' :::::::::::::::::::::::::::::::::::::::::::::::
+' :: Player trying to pick up something packet ::
+' :::::::::::::::::::::::::::::::::::::::::::::::
+Sub HandleMapGetItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Call PlayerMapGetItem(index)
+End Sub
+
+' ::::::::::::::::::::::::::::::::::::::::::::
+' :: Player trying to drop something packet ::
+' ::::::::::::::::::::::::::::::::::::::::::::
+Sub HandleMapDropItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim invNum As Long
+ Dim amount As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteBytes Data()
+ invNum = Buffer.ReadLong 'CLng(Parse(1))
+ amount = Buffer.ReadLong 'CLng(Parse(2))
+ Set Buffer = Nothing
+
+ If TempPlayer(index).InBank Or TempPlayer(index).InShop Then Exit Sub
+
+ ' Prevent hacking
+ If invNum < 1 Or invNum > MAX_INV Then Exit Sub
+
+ If GetPlayerInvItemNum(index, invNum) < 1 Or GetPlayerInvItemNum(index, invNum) > MAX_ITEMS Then Exit Sub
+
+ If Item(GetPlayerInvItemNum(index, invNum)).Type = ITEM_TYPE_CURRENCY Then
+ If amount < 1 Or amount > GetPlayerInvItemValue(index, invNum) Then Exit Sub
+ End If
+
+ ' everything worked out fine
+ Call PlayerMapDropItem(index, invNum, amount)
+End Sub
+
+' ::::::::::::::::::::::::
+' :: Respawn map packet ::
+' ::::::::::::::::::::::::
+Sub HandleMapRespawn(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim i As Long
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ ' Clear out it all
+ For i = 1 To MAX_MAP_ITEMS
+ Call SpawnItemSlot(i, 0, 0, GetPlayerMap(index), MapItem(GetPlayerMap(index), i).x, MapItem(GetPlayerMap(index), i).y)
+ Call ClearMapItem(i, GetPlayerMap(index))
+ Next
+
+ ' Respawn
+ Call SpawnMapItems(GetPlayerMap(index))
+
+ ' Respawn NPCS
+ For i = 1 To MAX_MAP_NPCS
+ Call SpawnNpc(i, GetPlayerMap(index))
+ Next
+
+ CacheResources GetPlayerMap(index)
+ Call PlayerMsg(index, "Map respawned.", Blue)
+ Call AddLog(GetPlayerName(index) & " has respawned map #" & GetPlayerMap(index), ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::::::
+' :: Map report packet ::
+' :::::::::::::::::::::::
+Sub HandleMapReport(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim s As String
+ Dim i As Long
+ Dim tMapStart As Long
+ Dim tMapEnd As Long
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ s = "Free Maps: "
+ tMapStart = 1
+ tMapEnd = 1
+
+ For i = 1 To MAX_MAPS
+
+ If LenB(Trim$(Map(i).MapData.Name)) = 0 Then
+ tMapEnd = tMapEnd + 1
+ Else
+
+ If tMapEnd - tMapStart > 0 Then
+ s = s & Trim$(CStr(tMapStart)) & "-" & Trim$(CStr(tMapEnd - 1)) & ", "
+ End If
+
+ tMapStart = i + 1
+ tMapEnd = i + 1
+ End If
+
+ Next
+
+ s = s & Trim$(CStr(tMapStart)) & "-" & Trim$(CStr(tMapEnd - 1)) & ", "
+ s = Mid$(s, 1, Len(s) - 2)
+ s = s & "."
+ Call PlayerMsg(index, s, Brown)
+End Sub
+
+' ::::::::::::::::::::::::
+' :: Kick player packet ::
+' ::::::::::::::::::::::::
+Sub HandleKickPlayer(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) <= 0 Then
+ Exit Sub
+ End If
+
+ ' The player index
+ n = FindPlayer(Buffer.ReadString) 'Parse(1))
+ Set Buffer = Nothing
+
+ If n <> index Then
+ If n > 0 Then
+ If GetPlayerAccess(n) < GetPlayerAccess(index) Then
+ Call GlobalMsg(GetPlayerName(n) & " has been kicked from " & GAME_NAME & " by " & GetPlayerName(index) & "!", White)
+ Call AddLog(GetPlayerName(index) & " has kicked " & GetPlayerName(n) & ".", ADMIN_LOG)
+ Call AlertMsg(n, DIALOGUE_MSG_KICKED)
+ Else
+ Call PlayerMsg(index, "That is a higher or same access admin then you!", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "Player is not online.", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "You cannot kick yourself!", White)
+ End If
+
+End Sub
+
+' :::::::::::::::::::::
+' :: Ban list packet ::
+' :::::::::::::::::::::
+Sub HandleBanlist(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ PlayerMsg index, "I'm afraid I can't do that.", BrightRed
+End Sub
+
+' ::::::::::::::::::::::::
+' :: Ban destroy packet ::
+' ::::::::::::::::::::::::
+Sub HandleBanDestroy(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ PlayerMsg index, "I'm afraid I can't do that.", BrightRed
+End Sub
+
+' :::::::::::::::::::::::
+' :: Ban player packet ::
+' :::::::::::::::::::::::
+Sub HandleBanPlayer(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ ' The player index
+ n = FindPlayer(Buffer.ReadString) 'Parse(1))
+ Set Buffer = Nothing
+
+ If n <> index Then
+ If n > 0 Then
+ If GetPlayerAccess(n) < GetPlayerAccess(index) Then
+ Call BanIndex(n)
+ Else
+ Call PlayerMsg(index, "That is a higher or same access admin then you!", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "Player is not online.", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "You cannot ban yourself!", White)
+ End If
+
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Request edit map packet ::
+' :::::::::::::::::::::::::::::
+Sub HandleRequestEditMap(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SEditMap
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' ::::::::::::::::::::::::::::::
+' :: Request edit item packet ::
+' ::::::::::::::::::::::::::::::
+Sub HandleRequestEditItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SItemEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' ::::::::::::::::::::::
+' :: Save item packet ::
+' ::::::::::::::::::::::
+Sub HandleSaveItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Dim ItemSize As Long
+ Dim ItemData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ n = Buffer.ReadLong 'CLng(Parse(1))
+
+ If n < 0 Or n > MAX_ITEMS Then
+ Exit Sub
+ End If
+
+ ' Update the item
+ ItemSize = LenB(Item(n))
+ ReDim ItemData(ItemSize - 1)
+ ItemData = Buffer.ReadBytes(ItemSize)
+ CopyMemory ByVal VarPtr(Item(n)), ByVal VarPtr(ItemData(0)), ItemSize
+ Set Buffer = Nothing
+
+ ' Save it
+ Call SendUpdateItemToAll(n)
+ Call SaveItem(n)
+ Call AddLog(GetPlayerName(index) & " saved item #" & n & ".", ADMIN_LOG)
+End Sub
+
+' ::::::::::::::::::::::::::::::
+' :: Request edit Animation packet ::
+' ::::::::::::::::::::::::::::::
+Sub HandleRequestEditAnimation(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SAnimationEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' ::::::::::::::::::::::
+' :: Save Animation packet ::
+' ::::::::::::::::::::::
+Sub HandleSaveAnimation(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Dim AnimationSize As Long
+ Dim AnimationData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ n = Buffer.ReadLong 'CLng(Parse(1))
+
+ If n < 0 Or n > MAX_ANIMATIONS Then
+ Exit Sub
+ End If
+
+ ' Update the Animation
+ AnimationSize = LenB(Animation(n))
+ ReDim AnimationData(AnimationSize - 1)
+ AnimationData = Buffer.ReadBytes(AnimationSize)
+ CopyMemory ByVal VarPtr(Animation(n)), ByVal VarPtr(AnimationData(0)), AnimationSize
+ Set Buffer = Nothing
+
+ ' Save it
+ Call SendUpdateAnimationToAll(n)
+ Call SaveAnimation(n)
+ Call AddLog(GetPlayerName(index) & " saved Animation #" & n & ".", ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Request edit npc packet ::
+' :::::::::::::::::::::::::::::
+Sub HandleRequestEditNpc(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' :::::::::::::::::::::
+' :: Save npc packet ::
+' :::::::::::::::::::::
+Private Sub HandleSaveNpc(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim npcNum As Long
+ Dim Buffer As clsBuffer
+ Dim NPCSize As Long
+ Dim NPCData() As Byte
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ npcNum = Buffer.ReadLong
+
+ ' Prevent hacking
+ If npcNum < 0 Or npcNum > MAX_NPCS Then
+ Exit Sub
+ End If
+
+ NPCSize = LenB(Npc(npcNum))
+ ReDim NPCData(NPCSize - 1)
+ NPCData = Buffer.ReadBytes(NPCSize)
+ CopyMemory ByVal VarPtr(Npc(npcNum)), ByVal VarPtr(NPCData(0)), NPCSize
+ ' Save it
+ Call SendUpdateNpcToAll(npcNum)
+ Call SaveNpc(npcNum)
+ Call AddLog(GetPlayerName(index) & " saved Npc #" & npcNum & ".", ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Request edit Resource packet ::
+' :::::::::::::::::::::::::::::
+Sub HandleRequestEditResource(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SResourceEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' :::::::::::::::::::::
+' :: Save Resource packet ::
+' :::::::::::::::::::::
+Private Sub HandleSaveResource(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim ResourceNum As Long
+ Dim Buffer As clsBuffer
+ Dim ResourceSize As Long
+ Dim ResourceData() As Byte
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ ResourceNum = Buffer.ReadLong
+
+ ' Prevent hacking
+ If ResourceNum < 0 Or ResourceNum > MAX_RESOURCES Then
+ Exit Sub
+ End If
+
+ ResourceSize = LenB(Resource(ResourceNum))
+ ReDim ResourceData(ResourceSize - 1)
+ ResourceData = Buffer.ReadBytes(ResourceSize)
+ CopyMemory ByVal VarPtr(Resource(ResourceNum)), ByVal VarPtr(ResourceData(0)), ResourceSize
+ ' Save it
+ Call SendUpdateResourceToAll(ResourceNum)
+ Call SaveResource(ResourceNum)
+ Call AddLog(GetPlayerName(index) & " saved Resource #" & ResourceNum & ".", ADMIN_LOG)
+End Sub
+
+' ::::::::::::::::::::::::::::::
+' :: Request edit shop packet ::
+' ::::::::::::::::::::::::::::::
+Sub HandleRequestEditShop(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SShopEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' ::::::::::::::::::::::
+' :: Save shop packet ::
+' ::::::::::::::::::::::
+Sub HandleSaveShop(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim shopNum As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Dim ShopSize As Long
+ Dim ShopData() As Byte
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ shopNum = Buffer.ReadLong
+
+ ' Prevent hacking
+ If shopNum < 0 Or shopNum > MAX_SHOPS Then
+ Exit Sub
+ End If
+
+ ShopSize = LenB(Shop(shopNum))
+ ReDim ShopData(ShopSize - 1)
+ ShopData = Buffer.ReadBytes(ShopSize)
+ CopyMemory ByVal VarPtr(Shop(shopNum)), ByVal VarPtr(ShopData(0)), ShopSize
+
+ Set Buffer = Nothing
+ ' Save it
+ Call SendUpdateShopToAll(shopNum)
+ Call SaveShop(shopNum)
+ Call AddLog(GetPlayerName(index) & " saving shop #" & shopNum & ".", ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Request edit spell packet ::
+' :::::::::::::::::::::::::::::
+Sub HandleRequestEditspell(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSpellEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' :::::::::::::::::::::::
+' :: Save spell packet ::
+' :::::::::::::::::::::::
+Sub HandleSaveSpell(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim spellNum As Long
+ Dim Buffer As clsBuffer
+ Dim SpellSize As Long
+ Dim SpellData() As Byte
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ spellNum = Buffer.ReadLong
+
+ ' Prevent hacking
+ If spellNum < 0 Or spellNum > MAX_SPELLS Then
+ Exit Sub
+ End If
+
+ SpellSize = LenB(Spell(spellNum))
+ ReDim SpellData(SpellSize - 1)
+ SpellData = Buffer.ReadBytes(SpellSize)
+ CopyMemory ByVal VarPtr(Spell(spellNum)), ByVal VarPtr(SpellData(0)), SpellSize
+ ' Save it
+ Call SendUpdateSpellToAll(spellNum)
+ Call SaveSpell(spellNum)
+ Call AddLog(GetPlayerName(index) & " saved Spell #" & spellNum & ".", ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::::::
+' :: Set access packet ::
+' :::::::::::::::::::::::
+Sub HandleSetAccess(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_CREATOR Then
+ Exit Sub
+ End If
+
+ ' The index
+ n = FindPlayer(Buffer.ReadString) 'Parse(1))
+ ' The access
+ i = Buffer.ReadLong 'CLng(Parse(2))
+ Set Buffer = Nothing
+
+ ' Check for invalid access level
+ If i >= 0 Or i <= 3 Then
+
+ ' Check if player is on
+ If n > 0 Then
+
+ 'check to see if same level access is trying to change another access of the very same level and boot them if they are.
+ If GetPlayerAccess(n) = GetPlayerAccess(index) Then
+ Call PlayerMsg(index, "Invalid access level.", Red)
+ Exit Sub
+ End If
+
+ If GetPlayerAccess(n) <= 0 Then
+ Call GlobalMsg(GetPlayerName(n) & " has been blessed with administrative access.", BrightBlue)
+ End If
+
+ Call SetPlayerAccess(n, i)
+ Call SendPlayerData(n)
+ Call AddLog(GetPlayerName(index) & " has modified " & GetPlayerName(n) & "'s access.", ADMIN_LOG)
+ Else
+ Call PlayerMsg(index, "Player is not online.", White)
+ End If
+
+ Else
+ Call PlayerMsg(index, "Invalid access level.", Red)
+ End If
+
+End Sub
+
+' :::::::::::::::::::::::
+' :: Who online packet ::
+' :::::::::::::::::::::::
+Sub HandleWhosOnline(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Call SendWhosOnline(index)
+End Sub
+
+' :::::::::::::::::::::
+' :: Set MOTD packet ::
+' :::::::::::::::::::::
+Sub HandleSetMotd(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_MAPPER Then
+ Exit Sub
+ End If
+
+ Options.MOTD = Trim$(Buffer.ReadString) 'Parse(1))
+ SaveOptions
+ Set Buffer = Nothing
+ Call GlobalMsg("MOTD changed to: " & Options.MOTD, BrightCyan)
+ Call AddLog(GetPlayerName(index) & " changed MOTD to: " & Options.MOTD, ADMIN_LOG)
+End Sub
+
+' :::::::::::::::::::
+' :: Search packet ::
+' :::::::::::::::::::
+Sub HandleTarget(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, target As Long, targetType As Long
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteBytes Data()
+
+ target = Buffer.ReadLong
+ targetType = Buffer.ReadLong
+
+ Set Buffer = Nothing
+
+ ' set player's target - no need to send, it's client side
+ TempPlayer(index).target = target
+ TempPlayer(index).targetType = targetType
+End Sub
+
+' :::::::::::::::::::
+' :: Spells packet ::
+' :::::::::::::::::::
+Sub HandleSpells(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Call SendPlayerSpells(index)
+End Sub
+
+' :::::::::::::::::
+' :: Cast packet ::
+' :::::::::::::::::
+Sub HandleCast(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ ' Spell slot
+ n = Buffer.ReadLong 'CLng(Parse(1))
+ Set Buffer = Nothing
+ ' set the spell buffer before castin
+ Call BufferSpell(index, n)
+End Sub
+
+' ::::::::::::::::::::::
+' :: Quit game packet ::
+' ::::::::::::::::::::::
+Sub HandleQuit(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Call CloseSocket(index)
+End Sub
+
+' ::::::::::::::::::::::::::
+' :: Swap Inventory Slots ::
+' ::::::::::::::::::::::::::
+Sub HandleSwapInvSlots(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Dim oldSlot As Long, newSlot As Long
+
+ If TempPlayer(index).InTrade > 0 Or TempPlayer(index).InBank Then Exit Sub
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ ' Old Slot
+ oldSlot = Buffer.ReadLong
+ newSlot = Buffer.ReadLong
+ Set Buffer = Nothing
+ PlayerSwitchInvSlots index, oldSlot, newSlot
+End Sub
+
+Sub HandleSwapSpellSlots(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim oldSlot As Long, newSlot As Long, n As Long
+
+ If TempPlayer(index).InTrade > 0 Or TempPlayer(index).InBank Or TempPlayer(index).InShop Then Exit Sub
+
+ If TempPlayer(index).spellBuffer.Spell > 0 Then
+ PlayerMsg index, "You cannot swap spells whilst casting.", BrightRed
+ Exit Sub
+ End If
+
+ For n = 1 To MAX_PLAYER_SPELLS
+ If TempPlayer(index).SpellCD(n) > GetTickCount Then
+ PlayerMsg index, "You cannot swap spells whilst they're cooling down.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ ' Old Slot
+ oldSlot = Buffer.ReadLong
+ newSlot = Buffer.ReadLong
+ Set Buffer = Nothing
+ PlayerSwitchSpellSlots index, oldSlot, newSlot
+End Sub
+
+' ::::::::::::::::
+' :: Check Ping ::
+' ::::::::::::::::
+Sub HandleCheckPing(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim n As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSendPing
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleUnequip(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ PlayerUnequipItem index, Buffer.ReadLong
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleRequestPlayerData(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendPlayerData index
+End Sub
+
+Sub HandleRequestItems(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendItems index
+End Sub
+
+Sub HandleRequestAnimations(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendAnimations index
+End Sub
+
+Sub HandleRequestNPCS(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendNpcs index
+End Sub
+
+Sub HandleRequestResources(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendResources index
+End Sub
+
+Sub HandleRequestSpells(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendSpells index
+End Sub
+
+Sub HandleRequestShops(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendShops index
+End Sub
+
+Sub HandleSpawnItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim tmpItem As Long
+ Dim tmpAmount As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' item
+ tmpItem = Buffer.ReadLong
+ tmpAmount = Buffer.ReadLong
+
+ If GetPlayerAccess(index) < ADMIN_CREATOR Then Exit Sub
+
+ SpawnItem tmpItem, tmpAmount, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index), GetPlayerName(index)
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleRequestLevelUp(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ If GetPlayerAccess(index) < 4 Then Exit Sub
+ SetPlayerExp index, GetPlayerNextLevel(index)
+ CheckPlayerLevelUp index
+End Sub
+
+Sub HandleForgetSpell(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim spellSlot As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ spellSlot = Buffer.ReadLong
+
+ ' Check for subscript out of range
+ If spellSlot < 1 Or spellSlot > MAX_PLAYER_SPELLS Then
+ Exit Sub
+ End If
+
+ ' dont let them forget a spell which is in CD
+ If TempPlayer(index).SpellCD(spellSlot) > GetTickCount Then
+ PlayerMsg index, "Cannot forget a spell which is cooling down!", BrightRed
+ Exit Sub
+ End If
+
+ ' dont let them forget a spell which is buffered
+ If TempPlayer(index).spellBuffer.Spell = spellSlot Then
+ PlayerMsg index, "Cannot forget a spell which you are casting!", BrightRed
+ Exit Sub
+ End If
+
+ Player(index).Spell(spellSlot).Spell = 0
+ Player(index).Spell(spellSlot).Uses = 0
+ SendPlayerSpells index
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleCloseShop(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ TempPlayer(index).InShop = 0
+End Sub
+
+Sub HandleBuyItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim shopslot As Long
+ Dim shopNum As Long
+ Dim itemAmount As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ shopslot = Buffer.ReadLong
+
+ ' not in shop, exit out
+ shopNum = TempPlayer(index).InShop
+ If shopNum < 1 Or shopNum > MAX_SHOPS Then Exit Sub
+
+ With Shop(shopNum).TradeItem(shopslot)
+ ' check trade exists
+ If .Item < 1 Then Exit Sub
+
+ ' make sure they have inventory space
+ If FindOpenInvSlot(index, .Item) = 0 Then
+ PlayerMsg index, "You do not have enough inventory space.", BrightRed
+ ResetShopAction index
+ Exit Sub
+ End If
+
+ ' check has the cost item
+ itemAmount = HasItem(index, .costitem)
+ If itemAmount = 0 Or itemAmount < .costvalue Then
+ PlayerMsg index, "You do not have enough to buy this item.", BrightRed
+ ResetShopAction index
+ Exit Sub
+ End If
+
+ ' it's fine, let's go ahead
+ TakeInvItem index, .costitem, .costvalue
+ GiveInvItem index, .Item, .ItemValue
+
+ PlayerMsg index, "You successfully bought " & Trim$(Item(.Item).Name) & " for " & .costvalue & " " & Trim$(Item(.costitem).Name) & ".", BrightGreen
+ End With
+
+ ' send confirmation message & reset their shop action
+ 'PlayerMsg index, "Trade successful.", BrightGreen
+
+ ResetShopAction index
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleSellItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim invSlot As Long
+ Dim itemNum As Long
+ Dim price As Long
+ Dim multiplier As Double
+ Dim amount As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ invSlot = Buffer.ReadLong
+
+ If TempPlayer(index).InShop = 0 Then Exit Sub
+
+ ' if invalid, exit out
+ If invSlot < 1 Or invSlot > MAX_INV Then Exit Sub
+
+ ' has item?
+ If GetPlayerInvItemNum(index, invSlot) < 1 Or GetPlayerInvItemNum(index, invSlot) > MAX_ITEMS Then Exit Sub
+
+ ' seems to be valid
+ itemNum = GetPlayerInvItemNum(index, invSlot)
+
+ ' work out price
+ multiplier = Shop(TempPlayer(index).InShop).BuyRate / 100
+ price = Item(itemNum).price * multiplier
+
+ ' item has cost?
+ If price <= 0 Then
+ PlayerMsg index, "The shop doesn't want that item.", BrightRed
+ ResetShopAction index
+ Exit Sub
+ End If
+
+ ' take item and give gold
+ TakeInvItem index, itemNum, 1
+ GiveInvItem index, 1, price
+
+ ' send confirmation message & reset their shop action
+ PlayerMsg index, "Trade successful.", BrightGreen
+ ResetShopAction index
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleChangeBankSlots(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim newSlot As Long
+ Dim oldSlot As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ oldSlot = Buffer.ReadLong
+ newSlot = Buffer.ReadLong
+
+ PlayerSwitchBankSlots index, oldSlot, newSlot
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleWithdrawItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim BankSlot As Long
+ Dim amount As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ BankSlot = Buffer.ReadLong
+ amount = Buffer.ReadLong
+
+ TakeBankItem index, BankSlot, amount
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleDepositItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim invSlot As Long
+ Dim amount As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ invSlot = Buffer.ReadLong
+ amount = Buffer.ReadLong
+
+ GiveBankItem index, invSlot, amount
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleCloseBank(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ SavePlayer index
+
+ TempPlayer(index).InBank = False
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleAdminWarp(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim x As Long
+ Dim y As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ x = Buffer.ReadLong
+ y = Buffer.ReadLong
+
+ If x < 0 Then x = 0
+ If y < 0 Then y = 0
+
+ If GetPlayerAccess(index) >= ADMIN_MAPPER Then
+ 'PlayerWarp index, GetPlayerMap(index), x, y
+ SetPlayerX index, x
+ SetPlayerY index, y
+ SendPlayerXYToMap index
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleTradeRequest(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim tradeTarget As Long, sX As Long, sY As Long, tX As Long, tY As Long, Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ ' find the target
+ tradeTarget = Buffer.ReadLong
+
+ Set Buffer = Nothing
+
+ If Not IsConnected(index) Or Not IsPlaying(index) Then
+ TempPlayer(tradeTarget).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If Not IsConnected(tradeTarget) Or Not IsPlaying(tradeTarget) Then
+ TempPlayer(tradeTarget).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ ' make sure we don't error
+ If tradeTarget <= 0 Or tradeTarget > MAX_PLAYERS Then Exit Sub
+
+ ' can't trade with yourself..
+ If tradeTarget = index Then
+ PlayerMsg index, "You can't trade with yourself.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure they're on the same map
+ If Not Player(tradeTarget).Map = Player(index).Map Then Exit Sub
+
+ ' make sure they're stood next to each other
+ tX = Player(tradeTarget).x
+ tY = Player(tradeTarget).y
+ sX = Player(index).x
+ sY = Player(index).y
+
+ ' within range?
+ If tX < sX - 1 Or tX > sX + 1 Then
+ PlayerMsg index, "You need to be standing next to someone to request a trade.", BrightRed
+ Exit Sub
+ End If
+ If tY < sY - 1 Or tY > sY + 1 Then
+ PlayerMsg index, "You need to be standing next to someone to request a trade.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure not already got a trade request
+ If TempPlayer(tradeTarget).TradeRequest > 0 Then
+ PlayerMsg index, "This player is busy.", BrightRed
+ Exit Sub
+ End If
+
+ ' send the trade request
+ TempPlayer(tradeTarget).TradeRequest = index
+ SendTradeRequest tradeTarget, index
+End Sub
+
+Sub HandleAcceptTradeRequest(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim tradeTarget As Long
+Dim i As Long
+
+ tradeTarget = TempPlayer(index).TradeRequest
+
+ If Not IsConnected(index) Or Not IsPlaying(index) Then
+ TempPlayer(tradeTarget).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If Not IsConnected(tradeTarget) Or Not IsPlaying(tradeTarget) Then
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If TempPlayer(index).TradeRequest <= 0 Or TempPlayer(index).TradeRequest > MAX_PLAYERS Then Exit Sub
+ ' let them know they're trading
+ PlayerMsg index, "You have accepted " & Trim$(GetPlayerName(tradeTarget)) & "'s trade request.", BrightGreen
+ PlayerMsg tradeTarget, Trim$(GetPlayerName(index)) & " has accepted your trade request.", BrightGreen
+ ' clear the tradeRequest server-side
+ TempPlayer(index).TradeRequest = 0
+ TempPlayer(tradeTarget).TradeRequest = 0
+ ' set that they're trading with each other
+ TempPlayer(index).InTrade = tradeTarget
+ TempPlayer(tradeTarget).InTrade = index
+ ' clear out their trade offers
+ For i = 1 To MAX_INV
+ TempPlayer(index).TradeOffer(i).Num = 0
+ TempPlayer(index).TradeOffer(i).Value = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Num = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Value = 0
+ Next
+ ' Used to init the trade window clientside
+ SendTrade index, tradeTarget
+ SendTrade tradeTarget, index
+ ' Send the offer data - Used to clear their client
+ SendTradeUpdate index, 0
+ SendTradeUpdate index, 1
+ SendTradeUpdate tradeTarget, 0
+ SendTradeUpdate tradeTarget, 1
+End Sub
+
+Sub HandleDeclineTradeRequest(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ PlayerMsg TempPlayer(index).TradeRequest, GetPlayerName(index) & " has declined your trade request.", BrightRed
+ PlayerMsg index, "You decline the trade request.", BrightRed
+ ' clear the tradeRequest server-side
+ TempPlayer(index).TradeRequest = 0
+End Sub
+
+Sub HandleAcceptTrade(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim tradeTarget As Long
+ Dim i As Long, x As Long
+ Dim tmpTradeItem(1 To MAX_INV) As PlayerInvRec
+ Dim tmpTradeItem2(1 To MAX_INV) As PlayerInvRec
+ Dim itemNum As Long
+ Dim theirInvSpace As Long, yourInvSpace As Long
+ Dim theirItemCount As Long, yourItemCount As Long
+
+ If TempPlayer(index).InTrade = 0 Then Exit Sub
+
+ TempPlayer(index).AcceptTrade = True
+ tradeTarget = TempPlayer(index).InTrade
+
+ If Not IsConnected(index) Or Not IsPlaying(index) Then
+ TempPlayer(tradeTarget).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ If Not IsConnected(tradeTarget) Or Not IsPlaying(tradeTarget) Then
+ TempPlayer(tradeTarget).TradeRequest = 0
+ TempPlayer(index).TradeRequest = 0
+ Exit Sub
+ End If
+
+ ' if not both of them accept, then exit
+ If Not TempPlayer(tradeTarget).AcceptTrade Then
+ SendTradeStatus index, 2
+ SendTradeStatus tradeTarget, 1
+ Exit Sub
+ End If
+
+ ' get inventory spaces
+ For i = 1 To MAX_INV
+ If GetPlayerInvItemNum(index, i) > 0 Then
+ ' check if we're offering it
+ For x = 1 To MAX_INV
+ If TempPlayer(index).TradeOffer(x).Num = i Then
+ itemNum = Player(index).Inv(TempPlayer(index).TradeOffer(x).Num).Num
+ ' if it's a currency then make sure we're offering all of it
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ If TempPlayer(index).TradeOffer(x).Value = GetPlayerInvItemNum(index, i) Then
+ yourInvSpace = yourInvSpace + 1
+ End If
+ Else
+ yourInvSpace = yourInvSpace + 1
+ End If
+ End If
+ Next
+ Else
+ yourInvSpace = yourInvSpace + 1
+ End If
+ If GetPlayerInvItemNum(tradeTarget, i) > 0 Then
+ ' check if we're offering it
+ For x = 1 To MAX_INV
+ If TempPlayer(tradeTarget).TradeOffer(x).Num = i Then
+ itemNum = Player(tradeTarget).Inv(TempPlayer(tradeTarget).TradeOffer(x).Num).Num
+ ' if it's a currency then make sure we're offering all of it
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ If TempPlayer(tradeTarget).TradeOffer(x).Value = GetPlayerInvItemNum(tradeTarget, i) Then
+ theirInvSpace = theirInvSpace + 1
+ End If
+ Else
+ theirInvSpace = theirInvSpace + 1
+ End If
+ End If
+ Next
+ Else
+ theirInvSpace = theirInvSpace + 1
+ End If
+ Next
+
+ ' get item count
+ For i = 1 To MAX_INV
+ If TempPlayer(index).TradeOffer(i).Num > 0 Then
+ itemNum = Player(index).Inv(TempPlayer(index).TradeOffer(i).Num).Num
+ If itemNum > 0 Then
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ ' check if the other player has the item
+ If HasItem(tradeTarget, itemNum) = 0 Then
+ yourItemCount = yourItemCount + 1
+ End If
+ Else
+ yourItemCount = yourItemCount + 1
+ End If
+ End If
+ End If
+ If TempPlayer(tradeTarget).TradeOffer(i).Num > 0 Then
+ itemNum = Player(tradeTarget).Inv(TempPlayer(tradeTarget).TradeOffer(i).Num).Num
+ If itemNum > 0 Then
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ ' check if the other player has the item
+ If HasItem(index, itemNum) = 0 Then
+ theirItemCount = theirItemCount + 1
+ End If
+ Else
+ theirItemCount = theirItemCount + 1
+ End If
+ End If
+ End If
+ Next
+
+ ' make sure they have enough space
+ If yourInvSpace < theirItemCount Then
+ PlayerMsg index, "You don't have enough inventory space.", BrightRed
+ PlayerMsg tradeTarget, "They don't have enough inventory space.", BrightRed
+ TempPlayer(index).AcceptTrade = False
+ TempPlayer(tradeTarget).AcceptTrade = False
+ SendTradeUpdate index, 0
+ SendTradeUpdate tradeTarget, 0
+ SendTradeStatus index, 3
+ SendTradeStatus tradeTarget, 3
+ Exit Sub
+ End If
+ If theirInvSpace < yourItemCount Then
+ PlayerMsg index, "They don't have enough inventory space.", BrightRed
+ PlayerMsg tradeTarget, "You don't have enough inventory space.", BrightRed
+ TempPlayer(index).AcceptTrade = False
+ TempPlayer(tradeTarget).AcceptTrade = False
+ SendTradeUpdate index, 0
+ SendTradeUpdate tradeTarget, 0
+ SendTradeStatus index, 3
+ SendTradeStatus tradeTarget, 3
+ Exit Sub
+ End If
+
+ ' take their items
+ For i = 1 To MAX_INV
+ ' player
+ If TempPlayer(index).TradeOffer(i).Num > 0 Then
+ itemNum = Player(index).Inv(TempPlayer(index).TradeOffer(i).Num).Num
+ If itemNum > 0 Then
+ ' store temp
+ tmpTradeItem(i).Num = itemNum
+ tmpTradeItem(i).Value = TempPlayer(index).TradeOffer(i).Value
+ ' take item
+ TakeInvSlot index, TempPlayer(index).TradeOffer(i).Num, tmpTradeItem(i).Value
+ End If
+ End If
+ ' target
+ If TempPlayer(tradeTarget).TradeOffer(i).Num > 0 Then
+ itemNum = GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num)
+ If itemNum > 0 Then
+ ' store temp
+ tmpTradeItem2(i).Num = itemNum
+ tmpTradeItem2(i).Value = TempPlayer(tradeTarget).TradeOffer(i).Value
+ ' take item
+ TakeInvSlot tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num, tmpTradeItem2(i).Value
+ End If
+ End If
+ Next
+
+ ' taken all items. now they can't not get items because of no inventory space.
+ For i = 1 To MAX_INV
+ ' player
+ If tmpTradeItem2(i).Num > 0 Then
+ ' give away!
+ GiveInvItem index, tmpTradeItem2(i).Num, tmpTradeItem2(i).Value, False
+ End If
+ ' target
+ If tmpTradeItem(i).Num > 0 Then
+ ' give away!
+ GiveInvItem tradeTarget, tmpTradeItem(i).Num, tmpTradeItem(i).Value, False
+ End If
+ Next
+
+ SendInventory index
+ SendInventory tradeTarget
+
+ ' they now have all the items. Clear out values + let them out of the trade.
+ For i = 1 To MAX_INV
+ TempPlayer(index).TradeOffer(i).Num = 0
+ TempPlayer(index).TradeOffer(i).Value = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Num = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Value = 0
+ Next
+
+ TempPlayer(index).InTrade = 0
+ TempPlayer(tradeTarget).InTrade = 0
+
+ PlayerMsg index, "Trade completed.", BrightGreen
+ PlayerMsg tradeTarget, "Trade completed.", BrightGreen
+
+ SendCloseTrade index
+ SendCloseTrade tradeTarget
+End Sub
+
+Sub HandleDeclineTrade(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim i As Long
+Dim tradeTarget As Long
+
+ tradeTarget = TempPlayer(index).InTrade
+
+ If tradeTarget = 0 Then
+ SendCloseTrade index
+ Exit Sub
+ End If
+
+ For i = 1 To MAX_INV
+ TempPlayer(index).TradeOffer(i).Num = 0
+ TempPlayer(index).TradeOffer(i).Value = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Num = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Value = 0
+ Next
+
+ TempPlayer(index).InTrade = 0
+ TempPlayer(tradeTarget).InTrade = 0
+
+ PlayerMsg index, "You declined the trade.", BrightRed
+ PlayerMsg tradeTarget, GetPlayerName(index) & " has declined the trade.", BrightRed
+
+ SendCloseTrade index
+ SendCloseTrade tradeTarget
+End Sub
+
+Sub HandleTradeItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim invSlot As Long
+ Dim amount As Long
+ Dim EmptySlot As Long
+ Dim itemNum As Long
+ Dim i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ invSlot = Buffer.ReadLong
+ amount = Buffer.ReadLong
+
+ Set Buffer = Nothing
+
+ If invSlot <= 0 Or invSlot > MAX_INV Then Exit Sub
+
+ itemNum = GetPlayerInvItemNum(index, invSlot)
+ If itemNum <= 0 Or itemNum > MAX_ITEMS Then Exit Sub
+
+ If TempPlayer(index).InTrade <= 0 Or TempPlayer(index).InTrade > MAX_PLAYERS Then Exit Sub
+
+ ' make sure they have the amount they offer
+ If amount < 0 Or amount > GetPlayerInvItemValue(index, invSlot) Then
+ PlayerMsg index, "You do not have that many.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure it's not soulbound
+ If Item(itemNum).BindType > 0 Then
+ If Player(index).Inv(invSlot).Bound > 0 Then
+ PlayerMsg index, "Cannot trade a soulbound item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ ' check if already offering same currency item
+ For i = 1 To MAX_INV
+ If TempPlayer(index).TradeOffer(i).Num = invSlot Then
+ ' add amount
+ TempPlayer(index).TradeOffer(i).Value = TempPlayer(index).TradeOffer(i).Value + amount
+ ' clamp to limits
+ If TempPlayer(index).TradeOffer(i).Value > GetPlayerInvItemValue(index, invSlot) Then
+ TempPlayer(index).TradeOffer(i).Value = GetPlayerInvItemValue(index, invSlot)
+ End If
+ ' cancel any trade agreement
+ TempPlayer(index).AcceptTrade = False
+ TempPlayer(TempPlayer(index).InTrade).AcceptTrade = False
+
+ SendTradeStatus index, 0
+ SendTradeStatus TempPlayer(index).InTrade, 0
+
+ SendTradeUpdate index, 0
+ SendTradeUpdate TempPlayer(index).InTrade, 1
+ ' exit early
+ Exit Sub
+ End If
+ Next
+ Else
+ ' make sure they're not already offering it
+ For i = 1 To MAX_INV
+ If TempPlayer(index).TradeOffer(i).Num = invSlot Then
+ PlayerMsg index, "You've already offered this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+ End If
+
+ ' not already offering - find earliest empty slot
+ For i = 1 To MAX_INV
+ If TempPlayer(index).TradeOffer(i).Num = 0 Then
+ EmptySlot = i
+ Exit For
+ End If
+ Next
+ TempPlayer(index).TradeOffer(EmptySlot).Num = invSlot
+ TempPlayer(index).TradeOffer(EmptySlot).Value = amount
+
+ ' cancel any trade agreement and send new data
+ TempPlayer(index).AcceptTrade = False
+ TempPlayer(TempPlayer(index).InTrade).AcceptTrade = False
+
+ SendTradeStatus index, 0
+ SendTradeStatus TempPlayer(index).InTrade, 0
+
+ SendTradeUpdate index, 0
+ SendTradeUpdate TempPlayer(index).InTrade, 1
+End Sub
+
+Sub HandleUntradeItem(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim tradeSlot As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ tradeSlot = Buffer.ReadLong
+
+ Set Buffer = Nothing
+
+ If tradeSlot <= 0 Or tradeSlot > MAX_INV Then Exit Sub
+ If TempPlayer(index).TradeOffer(tradeSlot).Num <= 0 Then Exit Sub
+
+ TempPlayer(index).TradeOffer(tradeSlot).Num = 0
+ TempPlayer(index).TradeOffer(tradeSlot).Value = 0
+
+ If TempPlayer(index).AcceptTrade Then TempPlayer(index).AcceptTrade = False
+ If TempPlayer(TempPlayer(index).InTrade).AcceptTrade Then TempPlayer(TempPlayer(index).InTrade).AcceptTrade = False
+
+ SendTradeStatus index, 0
+ SendTradeStatus TempPlayer(index).InTrade, 0
+
+ SendTradeUpdate index, 0
+ SendTradeUpdate TempPlayer(index).InTrade, 1
+End Sub
+
+Sub HandleHotbarChange(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim sType As Long
+ Dim Slot As Long
+ Dim hotbarNum As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ sType = Buffer.ReadLong
+ Slot = Buffer.ReadLong
+ hotbarNum = Buffer.ReadLong
+
+ Select Case sType
+ Case 0 ' clear
+ Player(index).Hotbar(hotbarNum).Slot = 0
+ Player(index).Hotbar(hotbarNum).sType = 0
+ Case 1 ' inventory
+ If Slot > 0 And Slot <= MAX_INV Then
+ If Player(index).Inv(Slot).Num > 0 Then
+ If Len(Trim$(Item(GetPlayerInvItemNum(index, Slot)).Name)) > 0 Then
+ Player(index).Hotbar(hotbarNum).Slot = Player(index).Inv(Slot).Num
+ Player(index).Hotbar(hotbarNum).sType = sType
+ End If
+ End If
+ End If
+ Case 2 ' spell
+ If Slot > 0 And Slot <= MAX_PLAYER_SPELLS Then
+ If Player(index).Spell(Slot).Spell > 0 Then
+ If Len(Trim$(Spell(Player(index).Spell(Slot).Spell).Name)) > 0 Then
+ Player(index).Hotbar(hotbarNum).Slot = Player(index).Spell(Slot).Spell
+ Player(index).Hotbar(hotbarNum).sType = sType
+ End If
+ End If
+ End If
+ End Select
+
+ SendHotbar index
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleHotbarUse(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim Slot As Long
+ Dim i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ Slot = Buffer.ReadLong
+
+ Select Case Player(index).Hotbar(Slot).sType
+ Case 1 ' inventory
+ For i = 1 To MAX_INV
+ If Player(index).Inv(i).Num > 0 Then
+ If Player(index).Inv(i).Num = Player(index).Hotbar(Slot).Slot Then
+ UseItem index, i
+ Exit Sub
+ End If
+ End If
+ Next
+ Case 2 ' spell
+ For i = 1 To MAX_PLAYER_SPELLS
+ If Player(index).Spell(i).Spell > 0 Then
+ If Player(index).Spell(i).Spell = Player(index).Hotbar(Slot).Slot Then
+ BufferSpell index, i
+ Exit Sub
+ End If
+ End If
+ Next
+ End Select
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandlePartyRequest(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer, targetIndex As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ targetIndex = Buffer.ReadLong
+ Set Buffer = Nothing
+
+ ' make sure it's a valid target
+ If targetIndex = index Then
+ PlayerMsg index, "You can't invite yourself. That would be weird.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure they're connected and on the same map
+ If Not IsConnected(targetIndex) Or Not IsPlaying(targetIndex) Then Exit Sub
+ If GetPlayerMap(targetIndex) <> GetPlayerMap(index) Then Exit Sub
+
+ ' init the request
+ Party_Invite index, targetIndex
+End Sub
+
+Sub HandleAcceptParty(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Party_InviteAccept TempPlayer(index).partyInvite, index
+End Sub
+
+Sub HandleDeclineParty(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Party_InviteDecline TempPlayer(index).partyInvite, index
+End Sub
+
+Sub HandlePartyLeave(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Party_PlayerLeave index
+End Sub
+
+' :::::::::::::::::::::::::::::
+' :: Request edit Conv packet ::
+' :::::::::::::::::::::::::::::
+Sub HandleRequestEditConv(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SConvEditor
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+' :::::::::::::::::::::::
+' :: Save Conv packet ::
+' :::::::::::::::::::::::
+Sub HandleSaveConv(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim convNum As Long
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Dim x As Long
+
+ ' Prevent hacking
+ If GetPlayerAccess(index) < ADMIN_DEVELOPER Then
+ Exit Sub
+ End If
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ convNum = Buffer.ReadLong
+
+ ' Prevent hacking
+ If convNum < 0 Or convNum > MAX_CONVS Then
+ Exit Sub
+ End If
+
+ With Conv(convNum)
+ .Name = Buffer.ReadString
+ .chatCount = Buffer.ReadLong
+ ReDim .Conv(1 To .chatCount)
+ For i = 1 To .chatCount
+ .Conv(i).Conv = Buffer.ReadString
+ For x = 1 To 4
+ .Conv(i).rText(x) = Buffer.ReadString
+ .Conv(i).rTarget(x) = Buffer.ReadLong
+ Next
+ .Conv(i).Event = Buffer.ReadLong
+ .Conv(i).Data1 = Buffer.ReadLong
+ .Conv(i).Data2 = Buffer.ReadLong
+ .Conv(i).Data3 = Buffer.ReadLong
+ Next
+ End With
+
+ ' Save it
+ Call SendUpdateConvToAll(convNum)
+ Call SaveConv(convNum)
+ Call AddLog(GetPlayerName(index) & " saved Conv #" & convNum & ".", ADMIN_LOG)
+End Sub
+
+Sub HandleRequestConvs(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ SendConvs index
+End Sub
+
+Sub HandleChatOption(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ chatOption index, Buffer.ReadLong
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleFinishTutorial(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+ Player(index).TutorialState = 1
+ SavePlayer index
+End Sub
+
+Sub HandleUseChar(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, charNum As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+
+ charNum = Buffer.ReadLong
+ UseChar index, charNum
+
+ Set Buffer = Nothing
+End Sub
+
+Sub HandleDelChar(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, charNum As Long, Login As String, charName As String, filename As String
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ charNum = Buffer.ReadLong
+ Set Buffer = Nothing
+
+ If charNum < 0 Or charNum > MAX_CHARS Then Exit Sub
+
+ ' clear the character
+ Login = Trim$(Player(index).Login)
+ filename = App.Path & "\data\accounts\" & SanitiseString(Login) & ".ini"
+ charName = GetVar(filename, "CHAR" & charNum, "Name")
+ DeleteCharacter Login, charNum
+
+ ' remove the character name from the list
+ DeleteName charName
+
+ ' send to portal again
+ 'AlertMsg index, DIALOGUE_MSG_DELCHAR, MENU_LOGIN
+ SendPlayerChars index
+End Sub
+
+Sub HandleMergeAccounts(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
+Dim Buffer As clsBuffer, username As String, password As String, oldPass As String, oldName As String
+Dim filename As String, i As Long, charNum As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteBytes Data()
+ username = Buffer.ReadString
+ password = Buffer.ReadString
+ Set Buffer = Nothing
+
+ ' Check versions
+ If Len(Trim$(username)) < 3 Or Len(Trim$(password)) < 3 Then
+ Call AlertMsg(index, DIALOGUE_MSG_USERLENGTH, MENU_MERGE, False)
+ Exit Sub
+ End If
+
+ ' check if the player has a slot free
+ filename = App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini"
+ ' exit out if we can't find the player's ACTUAL account
+ If Not FileExist(filename, True) Then
+ AlertMsg index, DIALOGUE_MSG_CONNECTION
+ Exit Sub
+ End If
+ For i = MAX_CHARS To 1 Step -1
+ ' check if the chars have a name
+ If LenB(Trim$(GetVar(filename, "CHAR" & i, "Name"))) < 1 Then
+ charNum = i
+ End If
+ Next
+ ' if charnum is defaulted to 0 then no chars available - exit out
+ If charNum = 0 Then
+ AlertMsg index, DIALOGUE_MSG_CONNECTION
+ Exit Sub
+ End If
+
+ ' check if the user exists
+ If Not OldAccount_Exist(username) Then
+ Call AlertMsg(index, DIALOGUE_MSG_WRONGPASS, MENU_MERGE, False)
+ Exit Sub
+ End If
+
+ ' check if passwords match
+ filename = App.Path & "\data\accounts\old\" & SanitiseString(username) & ".ini"
+ oldPass = GetVar(filename, "ACCOUNT", "Password")
+ If Not password = oldPass Then
+ Call AlertMsg(index, DIALOGUE_MSG_WRONGPASS, MENU_MERGE, False)
+ Exit Sub
+ End If
+
+ ' get the old name
+ oldName = GetVar(filename, "ACCOUNT", "Name")
+
+ ' make sure it's available
+ If FindChar(oldName) Then
+ Call AlertMsg(index, DIALOGUE_MSG_MERGENAME, MENU_MERGE, False)
+ Exit Sub
+ End If
+
+ ' fill the character slot with the old character
+ MergeAccount index, charNum, username
+End Sub
diff --git a/server/src/modPlayer.bas b/server/src/modPlayer.bas
new file mode 100644
index 0000000..c1a7241
--- /dev/null
+++ b/server/src/modPlayer.bas
@@ -0,0 +1,2426 @@
+Attribute VB_Name = "modPlayer"
+Option Explicit
+
+Public Sub InitChat(ByVal index As Long, ByVal mapnum As Long, ByVal mapNpcNum As Long, Optional ByVal remoteChat As Boolean = False)
+Dim npcNum As Long
+ npcNum = MapNpc(mapnum).Npc(mapNpcNum).Num
+
+ ' check if we can chat
+ If Npc(npcNum).Conv = 0 Then Exit Sub
+ If Len(Trim$(Conv(Npc(npcNum).Conv).Name)) = 0 Then Exit Sub
+
+ If Not remoteChat Then
+ With MapNpc(mapnum).Npc(mapNpcNum)
+ .c_inChatWith = index
+ .c_lastDir = .dir
+ If GetPlayerY(index) = .y - 1 Then
+ .dir = DIR_UP
+ ElseIf GetPlayerY(index) = .y + 1 Then
+ .dir = DIR_DOWN
+ ElseIf GetPlayerX(index) = .x - 1 Then
+ .dir = DIR_LEFT
+ ElseIf GetPlayerX(index) = .x + 1 Then
+ .dir = DIR_RIGHT
+ End If
+ ' send NPC's dir to the map
+ NpcDir mapnum, mapNpcNum, .dir
+ End With
+ End If
+
+ ' Set chat value to Npc
+ TempPlayer(index).inChatWith = npcNum
+ TempPlayer(index).c_mapNpcNum = mapNpcNum
+ TempPlayer(index).c_mapNum = mapnum
+ ' set to the root chat
+ TempPlayer(index).curChat = 1
+ ' send the root chat
+ sendChat index
+End Sub
+
+Public Sub chatOption(ByVal index As Long, ByVal chatOption As Long)
+ Dim exitChat As Boolean
+ Dim convNum As Long
+ Dim curChat As Long
+
+ If TempPlayer(index).inChatWith = 0 Then Exit Sub
+
+ convNum = Npc(TempPlayer(index).inChatWith).Conv
+ curChat = TempPlayer(index).curChat
+
+ exitChat = False
+
+ ' follow route
+ If Conv(convNum).Conv(curChat).rTarget(chatOption) = 0 Then
+ exitChat = True
+ Else
+ TempPlayer(index).curChat = Conv(convNum).Conv(curChat).rTarget(chatOption)
+ End If
+
+ ' if exiting chat, clear temp values
+ If exitChat Then
+ TempPlayer(index).inChatWith = 0
+ TempPlayer(index).curChat = 0
+ ' send chat update
+ sendChat index
+ ' send npc dir
+ With MapNpc(TempPlayer(index).c_mapNum).Npc(TempPlayer(index).c_mapNpcNum)
+ If .c_inChatWith = index Then
+ .c_inChatWith = 0
+ .dir = .c_lastDir
+ NpcDir TempPlayer(index).c_mapNum, TempPlayer(index).c_mapNpcNum, .dir
+ End If
+ End With
+ ' clear last of data
+ TempPlayer(index).c_mapNpcNum = 0
+ TempPlayer(index).c_mapNum = 0
+ ' exit out early so we don't send chat update twice
+ Exit Sub
+ End If
+
+ ' send update to the client
+ sendChat index
+End Sub
+
+Public Sub chat_Unique(ByVal index As Long)
+Dim convNum As Long
+Dim curChat As Long
+Dim itemAmount As Long
+
+ If TempPlayer(index).inChatWith > 0 Then
+ convNum = Npc(TempPlayer(index).inChatWith).Conv
+ curChat = TempPlayer(index).curChat
+
+ ' is unique?
+ If Conv(convNum).Conv(curChat).Event = 4 Then ' unique
+ ' which unique event?
+ Select Case Conv(convNum).Conv(curChat).Data1
+ Case 1 ' Little Boy
+ ' check has the gold
+ itemAmount = HasItem(index, 1)
+ If itemAmount = 0 Or itemAmount < 50 Then
+ PlayerMsg index, "You do not have enough gold.", BrightRed
+ Exit Sub
+ Else
+ PlayerWarp index, 15, 33, 32
+ SetPlayerDir index, DIR_LEFT
+ TakeInvItem index, 1, 50
+ PlayerMsg index, "The boy takes your money then pushes you head first through the hole.", BrightGreen
+ Exit Sub
+ End If
+ End Select
+ End If
+ End If
+End Sub
+
+Public Sub sendChat(ByVal index As Long)
+ Dim convNum As Long
+ Dim curChat As Long
+ Dim mainText As String
+ Dim optText(1 To 4) As String
+ Dim P_GENDER As String
+ Dim P_NAME As String
+ Dim P_CLASS As String
+ Dim i As Long
+
+ If TempPlayer(index).inChatWith > 0 Then
+ convNum = Npc(TempPlayer(index).inChatWith).Conv
+ curChat = TempPlayer(index).curChat
+
+ ' check for unique events and trigger them early
+ If Conv(convNum).Conv(curChat).Event > 0 Then
+ Select Case Conv(convNum).Conv(curChat).Event
+ Case 1 ' Open Shop
+ If Conv(convNum).Conv(curChat).Data1 > 0 Then ' shop exists?
+ SendOpenShop index, Conv(convNum).Conv(curChat).Data1
+ TempPlayer(index).InShop = Conv(convNum).Conv(curChat).Data1 ' stops movement and the like
+ End If
+ ' exit out early so we don't send chat update twice
+ ClosePlayerChat index
+ Exit Sub
+ Case 2 ' Open Bank
+ SendBank index
+ TempPlayer(index).InBank = True
+ ' exit out early
+ ClosePlayerChat index
+ Exit Sub
+ Case 3 ' Give Item
+ ' exit out early
+ ClosePlayerChat index
+ Exit Sub
+ Case 4 ' Unique event
+ chat_Unique index
+ ClosePlayerChat index
+ Exit Sub
+ End Select
+ End If
+
+continue:
+ ' cache player's details
+ If Player(index).Sex = SEX_MALE Then
+ P_GENDER = "man"
+ Else
+ P_GENDER = "woman"
+ End If
+ P_NAME = Trim$(Player(index).Name)
+ P_CLASS = Trim$(Class(Player(index).Class).Name)
+
+ mainText = Conv(convNum).Conv(curChat).Conv
+ For i = 1 To 4
+ optText(i) = Conv(convNum).Conv(curChat).rText(i)
+ Next
+ End If
+
+ SendChatUpdate index, TempPlayer(index).inChatWith, mainText, optText(1), optText(2), optText(3), optText(4)
+ Exit Sub
+End Sub
+
+Public Sub ClosePlayerChat(ByVal index As Long)
+ ' exit the chat
+ TempPlayer(index).inChatWith = 0
+ TempPlayer(index).curChat = 0
+ ' send chat update
+ sendChat index
+ ' send npc dir
+ With MapNpc(TempPlayer(index).c_mapNum).Npc(TempPlayer(index).c_mapNpcNum)
+ If .c_inChatWith = index Then
+ .c_inChatWith = 0
+ .dir = .c_lastDir
+ NpcDir TempPlayer(index).c_mapNum, TempPlayer(index).c_mapNpcNum, .dir
+ End If
+ End With
+ ' clear last of data
+ TempPlayer(index).c_mapNpcNum = 0
+ TempPlayer(index).c_mapNum = 0
+ Exit Sub
+End Sub
+
+Sub UseChar(ByVal index As Long, ByVal charNum As Long)
+ If Not IsPlaying(index) Then
+ Player(index).charNum = charNum
+ Call LoadPlayer(index, Trim$(Player(index).Login), charNum)
+ Call JoinGame(index)
+ Call AddLog(GetPlayerLogin(index) & "/" & GetPlayerName(index) & " has began playing " & GAME_NAME & ".", PLAYER_LOG)
+ Call TextAdd(GetPlayerLogin(index) & "/" & GetPlayerName(index) & " has began playing " & GAME_NAME & ".")
+ Call UpdateCaption
+ End If
+End Sub
+
+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
+ '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 the login ok
+ SendLoginOk index
+
+ TotalPlayersOnline = TotalPlayersOnline + 1
+
+ ' Send some more little goodies, no need to explain these
+ Call CheckEquippedItems(index)
+ Call SendClasses(index)
+ Call SendItems(index)
+ Call SendAnimations(index)
+ Call SendNpcs(index)
+ Call SendShops(index)
+ Call SendSpells(index)
+ Call SendConvs(index)
+ Call SendResources(index)
+ Call SendInventory(index)
+ Call SendWornEquipment(index)
+ Call SendMapEquipment(index)
+ Call SendPlayerSpells(index)
+ Call SendHotbar(index)
+ Call SendPlayerVariables(index)
+
+ ' send vitals, exp + stats
+ For i = 1 To Vitals.Vital_Count - 1
+ Call SendVital(index, i)
+ Next
+ SendEXP index
+ Call SendStats(index)
+
+ ' Warp the player to his saved location
+ Call PlayerWarp(index, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index))
+
+ ' Send a global message that he/she joined
+ Call GlobalMsg(GetPlayerName(index) & " has joined " & GAME_NAME & "!", White)
+
+ ' Send welcome messages
+ Call SendWelcome(index)
+
+ ' Send Resource cache
+ If GetPlayerMap(index) > 0 And GetPlayerMap(index) <= MAX_MAPS Then
+ For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count
+ SendResourceCacheTo index, i
+ Next
+ End If
+
+ ' Send the flag so they know they can start doing stuff
+ SendInGame index
+
+ ' tell them to do the damn tutorial
+ If Player(index).TutorialState = 0 Then SendStartTutorial index
+End Sub
+
+Sub LeftGame(ByVal index As Long)
+ Dim n As Long, i As Long
+ Dim tradeTarget As Long
+
+ If TempPlayer(index).InGame Then
+ TempPlayer(index).InGame = False
+
+ ' Check if player was the only player on the map and stop npc processing if so
+ If GetPlayerMap(index) <= 0 Or GetPlayerMap(index) > MAX_MAPS Then Exit Sub
+ If GetTotalMapPlayers(GetPlayerMap(index)) < 1 Then
+ PlayersOnMap(GetPlayerMap(index)) = NO
+ End If
+
+ ' cancel any trade they're in
+ If TempPlayer(index).InTrade > 0 Then
+ tradeTarget = TempPlayer(index).InTrade
+ PlayerMsg tradeTarget, Trim$(GetPlayerName(index)) & " has declined the trade.", BrightRed
+ ' clear out trade
+ For i = 1 To MAX_INV
+ TempPlayer(tradeTarget).TradeOffer(i).Num = 0
+ TempPlayer(tradeTarget).TradeOffer(i).Value = 0
+ Next
+ TempPlayer(tradeTarget).InTrade = 0
+ SendCloseTrade tradeTarget
+ End If
+
+ ' leave party.
+ Party_PlayerLeave index
+
+ ' save and clear data.
+ Call SavePlayer(index)
+
+ ' Send a global message that he/she left
+ Call GlobalMsg(GetPlayerName(index) & " has left " & GAME_NAME & "!", White)
+
+ Call TextAdd(GetPlayerName(index) & " has disconnected from " & GAME_NAME & ".")
+ Call SendLeftGame(index)
+ TotalPlayersOnline = TotalPlayersOnline - 1
+ End If
+
+ Call ClearPlayer(index)
+End Sub
+
+Function GetPlayerProtection(ByVal index As Long) As Long
+ Dim Armor As Long
+ Dim Helm As Long
+ GetPlayerProtection = 0
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or index <= 0 Or index > Player_HighIndex Then
+ Exit Function
+ End If
+
+ Armor = GetPlayerEquipment(index, Armor)
+ Helm = GetPlayerEquipment(index, Helmet)
+ GetPlayerProtection = (GetPlayerStat(index, Stats.Endurance) \ 5)
+
+ If Armor > 0 Then
+ GetPlayerProtection = GetPlayerProtection + Item(Armor).Data2
+ End If
+
+ If Helm > 0 Then
+ GetPlayerProtection = GetPlayerProtection + Item(Helm).Data2
+ End If
+
+End Function
+
+Function CanPlayerCriticalHit(ByVal index As Long) As Boolean
+ On Error Resume Next
+ Dim i As Long
+ Dim n As Long
+
+ If GetPlayerEquipment(index, Weapon) > 0 Then
+ n = (Rnd) * 2
+
+ If n = 1 Then
+ i = (GetPlayerStat(index, Stats.Strength) \ 2) + (GetPlayerLevel(index) \ 2)
+ n = Int(Rnd * 100) + 1
+
+ If n <= i Then
+ CanPlayerCriticalHit = True
+ End If
+ End If
+ End If
+
+End Function
+
+Function CanPlayerBlockHit(ByVal index As Long) As Boolean
+ Dim i As Long
+ Dim n As Long
+ Dim ShieldSlot As Long
+ ShieldSlot = GetPlayerEquipment(index, Shield)
+
+ If ShieldSlot > 0 Then
+ n = Int(Rnd * 2)
+
+ If n = 1 Then
+ i = (GetPlayerStat(index, Stats.Endurance) \ 2) + (GetPlayerLevel(index) \ 2)
+ n = Int(Rnd * 100) + 1
+
+ If n <= i Then
+ CanPlayerBlockHit = True
+ End If
+ End If
+ End If
+
+End Function
+
+Sub PlayerWarp(ByVal index As Long, ByVal mapnum As Long, ByVal x As Long, ByVal y As Long)
+ Dim shopNum As Long
+ Dim OldMap As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or mapnum <= 0 Or mapnum > MAX_MAPS Then
+ Exit Sub
+ End If
+
+ ' Check if you are out of bounds
+ If x > Map(mapnum).MapData.MaxX Then x = Map(mapnum).MapData.MaxX
+ If y > Map(mapnum).MapData.MaxY Then y = Map(mapnum).MapData.MaxY
+ If x < 0 Then x = 0
+ If y < 0 Then y = 0
+
+ ' if same map then just send their co-ordinates
+ If mapnum = GetPlayerMap(index) Then
+ SendPlayerXYToMap index
+ End If
+
+ ' clear target
+ TempPlayer(index).target = 0
+ TempPlayer(index).targetType = TARGET_TYPE_NONE
+ SendTarget index
+
+ ' Save old map to send erase player data to
+ OldMap = GetPlayerMap(index)
+
+ If OldMap <> mapnum Then
+ Call SendLeaveMap(index, OldMap)
+ End If
+
+ Call SetPlayerMap(index, mapnum)
+ Call SetPlayerX(index, x)
+ Call SetPlayerY(index, y)
+
+ ' send player's equipment to new map
+ SendMapEquipment index
+
+ ' send equipment of all people on new map
+ If GetTotalMapPlayers(mapnum) > 0 Then
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = mapnum Then
+ SendMapEquipmentTo i, index
+ End If
+ End If
+ Next
+ End If
+
+ ' Now we check if there were any players left on the map the player just left, and if not stop processing npcs
+ If GetTotalMapPlayers(OldMap) = 0 Then
+ PlayersOnMap(OldMap) = NO
+ ' Regenerate all NPCs' health
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(OldMap).Npc(i).Num > 0 Then
+ MapNpc(OldMap).Npc(i).Vital(Vitals.HP) = GetNpcMaxVital(MapNpc(OldMap).Npc(i).Num, Vitals.HP)
+ End If
+ Next
+ End If
+
+ ' Sets it so we know to process npcs on the map
+ PlayersOnMap(mapnum) = YES
+ TempPlayer(index).GettingMap = YES
+ SendCheckForMap index, mapnum
+End Sub
+
+Function CanMove(index As Long, dir As Long) As Byte
+Dim warped As Boolean, newMapX As Long, newMapY As Long
+
+ CanMove = 1
+ Select Case dir
+ Case DIR_UP
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerY(index) > 0 Then
+ If CheckDirection(index, DIR_UP) Then
+ CanMove = 0
+ Exit Function
+ End If
+ Else
+ ' Check if they can warp to a new map
+ If Map(GetPlayerMap(index)).MapData.Up > 0 Then
+ newMapY = Map(Map(GetPlayerMap(index)).MapData.Up).MapData.MaxY
+ Call PlayerWarp(index, Map(GetPlayerMap(index)).MapData.Up, GetPlayerX(index), newMapY)
+ warped = True
+ CanMove = 2
+ End If
+ CanMove = 0
+ Exit Function
+ End If
+ Case DIR_DOWN
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerY(index) < Map(GetPlayerMap(index)).MapData.MaxY Then
+ If CheckDirection(index, DIR_DOWN) Then
+ CanMove = 0
+ Exit Function
+ End If
+ Else
+ ' Check if they can warp to a new map
+ If Map(GetPlayerMap(index)).MapData.Down > 0 Then
+ Call PlayerWarp(index, Map(GetPlayerMap(index)).MapData.Down, GetPlayerX(index), 0)
+ warped = True
+ CanMove = 2
+ End If
+ CanMove = False
+ Exit Function
+ End If
+ Case DIR_LEFT
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerX(index) > 0 Then
+ If CheckDirection(index, DIR_LEFT) Then
+ CanMove = 0
+ Exit Function
+ End If
+ Else
+ ' Check if they can warp to a new map
+ If Map(GetPlayerMap(index)).MapData.left > 0 Then
+ newMapX = Map(Map(GetPlayerMap(index)).MapData.left).MapData.MaxX
+ Call PlayerWarp(index, Map(GetPlayerMap(index)).MapData.left, newMapX, GetPlayerY(index))
+ warped = True
+ CanMove = 2
+ End If
+ CanMove = False
+ Exit Function
+ End If
+ Case DIR_RIGHT
+ ' Check to see if they are trying to go out of bounds
+ If GetPlayerX(index) < Map(GetPlayerMap(index)).MapData.MaxX Then
+ If CheckDirection(index, DIR_RIGHT) Then
+ CanMove = False
+ Exit Function
+ End If
+ Else
+ ' Check if they can warp to a new map
+ If Map(GetPlayerMap(index)).MapData.Right > 0 Then
+ Call PlayerWarp(index, Map(GetPlayerMap(index)).MapData.Right, 0, GetPlayerY(index))
+ warped = True
+ CanMove = 2
+ End If
+ CanMove = False
+ Exit Function
+ End If
+ End Select
+ ' check if we've warped
+ If warped Then
+ ' clear their target
+ TempPlayer(index).target = 0
+ TempPlayer(index).targetType = TARGET_TYPE_NONE
+ SendTarget index
+ End If
+End Function
+
+Function CheckDirection(index As Long, direction As Long) As Boolean
+Dim x As Long, y As Long, i As Long, EventCount As Long, mapnum As Long, page As Long
+
+ CheckDirection = False
+
+ Select Case direction
+ Case DIR_UP
+ x = GetPlayerX(index)
+ y = GetPlayerY(index) - 1
+ Case DIR_DOWN
+ x = GetPlayerX(index)
+ y = GetPlayerY(index) + 1
+ Case DIR_LEFT
+ x = GetPlayerX(index) - 1
+ y = GetPlayerY(index)
+ Case DIR_RIGHT
+ x = GetPlayerX(index) + 1
+ y = GetPlayerY(index)
+ End Select
+
+ ' Check to see if the map tile is blocked or not
+ If Map(GetPlayerMap(index)).TileData.Tile(x, y).Type = TILE_TYPE_BLOCKED Then
+ CheckDirection = True
+ Exit Function
+ End If
+
+ ' Check to see if the map tile is tree or not
+ If Map(GetPlayerMap(index)).TileData.Tile(x, y).Type = TILE_TYPE_RESOURCE Then
+ CheckDirection = True
+ Exit Function
+ End If
+
+ ' Check to make sure that any events on that space aren't blocked
+ mapnum = GetPlayerMap(index)
+ EventCount = Map(mapnum).TileData.EventCount
+ For i = 1 To EventCount
+ With Map(mapnum).TileData.Events(i)
+ If .x = x And .y = y Then
+ ' Get the active event page
+ page = ActiveEventPage(index, i)
+ If page > 0 Then
+ If Map(mapnum).TileData.Events(i).EventPage(page).WalkThrough = 0 Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+ End If
+ End With
+ Next
+
+ ' Check to see if a player is already on that tile
+ If Map(GetPlayerMap(index)).MapData.Moral = 0 Then
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And GetPlayerMap(i) = GetPlayerMap(index) Then
+ If GetPlayerX(i) = x Then
+ If GetPlayerY(i) = y Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+ End If
+ Next i
+ End If
+
+ ' Check to see if a npc is already on that tile
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(GetPlayerMap(index)).Npc(i).Num > 0 Then
+ If MapNpc(GetPlayerMap(index)).Npc(i).x = x Then
+ If MapNpc(GetPlayerMap(index)).Npc(i).y = y Then
+ CheckDirection = True
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+End Function
+
+Sub PlayerMove(ByVal index As Long, ByVal dir As Long, ByVal movement As Long, Optional ByVal sendToSelf As Boolean = False)
+ Dim Buffer As clsBuffer, mapnum As Long, x As Long, y As Long, moved As Byte, MovedSoFar As Boolean, newMapX As Byte, newMapY As Byte
+ Dim TileType As Long, vitalType As Long, colour As Long, amount As Long, canMoveResult As Long, i As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or dir < DIR_UP Or dir > DIR_RIGHT Or movement < 1 Or movement > 2 Then
+ Exit Sub
+ End If
+
+ Call SetPlayerDir(index, dir)
+ moved = NO
+ mapnum = GetPlayerMap(index)
+
+ If mapnum = 0 Then Exit Sub
+
+ ' check if they're casting a spell
+ If TempPlayer(index).spellBuffer.Spell > 0 Then
+ SendCancelAnimation index
+ SendClearSpellBuffer index
+ TempPlayer(index).spellBuffer.Spell = 0
+ TempPlayer(index).spellBuffer.target = 0
+ TempPlayer(index).spellBuffer.Timer = 0
+ TempPlayer(index).spellBuffer.tType = 0
+ End If
+
+ ' check directions
+ canMoveResult = CanMove(index, dir)
+ If canMoveResult = 1 Then
+ Select Case dir
+ Case DIR_UP
+ Call SetPlayerY(index, GetPlayerY(index) - 1)
+ SendPlayerMove index, movement, sendToSelf
+ moved = YES
+ Case DIR_DOWN
+ Call SetPlayerY(index, GetPlayerY(index) + 1)
+ SendPlayerMove index, movement, sendToSelf
+ moved = YES
+ Case DIR_LEFT
+ Call SetPlayerX(index, GetPlayerX(index) - 1)
+ SendPlayerMove index, movement, sendToSelf
+ moved = YES
+ Case DIR_RIGHT
+ Call SetPlayerX(index, GetPlayerX(index) + 1)
+ SendPlayerMove index, movement, sendToSelf
+ moved = YES
+ End Select
+ End If
+
+ With Map(GetPlayerMap(index)).TileData.Tile(GetPlayerX(index), GetPlayerY(index))
+ ' Check to see if the tile is a warp tile, and if so warp them
+ If .Type = TILE_TYPE_WARP Then
+ mapnum = .Data1
+ x = .Data2
+ y = .Data3
+ Call PlayerWarp(index, mapnum, x, y)
+ moved = YES
+ End If
+
+ ' Check to see if the tile is a door tile, and if so warp them
+ If .Type = TILE_TYPE_DOOR Then
+ mapnum = .Data1
+ x = .Data2
+ y = .Data3
+ ' send the animation to the map
+ SendDoorAnimation GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index)
+ Call PlayerWarp(index, mapnum, x, y)
+ moved = YES
+ End If
+
+ ' Check for key trigger open
+ If .Type = TILE_TYPE_KEYOPEN Then
+ x = .Data1
+ y = .Data2
+
+ If Map(GetPlayerMap(index)).TileData.Tile(x, y).Type = TILE_TYPE_KEY And TempTile(GetPlayerMap(index)).DoorOpen(x, y) = NO Then
+ TempTile(GetPlayerMap(index)).DoorOpen(x, y) = YES
+ TempTile(GetPlayerMap(index)).DoorTimer = GetTickCount
+ SendMapKey index, x, y, 1
+ 'Call MapMsg(GetPlayerMap(index), "A door has been unlocked.", White)
+ End If
+ End If
+
+ ' Check for a shop, and if so open it
+ If .Type = TILE_TYPE_SHOP Then
+ x = .Data1
+ If x > 0 Then ' shop exists?
+ If Len(Trim$(Shop(x).Name)) > 0 Then ' name exists?
+ SendOpenShop index, x
+ TempPlayer(index).InShop = x ' stops movement and the like
+ End If
+ End If
+ End If
+
+ ' Check to see if the tile is a bank, and if so send bank
+ If .Type = TILE_TYPE_BANK Then
+ SendBank index
+ TempPlayer(index).InBank = True
+ moved = YES
+ End If
+
+ ' Check if it's a heal tile
+ If .Type = TILE_TYPE_HEAL Then
+ vitalType = .Data1
+ amount = .Data2
+ If Not GetPlayerVital(index, vitalType) = GetPlayerMaxVital(index, vitalType) Then
+ If vitalType = Vitals.HP Then
+ colour = BrightGreen
+ Else
+ colour = BrightBlue
+ End If
+ SendActionMsg GetPlayerMap(index), "+" & amount, colour, ACTIONMSG_SCROLL, GetPlayerX(index) * 32, GetPlayerY(index) * 32, 1
+ SetPlayerVital index, vitalType, GetPlayerVital(index, vitalType) + amount
+ PlayerMsg index, "You feel rejuvinating forces flowing through your boy.", BrightGreen
+ Call SendVital(index, vitalType)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+ End If
+ moved = YES
+ End If
+
+ ' Check if it's a trap tile
+ If .Type = TILE_TYPE_TRAP Then
+ amount = .Data1
+ SendActionMsg GetPlayerMap(index), "-" & amount, BrightRed, ACTIONMSG_SCROLL, GetPlayerX(index) * 32, GetPlayerY(index) * 32, 1
+ If GetPlayerVital(index, HP) - amount <= 0 Then
+ KillPlayer index
+ PlayerMsg index, "You're killed by a trap.", BrightRed
+ Else
+ SetPlayerVital index, HP, GetPlayerVital(index, HP) - amount
+ PlayerMsg index, "You're injured by a trap.", BrightRed
+ Call SendVital(index, HP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+ End If
+ moved = YES
+ End If
+ End With
+
+ ' check for events
+ If Map(GetPlayerMap(index)).TileData.EventCount > 0 Then
+ For i = 1 To Map(GetPlayerMap(index)).TileData.EventCount
+ CheckPlayerEvent index, i
+ Next
+ End If
+
+ ' They tried to hack
+ If moved = NO And canMoveResult <> 2 Then
+ PlayerWarp index, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index)
+ End If
+End Sub
+
+Sub CheckPlayerEvent(index As Long, eventNum As Long)
+Dim Count As Long, mapnum As Long, i As Long
+ ' find the page to process
+ mapnum = GetPlayerMap(index)
+ ' make sure it's in the same spot
+ If Map(mapnum).TileData.Events(eventNum).x <> GetPlayerX(index) Then Exit Sub
+ If Map(mapnum).TileData.Events(eventNum).y <> GetPlayerY(index) Then Exit Sub
+ ' loop
+ Count = Map(mapnum).TileData.Events(eventNum).PageCount
+ ' get the active page
+ i = ActiveEventPage(index, eventNum)
+ ' exit out early
+ If i = 0 Then Exit Sub
+ ' make sure the page has actual commands
+ If Map(mapnum).TileData.Events(eventNum).EventPage(i).CommandCount = 0 Then Exit Sub
+ ' set event
+ TempPlayer(index).inEvent = True
+ TempPlayer(index).eventNum = eventNum
+ TempPlayer(index).pageNum = i
+ TempPlayer(index).commandNum = 1
+ ' send it to the player
+ SendEvent index
+End Sub
+
+Sub EventLogic(index As Long)
+Dim eventNum As Long, pageNum As Long, commandNum As Long
+ eventNum = TempPlayer(index).eventNum
+ pageNum = TempPlayer(index).pageNum
+ commandNum = TempPlayer(index).commandNum
+ ' carry out the command
+ With Map(GetPlayerMap(index)).TileData.Events(eventNum).EventPage(pageNum)
+ ' server-side processing
+ Select Case .Commands(commandNum).Type
+ Case EventType.evPlayerVar
+ If .Commands(commandNum).target > 0 Then Player(index).Variable(.Commands(commandNum).target) = .Commands(commandNum).colour
+ End Select
+ ' increment commands
+ If commandNum < .CommandCount Then
+ TempPlayer(index).commandNum = TempPlayer(index).commandNum + 1
+ Exit Sub
+ End If
+ End With
+ ' we're done - close event
+ TempPlayer(index).eventNum = 0
+ TempPlayer(index).pageNum = 0
+ TempPlayer(index).commandNum = 0
+ TempPlayer(index).inEvent = False
+ ' send it to the player
+ 'SendEvent index
+End Sub
+
+Sub ForcePlayerMove(ByVal index As Long, ByVal movement As Long, ByVal direction As Long)
+ If direction < DIR_UP Or direction > DIR_RIGHT Then Exit Sub
+ If movement < 1 Or movement > 2 Then Exit Sub
+
+ Select Case direction
+ Case DIR_UP
+ If GetPlayerY(index) = 0 Then Exit Sub
+ Case DIR_LEFT
+ If GetPlayerX(index) = 0 Then Exit Sub
+ Case DIR_DOWN
+ If GetPlayerY(index) = Map(GetPlayerMap(index)).MapData.MaxY Then Exit Sub
+ Case DIR_RIGHT
+ If GetPlayerX(index) = Map(GetPlayerMap(index)).MapData.MaxX Then Exit Sub
+ End Select
+
+ PlayerMove index, direction, movement, True
+End Sub
+
+Sub CheckEquippedItems(ByVal index As Long)
+ Dim Slot As Long
+ Dim itemNum As Long
+ Dim i As Long
+
+ ' We want to check incase an admin takes away an object but they had it equipped
+ For i = 1 To Equipment.Equipment_Count - 1
+ itemNum = GetPlayerEquipment(index, i)
+
+ If itemNum > 0 Then
+
+ Select Case i
+ Case Equipment.Weapon
+
+ If Item(itemNum).Type <> ITEM_TYPE_WEAPON Then SetPlayerEquipment index, 0, i
+ Case Equipment.Armor
+
+ If Item(itemNum).Type <> ITEM_TYPE_ARMOR Then SetPlayerEquipment index, 0, i
+ Case Equipment.Helmet
+
+ If Item(itemNum).Type <> ITEM_TYPE_HELMET Then SetPlayerEquipment index, 0, i
+ Case Equipment.Shield
+
+ If Item(itemNum).Type <> ITEM_TYPE_SHIELD Then SetPlayerEquipment index, 0, i
+ End Select
+
+ Else
+ SetPlayerEquipment index, 0, i
+ End If
+
+ Next
+
+End Sub
+
+Function FindOpenInvSlot(ByVal index As Long, ByVal itemNum As Long) As Long
+ Dim i As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or itemNum <= 0 Or itemNum > MAX_ITEMS Then
+ Exit Function
+ End If
+
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+
+ ' If currency then check to see if they already have an instance of the item and add it to that
+ For i = 1 To MAX_INV
+
+ If GetPlayerInvItemNum(index, i) = itemNum Then
+ FindOpenInvSlot = i
+ Exit Function
+ End If
+
+ Next
+
+ End If
+
+ For i = 1 To MAX_INV
+
+ ' Try to find an open free slot
+ If GetPlayerInvItemNum(index, i) = 0 Then
+ FindOpenInvSlot = i
+ Exit Function
+ End If
+
+ Next
+
+End Function
+
+Function FindOpenBankSlot(ByVal index As Long, ByVal itemNum As Long) As Long
+ Dim i As Long
+
+ If Not IsPlaying(index) Then Exit Function
+ If itemNum <= 0 Or itemNum > MAX_ITEMS Then Exit Function
+
+ For i = 1 To MAX_BANK
+ If GetPlayerBankItemNum(index, i) = itemNum Then
+ FindOpenBankSlot = i
+ Exit Function
+ End If
+ Next i
+
+ For i = 1 To MAX_BANK
+ If GetPlayerBankItemNum(index, i) = 0 Then
+ FindOpenBankSlot = i
+ Exit Function
+ End If
+ Next i
+
+End Function
+
+Function HasItem(ByVal index As Long, ByVal itemNum As Long) As Long
+ Dim i As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or itemNum <= 0 Or itemNum > MAX_ITEMS Then
+ Exit Function
+ End If
+
+ For i = 1 To MAX_INV
+
+ ' Check to see if the player has the item
+ If GetPlayerInvItemNum(index, i) = itemNum Then
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+ HasItem = GetPlayerInvItemValue(index, i)
+ Else
+ HasItem = 1
+ End If
+
+ Exit Function
+ End If
+
+ Next
+
+End Function
+
+Function TakeInvItem(ByVal index As Long, ByVal itemNum As Long, ByVal ItemVal As Long) As Boolean
+ Dim i As Long
+ Dim n As Long
+
+ TakeInvItem = False
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or itemNum <= 0 Or itemNum > MAX_ITEMS Then
+ Exit Function
+ End If
+
+ For i = 1 To MAX_INV
+
+ ' Check to see if the player has the item
+ If GetPlayerInvItemNum(index, i) = itemNum Then
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+
+ ' Is what we are trying to take away more then what they have? If so just set it to zero
+ If ItemVal >= GetPlayerInvItemValue(index, i) Then
+ TakeInvItem = True
+ Else
+ Call SetPlayerInvItemValue(index, i, GetPlayerInvItemValue(index, i) - ItemVal)
+ Call SendInventoryUpdate(index, i)
+ End If
+ Else
+ TakeInvItem = True
+ End If
+
+ If TakeInvItem Then
+ Call SetPlayerInvItemNum(index, i, 0)
+ Call SetPlayerInvItemValue(index, i, 0)
+ Player(index).Inv(i).Bound = 0
+ ' Send the inventory update
+ Call SendInventoryUpdate(index, i)
+ Exit Function
+ End If
+ End If
+
+ Next
+
+End Function
+
+Function TakeInvSlot(ByVal index As Long, ByVal invSlot As Long, ByVal ItemVal As Long) As Boolean
+ Dim i As Long
+ Dim n As Long
+ Dim itemNum
+
+ TakeInvSlot = False
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or invSlot <= 0 Or invSlot > MAX_ITEMS Then
+ Exit Function
+ End If
+
+ itemNum = GetPlayerInvItemNum(index, invSlot)
+
+ If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then
+
+ ' Is what we are trying to take away more then what they have? If so just set it to zero
+ If ItemVal >= GetPlayerInvItemValue(index, invSlot) Then
+ TakeInvSlot = True
+ Else
+ Call SetPlayerInvItemValue(index, invSlot, GetPlayerInvItemValue(index, invSlot) - ItemVal)
+ End If
+ Else
+ TakeInvSlot = True
+ End If
+
+ If TakeInvSlot Then
+ Call SetPlayerInvItemNum(index, invSlot, 0)
+ Call SetPlayerInvItemValue(index, invSlot, 0)
+ Player(index).Inv(invSlot).Bound = 0
+ Exit Function
+ End If
+
+End Function
+
+Function GiveInvItem(ByVal index As Long, ByVal itemNum As Long, ByVal ItemVal As Long, Optional ByVal sendUpdate As Boolean = True, Optional ByVal forceBound As Boolean = False) As Boolean
+ Dim i As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or itemNum <= 0 Or itemNum > MAX_ITEMS Then
+ GiveInvItem = False
+ Exit Function
+ End If
+
+ i = FindOpenInvSlot(index, itemNum)
+
+ ' Check to see if inventory is full
+ If i <> 0 Then
+ Call SetPlayerInvItemNum(index, i, itemNum)
+ Call SetPlayerInvItemValue(index, i, GetPlayerInvItemValue(index, i) + ItemVal)
+ ' force bound?
+ If Not forceBound Then
+ ' bind on pickup?
+ If Item(itemNum).BindType = 1 Then ' bind on pickup
+ Player(index).Inv(i).Bound = 1
+ PlayerMsg index, "This item is now bound to your soul.", BrightRed
+ Else
+ Player(index).Inv(i).Bound = 0
+ End If
+ Else
+ Player(index).Inv(i).Bound = 1
+ End If
+ ' send update
+ If sendUpdate Then Call SendInventoryUpdate(index, i)
+ GiveInvItem = True
+ Else
+ Call PlayerMsg(index, "Your inventory is full.", BrightRed)
+ GiveInvItem = False
+ End If
+
+End Function
+
+Function HasSpell(ByVal index As Long, ByVal spellNum As Long) As Boolean
+ Dim i As Long
+
+ For i = 1 To MAX_PLAYER_SPELLS
+
+ If Player(index).Spell(i).Spell = spellNum Then
+ HasSpell = True
+ Exit Function
+ End If
+
+ Next
+
+End Function
+
+Function FindOpenSpellSlot(ByVal index As Long) As Long
+ Dim i As Long
+
+ For i = 1 To MAX_PLAYER_SPELLS
+
+ If Player(index).Spell(i).Spell = 0 Then
+ FindOpenSpellSlot = i
+ Exit Function
+ End If
+
+ Next
+
+End Function
+
+Sub PlayerMapGetItem(ByVal index As Long)
+ Dim i As Long
+ Dim n As Long
+ Dim mapnum As Long
+ Dim Msg As String
+
+ If Not IsPlaying(index) Then Exit Sub
+ mapnum = GetPlayerMap(index)
+
+ If mapnum = 0 Then Exit Sub
+
+ For i = 1 To MAX_MAP_ITEMS
+ ' See if theres even an item here
+ If (MapItem(mapnum, i).Num > 0) And (MapItem(mapnum, i).Num <= MAX_ITEMS) Then
+ ' our drop?
+ If CanPlayerPickupItem(index, i) Then
+ ' Check if item is at the same location as the player
+ If (MapItem(mapnum, i).x = GetPlayerX(index)) Then
+ If (MapItem(mapnum, i).y = GetPlayerY(index)) Then
+ ' Find open slot
+ n = FindOpenInvSlot(index, MapItem(mapnum, i).Num)
+
+ ' Open slot available?
+ If n <> 0 Then
+ ' Set item in players inventor
+ Call SetPlayerInvItemNum(index, n, MapItem(mapnum, i).Num)
+
+ If Item(GetPlayerInvItemNum(index, n)).Type = ITEM_TYPE_CURRENCY Then
+ Call SetPlayerInvItemValue(index, n, GetPlayerInvItemValue(index, n) + MapItem(mapnum, i).Value)
+ Msg = MapItem(mapnum, i).Value & " " & Trim$(Item(GetPlayerInvItemNum(index, n)).Name)
+ Else
+ Call SetPlayerInvItemValue(index, n, 0)
+ Msg = Trim$(Item(GetPlayerInvItemNum(index, n)).Name)
+ End If
+
+ ' is it bind on pickup?
+ Player(index).Inv(n).Bound = 0
+ If Item(GetPlayerInvItemNum(index, n)).BindType = 1 Or MapItem(mapnum, i).Bound Then
+ Player(index).Inv(n).Bound = 1
+ If Not Trim$(MapItem(mapnum, i).playerName) = Trim$(GetPlayerName(index)) Then
+ PlayerMsg index, "This item is now bound to your soul.", BrightRed
+ End If
+ End If
+
+ ' Erase item from the map
+ ClearMapItem i, mapnum
+
+ Call SendInventoryUpdate(index, n)
+ Call SpawnItemSlot(i, 0, 0, GetPlayerMap(index), 0, 0)
+ SendActionMsg GetPlayerMap(index), Msg, White, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
+ Exit For
+ Else
+ Call PlayerMsg(index, "Your inventory is full.", BrightRed)
+ Exit For
+ End If
+ End If
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Function CanPlayerPickupItem(ByVal index As Long, ByVal mapItemNum As Long)
+Dim mapnum As Long, tmpIndex As Long, i As Long
+
+ mapnum = GetPlayerMap(index)
+
+ ' no lock or locked to player?
+ If MapItem(mapnum, mapItemNum).playerName = vbNullString Or MapItem(mapnum, mapItemNum).playerName = Trim$(GetPlayerName(index)) Then
+ CanPlayerPickupItem = True
+ Exit Function
+ End If
+
+ ' if in party show their party member's drops
+ If TempPlayer(index).inParty > 0 Then
+ For i = 1 To MAX_PARTY_MEMBERS
+ tmpIndex = Party(TempPlayer(index).inParty).Member(i)
+ If tmpIndex > 0 Then
+ If Trim$(GetPlayerName(tmpIndex)) = MapItem(mapnum, mapItemNum).playerName Then
+ If MapItem(mapnum, mapItemNum).Bound = 0 Then
+ CanPlayerPickupItem = True
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+ End If
+
+ ' exit out
+ CanPlayerPickupItem = False
+End Function
+
+Sub PlayerMapDropItem(ByVal index As Long, ByVal invNum As Long, ByVal amount As Long)
+ Dim i As Long
+
+ ' Check for subscript out of range
+ If IsPlaying(index) = False Or invNum <= 0 Or invNum > MAX_INV Then
+ Exit Sub
+ End If
+
+ ' check the player isn't doing something
+ If TempPlayer(index).InBank Or TempPlayer(index).InShop Or TempPlayer(index).InTrade > 0 Then Exit Sub
+
+ If (GetPlayerInvItemNum(index, invNum) > 0) Then
+ If (GetPlayerInvItemNum(index, invNum) <= MAX_ITEMS) Then
+ ' make sure it's not bound
+ If Item(GetPlayerInvItemNum(index, invNum)).BindType > 0 Then
+ If Player(index).Inv(invNum).Bound = 1 Then
+ PlayerMsg index, "This item is soulbound and cannot be picked up by other players.", BrightRed
+ End If
+ End If
+
+ i = FindOpenMapItemSlot(GetPlayerMap(index))
+
+ If i <> 0 Then
+ MapItem(GetPlayerMap(index), i).Num = GetPlayerInvItemNum(index, invNum)
+ MapItem(GetPlayerMap(index), i).x = GetPlayerX(index)
+ MapItem(GetPlayerMap(index), i).y = GetPlayerY(index)
+ MapItem(GetPlayerMap(index), i).playerName = Trim$(GetPlayerName(index))
+ MapItem(GetPlayerMap(index), i).playerTimer = GetTickCount + ITEM_SPAWN_TIME
+ MapItem(GetPlayerMap(index), i).canDespawn = True
+ MapItem(GetPlayerMap(index), i).despawnTimer = GetTickCount + ITEM_DESPAWN_TIME
+ If Player(index).Inv(invNum).Bound > 0 Then
+ MapItem(GetPlayerMap(index), i).Bound = True
+ Else
+ MapItem(GetPlayerMap(index), i).Bound = False
+ End If
+
+ If Item(GetPlayerInvItemNum(index, invNum)).Type = ITEM_TYPE_CURRENCY Then
+
+ ' Check if its more then they have and if so drop it all
+ If amount >= GetPlayerInvItemValue(index, invNum) Then
+ MapItem(GetPlayerMap(index), i).Value = GetPlayerInvItemValue(index, invNum)
+ Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & " drops " & GetPlayerInvItemValue(index, invNum) & " " & Trim$(Item(GetPlayerInvItemNum(index, invNum)).Name) & ".", Yellow)
+ Call SetPlayerInvItemNum(index, invNum, 0)
+ Call SetPlayerInvItemValue(index, invNum, 0)
+ Player(index).Inv(invNum).Bound = 0
+ Else
+ MapItem(GetPlayerMap(index), i).Value = amount
+ Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & " drops " & amount & " " & Trim$(Item(GetPlayerInvItemNum(index, invNum)).Name) & ".", Yellow)
+ Call SetPlayerInvItemValue(index, invNum, GetPlayerInvItemValue(index, invNum) - amount)
+ End If
+
+ Else
+ ' Its not a currency object so this is easy
+ MapItem(GetPlayerMap(index), i).Value = 0
+ ' send message
+ Call MapMsg(GetPlayerMap(index), GetPlayerName(index) & " drops " & CheckGrammar(Trim$(Item(GetPlayerInvItemNum(index, invNum)).Name)) & ".", Yellow)
+ Call SetPlayerInvItemNum(index, invNum, 0)
+ Call SetPlayerInvItemValue(index, invNum, 0)
+ Player(index).Inv(invNum).Bound = 0
+ End If
+
+ ' Send inventory update
+ Call SendInventoryUpdate(index, invNum)
+ ' Spawn the item before we set the num or we'll get a different free map item slot
+ Call SpawnItemSlot(i, MapItem(GetPlayerMap(index), i).Num, amount, GetPlayerMap(index), GetPlayerX(index), GetPlayerY(index), Trim$(GetPlayerName(index)), MapItem(GetPlayerMap(index), i).canDespawn, MapItem(GetPlayerMap(index), i).Bound)
+ Else
+ Call PlayerMsg(index, "Too many items already on the ground.", BrightRed)
+ End If
+ End If
+ End If
+
+End Sub
+
+Sub CheckPlayerLevelUp(ByVal index As Long)
+ Dim i As Long
+ Dim expRollover As Long
+ Dim level_count As Long
+
+ level_count = 0
+
+ Do While GetPlayerExp(index) >= GetPlayerNextLevel(index)
+ expRollover = GetPlayerExp(index) - GetPlayerNextLevel(index)
+
+ ' can level up?
+ If Not SetPlayerLevel(index, GetPlayerLevel(index) + 1) Then
+ Exit Sub
+ End If
+
+ Call SetPlayerPOINTS(index, GetPlayerPOINTS(index) + 3)
+ Call SetPlayerExp(index, expRollover)
+ level_count = level_count + 1
+ Loop
+
+ If level_count > 0 Then
+ If level_count = 1 Then
+ 'singular
+ GlobalMsg GetPlayerName(index) & " has gained " & level_count & " level!", Brown
+ Else
+ 'plural
+ GlobalMsg GetPlayerName(index) & " has gained " & level_count & " levels!", Brown
+ End If
+ SendEXP index
+ SendPlayerData index
+ End If
+End Sub
+
+' //////////////////////
+' // PLAYER FUNCTIONS //
+' //////////////////////
+Function GetPlayerLogin(ByVal index As Long) As String
+ GetPlayerLogin = Trim$(Player(index).Login)
+End Function
+
+Sub SetPlayerLogin(ByVal index As Long, ByVal Login As String)
+ Player(index).Login = Login
+End Sub
+
+Function GetPlayerName(ByVal index As Long) As String
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerName = Trim$(Player(index).Name)
+End Function
+
+Sub SetPlayerName(ByVal index As Long, ByVal Name As String)
+ Player(index).Name = Name
+End Sub
+
+Function GetPlayerClass(ByVal index As Long) As Long
+ GetPlayerClass = Player(index).Class
+End Function
+
+Sub SetPlayerClass(ByVal index As Long, ByVal ClassNum As Long)
+ Player(index).Class = ClassNum
+End Sub
+
+Function GetPlayerSprite(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerSprite = Player(index).Sprite
+End Function
+
+Sub SetPlayerSprite(ByVal index As Long, ByVal Sprite As Long)
+ Player(index).Sprite = Sprite
+End Sub
+
+Function GetPlayerLevel(ByVal index As Long) As Long
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Function
+ GetPlayerLevel = Player(index).Level
+End Function
+
+Function SetPlayerLevel(ByVal index As Long, ByVal Level As Long) As Boolean
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Function
+ SetPlayerLevel = False
+ If Level > MAX_LEVELS Then
+ Player(index).Level = MAX_LEVELS
+ Exit Function
+ End If
+ Player(index).Level = Level
+ SetPlayerLevel = True
+End Function
+
+Function GetPlayerNextLevel(ByVal index As Long) As Long
+ GetPlayerNextLevel = 100 + (((GetPlayerLevel(index) ^ 2) * 10) * 2)
+End Function
+
+Function GetPlayerExp(ByVal index As Long) As Long
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Function
+ GetPlayerExp = Player(index).exp
+End Function
+
+Sub SetPlayerExp(ByVal index As Long, ByVal exp As Long)
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Sub
+ Player(index).exp = exp
+End Sub
+
+Function GetPlayerAccess(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerAccess = Player(index).Access
+End Function
+
+Sub SetPlayerAccess(ByVal index As Long, ByVal Access As Long)
+ Player(index).Access = Access
+End Sub
+
+Function GetPlayerPK(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerPK = Player(index).PK
+End Function
+
+Sub SetPlayerPK(ByVal index As Long, ByVal PK As Long)
+ Player(index).PK = PK
+End Sub
+
+Function GetPlayerVital(ByVal index As Long, ByVal Vital As Vitals) As Long
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerVital = Player(index).Vital(Vital)
+End Function
+
+Sub SetPlayerVital(ByVal index As Long, ByVal Vital As Vitals, ByVal Value As Long)
+ Player(index).Vital(Vital) = Value
+
+ If GetPlayerVital(index, Vital) > GetPlayerMaxVital(index, Vital) Then
+ Player(index).Vital(Vital) = GetPlayerMaxVital(index, Vital)
+ End If
+
+ If GetPlayerVital(index, Vital) < 0 Then
+ Player(index).Vital(Vital) = 0
+ End If
+
+End Sub
+
+Public Function GetPlayerStat(ByVal index As Long, ByVal Stat As Stats) As Long
+ Dim x As Long, i As Long
+ If index > MAX_PLAYERS Then Exit Function
+
+ x = Player(index).Stat(Stat)
+
+ For i = 1 To Equipment.Equipment_Count - 1
+ If Player(index).Equipment(i) > 0 Then
+ If Item(Player(index).Equipment(i)).Add_Stat(Stat) > 0 Then
+ x = x + Item(Player(index).Equipment(i)).Add_Stat(Stat)
+ End If
+ End If
+ Next
+
+ GetPlayerStat = x
+End Function
+
+Public Function GetPlayerRawStat(ByVal index As Long, ByVal Stat As Stats) As Long
+ If index > MAX_PLAYERS Then Exit Function
+
+ GetPlayerRawStat = Player(index).Stat(Stat)
+End Function
+
+Public Sub SetPlayerStat(ByVal index As Long, ByVal Stat As Stats, ByVal Value As Long)
+ Player(index).Stat(Stat) = Value
+End Sub
+
+Function GetPlayerPOINTS(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerPOINTS = Player(index).POINTS
+End Function
+
+Sub SetPlayerPOINTS(ByVal index As Long, ByVal POINTS As Long)
+ If POINTS <= 0 Then POINTS = 0
+ Player(index).POINTS = POINTS
+End Sub
+
+Function GetPlayerMap(ByVal index As Long) As Long
+
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Function
+ GetPlayerMap = Player(index).Map
+End Function
+
+Sub SetPlayerMap(ByVal index As Long, ByVal mapnum As Long)
+
+ If mapnum > 0 And mapnum <= MAX_MAPS Then
+ Player(index).Map = mapnum
+ End If
+
+End Sub
+
+Function GetPlayerX(ByVal index As Long) As Long
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Function
+ GetPlayerX = Player(index).x
+End Function
+
+Sub SetPlayerX(ByVal index As Long, ByVal x As Long)
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Sub
+ Player(index).x = x
+End Sub
+
+Function GetPlayerY(ByVal index As Long) As Long
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Function
+ GetPlayerY = Player(index).y
+End Function
+
+Sub SetPlayerY(ByVal index As Long, ByVal y As Long)
+ If index <= 0 Or index > MAX_PLAYERS Then Exit Sub
+ Player(index).y = y
+End Sub
+
+Function GetPlayerDir(ByVal index As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerDir = Player(index).dir
+End Function
+
+Sub SetPlayerDir(ByVal index As Long, ByVal dir As Long)
+ Player(index).dir = dir
+End Sub
+
+Function GetPlayerIP(ByVal index As Long) As String
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerIP = frmServer.Socket(index).RemoteHostIP
+End Function
+
+Function GetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long) As Long
+ If index > MAX_PLAYERS Then Exit Function
+ If invSlot = 0 Then Exit Function
+
+ GetPlayerInvItemNum = Player(index).Inv(invSlot).Num
+End Function
+
+Sub SetPlayerInvItemNum(ByVal index As Long, ByVal invSlot As Long, ByVal itemNum As Long)
+ Player(index).Inv(invSlot).Num = itemNum
+End Sub
+
+Function GetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ GetPlayerInvItemValue = Player(index).Inv(invSlot).Value
+End Function
+
+Sub SetPlayerInvItemValue(ByVal index As Long, ByVal invSlot As Long, ByVal ItemValue As Long)
+ Player(index).Inv(invSlot).Value = ItemValue
+End Sub
+
+Function GetPlayerEquipment(ByVal index As Long, ByVal EquipmentSlot As Equipment) As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ If EquipmentSlot = 0 Then Exit Function
+
+ GetPlayerEquipment = Player(index).Equipment(EquipmentSlot)
+End Function
+
+Sub SetPlayerEquipment(ByVal index As Long, ByVal invNum As Long, ByVal EquipmentSlot As Equipment)
+ Player(index).Equipment(EquipmentSlot) = invNum
+End Sub
+
+' ToDo
+Sub OnDeath(ByVal index As Long)
+ Dim i As Long
+
+ ' Set HP to nothing
+ Call SetPlayerVital(index, Vitals.HP, 0)
+ SendVital index, HP
+
+ ' Drop all worn items
+ For i = 1 To Equipment.Equipment_Count - 1
+ If GetPlayerEquipment(index, i) > 0 Then
+ PlayerMapDropItem index, GetPlayerEquipment(index, i), 0
+ End If
+ Next
+
+ ' Warp player away
+ Call SetPlayerDir(index, DIR_DOWN)
+
+ With Map(GetPlayerMap(index)).MapData
+ ' to the bootmap if it is set
+ If .BootMap > 0 Then
+ PlayerWarp index, .BootMap, .BootX, .BootY
+ Else
+ Call PlayerWarp(index, START_MAP, START_X, START_Y)
+ End If
+ End With
+
+ ' clear all DoTs and HoTs
+ For i = 1 To MAX_DOTS
+ With TempPlayer(index).DoT(i)
+ .Used = False
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ End With
+
+ With TempPlayer(index).HoT(i)
+ .Used = False
+ .Spell = 0
+ .Timer = 0
+ .Caster = 0
+ .StartTime = 0
+ End With
+ Next
+
+ ' Clear spell casting
+ TempPlayer(index).spellBuffer.Spell = 0
+ TempPlayer(index).spellBuffer.Timer = 0
+ TempPlayer(index).spellBuffer.target = 0
+ TempPlayer(index).spellBuffer.tType = 0
+ Call SendClearSpellBuffer(index)
+
+ ' Restore vitals
+ Call SetPlayerVital(index, Vitals.HP, GetPlayerMaxVital(index, Vitals.HP))
+ Call SetPlayerVital(index, Vitals.MP, GetPlayerMaxVital(index, Vitals.MP))
+ Call SendVital(index, Vitals.HP)
+ Call SendVital(index, Vitals.MP)
+
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+
+ ' If the player the attacker killed was a pk then take it away
+ If GetPlayerPK(index) = YES Then
+ Call SetPlayerPK(index, NO)
+ Call SendPlayerData(index)
+ End If
+
+End Sub
+
+Sub CheckResource(ByVal index As Long, ByVal x As Long, ByVal y As Long)
+ Dim Resource_num As Long
+ Dim Resource_index As Long
+ Dim rX As Long, rY As Long
+ Dim i As Long
+ Dim damage As Long
+
+ If Map(GetPlayerMap(index)).TileData.Tile(x, y).Type = TILE_TYPE_RESOURCE Then
+ Resource_num = 0
+ Resource_index = Map(GetPlayerMap(index)).TileData.Tile(x, y).Data1
+
+ ' Get the cache number
+ For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count
+
+ If ResourceCache(GetPlayerMap(index)).ResourceData(i).x = x Then
+ If ResourceCache(GetPlayerMap(index)).ResourceData(i).y = y Then
+ Resource_num = i
+ End If
+ End If
+
+ Next
+
+ If Resource_num > 0 Then
+ If GetPlayerEquipment(index, Weapon) > 0 Then
+ If Item(GetPlayerEquipment(index, Weapon)).Data3 = Resource(Resource_index).ToolRequired Then
+
+ ' inv space?
+ If Resource(Resource_index).ItemReward > 0 Then
+ If FindOpenInvSlot(index, Resource(Resource_index).ItemReward) = 0 Then
+ PlayerMsg index, "You have no inventory space.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' check if already cut down
+ If ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).ResourceState = 0 Then
+
+ rX = ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).x
+ rY = ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).y
+
+ damage = Item(GetPlayerEquipment(index, Weapon)).Data2
+
+ ' check if damage is more than health
+ If damage > 0 Then
+ ' cut it down!
+ If ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).cur_health - damage <= 0 Then
+ SendActionMsg GetPlayerMap(index), "-" & ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).cur_health, BrightRed, 1, (rX * 32), (rY * 32)
+ ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).ResourceState = 1 ' Cut
+ ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).ResourceTimer = GetTickCount
+ SendResourceCacheToMap GetPlayerMap(index), Resource_num
+ ' send message if it exists
+ If Len(Trim$(Resource(Resource_index).SuccessMessage)) > 0 Then
+ SendActionMsg GetPlayerMap(index), Trim$(Resource(Resource_index).SuccessMessage), BrightGreen, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
+ End If
+ ' carry on
+ GiveInvItem index, Resource(Resource_index).ItemReward, 1
+ SendAnimation GetPlayerMap(index), Resource(Resource_index).Animation, rX, rY
+ Else
+ ' just do the damage
+ ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).cur_health = ResourceCache(GetPlayerMap(index)).ResourceData(Resource_num).cur_health - damage
+ SendActionMsg GetPlayerMap(index), "-" & damage, BrightRed, 1, (rX * 32), (rY * 32)
+ SendAnimation GetPlayerMap(index), Resource(Resource_index).Animation, rX, rY
+ End If
+ ' send the sound
+ SendMapSound index, rX, rY, SoundEntity.seResource, Resource_index
+ Else
+ ' too weak
+ SendActionMsg GetPlayerMap(index), "Miss!", BrightRed, 1, (rX * 32), (rY * 32)
+ End If
+ Else
+ ' send message if it exists
+ If Len(Trim$(Resource(Resource_index).EmptyMessage)) > 0 Then
+ SendActionMsg GetPlayerMap(index), Trim$(Resource(Resource_index).EmptyMessage), BrightRed, 1, (GetPlayerX(index) * 32), (GetPlayerY(index) * 32)
+ End If
+ End If
+
+ Else
+ PlayerMsg index, "You have the wrong type of tool equiped.", BrightRed
+ End If
+
+ Else
+ PlayerMsg index, "You need a tool to interact with this resource.", BrightRed
+ End If
+ End If
+ End If
+End Sub
+
+Function GetPlayerBankItemNum(ByVal index As Long, ByVal BankSlot As Long) As Long
+ If BankSlot = 0 Then Exit Function
+ GetPlayerBankItemNum = Player(index).Bank(BankSlot).Num
+End Function
+
+Sub SetPlayerBankItemNum(ByVal index As Long, ByVal BankSlot As Long, ByVal itemNum As Long)
+ If BankSlot = 0 Then Exit Sub
+ Player(index).Bank(BankSlot).Num = itemNum
+End Sub
+
+Function GetPlayerBankItemValue(ByVal index As Long, ByVal BankSlot As Long) As Long
+ If BankSlot = 0 Then Exit Function
+ GetPlayerBankItemValue = Player(index).Bank(BankSlot).Value
+End Function
+
+Sub SetPlayerBankItemValue(ByVal index As Long, ByVal BankSlot As Long, ByVal ItemValue As Long)
+ If BankSlot = 0 Then Exit Sub
+ Player(index).Bank(BankSlot).Value = ItemValue
+End Sub
+
+Sub GiveBankItem(ByVal index As Long, ByVal invSlot As Long, ByVal amount As Long)
+Dim BankSlot
+
+ If invSlot < 0 Or invSlot > MAX_INV Then
+ Exit Sub
+ End If
+
+ If amount < 0 Or amount > GetPlayerInvItemValue(index, invSlot) Then
+ Exit Sub
+ End If
+
+ BankSlot = FindOpenBankSlot(index, GetPlayerInvItemNum(index, invSlot))
+
+ If BankSlot > 0 Then
+ If Item(GetPlayerInvItemNum(index, invSlot)).Type = ITEM_TYPE_CURRENCY Then
+ If GetPlayerBankItemNum(index, BankSlot) = GetPlayerInvItemNum(index, invSlot) Then
+ Call SetPlayerBankItemValue(index, BankSlot, GetPlayerBankItemValue(index, BankSlot) + amount)
+ Call TakeInvItem(index, GetPlayerInvItemNum(index, invSlot), amount)
+ Else
+ Call SetPlayerBankItemNum(index, BankSlot, GetPlayerInvItemNum(index, invSlot))
+ Call SetPlayerBankItemValue(index, BankSlot, amount)
+ Call TakeInvItem(index, GetPlayerInvItemNum(index, invSlot), amount)
+ End If
+ Else
+ If GetPlayerBankItemNum(index, BankSlot) = GetPlayerInvItemNum(index, invSlot) Then
+ Call SetPlayerBankItemValue(index, BankSlot, GetPlayerBankItemValue(index, BankSlot) + 1)
+ Call TakeInvItem(index, GetPlayerInvItemNum(index, invSlot), 0)
+ Else
+ Call SetPlayerBankItemNum(index, BankSlot, GetPlayerInvItemNum(index, invSlot))
+ Call SetPlayerBankItemValue(index, BankSlot, 1)
+ Call TakeInvItem(index, GetPlayerInvItemNum(index, invSlot), 0)
+ End If
+ End If
+ End If
+
+ SavePlayer index
+ SendBank index
+
+End Sub
+
+Sub TakeBankItem(ByVal index As Long, ByVal BankSlot As Long, ByVal amount As Long)
+Dim invSlot
+
+ If BankSlot < 0 Or BankSlot > MAX_BANK Then
+ Exit Sub
+ End If
+
+ If amount < 0 Or amount > GetPlayerBankItemValue(index, BankSlot) Then
+ Exit Sub
+ End If
+
+ invSlot = FindOpenInvSlot(index, GetPlayerBankItemNum(index, BankSlot))
+
+ If invSlot > 0 Then
+ If Item(GetPlayerBankItemNum(index, BankSlot)).Type = ITEM_TYPE_CURRENCY Then
+ Call GiveInvItem(index, GetPlayerBankItemNum(index, BankSlot), amount)
+ Call SetPlayerBankItemValue(index, BankSlot, GetPlayerBankItemValue(index, BankSlot) - amount)
+ If GetPlayerBankItemValue(index, BankSlot) <= 0 Then
+ Call SetPlayerBankItemNum(index, BankSlot, 0)
+ Call SetPlayerBankItemValue(index, BankSlot, 0)
+ End If
+ Else
+ If GetPlayerBankItemValue(index, BankSlot) > 1 Then
+ Call GiveInvItem(index, GetPlayerBankItemNum(index, BankSlot), 0)
+ Call SetPlayerBankItemValue(index, BankSlot, GetPlayerBankItemValue(index, BankSlot) - 1)
+ Else
+ Call GiveInvItem(index, GetPlayerBankItemNum(index, BankSlot), 0)
+ Call SetPlayerBankItemNum(index, BankSlot, 0)
+ Call SetPlayerBankItemValue(index, BankSlot, 0)
+ End If
+ End If
+ End If
+
+ SavePlayer index
+ SendBank index
+
+End Sub
+
+Public Sub KillPlayer(ByVal index As Long)
+Dim exp As Long
+
+ ' Calculate exp to give attacker
+ exp = GetPlayerExp(index) \ 3
+
+ ' Make sure we dont get less then 0
+ If exp < 0 Then exp = 0
+ If exp = 0 Then
+ Call PlayerMsg(index, "You lost no exp.", BrightRed)
+ Else
+ Call SetPlayerExp(index, GetPlayerExp(index) - exp)
+ SendEXP index
+ Call PlayerMsg(index, "You lost " & exp & " exp.", BrightRed)
+ End If
+
+ Call OnDeath(index)
+End Sub
+
+Public Sub UseItem(ByVal index As Long, ByVal invNum As Long)
+Dim n As Long, i As Long, tempItem As Long, x As Long, y As Long, itemNum As Long
+
+ ' Prevent hacking
+ If invNum < 1 Or invNum > MAX_ITEMS Then
+ Exit Sub
+ End If
+
+ If (GetPlayerInvItemNum(index, invNum) > 0) And (GetPlayerInvItemNum(index, invNum) <= MAX_ITEMS) Then
+ n = Item(GetPlayerInvItemNum(index, invNum)).Data2
+ itemNum = GetPlayerInvItemNum(index, invNum)
+
+ ' Find out what kind of item it is
+ Select Case Item(itemNum).Type
+ Case ITEM_TYPE_ARMOR
+
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to equip this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' prociency requirement
+ If Not hasProficiency(index, Item(itemNum).proficiency) Then
+ PlayerMsg index, "You do not have the proficiency this item requires.", BrightRed
+ Exit Sub
+ End If
+
+ If GetPlayerEquipment(index, Armor) > 0 Then
+ tempItem = GetPlayerEquipment(index, Armor)
+ End If
+
+ SetPlayerEquipment index, itemNum, Armor
+
+ PlayerMsg index, "You equip " & CheckGrammar(Item(itemNum).Name), BrightGreen
+
+ ' tell them if it's soulbound
+ If Item(itemNum).BindType = 2 Then ' BoE
+ If Player(index).Inv(invNum).Bound = 0 Then
+ PlayerMsg index, "This item is now bound to your soul.", BrightRed
+ End If
+ End If
+
+ TakeInvItem index, itemNum, 0
+
+ If tempItem > 0 Then
+ If Item(tempItem).BindType > 0 Then
+ GiveInvItem index, tempItem, 0, , True ' give back the stored item
+ tempItem = 0
+ Else
+ GiveInvItem index, tempItem, 0
+ tempItem = 0
+ End If
+ End If
+
+ Call SendWornEquipment(index)
+ Call SendMapEquipment(index)
+
+ ' send vitals
+ Call SendVital(index, Vitals.HP)
+ Call SendVital(index, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ Case ITEM_TYPE_WEAPON
+
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to equip this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' prociency requirement
+ If Not hasProficiency(index, Item(itemNum).proficiency) Then
+ PlayerMsg index, "You do not have the proficiency this item requires.", BrightRed
+ Exit Sub
+ End If
+
+ If GetPlayerEquipment(index, Weapon) > 0 Then
+ tempItem = GetPlayerEquipment(index, Weapon)
+ End If
+
+ SetPlayerEquipment index, itemNum, Weapon
+ PlayerMsg index, "You equip " & CheckGrammar(Item(itemNum).Name), BrightGreen
+
+ ' tell them if it's soulbound
+ If Item(itemNum).BindType = 2 Then ' BoE
+ If Player(index).Inv(invNum).Bound = 0 Then
+ PlayerMsg index, "This item is now bound to your soul.", BrightRed
+ End If
+ End If
+
+ TakeInvItem index, itemNum, 1
+
+ If tempItem > 0 Then
+ If Item(tempItem).BindType > 0 Then
+ GiveInvItem index, tempItem, 0, , True ' give back the stored item
+ tempItem = 0
+ Else
+ GiveInvItem index, tempItem, 0
+ tempItem = 0
+ End If
+ End If
+
+ Call SendWornEquipment(index)
+ Call SendMapEquipment(index)
+
+ ' send vitals
+ Call SendVital(index, Vitals.HP)
+ Call SendVital(index, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ Case ITEM_TYPE_HELMET
+
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to equip this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' prociency requirement
+ If Not hasProficiency(index, Item(itemNum).proficiency) Then
+ PlayerMsg index, "You do not have the proficiency this item requires.", BrightRed
+ Exit Sub
+ End If
+
+ If GetPlayerEquipment(index, Helmet) > 0 Then
+ tempItem = GetPlayerEquipment(index, Helmet)
+ End If
+
+ SetPlayerEquipment index, itemNum, Helmet
+ PlayerMsg index, "You equip " & CheckGrammar(Item(itemNum).Name), BrightGreen
+
+ ' tell them if it's soulbound
+ If Item(itemNum).BindType = 2 Then ' BoE
+ If Player(index).Inv(invNum).Bound = 0 Then
+ PlayerMsg index, "This item is now bound to your soul.", BrightRed
+ End If
+ End If
+
+ TakeInvItem index, itemNum, 1
+
+ If tempItem > 0 Then
+ If Item(tempItem).BindType > 0 Then
+ GiveInvItem index, tempItem, 0, , True ' give back the stored item
+ tempItem = 0
+ Else
+ GiveInvItem index, tempItem, 0
+ tempItem = 0
+ End If
+ End If
+
+ Call SendWornEquipment(index)
+ Call SendMapEquipment(index)
+
+ ' send vitals
+ Call SendVital(index, Vitals.HP)
+ Call SendVital(index, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ Case ITEM_TYPE_SHIELD
+
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to equip this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to equip this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' prociency requirement
+ If Not hasProficiency(index, Item(itemNum).proficiency) Then
+ PlayerMsg index, "You do not have the proficiency this item requires.", BrightRed
+ Exit Sub
+ End If
+
+ If GetPlayerEquipment(index, Shield) > 0 Then
+ tempItem = GetPlayerEquipment(index, Shield)
+ End If
+
+ SetPlayerEquipment index, itemNum, Shield
+ PlayerMsg index, "You equip " & CheckGrammar(Item(itemNum).Name), BrightGreen
+
+ ' tell them if it's soulbound
+ If Item(itemNum).BindType = 2 Then ' BoE
+ If Player(index).Inv(invNum).Bound = 0 Then
+ PlayerMsg index, "This item is now bound to your soul.", BrightRed
+ End If
+ End If
+
+ TakeInvItem index, itemNum, 1
+
+ If tempItem > 0 Then
+ If Item(tempItem).BindType > 0 Then
+ GiveInvItem index, tempItem, 0, , True ' give back the stored item
+ tempItem = 0
+ Else
+ GiveInvItem index, tempItem, 0
+ tempItem = 0
+ End If
+ End If
+
+ ' send vitals
+ Call SendVital(index, Vitals.HP)
+ Call SendVital(index, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+
+ Call SendWornEquipment(index)
+ Call SendMapEquipment(index)
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ ' consumable
+ Case ITEM_TYPE_CONSUME
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to use this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' add hp
+ If Item(itemNum).AddHP > 0 Then
+ Player(index).Vital(Vitals.HP) = Player(index).Vital(Vitals.HP) + Item(itemNum).AddHP
+ SendActionMsg GetPlayerMap(index), "+" & Item(itemNum).AddHP, BrightGreen, ACTIONMSG_SCROLL, GetPlayerX(index) * 32, GetPlayerY(index) * 32
+ SendVital index, HP
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+ End If
+ ' add mp
+ If Item(itemNum).AddMP > 0 Then
+ Player(index).Vital(Vitals.MP) = Player(index).Vital(Vitals.MP) + Item(itemNum).AddMP
+ SendActionMsg GetPlayerMap(index), "+" & Item(itemNum).AddMP, BrightBlue, ACTIONMSG_SCROLL, GetPlayerX(index) * 32, GetPlayerY(index) * 32
+ SendVital index, MP
+ ' send vitals to party if in one
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+ End If
+ ' add exp
+ If Item(itemNum).AddEXP > 0 Then
+ SetPlayerExp index, GetPlayerExp(index) + Item(itemNum).AddEXP
+ CheckPlayerLevelUp index
+ SendActionMsg GetPlayerMap(index), "+" & Item(itemNum).AddEXP & " EXP", White, ACTIONMSG_SCROLL, GetPlayerX(index) * 32, GetPlayerY(index) * 32
+ SendEXP index
+ End If
+ Call SendAnimation(GetPlayerMap(index), Item(itemNum).Animation, 0, 0, TARGET_TYPE_PLAYER, index)
+ Call TakeInvItem(index, Player(index).Inv(invNum).Num, 0)
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ Case ITEM_TYPE_KEY
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to use this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ Select Case GetPlayerDir(index)
+ Case DIR_UP
+
+ If GetPlayerY(index) > 0 Then
+ x = GetPlayerX(index)
+ y = GetPlayerY(index) - 1
+ Else
+ Exit Sub
+ End If
+
+ Case DIR_DOWN
+
+ If GetPlayerY(index) < Map(GetPlayerMap(index)).MapData.MaxY Then
+ x = GetPlayerX(index)
+ y = GetPlayerY(index) + 1
+ Else
+ Exit Sub
+ End If
+
+ Case DIR_LEFT
+
+ If GetPlayerX(index) > 0 Then
+ x = GetPlayerX(index) - 1
+ y = GetPlayerY(index)
+ Else
+ Exit Sub
+ End If
+
+ Case DIR_RIGHT
+
+ If GetPlayerX(index) < Map(GetPlayerMap(index)).MapData.MaxX Then
+ x = GetPlayerX(index) + 1
+ y = GetPlayerY(index)
+ Else
+ Exit Sub
+ End If
+
+ End Select
+
+ ' Check if a key exists
+ If Map(GetPlayerMap(index)).TileData.Tile(x, y).Type = TILE_TYPE_KEY Then
+
+ ' Check if the key they are using matches the map key
+ If itemNum = Map(GetPlayerMap(index)).TileData.Tile(x, y).Data1 Then
+ TempTile(GetPlayerMap(index)).DoorOpen(x, y) = YES
+ TempTile(GetPlayerMap(index)).DoorTimer = GetTickCount
+ SendMapKey index, x, y, 1
+ 'Call MapMsg(GetPlayerMap(index), "A door has been unlocked.", White)
+
+ Call SendAnimation(GetPlayerMap(index), Item(itemNum).Animation, x, y)
+
+ ' Check if we are supposed to take away the item
+ If Map(GetPlayerMap(index)).TileData.Tile(x, y).Data2 = 1 Then
+ Call TakeInvItem(index, itemNum, 0)
+ Call PlayerMsg(index, "The key is destroyed in the lock.", Yellow)
+ End If
+ End If
+ End If
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ Case ITEM_TYPE_UNIQUE
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to use this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' Go through with it
+ Unique_Item index, itemNum
+ Case ITEM_TYPE_SPELL
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to use this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' Get the spell num
+ n = Item(itemNum).Data1
+
+ If n > 0 Then
+
+ ' Make sure they are the right class
+ If Spell(n).ClassReq = GetPlayerClass(index) Or Spell(n).ClassReq = 0 Then
+
+ ' make sure they don't already know it
+ For i = 1 To MAX_PLAYER_SPELLS
+ If Player(index).Spell(i).Spell > 0 Then
+ If Player(index).Spell(i).Spell = n Then
+ PlayerMsg index, "You already know this spell.", BrightRed
+ Exit Sub
+ End If
+ If Spell(Player(index).Spell(i).Spell).UniqueIndex = Spell(n).UniqueIndex Then
+ PlayerMsg index, "You already know this spell.", BrightRed
+ Exit Sub
+ End If
+ End If
+ Next
+
+ ' Make sure they are the right level
+ i = Spell(n).LevelReq
+
+
+ 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
+ Player(index).Spell(i).Spell = n
+ Call SendAnimation(GetPlayerMap(index), Item(itemNum).Animation, 0, 0, TARGET_TYPE_PLAYER, index)
+ Call TakeInvItem(index, itemNum, 0)
+ Call PlayerMsg(index, "You feel the rush of knowledge fill your mind. You can now use " & Trim$(Spell(n).Name) & ".", BrightGreen)
+ SendPlayerSpells index
+ Else
+ Call PlayerMsg(index, "You already have knowledge of this skill.", BrightRed)
+ End If
+
+ Else
+ Call PlayerMsg(index, "You cannot learn any more skills.", BrightRed)
+ End If
+
+ Else
+ Call PlayerMsg(index, "You must be level " & i & " to learn this skill.", BrightRed)
+ End If
+
+ Else
+ Call PlayerMsg(index, "This spell can only be learned by " & CheckGrammar(GetClassName(Spell(n).ClassReq)) & ".", BrightRed)
+ End If
+ End If
+
+ ' send the sound
+ SendPlayerSound index, GetPlayerX(index), GetPlayerY(index), SoundEntity.seItem, itemNum
+ Case ITEM_TYPE_FOOD
+ ' stat requirements
+ For i = 1 To Stats.Stat_Count - 1
+ If GetPlayerRawStat(index, i) < Item(itemNum).Stat_Req(i) Then
+ PlayerMsg index, "You do not meet the stat requirements to use this item.", BrightRed
+ Exit Sub
+ End If
+ Next
+
+ ' level requirement
+ If GetPlayerLevel(index) < Item(itemNum).LevelReq Then
+ PlayerMsg index, "You do not meet the level requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' class requirement
+ If Item(itemNum).ClassReq > 0 Then
+ If Not GetPlayerClass(index) = Item(itemNum).ClassReq Then
+ PlayerMsg index, "You do not meet the class requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' access requirement
+ If Not GetPlayerAccess(index) >= Item(itemNum).AccessReq Then
+ PlayerMsg index, "You do not meet the access requirement to use this item.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure they're not in combat
+ If TempPlayer(index).stopRegen Then
+ PlayerMsg index, "You cannot eat whilst in combat.", BrightRed
+ Exit Sub
+ End If
+
+ ' make sure not full hp
+ x = Item(itemNum).HPorSP
+ If Player(index).Vital(x) >= GetPlayerMaxVital(index, x) Then
+ PlayerMsg index, "You don't need to eat this at the moment.", BrightRed
+ Exit Sub
+ End If
+
+ ' set the player's food
+ If Item(itemNum).HPorSP = 2 Then 'mp
+ If Not TempPlayer(index).foodItem(Vitals.MP) = itemNum Then
+ TempPlayer(index).foodItem(Vitals.MP) = itemNum
+ TempPlayer(index).foodTick(Vitals.MP) = 0
+ TempPlayer(index).foodTimer(Vitals.MP) = GetTickCount
+ Else
+ PlayerMsg index, "You are already eating this.", BrightRed
+ Exit Sub
+ End If
+ Else ' hp
+ If Not TempPlayer(index).foodItem(Vitals.HP) = itemNum Then
+ TempPlayer(index).foodItem(Vitals.HP) = itemNum
+ TempPlayer(index).foodTick(Vitals.HP) = 0
+ TempPlayer(index).foodTimer(Vitals.HP) = GetTickCount
+ Else
+ PlayerMsg index, "You are already eating this.", BrightRed
+ Exit Sub
+ End If
+ End If
+
+ ' take the item
+ Call TakeInvItem(index, Player(index).Inv(invNum).Num, 0)
+ End Select
+ End If
+End Sub
diff --git a/server/src/modServerLoop.bas b/server/src/modServerLoop.bas
new file mode 100644
index 0000000..e7171f8
--- /dev/null
+++ b/server/src/modServerLoop.bas
@@ -0,0 +1,751 @@
+Attribute VB_Name = "modServerLoop"
+Option Explicit
+
+' halts thread of execution
+Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+Sub ServerLoop()
+ Dim i As Long, x As Long
+ Dim tick As Long, TickCPS As Long, CPS As Long, FrameTime As Long
+ Dim tmr25 As Long, tmr500 As Long, tmr1000 As Long
+ Dim LastUpdateSavePlayers, LastUpdateMapSpawnItems As Long, LastUpdatePlayerVitals As Long
+
+ ServerOnline = True
+
+ Do While ServerOnline
+ tick = GetTickCount
+ ElapsedTime = tick - FrameTime
+ FrameTime = tick
+
+ If tick > tmr25 Then
+ ' loops
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ ' check if they've completed casting, and if so set the actual spell going
+ If TempPlayer(i).spellBuffer.Spell > 0 Then
+ If GetTickCount > TempPlayer(i).spellBuffer.Timer + (Spell(Player(i).Spell(TempPlayer(i).spellBuffer.Spell).Spell).CastTime * 1000) Then
+ CastSpell i, TempPlayer(i).spellBuffer.Spell, TempPlayer(i).spellBuffer.target, TempPlayer(i).spellBuffer.tType
+ TempPlayer(i).spellBuffer.Spell = 0
+ TempPlayer(i).spellBuffer.Timer = 0
+ TempPlayer(i).spellBuffer.target = 0
+ TempPlayer(i).spellBuffer.tType = 0
+ End If
+ End If
+ ' check if need to turn off stunned
+ If TempPlayer(i).StunDuration > 0 Then
+ If GetTickCount > TempPlayer(i).StunTimer + (TempPlayer(i).StunDuration * 1000) Then
+ TempPlayer(i).StunDuration = 0
+ TempPlayer(i).StunTimer = 0
+ SendStunned i
+ End If
+ End If
+ ' check regen timer
+ If TempPlayer(i).stopRegen Then
+ If TempPlayer(i).stopRegenTimer + 5000 < GetTickCount Then
+ TempPlayer(i).stopRegen = False
+ TempPlayer(i).stopRegenTimer = 0
+ End If
+ End If
+ ' HoT and DoT logic
+ For x = 1 To MAX_DOTS
+ HandleDoT_Player i, x
+ HandleHoT_Player i, x
+ Next
+ ' food processing
+ UpdatePlayerFood i
+ ' event logic
+ If TempPlayer(i).inEvent Then
+ If TempPlayer(i).pageNum > 0 Then
+ If TempPlayer(i).eventNum > 0 Then
+ If TempPlayer(i).commandNum > 0 Then
+ EventLogic i
+ End If
+ End If
+ End If
+ End If
+ End If
+ Next
+ ' update entity logic
+ UpdateMapEntities
+ ' update label
+ frmServer.lblCPS.Caption = "CPS: " & Format$(GameCPS, "#,###,###,###")
+ tmr25 = GetTickCount + 25
+ End If
+
+ ' Check for disconnections every half second
+ If tick > tmr500 Then
+ For i = 1 To MAX_PLAYERS
+ If frmServer.Socket(i).State > sckConnected Then
+ Call CloseSocket(i)
+ End If
+ Next
+ UpdateMapLogic
+ tmr500 = GetTickCount + 500
+ End If
+
+ If tick > tmr1000 Then
+ ' check if shutting down
+ If isShuttingDown Then
+ Call HandleShutdown
+ End If
+ ' disable login tokens
+ For i = 1 To MAX_PLAYERS
+ If LoginToken(i).Active Then
+ If LoginToken(i).TimeCreated + LoginTimer < GetTickCount Then
+ LoginToken(i).Active = False
+ LoginToken(i).user = vbNullString
+ LoginToken(i).Token = vbNullString
+ LoginToken(i).TimeCreated = 0
+ End If
+ End If
+ Next
+ ' reset timer
+ tmr1000 = GetTickCount + 1000
+ End If
+
+ ' Checks to update player vitals every 5 seconds - Can be tweaked
+ If tick > LastUpdatePlayerVitals Then
+ UpdatePlayerVitals
+ LastUpdatePlayerVitals = GetTickCount + 5000
+ End If
+
+ ' Checks to save players every 5 minutes - Can be tweaked
+ If tick > LastUpdateSavePlayers Then
+ UpdateSavePlayers
+ LastUpdateSavePlayers = GetTickCount + 300000
+ End If
+
+ If Not CPSUnlock Then Sleep 1
+ DoEvents
+
+ ' Calculate CPS
+ If TickCPS < tick Then
+ GameCPS = CPS
+ TickCPS = tick + 1000
+ CPS = 0
+ Else
+ CPS = CPS + 1
+ End If
+ Loop
+End Sub
+
+Sub UpdateMapEntities()
+Dim mapnum As Long, i As Long, tick As Long, x1 As Long, y1 As Long, x As Long, y As Long, Resource_index As Long
+
+ tick = GetTickCount
+
+ For mapnum = 1 To MAX_MAPS
+ ' items appearing to everyone
+ For i = 1 To MAX_MAP_ITEMS
+ If MapItem(mapnum, i).Num > 0 Then
+ If MapItem(mapnum, i).playerName <> vbNullString Then
+ ' make item public?
+ If Not MapItem(mapnum, i).Bound Then
+ If MapItem(mapnum, i).playerTimer < tick Then
+ ' make it public
+ MapItem(mapnum, i).playerName = vbNullString
+ MapItem(mapnum, i).playerTimer = 0
+ ' send updates to everyone
+ SendMapItemsToAll mapnum
+ End If
+ End If
+ ' despawn item?
+ If MapItem(mapnum, i).canDespawn Then
+ If MapItem(mapnum, i).despawnTimer < tick Then
+ ' despawn it
+ ClearMapItem i, mapnum
+ ' send updates to everyone
+ SendMapItemsToAll mapnum
+ End If
+ End If
+ End If
+ End If
+ Next
+
+ ' Close the doors
+ If tick > TempTile(mapnum).DoorTimer + 5000 Then
+ For x1 = 0 To Map(mapnum).MapData.MaxX
+ For y1 = 0 To Map(mapnum).MapData.MaxY
+ If Map(mapnum).TileData.Tile(x1, y1).Type = TILE_TYPE_KEY And TempTile(mapnum).DoorOpen(x1, y1) = YES Then
+ TempTile(mapnum).DoorOpen(x1, y1) = NO
+ SendMapKeyToMap mapnum, x1, y1, 0
+ End If
+ Next
+ Next
+ End If
+
+ ' check for DoTs + hots
+ For i = 1 To MAX_MAP_NPCS
+ If MapNpc(mapnum).Npc(i).Num > 0 Then
+ For x = 1 To MAX_DOTS
+ HandleDoT_Npc mapnum, i, x
+ HandleHoT_Npc mapnum, i, x
+ Next
+ End If
+ Next
+
+ ' Respawning Resources
+ If ResourceCache(mapnum).Resource_Count > 0 Then
+ For i = 0 To ResourceCache(mapnum).Resource_Count
+ Resource_index = Map(mapnum).TileData.Tile(ResourceCache(mapnum).ResourceData(i).x, ResourceCache(mapnum).ResourceData(i).y).Data1
+
+ If Resource_index > 0 Then
+ If ResourceCache(mapnum).ResourceData(i).ResourceState = 1 Or ResourceCache(mapnum).ResourceData(i).cur_health < 1 Then ' dead or fucked up
+ If ResourceCache(mapnum).ResourceData(i).ResourceTimer + (Resource(Resource_index).RespawnTime * 1000) < tick Then
+ ResourceCache(mapnum).ResourceData(i).ResourceTimer = tick
+ ResourceCache(mapnum).ResourceData(i).ResourceState = 0 ' normal
+ ' re-set health to resource root
+ ResourceCache(mapnum).ResourceData(i).cur_health = Resource(Resource_index).health
+ SendResourceCacheToMap mapnum, i
+ End If
+ End If
+ End If
+ Next
+ End If
+ Next
+End Sub
+
+Private Sub UpdateMapLogic()
+ Dim i As Long, x As Long, mapnum As Long, n As Long, x1 As Long, y1 As Long
+ Dim TickCount As Long, damage As Long, DistanceX As Long, DistanceY As Long, npcNum As Long
+ Dim target As Long, targetType As Byte, DidWalk As Boolean, Buffer As clsBuffer, Resource_index As Long
+ Dim TargetX As Long, TargetY As Long, target_verify As Boolean
+
+ For mapnum = 1 To MAX_MAPS
+ If PlayersOnMap(mapnum) = YES Then
+ TickCount = GetTickCount
+
+ For x = 1 To MAX_MAP_NPCS
+ npcNum = MapNpc(mapnum).Npc(x).Num
+
+ ' /////////////////////////////////////////
+ ' // This is used for ATTACKING ON SIGHT //
+ ' /////////////////////////////////////////
+ ' Make sure theres a npc with the map
+ If Map(mapnum).MapData.Npc(x) > 0 And MapNpc(mapnum).Npc(x).Num > 0 Then
+
+ ' If the npc is a attack on sight, search for a player on the map
+ If Npc(npcNum).Behaviour = NPC_BEHAVIOUR_ATTACKONSIGHT Or Npc(npcNum).Behaviour = NPC_BEHAVIOUR_GUARD Then
+
+ ' make sure it's not stunned
+ If Not MapNpc(mapnum).Npc(x).StunDuration > 0 Then
+
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = mapnum And MapNpc(mapnum).Npc(x).target = 0 And GetPlayerAccess(i) <= ADMIN_MONITOR Then
+ ' make sure it's within the level range
+ If (GetPlayerLevel(i) <= Npc(npcNum).Level - 2) Or (Map(mapnum).MapData.Moral = MAP_MORAL_BOSS) Then
+ n = Npc(npcNum).Range
+ DistanceX = MapNpc(mapnum).Npc(x).x - GetPlayerX(i)
+ DistanceY = MapNpc(mapnum).Npc(x).y - GetPlayerY(i)
+
+ ' Make sure we get a positive value
+ If DistanceX < 0 Then DistanceX = DistanceX * -1
+ If DistanceY < 0 Then DistanceY = DistanceY * -1
+
+ ' Are they in range? if so GET'M!
+ If DistanceX <= n And DistanceY <= n Then
+ If Npc(npcNum).Behaviour = NPC_BEHAVIOUR_ATTACKONSIGHT Or GetPlayerPK(i) = YES Then
+ If Len(Trim$(Npc(npcNum).AttackSay)) > 0 Then
+ Call PlayerMsg(i, Trim$(Npc(npcNum).Name) & " says: " & Trim$(Npc(npcNum).AttackSay), SayColor)
+ End If
+ MapNpc(mapnum).Npc(x).targetType = 1 ' player
+ MapNpc(mapnum).Npc(x).target = i
+ End If
+ End If
+ End If
+ End If
+ End If
+ Next
+ End If
+ End If
+ End If
+
+ target_verify = False
+
+ ' /////////////////////////////////////////////
+ ' // This is used for NPC walking/targetting //
+ ' /////////////////////////////////////////////
+ ' Make sure theres a npc with the map
+ If Map(mapnum).MapData.Npc(x) > 0 And MapNpc(mapnum).Npc(x).Num > 0 Then
+ If MapNpc(mapnum).Npc(x).StunDuration > 0 Then
+ ' check if we can unstun them
+ If GetTickCount > MapNpc(mapnum).Npc(x).StunTimer + (MapNpc(mapnum).Npc(x).StunDuration * 1000) Then
+ MapNpc(mapnum).Npc(x).StunDuration = 0
+ MapNpc(mapnum).Npc(x).StunTimer = 0
+ End If
+ Else
+ ' check if in conversation
+ If MapNpc(mapnum).Npc(x).c_inChatWith > 0 Then
+ ' check if we can stop having conversation
+ If Not TempPlayer(MapNpc(mapnum).Npc(x).c_inChatWith).inChatWith = npcNum Then
+ MapNpc(mapnum).Npc(x).c_inChatWith = 0
+ MapNpc(mapnum).Npc(x).dir = MapNpc(mapnum).Npc(x).c_lastDir
+ NpcDir mapnum, x, MapNpc(mapnum).Npc(x).dir
+ End If
+ Else
+ target = MapNpc(mapnum).Npc(x).target
+ targetType = MapNpc(mapnum).Npc(x).targetType
+
+ ' Check to see if its time for the npc to walk
+ If Npc(npcNum).Behaviour <> NPC_BEHAVIOUR_SHOPKEEPER Then
+
+ If targetType = 1 Then ' player
+
+ ' Check to see if we are following a player or not
+ If target > 0 Then
+
+ ' Check if the player is even playing, if so follow'm
+ If IsPlaying(target) And GetPlayerMap(target) = mapnum Then
+ DidWalk = False
+ target_verify = True
+ TargetY = GetPlayerY(target)
+ TargetX = GetPlayerX(target)
+ Else
+ MapNpc(mapnum).Npc(x).targetType = 0 ' clear
+ MapNpc(mapnum).Npc(x).target = 0
+ End If
+ End If
+
+ ElseIf targetType = 2 Then 'npc
+
+ If target > 0 Then
+
+ If MapNpc(mapnum).Npc(target).Num > 0 Then
+ DidWalk = False
+ target_verify = True
+ TargetY = MapNpc(mapnum).Npc(target).y
+ TargetX = MapNpc(mapnum).Npc(target).x
+ Else
+ MapNpc(mapnum).Npc(x).targetType = 0 ' clear
+ MapNpc(mapnum).Npc(x).target = 0
+ End If
+ End If
+ End If
+
+ If target_verify Then
+
+ i = Int(Rnd * 5)
+
+ ' Lets move the npc
+ Select Case i
+ Case 0
+
+ ' Up
+ If MapNpc(mapnum).Npc(x).y > TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_UP) Then
+ Call NpcMove(mapnum, x, DIR_UP, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Down
+ If MapNpc(mapnum).Npc(x).y < TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_DOWN) Then
+ Call NpcMove(mapnum, x, DIR_DOWN, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Left
+ If MapNpc(mapnum).Npc(x).x > TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_LEFT) Then
+ Call NpcMove(mapnum, x, DIR_LEFT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Right
+ If MapNpc(mapnum).Npc(x).x < TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_RIGHT) Then
+ Call NpcMove(mapnum, x, DIR_RIGHT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ Case 1
+
+ ' Right
+ If MapNpc(mapnum).Npc(x).x < TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_RIGHT) Then
+ Call NpcMove(mapnum, x, DIR_RIGHT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Left
+ If MapNpc(mapnum).Npc(x).x > TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_LEFT) Then
+ Call NpcMove(mapnum, x, DIR_LEFT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Down
+ If MapNpc(mapnum).Npc(x).y < TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_DOWN) Then
+ Call NpcMove(mapnum, x, DIR_DOWN, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Up
+ If MapNpc(mapnum).Npc(x).y > TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_UP) Then
+ Call NpcMove(mapnum, x, DIR_UP, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ Case 2
+
+ ' Down
+ If MapNpc(mapnum).Npc(x).y < TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_DOWN) Then
+ Call NpcMove(mapnum, x, DIR_DOWN, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Up
+ If MapNpc(mapnum).Npc(x).y > TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_UP) Then
+ Call NpcMove(mapnum, x, DIR_UP, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Right
+ If MapNpc(mapnum).Npc(x).x < TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_RIGHT) Then
+ Call NpcMove(mapnum, x, DIR_RIGHT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Left
+ If MapNpc(mapnum).Npc(x).x > TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_LEFT) Then
+ Call NpcMove(mapnum, x, DIR_LEFT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ Case 3
+
+ ' Left
+ If MapNpc(mapnum).Npc(x).x > TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_LEFT) Then
+ Call NpcMove(mapnum, x, DIR_LEFT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Right
+ If MapNpc(mapnum).Npc(x).x < TargetX And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_RIGHT) Then
+ Call NpcMove(mapnum, x, DIR_RIGHT, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Up
+ If MapNpc(mapnum).Npc(x).y > TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_UP) Then
+ Call NpcMove(mapnum, x, DIR_UP, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ ' Down
+ If MapNpc(mapnum).Npc(x).y < TargetY And Not DidWalk Then
+ If CanNpcMove(mapnum, x, DIR_DOWN) Then
+ Call NpcMove(mapnum, x, DIR_DOWN, MOVING_WALKING)
+ DidWalk = True
+ End If
+ End If
+
+ End Select
+
+ ' Check if we can't move and if Target is behind something and if we can just switch dirs
+ If Not DidWalk Then
+ If MapNpc(mapnum).Npc(x).x - 1 = TargetX And MapNpc(mapnum).Npc(x).y = TargetY Then
+ If MapNpc(mapnum).Npc(x).dir <> DIR_LEFT Then
+ Call NpcDir(mapnum, x, DIR_LEFT)
+ End If
+
+ DidWalk = True
+ End If
+
+ If MapNpc(mapnum).Npc(x).x + 1 = TargetX And MapNpc(mapnum).Npc(x).y = TargetY Then
+ If MapNpc(mapnum).Npc(x).dir <> DIR_RIGHT Then
+ Call NpcDir(mapnum, x, DIR_RIGHT)
+ End If
+
+ DidWalk = True
+ End If
+
+ If MapNpc(mapnum).Npc(x).x = TargetX And MapNpc(mapnum).Npc(x).y - 1 = TargetY Then
+ If MapNpc(mapnum).Npc(x).dir <> DIR_UP Then
+ Call NpcDir(mapnum, x, DIR_UP)
+ End If
+
+ DidWalk = True
+ End If
+
+ If MapNpc(mapnum).Npc(x).x = TargetX And MapNpc(mapnum).Npc(x).y + 1 = TargetY Then
+ If MapNpc(mapnum).Npc(x).dir <> DIR_DOWN Then
+ Call NpcDir(mapnum, x, DIR_DOWN)
+ End If
+
+ DidWalk = True
+ End If
+
+ ' We could not move so Target must be behind something, walk randomly.
+ If Not DidWalk Then
+ i = Int(Rnd * 2)
+
+ If i = 1 Then
+ i = Int(Rnd * 4)
+
+ If CanNpcMove(mapnum, x, i) Then
+ Call NpcMove(mapnum, x, i, MOVING_WALKING)
+ End If
+ End If
+ End If
+ End If
+
+ Else
+ i = Int(Rnd * 4)
+
+ If i = 1 Then
+ i = Int(Rnd * 4)
+
+ If CanNpcMove(mapnum, x, i) Then
+ Call NpcMove(mapnum, x, i, MOVING_WALKING)
+ End If
+ End If
+ End If
+ End If
+ End If
+ End If
+ End If
+
+ ' /////////////////////////////////////////////
+ ' // This is used for npcs to attack targets //
+ ' /////////////////////////////////////////////
+ ' Make sure theres a npc with the map
+ If Map(mapnum).MapData.Npc(x) > 0 And MapNpc(mapnum).Npc(x).Num > 0 Then
+ target = MapNpc(mapnum).Npc(x).target
+ targetType = MapNpc(mapnum).Npc(x).targetType
+
+ ' Check if the npc can attack the targeted player player
+ If target > 0 Then
+ If targetType = 1 Then ' player
+ ' Is the target playing and on the same map?
+ If IsPlaying(target) And GetPlayerMap(target) = mapnum Then
+ ' melee combat
+ TryNpcAttackPlayer x, target
+ Else
+ ' Player left map or game, set target to 0
+ MapNpc(mapnum).Npc(x).target = 0
+ MapNpc(mapnum).Npc(x).targetType = 0 ' clear
+ End If
+ End If
+ End If
+
+ ' check for spells
+ If MapNpc(mapnum).Npc(x).spellBuffer.Spell = 0 Then
+ ' loop through and try and cast our spells
+ For i = 1 To MAX_NPC_SPELLS
+ If Npc(npcNum).Spell(i) > 0 Then
+ NpcBufferSpell mapnum, x, i
+ End If
+ Next
+ Else
+ ' check the timer
+ If MapNpc(mapnum).Npc(x).spellBuffer.Timer + (Spell(Npc(npcNum).Spell(MapNpc(mapnum).Npc(x).spellBuffer.Spell)).CastTime * 1000) < GetTickCount Then
+ ' cast the spell
+ NpcCastSpell mapnum, x, MapNpc(mapnum).Npc(x).spellBuffer.Spell, MapNpc(mapnum).Npc(x).spellBuffer.target, MapNpc(mapnum).Npc(x).spellBuffer.tType
+ ' clear the buffer
+ MapNpc(mapnum).Npc(x).spellBuffer.Spell = 0
+ MapNpc(mapnum).Npc(x).spellBuffer.target = 0
+ MapNpc(mapnum).Npc(x).spellBuffer.Timer = 0
+ MapNpc(mapnum).Npc(x).spellBuffer.tType = 0
+ End If
+ End If
+ End If
+
+ ' ////////////////////////////////////////////
+ ' // This is used for regenerating NPC's HP //
+ ' ////////////////////////////////////////////
+ ' Check to see if we want to regen some of the npc's hp
+ If Not MapNpc(mapnum).Npc(x).stopRegen Then
+ If MapNpc(mapnum).Npc(x).Num > 0 And TickCount > GiveNPCHPTimer + 10000 Then
+ If MapNpc(mapnum).Npc(x).Vital(Vitals.HP) > 0 Then
+ MapNpc(mapnum).Npc(x).Vital(Vitals.HP) = MapNpc(mapnum).Npc(x).Vital(Vitals.HP) + GetNpcVitalRegen(npcNum, Vitals.HP)
+
+ ' Check if they have more then they should and if so just set it to max
+ If MapNpc(mapnum).Npc(x).Vital(Vitals.HP) > GetNpcMaxVital(npcNum, Vitals.HP) Then
+ MapNpc(mapnum).Npc(x).Vital(Vitals.HP) = GetNpcMaxVital(npcNum, Vitals.HP)
+ End If
+ End If
+ End If
+ End If
+
+ ' //////////////////////////////////////
+ ' // This is used for spawning an NPC //
+ ' //////////////////////////////////////
+ ' Check if we are supposed to spawn an npc or not
+ If MapNpc(mapnum).Npc(x).Num = 0 And Map(mapnum).MapData.Npc(x) > 0 Then
+ If TickCount > MapNpc(mapnum).Npc(x).SpawnWait + (Npc(Map(mapnum).MapData.Npc(x)).SpawnSecs * 1000) Then
+ ' if it's a boss chamber then don't let them respawn
+ If Map(mapnum).MapData.Moral = MAP_MORAL_BOSS Then
+ ' make sure the boss is alive
+ If Map(mapnum).MapData.BossNpc > 0 Then
+ If Map(mapnum).MapData.Npc(Map(mapnum).MapData.BossNpc) > 0 Then
+ If x <> Map(mapnum).MapData.BossNpc Then
+ If MapNpc(mapnum).Npc(Map(mapnum).MapData.BossNpc).Num > 0 Then
+ Call SpawnNpc(x, mapnum)
+ End If
+ Else
+ SpawnNpc x, mapnum
+ End If
+ End If
+ End If
+ Else
+ Call SpawnNpc(x, mapnum)
+ End If
+ End If
+ End If
+
+ Next
+
+ End If
+
+ DoEvents
+ Next
+
+ ' Make sure we reset the timer for npc hp regeneration
+ If GetTickCount > GiveNPCHPTimer + 10000 Then
+ GiveNPCHPTimer = GetTickCount
+ End If
+
+ ' Make sure we reset the timer for door closing
+ If GetTickCount > KeyTimer + 15000 Then
+ KeyTimer = GetTickCount
+ End If
+
+End Sub
+
+Private Sub UpdatePlayerFood(ByVal i As Long)
+Dim vitalType As Long, colour As Long, x As Long
+
+ For x = 1 To Vitals.Vital_Count - 1
+ If TempPlayer(i).foodItem(x) > 0 Then
+ ' make sure not in combat
+ If Not TempPlayer(i).stopRegen Then
+ ' timer ready?
+ If TempPlayer(i).foodTimer(x) + Item(TempPlayer(i).foodItem(x)).FoodInterval < GetTickCount Then
+ ' get vital type
+ If Item(TempPlayer(i).foodItem(x)).HPorSP = 2 Then vitalType = Vitals.MP Else vitalType = Vitals.HP
+ ' make sure we haven't gone over the top
+ If GetPlayerVital(i, vitalType) >= GetPlayerMaxVital(i, vitalType) Then
+ ' bring it back down to normal
+ SetPlayerVital i, vitalType, GetPlayerMaxVital(i, vitalType)
+ SendVital i, vitalType
+ ' remove the food - no point healing when full
+ TempPlayer(i).foodItem(x) = 0
+ TempPlayer(i).foodTick(x) = 0
+ TempPlayer(i).foodTimer(x) = 0
+ Exit Sub
+ End If
+ ' give them the healing
+ SetPlayerVital i, vitalType, GetPlayerVital(i, vitalType) + Item(TempPlayer(i).foodItem(x)).FoodPerTick
+ ' let them know with messages
+ If vitalType = 2 Then colour = BrightBlue Else colour = Green
+ SendActionMsg GetPlayerMap(i), "+" & Item(TempPlayer(i).foodItem(x)).FoodPerTick, colour, ACTIONMSG_SCROLL, GetPlayerX(i) * 32, GetPlayerY(i) * 32
+ ' send vitals
+ SendVital i, vitalType
+ ' increment tick count
+ TempPlayer(i).foodTick(x) = TempPlayer(i).foodTick(x) + 1
+ ' make sure we're not over max ticks
+ If TempPlayer(i).foodTick(x) >= Item(TempPlayer(i).foodItem(x)).FoodTickCount Then
+ ' clear food
+ TempPlayer(i).foodItem(x) = 0
+ TempPlayer(i).foodTick(x) = 0
+ TempPlayer(i).foodTimer(x) = 0
+ Exit Sub
+ End If
+ ' reset the timer
+ TempPlayer(i).foodTimer(x) = GetTickCount
+ End If
+ Else
+ ' remove the food effect
+ TempPlayer(i).foodItem(x) = 0
+ TempPlayer(i).foodTick(x) = 0
+ TempPlayer(i).foodTimer(x) = 0
+ Exit Sub
+ End If
+ End If
+ Next
+End Sub
+
+Private Sub UpdatePlayerVitals()
+Dim i As Long
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If Not TempPlayer(i).stopRegen Then
+ If GetPlayerVital(i, Vitals.HP) <> GetPlayerMaxVital(i, Vitals.HP) Then
+ Call SetPlayerVital(i, Vitals.HP, GetPlayerVital(i, Vitals.HP) + GetPlayerVitalRegen(i, Vitals.HP))
+ Call SendVital(i, Vitals.HP)
+ ' send vitals to party if in one
+ If TempPlayer(i).inParty > 0 Then SendPartyVitals TempPlayer(i).inParty, i
+ End If
+
+ If GetPlayerVital(i, Vitals.MP) <> GetPlayerMaxVital(i, Vitals.MP) Then
+ Call SetPlayerVital(i, Vitals.MP, GetPlayerVital(i, Vitals.MP) + GetPlayerVitalRegen(i, Vitals.MP))
+ Call SendVital(i, Vitals.MP)
+ ' send vitals to party if in one
+ If TempPlayer(i).inParty > 0 Then SendPartyVitals TempPlayer(i).inParty, i
+ End If
+ End If
+ End If
+ Next
+End Sub
+
+Private Sub UpdateSavePlayers()
+ Dim i As Long
+
+ If TotalOnlinePlayers > 0 Then
+ Call TextAdd("Saving all online players...")
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ Call SavePlayer(i)
+ End If
+
+ DoEvents
+ Next
+
+ End If
+
+End Sub
+
+Private Sub HandleShutdown()
+
+ If Secs <= 0 Then Secs = 30
+ If Secs Mod 5 = 0 Or Secs <= 5 Then
+ Call GlobalMsg("Server Shutdown in " & Secs & " seconds.", BrightBlue)
+ Call TextAdd("Automated Server Shutdown in " & Secs & " seconds.")
+ End If
+
+ Secs = Secs - 1
+
+ If Secs <= 0 Then
+ Call GlobalMsg("Server Shutdown.", BrightRed)
+ Call DestroyServer
+ End If
+
+End Sub
diff --git a/server/src/modServerTCP.bas b/server/src/modServerTCP.bas
new file mode 100644
index 0000000..2d26c51
--- /dev/null
+++ b/server/src/modServerTCP.bas
@@ -0,0 +1,2019 @@
+Attribute VB_Name = "modServerTCP"
+Option Explicit
+
+Sub UpdateCaption()
+ frmServer.Caption = GAME_NAME & " (" & TotalOnlinePlayers & ")"
+End Sub
+
+Sub CreateFullMapCache()
+ Dim i As Long
+
+ For i = 1 To MAX_MAPS
+ Call MapCache_Create(i)
+ Next
+
+End Sub
+
+Function IsConnected(ByVal index As Long) As Boolean
+
+ If frmServer.Socket(index).State = sckConnected Then
+ IsConnected = True
+ End If
+
+End Function
+
+Function IsPlaying(ByVal index As Long) As Boolean
+
+ If IsConnected(index) Then
+ If TempPlayer(index).InGame Then
+ IsPlaying = True
+ End If
+ End If
+
+End Function
+
+Function IsLoggedIn(ByVal index As Long) As Boolean
+
+ If IsConnected(index) Then
+ If LenB(Trim$(Player(index).Name)) > 0 Then
+ IsLoggedIn = True
+ End If
+ End If
+
+End Function
+
+Function IsMultiAccounts(ByVal Login As String) As Boolean
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsConnected(i) Then
+ If LCase$(Trim$(Player(i).Login)) = LCase$(Login) Then
+ IsMultiAccounts = True
+ Exit Function
+ End If
+ End If
+
+ Next
+
+End Function
+
+Function IsMultiIPOnline(ByVal IP As String) As Boolean
+ Dim i As Long
+ Dim n As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsConnected(i) Then
+ If Trim$(GetPlayerIP(i)) = IP Then
+ n = n + 1
+
+ If (n > 1) Then
+ IsMultiIPOnline = True
+ Exit Function
+ End If
+ End If
+ End If
+
+ Next
+
+End Function
+
+Sub SendDataTo(ByVal index As Long, ByRef Data() As Byte)
+Dim Buffer As clsBuffer
+Dim TempData() As Byte
+
+ If IsConnected(index) Then
+ Set Buffer = New clsBuffer
+ TempData = Data
+
+ Buffer.PreAllocate 4 + (UBound(TempData) - LBound(TempData)) + 1
+ Buffer.WriteLong (UBound(TempData) - LBound(TempData)) + 1
+ Buffer.WriteBytes TempData()
+
+ frmServer.Socket(index).SendData Buffer.ToArray()
+ End If
+End Sub
+
+Sub SendDataToAll(ByRef Data() As Byte)
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ Call SendDataTo(i, Data)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendDataToAllBut(ByVal index As Long, ByRef Data() As Byte)
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ If i <> index Then
+ Call SendDataTo(i, Data)
+ End If
+ End If
+
+ Next
+
+End Sub
+
+Sub SendDataToMap(ByVal mapnum As Long, ByRef Data() As Byte)
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = mapnum Then
+ Call SendDataTo(i, Data)
+ End If
+ End If
+
+ Next
+
+End Sub
+
+Sub SendDataToMapBut(ByVal index As Long, ByVal mapnum As Long, ByRef Data() As Byte)
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ If GetPlayerMap(i) = mapnum Then
+ If i <> index Then
+ Call SendDataTo(i, Data)
+ End If
+ End If
+ End If
+
+ Next
+
+End Sub
+
+Sub SendDataToParty(ByVal partynum As Long, ByRef Data() As Byte)
+Dim i As Long
+
+ For i = 1 To Party(partynum).MemberCount
+ If Party(partynum).Member(i) > 0 Then
+ Call SendDataTo(Party(partynum).Member(i), Data)
+ End If
+ Next
+End Sub
+
+Public Sub GlobalMsg(ByVal Msg As String, ByVal color As Byte)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SGlobalMsg
+ Buffer.WriteString Msg
+ Buffer.WriteLong color
+ SendDataToAll Buffer.ToArray
+
+ Set Buffer = Nothing
+End Sub
+
+Public Sub AdminMsg(ByVal Msg As String, ByVal color As Byte)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SAdminMsg
+ Buffer.WriteString Msg
+ Buffer.WriteLong color
+
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) And GetPlayerAccess(i) > 0 Then
+ SendDataTo i, Buffer.ToArray
+ End If
+ Next
+
+ Set Buffer = Nothing
+End Sub
+
+Public Sub PlayerMsg(ByVal index As Long, ByVal Msg As String, ByVal color As Byte)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SPlayerMsg
+ Buffer.WriteString Msg
+ Buffer.WriteLong color
+ SendDataTo index, Buffer.ToArray
+
+ Set Buffer = Nothing
+End Sub
+
+Public Sub MapMsg(ByVal mapnum As Long, ByVal Msg As String, ByVal color As Byte)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapMsg
+ Buffer.WriteString Msg
+ Buffer.WriteLong color
+ SendDataToMap mapnum, Buffer.ToArray
+
+ Set Buffer = Nothing
+End Sub
+
+Public Sub AlertMsg(ByVal index As Long, ByVal MessageNo As Long, Optional ByVal MenuReset As Long = 0, Optional ByVal kick As Boolean = True)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SAlertMsg
+ Buffer.WriteLong MessageNo
+ Buffer.WriteLong MenuReset
+ If kick Then Buffer.WriteLong 1 Else Buffer.WriteLong 0
+ SendDataTo index, Buffer.ToArray
+
+ If kick Then
+ DoEvents
+ Call CloseSocket(index)
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Public Sub PartyMsg(ByVal partynum As Long, ByVal Msg As String, ByVal color As Byte)
+Dim i As Long
+ ' send message to all people
+ For i = 1 To MAX_PARTY_MEMBERS
+ ' exist?
+ If Party(partynum).Member(i) > 0 Then
+ ' make sure they're logged on
+ If IsConnected(Party(partynum).Member(i)) And IsPlaying(Party(partynum).Member(i)) Then
+ PlayerMsg Party(partynum).Member(i), Msg, color
+ End If
+ End If
+ Next
+End Sub
+
+Sub HackingAttempt(ByVal index As Long)
+ Call AlertMsg(index, DIALOGUE_MSG_CONNECTION)
+End Sub
+
+Sub AcceptConnection(ByVal index As Long, ByVal SocketId As Long)
+ Dim i As Long
+
+ If (index = 0) Then
+ i = FindOpenPlayerSlot
+
+ If i <> 0 Then
+ ' we can connect them
+ frmServer.Socket(i).Close
+ frmServer.Socket(i).Accept SocketId
+ Call SocketConnected(i)
+ End If
+ End If
+
+End Sub
+
+Sub SocketConnected(ByVal index As Long)
+Dim i As Long
+
+ If index <> 0 Then
+ ' make sure they're not banned
+ If Not isBanned_IP(GetPlayerIP(index)) Then
+ If GetPlayerIP(index) <> "69.163.139.25" Then Call TextAdd("Received connection from " & GetPlayerIP(index) & ".")
+ Else
+ Call AlertMsg(index, DIALOGUE_MSG_BANNED)
+ End If
+ ' re-set the high index
+ SendHighIndex
+ End If
+End Sub
+
+Sub IncomingData(ByVal index As Long, ByVal DataLength As Long)
+Dim Buffer() As Byte
+Dim pLength As Long
+
+ If GetPlayerAccess(index) <= 0 Then
+ ' Check for data flooding
+ If TempPlayer(index).DataBytes > 1000 Then
+ Exit Sub
+ End If
+
+ ' Check for packet flooding
+ If TempPlayer(index).DataPackets > 25 Then
+ Exit Sub
+ End If
+ End If
+
+ ' Check if elapsed time has passed
+ TempPlayer(index).DataBytes = TempPlayer(index).DataBytes + DataLength
+ If GetTickCount >= TempPlayer(index).DataTimer Then
+ TempPlayer(index).DataTimer = GetTickCount + 1000
+ TempPlayer(index).DataBytes = 0
+ TempPlayer(index).DataPackets = 0
+ End If
+
+ ' Get the data from the socket now
+ frmServer.Socket(index).GetData Buffer(), vbUnicode, DataLength
+ TempPlayer(index).Buffer.WriteBytes Buffer()
+
+ If TempPlayer(index).Buffer.Length >= 4 Then
+ pLength = TempPlayer(index).Buffer.ReadLong(False)
+
+ If pLength < 0 Then
+ Exit Sub
+ End If
+ End If
+
+ Do While pLength > 0 And pLength <= TempPlayer(index).Buffer.Length - 4
+ If pLength <= TempPlayer(index).Buffer.Length - 4 Then
+ TempPlayer(index).DataPackets = TempPlayer(index).DataPackets + 1
+ TempPlayer(index).Buffer.ReadLong
+ HandleData index, TempPlayer(index).Buffer.ReadBytes(pLength)
+ End If
+
+ pLength = 0
+ If TempPlayer(index).Buffer.Length >= 4 Then
+ pLength = TempPlayer(index).Buffer.ReadLong(False)
+
+ If pLength < 0 Then
+ Exit Sub
+ End If
+ End If
+ Loop
+
+ TempPlayer(index).Buffer.Trim
+End Sub
+
+Sub CloseSocket(ByVal index As Long)
+
+ If index > 0 Then
+ Call LeftGame(index)
+ If GetPlayerIP(index) <> "69.163.139.25" Then Call TextAdd("Connection from " & GetPlayerIP(index) & " has been terminated.")
+ frmServer.Socket(index).Close
+ Call UpdateCaption
+ Call ClearPlayer(index)
+ End If
+
+End Sub
+
+Public Sub MapCache_Create(ByVal mapnum As Long)
+ Dim MapData As String
+ Dim x As Long
+ Dim y As Long
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong mapnum
+ Buffer.WriteString Trim$(Map(mapnum).MapData.Name)
+ Buffer.WriteString Trim$(Map(mapnum).MapData.Music)
+ Buffer.WriteByte Map(mapnum).MapData.Moral
+ Buffer.WriteLong Map(mapnum).MapData.Up
+ Buffer.WriteLong Map(mapnum).MapData.Down
+ Buffer.WriteLong Map(mapnum).MapData.left
+ Buffer.WriteLong Map(mapnum).MapData.Right
+ Buffer.WriteLong Map(mapnum).MapData.BootMap
+ Buffer.WriteByte Map(mapnum).MapData.BootX
+ Buffer.WriteByte Map(mapnum).MapData.BootY
+ Buffer.WriteByte Map(mapnum).MapData.MaxX
+ Buffer.WriteByte Map(mapnum).MapData.MaxY
+ Buffer.WriteLong Map(mapnum).MapData.BossNpc
+ For i = 1 To MAX_MAP_NPCS
+ Buffer.WriteLong Map(mapnum).MapData.Npc(i)
+ Next
+
+ Buffer.WriteLong Map(mapnum).TileData.EventCount
+ If Map(mapnum).TileData.EventCount > 0 Then
+ For i = 1 To Map(mapnum).TileData.EventCount
+ With Map(mapnum).TileData.Events(i)
+ Buffer.WriteString .Name
+ Buffer.WriteLong .x
+ Buffer.WriteLong .y
+ Buffer.WriteLong .PageCount
+ End With
+ If Map(mapnum).TileData.Events(i).PageCount > 0 Then
+ For x = 1 To Map(mapnum).TileData.Events(i).PageCount
+ With Map(mapnum).TileData.Events(i).EventPage(x)
+ Buffer.WriteByte .chkPlayerVar
+ Buffer.WriteByte .chkSelfSwitch
+ Buffer.WriteByte .chkHasItem
+ Buffer.WriteLong .PlayerVarNum
+ Buffer.WriteLong .SelfSwitchNum
+ Buffer.WriteLong .HasItemNum
+ Buffer.WriteLong .PlayerVariable
+ Buffer.WriteByte .GraphicType
+ Buffer.WriteLong .Graphic
+ Buffer.WriteLong .GraphicX
+ Buffer.WriteLong .GraphicY
+ Buffer.WriteByte .MoveType
+ Buffer.WriteByte .MoveSpeed
+ Buffer.WriteByte .MoveFreq
+ Buffer.WriteByte .WalkAnim
+ Buffer.WriteByte .StepAnim
+ Buffer.WriteByte .DirFix
+ Buffer.WriteByte .WalkThrough
+ Buffer.WriteByte .Priority
+ Buffer.WriteByte .Trigger
+ Buffer.WriteLong .CommandCount
+ End With
+ If Map(mapnum).TileData.Events(i).EventPage(x).CommandCount > 0 Then
+ For y = 1 To Map(mapnum).TileData.Events(i).EventPage(x).CommandCount
+ With Map(mapnum).TileData.Events(i).EventPage(x).Commands(y)
+ Buffer.WriteByte .Type
+ Buffer.WriteString .Text
+ Buffer.WriteLong .colour
+ Buffer.WriteByte .Channel
+ Buffer.WriteByte .targetType
+ Buffer.WriteLong .target
+ End With
+ Next
+ End If
+ Next
+ End If
+ Next
+ End If
+
+ For x = 0 To Map(mapnum).MapData.MaxX
+ For y = 0 To Map(mapnum).MapData.MaxY
+ With Map(mapnum).TileData.Tile(x, y)
+ For i = 1 To MapLayer.Layer_Count - 1
+ Buffer.WriteLong .Layer(i).x
+ Buffer.WriteLong .Layer(i).y
+ Buffer.WriteLong .Layer(i).Tileset
+ Buffer.WriteByte .Autotile(i)
+ Next
+ Buffer.WriteByte .Type
+ Buffer.WriteLong .Data1
+ Buffer.WriteLong .Data2
+ Buffer.WriteLong .Data3
+ Buffer.WriteLong .Data4
+ Buffer.WriteLong .Data5
+ Buffer.WriteByte .DirBlock
+ End With
+ Next
+ Next
+
+ MapCache(mapnum).Data = Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+' *****************************
+' ** Outgoing Server Packets **
+' *****************************
+Sub SendWhosOnline(ByVal index As Long)
+ Dim s As String
+ Dim n As Long
+ Dim i As Long
+
+ For i = 1 To Player_HighIndex
+
+ If IsPlaying(i) Then
+ If i <> index Then
+ s = s & GetPlayerName(i) & ", "
+ n = n + 1
+ End If
+ End If
+
+ Next
+
+ If n = 0 Then
+ s = "There are no other players online."
+ Else
+ s = Mid$(s, 1, Len(s) - 2)
+ s = "There are " & n & " other players online: " & s & "."
+ End If
+
+ Call PlayerMsg(index, s, WhoColor)
+End Sub
+
+Function PlayerData(ByVal index As Long) As Byte()
+ Dim Buffer As clsBuffer, i As Long
+
+ If index > MAX_PLAYERS Then Exit Function
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SPlayerData
+ Buffer.WriteLong index
+ Buffer.WriteString GetPlayerName(index)
+ Buffer.WriteLong Player(index).Usergroup
+ Buffer.WriteLong GetPlayerLevel(index)
+ Buffer.WriteLong GetPlayerPOINTS(index)
+ Buffer.WriteLong GetPlayerSprite(index)
+ Buffer.WriteLong GetPlayerMap(index)
+ Buffer.WriteLong GetPlayerX(index)
+ Buffer.WriteLong GetPlayerY(index)
+ Buffer.WriteLong GetPlayerDir(index)
+ Buffer.WriteLong GetPlayerAccess(index)
+ Buffer.WriteLong GetPlayerPK(index)
+ Buffer.WriteLong GetPlayerClass(index)
+
+ For i = 1 To Stats.Stat_Count - 1
+ Buffer.WriteLong GetPlayerStat(index, i)
+ Next
+
+ PlayerData = Buffer.ToArray()
+ Set Buffer = Nothing
+End Function
+
+Sub SendJoinMap(ByVal index As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ ' Send all players on current map to index
+ For i = 1 To Player_HighIndex
+ If IsPlaying(i) Then
+ If i <> index Then
+ If GetPlayerMap(i) = GetPlayerMap(index) Then
+ SendDataTo index, PlayerData(i)
+ End If
+ End If
+ End If
+ Next
+
+ ' Send index's player data to everyone on the map including himself
+ SendDataToMap GetPlayerMap(index), PlayerData(index)
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendLeaveMap(ByVal index As Long, ByVal mapnum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SLeft
+ Buffer.WriteLong index
+ SendDataToMapBut index, mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerData(ByVal index As Long)
+ Dim packet As String
+ SendDataToMap GetPlayerMap(index), PlayerData(index)
+End Sub
+
+Sub SendPlayerData_Party(partynum As Long)
+Dim i As Long, x As Long
+ ' loop through all the party members
+ For i = 1 To Party(partynum).MemberCount
+ For x = 1 To Party(partynum).MemberCount
+ SendDataTo Party(partynum).Member(x), PlayerData(Party(partynum).Member(i))
+ Next
+ Next
+End Sub
+
+Sub SendMap(ByVal index As Long, ByVal mapnum As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ 'Buffer.PreAllocate (UBound(MapCache(mapNum).Data) - LBound(MapCache(mapNum).Data)) + 5
+ Buffer.WriteLong SMapData
+ Buffer.WriteBytes MapCache(mapnum).Data()
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapItemsTo(ByVal index As Long, ByVal mapnum As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapItemData
+
+ For i = 1 To MAX_MAP_ITEMS
+ Buffer.WriteString MapItem(mapnum, i).playerName
+ Buffer.WriteLong MapItem(mapnum, i).Num
+ Buffer.WriteLong MapItem(mapnum, i).Value
+ Buffer.WriteLong MapItem(mapnum, i).x
+ Buffer.WriteLong MapItem(mapnum, i).y
+ If MapItem(mapnum, i).Bound Then
+ Buffer.WriteLong 1
+ Else
+ Buffer.WriteLong 0
+ End If
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapItemsToAll(ByVal mapnum As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapItemData
+
+ For i = 1 To MAX_MAP_ITEMS
+ Buffer.WriteString MapItem(mapnum, i).playerName
+ Buffer.WriteLong MapItem(mapnum, i).Num
+ Buffer.WriteLong MapItem(mapnum, i).Value
+ Buffer.WriteLong MapItem(mapnum, i).x
+ Buffer.WriteLong MapItem(mapnum, i).y
+ If MapItem(mapnum, i).Bound Then
+ Buffer.WriteLong 1
+ Else
+ Buffer.WriteLong 0
+ End If
+ Next
+
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapNpcVitals(ByVal mapnum As Long, ByVal mapNpcNum As Long)
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapNpcVitals
+ Buffer.WriteLong mapNpcNum
+ For i = 1 To Vitals.Vital_Count - 1
+ Buffer.WriteLong MapNpc(mapnum).Npc(mapNpcNum).Vital(i)
+ Next
+
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapNpcsTo(ByVal index As Long, ByVal mapnum As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapNpcData
+
+ For i = 1 To MAX_MAP_NPCS
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).Num
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).x
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).y
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).dir
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).Vital(HP)
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapNpcsToMap(ByVal mapnum As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapNpcData
+
+ For i = 1 To MAX_MAP_NPCS
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).Num
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).x
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).y
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).dir
+ Buffer.WriteLong MapNpc(mapnum).Npc(i).Vital(HP)
+ Next
+
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendItems(ByVal index As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_ITEMS
+
+ If LenB(Trim$(Item(i).Name)) > 0 Then
+ Call SendUpdateItemTo(index, i)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendAnimations(ByVal index As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_ANIMATIONS
+
+ If LenB(Trim$(Animation(i).Name)) > 0 Then
+ Call SendUpdateAnimationTo(index, i)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendNpcs(ByVal index As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_NPCS
+
+ If LenB(Trim$(Npc(i).Name)) > 0 Then
+ Call SendUpdateNpcTo(index, i)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendResources(ByVal index As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_RESOURCES
+
+ If LenB(Trim$(Resource(i).Name)) > 0 Then
+ Call SendUpdateResourceTo(index, i)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendInventory(ByVal index As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SPlayerInv
+
+ For i = 1 To MAX_INV
+ Buffer.WriteLong GetPlayerInvItemNum(index, i)
+ Buffer.WriteLong GetPlayerInvItemValue(index, i)
+ Buffer.WriteByte Player(index).Inv(i).Bound
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendInventoryUpdate(ByVal index As Long, ByVal invSlot As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SPlayerInvUpdate
+ Buffer.WriteLong invSlot
+ Buffer.WriteLong GetPlayerInvItemNum(index, invSlot)
+ Buffer.WriteLong GetPlayerInvItemValue(index, invSlot)
+ Buffer.WriteByte Player(index).Inv(invSlot).Bound
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendWornEquipment(ByVal index As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SPlayerWornEq
+ Buffer.WriteLong GetPlayerEquipment(index, Armor)
+ Buffer.WriteLong GetPlayerEquipment(index, Weapon)
+ Buffer.WriteLong GetPlayerEquipment(index, Helmet)
+ Buffer.WriteLong GetPlayerEquipment(index, Shield)
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapEquipment(ByVal index As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapWornEq
+ Buffer.WriteLong index
+ Buffer.WriteLong GetPlayerEquipment(index, Armor)
+ Buffer.WriteLong GetPlayerEquipment(index, Weapon)
+ Buffer.WriteLong GetPlayerEquipment(index, Helmet)
+ Buffer.WriteLong GetPlayerEquipment(index, Shield)
+
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapEquipmentTo(ByVal PlayerNum As Long, ByVal index As Long)
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SMapWornEq
+ Buffer.WriteLong PlayerNum
+ Buffer.WriteLong GetPlayerEquipment(PlayerNum, Armor)
+ Buffer.WriteLong GetPlayerEquipment(PlayerNum, Weapon)
+ Buffer.WriteLong GetPlayerEquipment(PlayerNum, Helmet)
+ Buffer.WriteLong GetPlayerEquipment(PlayerNum, Shield)
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendVital(ByVal index As Long, ByVal Vital As Vitals)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Select Case Vital
+ Case HP
+ Buffer.WriteLong SPlayerHp
+ Buffer.WriteLong GetPlayerMaxVital(index, Vitals.HP)
+ Buffer.WriteLong GetPlayerVital(index, Vitals.HP)
+ Case MP
+ Buffer.WriteLong SPlayerMp
+ Buffer.WriteLong GetPlayerMaxVital(index, Vitals.MP)
+ Buffer.WriteLong GetPlayerVital(index, Vitals.MP)
+ End Select
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+
+ ' check if they're in a party
+ If TempPlayer(index).inParty > 0 Then SendPartyVitals TempPlayer(index).inParty, index
+End Sub
+
+Sub SendEXP(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SPlayerEXP
+ Buffer.WriteLong GetPlayerExp(index)
+ Buffer.WriteLong GetPlayerNextLevel(index)
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendStats(ByVal index As Long)
+Dim i As Long
+Dim packet As String
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerStats
+ For i = 1 To Stats.Stat_Count - 1
+ Buffer.WriteLong GetPlayerStat(index, i)
+ Next
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendWelcome(ByVal index As Long)
+
+ ' Send them MOTD
+ If LenB(Options.MOTD) > 0 Then
+ Call PlayerMsg(index, Options.MOTD, BrightCyan)
+ End If
+
+ ' Send whos online
+ Call SendWhosOnline(index)
+End Sub
+
+Sub SendClasses(ByVal index As Long)
+ Dim packet As String
+ Dim i As Long, n As Long, q As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SClassesData
+ Buffer.WriteLong Max_Classes
+
+ For i = 1 To Max_Classes
+ Buffer.WriteString GetClassName(i)
+ Buffer.WriteLong GetClassMaxVital(i, Vitals.HP)
+ Buffer.WriteLong GetClassMaxVital(i, Vitals.MP)
+
+ ' set sprite array size
+ n = UBound(Class(i).MaleSprite)
+
+ ' send array size
+ Buffer.WriteLong n
+
+ ' loop around sending each sprite
+ For q = 0 To n
+ Buffer.WriteLong Class(i).MaleSprite(q)
+ Next
+
+ ' set sprite array size
+ n = UBound(Class(i).FemaleSprite)
+
+ ' send array size
+ Buffer.WriteLong n
+
+ ' loop around sending each sprite
+ For q = 0 To n
+ Buffer.WriteLong Class(i).FemaleSprite(q)
+ Next
+
+ For q = 1 To Stats.Stat_Count - 1
+ Buffer.WriteLong Class(i).Stat(q)
+ Next
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendNewCharClasses(ByVal index As Long)
+ Dim packet As String
+ Dim i As Long, n As Long, q As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNewCharClasses
+ Buffer.WriteLong Max_Classes
+
+ For i = 1 To Max_Classes
+ Buffer.WriteString GetClassName(i)
+ Buffer.WriteLong GetClassMaxVital(i, Vitals.HP)
+ Buffer.WriteLong GetClassMaxVital(i, Vitals.MP)
+
+ ' set sprite array size
+ n = UBound(Class(i).MaleSprite)
+ ' send array size
+ Buffer.WriteLong n
+ ' loop around sending each sprite
+ For q = 0 To n
+ Buffer.WriteLong Class(i).MaleSprite(q)
+ Next
+
+ ' set sprite array size
+ n = UBound(Class(i).FemaleSprite)
+ ' send array size
+ Buffer.WriteLong n
+ ' loop around sending each sprite
+ For q = 0 To n
+ Buffer.WriteLong Class(i).FemaleSprite(q)
+ Next
+
+ For q = 1 To Stats.Stat_Count - 1
+ Buffer.WriteLong Class(i).Stat(q)
+ Next
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendLeftGame(ByVal index As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerData
+ Buffer.WriteLong index
+ Buffer.WriteString vbNullString
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ Buffer.WriteLong 0
+ SendDataToAllBut index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerXY(ByVal index As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerXY
+ Buffer.WriteLong GetPlayerX(index)
+ Buffer.WriteLong GetPlayerY(index)
+ Buffer.WriteLong GetPlayerDir(index)
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerXYToMap(ByVal index As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerXYMap
+ Buffer.WriteLong index
+ Buffer.WriteLong GetPlayerX(index)
+ Buffer.WriteLong GetPlayerY(index)
+ Buffer.WriteLong GetPlayerDir(index)
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateItemToAll(ByVal itemNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim ItemSize As Long
+ Dim ItemData() As Byte
+ Set Buffer = New clsBuffer
+ ItemSize = LenB(Item(itemNum))
+
+ ReDim ItemData(ItemSize - 1)
+
+ CopyMemory ItemData(0), ByVal VarPtr(Item(itemNum)), ItemSize
+
+ Buffer.WriteLong SUpdateItem
+ Buffer.WriteLong itemNum
+ Buffer.WriteBytes ItemData
+
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateItemTo(ByVal index As Long, ByVal itemNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim ItemSize As Long
+ Dim ItemData() As Byte
+ Set Buffer = New clsBuffer
+ ItemSize = LenB(Item(itemNum))
+ ReDim ItemData(ItemSize - 1)
+ CopyMemory ItemData(0), ByVal VarPtr(Item(itemNum)), ItemSize
+ Buffer.WriteLong SUpdateItem
+ Buffer.WriteLong itemNum
+ Buffer.WriteBytes ItemData
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateAnimationToAll(ByVal AnimationNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim AnimationSize As Long
+ Dim AnimationData() As Byte
+ Set Buffer = New clsBuffer
+ AnimationSize = LenB(Animation(AnimationNum))
+ ReDim AnimationData(AnimationSize - 1)
+ CopyMemory AnimationData(0), ByVal VarPtr(Animation(AnimationNum)), AnimationSize
+ Buffer.WriteLong SUpdateAnimation
+ Buffer.WriteLong AnimationNum
+ Buffer.WriteBytes AnimationData
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateAnimationTo(ByVal index As Long, ByVal AnimationNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim AnimationSize As Long
+ Dim AnimationData() As Byte
+ Set Buffer = New clsBuffer
+ AnimationSize = LenB(Animation(AnimationNum))
+ ReDim AnimationData(AnimationSize - 1)
+ CopyMemory AnimationData(0), ByVal VarPtr(Animation(AnimationNum)), AnimationSize
+ Buffer.WriteLong SUpdateAnimation
+ Buffer.WriteLong AnimationNum
+ Buffer.WriteBytes AnimationData
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateNpcToAll(ByVal npcNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim NPCSize As Long
+ Dim NPCData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ NPCSize = LenB(Npc(npcNum))
+
+ ReDim NPCData(NPCSize - 1)
+
+ CopyMemory NPCData(0), ByVal VarPtr(Npc(npcNum)), NPCSize
+
+ Buffer.WriteLong SUpdateNpc
+ Buffer.WriteLong npcNum
+ Buffer.WriteBytes NPCData
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateNpcTo(ByVal index As Long, ByVal npcNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim NPCSize As Long
+ Dim NPCData() As Byte
+ Set Buffer = New clsBuffer
+ NPCSize = LenB(Npc(npcNum))
+ ReDim NPCData(NPCSize - 1)
+ CopyMemory NPCData(0), ByVal VarPtr(Npc(npcNum)), NPCSize
+ Buffer.WriteLong SUpdateNpc
+ Buffer.WriteLong npcNum
+ Buffer.WriteBytes NPCData
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateResourceToAll(ByVal ResourceNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim ResourceSize As Long
+ Dim ResourceData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ ResourceSize = LenB(Resource(ResourceNum))
+ ReDim ResourceData(ResourceSize - 1)
+ CopyMemory ResourceData(0), ByVal VarPtr(Resource(ResourceNum)), ResourceSize
+
+ Buffer.WriteLong SUpdateResource
+ Buffer.WriteLong ResourceNum
+ Buffer.WriteBytes ResourceData
+
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateResourceTo(ByVal index As Long, ByVal ResourceNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim ResourceSize As Long
+ Dim ResourceData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ ResourceSize = LenB(Resource(ResourceNum))
+ ReDim ResourceData(ResourceSize - 1)
+ CopyMemory ResourceData(0), ByVal VarPtr(Resource(ResourceNum)), ResourceSize
+
+ Buffer.WriteLong SUpdateResource
+ Buffer.WriteLong ResourceNum
+ Buffer.WriteBytes ResourceData
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendShops(ByVal index As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_SHOPS
+
+ If LenB(Trim$(Shop(i).Name)) > 0 Then
+ Call SendUpdateShopTo(index, i)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendUpdateShopToAll(ByVal shopNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim ShopSize As Long
+ Dim ShopData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ ShopSize = LenB(Shop(shopNum))
+ ReDim ShopData(ShopSize - 1)
+ CopyMemory ShopData(0), ByVal VarPtr(Shop(shopNum)), ShopSize
+
+ Buffer.WriteLong SUpdateShop
+ Buffer.WriteLong shopNum
+ Buffer.WriteBytes ShopData
+
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateShopTo(ByVal index As Long, ByVal shopNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim ShopSize As Long
+ Dim ShopData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ ShopSize = LenB(Shop(shopNum))
+ ReDim ShopData(ShopSize - 1)
+ CopyMemory ShopData(0), ByVal VarPtr(Shop(shopNum)), ShopSize
+
+ Buffer.WriteLong SUpdateShop
+ Buffer.WriteLong shopNum
+ Buffer.WriteBytes ShopData
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendSpells(ByVal index As Long)
+ Dim i As Long
+
+ For i = 1 To MAX_SPELLS
+
+ If LenB(Trim$(Spell(i).Name)) > 0 Then
+ Call SendUpdateSpellTo(index, i)
+ End If
+
+ Next
+
+End Sub
+
+Sub SendUpdateSpellToAll(ByVal spellNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Dim SpellSize As Long
+ Dim SpellData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ SpellSize = LenB(Spell(spellNum))
+ ReDim SpellData(SpellSize - 1)
+ CopyMemory SpellData(0), ByVal VarPtr(Spell(spellNum)), SpellSize
+
+ Buffer.WriteLong SUpdateSpell
+ Buffer.WriteLong spellNum
+ Buffer.WriteBytes SpellData
+
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateSpellTo(ByVal index As Long, ByVal spellNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim SpellSize As Long
+ Dim SpellData() As Byte
+
+ Set Buffer = New clsBuffer
+
+ SpellSize = LenB(Spell(spellNum))
+ ReDim SpellData(SpellSize - 1)
+ CopyMemory SpellData(0), ByVal VarPtr(Spell(spellNum)), SpellSize
+
+ Buffer.WriteLong SUpdateSpell
+ Buffer.WriteLong spellNum
+ Buffer.WriteBytes SpellData
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerSpells(ByVal index As Long)
+ Dim packet As String
+ Dim i As Long
+ Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSpells
+
+ For i = 1 To MAX_PLAYER_SPELLS
+ Buffer.WriteLong Player(index).Spell(i).Spell
+ Buffer.WriteLong Player(index).Spell(i).Uses
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendResourceCacheTo(ByVal index As Long, ByVal Resource_num As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SResourceCache
+ Buffer.WriteLong ResourceCache(GetPlayerMap(index)).Resource_Count
+
+ If ResourceCache(GetPlayerMap(index)).Resource_Count > 0 Then
+
+ For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count
+ Buffer.WriteByte ResourceCache(GetPlayerMap(index)).ResourceData(i).ResourceState
+ Buffer.WriteLong ResourceCache(GetPlayerMap(index)).ResourceData(i).x
+ Buffer.WriteLong ResourceCache(GetPlayerMap(index)).ResourceData(i).y
+ Next
+
+ End If
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendResourceCacheToMap(ByVal mapnum As Long, ByVal Resource_num As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SResourceCache
+ Buffer.WriteLong ResourceCache(mapnum).Resource_Count
+
+ If ResourceCache(mapnum).Resource_Count > 0 Then
+
+ For i = 0 To ResourceCache(mapnum).Resource_Count
+ Buffer.WriteByte ResourceCache(mapnum).ResourceData(i).ResourceState
+ Buffer.WriteLong ResourceCache(mapnum).ResourceData(i).x
+ Buffer.WriteLong ResourceCache(mapnum).ResourceData(i).y
+ Next
+
+ End If
+
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendDoorAnimation(ByVal mapnum As Long, ByVal x As Long, ByVal y As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SDoorAnimation
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendActionMsg(ByVal mapnum As Long, ByVal message As String, ByVal color As Long, ByVal MsgType As Long, ByVal x As Long, ByVal y As Long, Optional PlayerOnlyNum As Long = 0)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SActionMsg
+ Buffer.WriteString message
+ Buffer.WriteLong color
+ Buffer.WriteLong MsgType
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+
+ If PlayerOnlyNum > 0 Then
+ SendDataTo PlayerOnlyNum, Buffer.ToArray()
+ Else
+ SendDataToMap mapnum, Buffer.ToArray()
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendBlood(ByVal mapnum As Long, ByVal x As Long, ByVal y As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SBlood
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendAnimation(ByVal mapnum As Long, ByVal Anim As Long, ByVal x As Long, ByVal y As Long, Optional ByVal LockType As Byte = 0, Optional ByVal LockIndex As Long = 0, Optional isCasting As Byte = 0)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SAnimation
+ Buffer.WriteLong Anim
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+ Buffer.WriteByte LockType
+ Buffer.WriteLong LockIndex
+ Buffer.WriteByte isCasting
+
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendCooldown(ByVal index As Long, ByVal Slot As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SCooldown
+ Buffer.WriteLong Slot
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendClearSpellBuffer(ByVal index As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SClearSpellBuffer
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SayMsg_Map(ByVal mapnum As Long, ByVal index As Long, ByVal message As String, ByVal saycolour As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSayMsg
+ Buffer.WriteString GetPlayerName(index)
+ Buffer.WriteLong GetPlayerAccess(index)
+ Buffer.WriteLong Player(index).Usergroup
+ Buffer.WriteLong GetPlayerPK(index)
+ Buffer.WriteString message
+ Buffer.WriteString "[Map] "
+ Buffer.WriteLong saycolour
+
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SayMsg_Global(ByVal index As Long, ByVal message As String, ByVal saycolour As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSayMsg
+ Buffer.WriteString GetPlayerName(index)
+ Buffer.WriteLong GetPlayerAccess(index)
+ Buffer.WriteLong Player(index).Usergroup
+ Buffer.WriteLong GetPlayerPK(index)
+ Buffer.WriteString message
+ Buffer.WriteString "[Global] "
+ Buffer.WriteLong saycolour
+
+ SendDataToAll Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub ResetShopAction(ByVal index As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SResetShopAction
+
+ SendDataToAll Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendStunned(ByVal index As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SStunned
+ Buffer.WriteLong TempPlayer(index).StunDuration
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendBank(ByVal index As Long)
+ Dim Buffer As clsBuffer
+ Dim i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SBank
+
+ For i = 1 To MAX_BANK
+ Buffer.WriteLong Player(index).Bank(i).Num
+ Buffer.WriteLong Player(index).Bank(i).Value
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapKey(ByVal index As Long, ByVal x As Long, ByVal y As Long, ByVal Value As Byte)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SMapKey
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+ Buffer.WriteByte Value
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapKeyToMap(ByVal mapnum As Long, ByVal x As Long, ByVal y As Long, ByVal Value As Byte)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SMapKey
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+ Buffer.WriteByte Value
+ SendDataToMap mapnum, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendOpenShop(ByVal index As Long, ByVal shopNum As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SOpenShop
+ Buffer.WriteLong shopNum
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerMove(ByVal index As Long, ByVal movement As Long, Optional ByVal sendToSelf As Boolean = False)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerMove
+ Buffer.WriteLong index
+ Buffer.WriteLong GetPlayerX(index)
+ Buffer.WriteLong GetPlayerY(index)
+ Buffer.WriteLong GetPlayerDir(index)
+ Buffer.WriteLong movement
+
+ If Not sendToSelf Then
+ SendDataToMapBut index, GetPlayerMap(index), Buffer.ToArray()
+ Else
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+ End If
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTrade(ByVal index As Long, ByVal tradeTarget As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong STrade
+ Buffer.WriteLong tradeTarget
+ Buffer.WriteString Trim$(GetPlayerName(tradeTarget))
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendCloseTrade(ByVal index As Long)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SCloseTrade
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTradeUpdate(ByVal index As Long, ByVal dataType As Byte)
+Dim Buffer As clsBuffer
+Dim i As Long
+Dim tradeTarget As Long
+Dim totalWorth As Long, multiplier As Long
+
+ tradeTarget = TempPlayer(index).InTrade
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong STradeUpdate
+ Buffer.WriteByte dataType
+
+ If dataType = 0 Then ' own inventory
+ For i = 1 To MAX_INV
+ Buffer.WriteLong TempPlayer(index).TradeOffer(i).Num
+ Buffer.WriteLong TempPlayer(index).TradeOffer(i).Value
+ ' add total worth
+ If TempPlayer(index).TradeOffer(i).Num > 0 Then
+ ' currency?
+ If Item(TempPlayer(index).TradeOffer(i).Num).Type = ITEM_TYPE_CURRENCY Then
+ totalWorth = totalWorth + (Item(GetPlayerInvItemNum(index, TempPlayer(index).TradeOffer(i).Num)).price * TempPlayer(index).TradeOffer(i).Value)
+ Else
+ totalWorth = totalWorth + Item(GetPlayerInvItemNum(index, TempPlayer(index).TradeOffer(i).Num)).price
+ End If
+ End If
+ Next
+ ElseIf dataType = 1 Then ' other inventory
+ For i = 1 To MAX_INV
+ Buffer.WriteLong GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num)
+ Buffer.WriteLong TempPlayer(tradeTarget).TradeOffer(i).Value
+ ' add total worth
+ If GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num) > 0 Then
+ ' currency?
+ If Item(GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num)).Type = ITEM_TYPE_CURRENCY Then
+ totalWorth = totalWorth + (Item(GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num)).price * TempPlayer(tradeTarget).TradeOffer(i).Value)
+ Else
+ totalWorth = totalWorth + Item(GetPlayerInvItemNum(tradeTarget, TempPlayer(tradeTarget).TradeOffer(i).Num)).price
+ End If
+ End If
+ Next
+ End If
+
+ ' send total worth of trade
+ Buffer.WriteLong totalWorth
+
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTradeStatus(ByVal index As Long, ByVal Status As Byte)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong STradeStatus
+ Buffer.WriteByte Status
+ SendDataTo index, Buffer.ToArray()
+
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTarget(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong STarget
+ Buffer.WriteLong TempPlayer(index).target
+ Buffer.WriteLong TempPlayer(index).targetType
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendHotbar(ByVal index As Long)
+Dim i As Long
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SHotbar
+ For i = 1 To MAX_HOTBAR
+ Buffer.WriteLong Player(index).Hotbar(i).Slot
+ Buffer.WriteByte Player(index).Hotbar(i).sType
+ Next
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendLoginOk(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SLoginOk
+ Buffer.WriteLong index
+ Buffer.WriteLong Player_HighIndex
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendInGame(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SInGame
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendHighIndex()
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SHighIndex
+ Buffer.WriteLong Player_HighIndex
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerSound(ByVal index As Long, ByVal x As Long, ByVal y As Long, ByVal entityType As Long, ByVal entityNum As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSound
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+ Buffer.WriteLong entityType
+ Buffer.WriteLong entityNum
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendMapSound(ByVal index As Long, ByVal x As Long, ByVal y As Long, ByVal entityType As Long, ByVal entityNum As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSound
+ Buffer.WriteLong x
+ Buffer.WriteLong y
+ Buffer.WriteLong entityType
+ Buffer.WriteLong entityNum
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendTradeRequest(ByVal index As Long, ByVal TradeRequest As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong STradeRequest
+ Buffer.WriteString Trim$(Player(TradeRequest).Name)
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPartyInvite(ByVal index As Long, ByVal targetPlayer As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPartyInvite
+ Buffer.WriteString Trim$(Player(targetPlayer).Name)
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPartyUpdate(ByVal partynum As Long)
+Dim Buffer As clsBuffer, i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPartyUpdate
+ Buffer.WriteByte 1
+ Buffer.WriteLong Party(partynum).Leader
+ For i = 1 To MAX_PARTY_MEMBERS
+ Buffer.WriteLong Party(partynum).Member(i)
+ Next
+ Buffer.WriteLong Party(partynum).MemberCount
+ SendDataToParty partynum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPartyUpdateTo(ByVal index As Long)
+Dim Buffer As clsBuffer, i As Long, partynum As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPartyUpdate
+
+ ' check if we're in a party
+ partynum = TempPlayer(index).inParty
+ If partynum > 0 Then
+ ' send party data
+ Buffer.WriteByte 1
+ Buffer.WriteLong Party(partynum).Leader
+ For i = 1 To MAX_PARTY_MEMBERS
+ Buffer.WriteLong Party(partynum).Member(i)
+ Next
+ Buffer.WriteLong Party(partynum).MemberCount
+ Else
+ ' send clear command
+ Buffer.WriteByte 0
+ End If
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPartyVitals(ByVal partynum As Long, ByVal index As Long)
+Dim Buffer As clsBuffer, i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPartyVitals
+ Buffer.WriteLong index
+ For i = 1 To Vitals.Vital_Count - 1
+ Buffer.WriteLong GetPlayerMaxVital(index, i)
+ Buffer.WriteLong Player(index).Vital(i)
+ Next
+ SendDataToParty partynum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendSpawnItemToMap(ByVal mapnum As Long, ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SSpawnItem
+ Buffer.WriteLong index
+ Buffer.WriteString MapItem(mapnum, index).playerName
+ Buffer.WriteLong MapItem(mapnum, index).Num
+ Buffer.WriteLong MapItem(mapnum, index).Value
+ Buffer.WriteLong MapItem(mapnum, index).x
+ Buffer.WriteLong MapItem(mapnum, index).y
+ If MapItem(mapnum, index).Bound Then
+ Buffer.WriteLong 1
+ Else
+ Buffer.WriteLong 0
+ End If
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendConvs(ByVal index As Long)
+Dim i As Long
+
+ For i = 1 To MAX_CONVS
+ If LenB(Trim$(Conv(i).Name)) > 0 Then
+ Call SendUpdateConvTo(index, i)
+ End If
+ Next
+End Sub
+
+Sub SendUpdateConvToAll(ByVal convNum As Long)
+Dim packet As String
+Dim Buffer As clsBuffer
+Dim i As Long
+Dim x As Long
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SUpdateConv
+ Buffer.WriteLong convNum
+ With Conv(convNum)
+ Buffer.WriteString .Name
+ Buffer.WriteLong .chatCount
+ For i = 1 To .chatCount
+ Buffer.WriteString .Conv(i).Conv
+ For x = 1 To 4
+ Buffer.WriteString .Conv(i).rText(x)
+ Buffer.WriteLong .Conv(i).rTarget(x)
+ Next
+ Buffer.WriteLong .Conv(i).Event
+ Buffer.WriteLong .Conv(i).Data1
+ Buffer.WriteLong .Conv(i).Data2
+ Buffer.WriteLong .Conv(i).Data3
+ Next
+ End With
+
+ SendDataToAll Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendUpdateConvTo(ByVal index As Long, ByVal convNum As Long)
+ Dim packet As String
+ Dim Buffer As clsBuffer
+ Dim i As Long
+ Dim x As Long
+
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SUpdateConv
+ Buffer.WriteLong convNum
+ With Conv(convNum)
+ Buffer.WriteString .Name
+ Buffer.WriteLong .chatCount
+ For i = 1 To .chatCount
+ Buffer.WriteString .Conv(i).Conv
+ For x = 1 To 4
+ Buffer.WriteString .Conv(i).rText(x)
+ Buffer.WriteLong .Conv(i).rTarget(x)
+ Next
+ Buffer.WriteLong .Conv(i).Event
+ Buffer.WriteLong .Conv(i).Data1
+ Buffer.WriteLong .Conv(i).Data2
+ Buffer.WriteLong .Conv(i).Data3
+ Next
+ End With
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendChatUpdate(ByVal index As Long, ByVal npcNum As Long, ByVal mT As String, ByVal o1 As String, ByVal o2 As String, ByVal o3 As String, ByVal o4 As String)
+ Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SChatUpdate
+ Buffer.WriteLong npcNum
+ Buffer.WriteString mT
+ Buffer.WriteString o1
+ Buffer.WriteString o2
+ Buffer.WriteString o3
+ Buffer.WriteString o4
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendStartTutorial(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SStartTutorial
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendNpcDeath(ByVal mapnum As Long, ByVal mapNpcNum As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SNpcDead
+ Buffer.WriteLong mapNpcNum
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendChatBubble(ByVal mapnum As Long, ByVal target As Long, ByVal targetType As Long, ByVal message As String, ByVal colour As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SChatBubble
+ Buffer.WriteLong target
+ Buffer.WriteLong targetType
+ Buffer.WriteString message
+ Buffer.WriteLong colour
+ SendDataToMap mapnum, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendAttack(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SAttack
+ Buffer.WriteLong index
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Function SanitiseString(ByVal theString As String) As String
+Dim i As Long, tmpString As String
+ tmpString = vbNullString
+ If Len(theString) <= 0 Then Exit Function
+ For i = 1 To Len(theString)
+ Select Case Mid$(theString, i, 1)
+ Case "*"
+ tmpString = tmpString + "[s]"
+ Case ":"
+ tmpString = tmpString + "[c]"
+ Case Else
+ tmpString = tmpString + Mid$(theString, i, 1)
+ End Select
+ Next
+ SanitiseString = tmpString
+End Function
+
+Sub SendPlayerChars(ByVal index As Long)
+Dim Buffer As clsBuffer, tmpName As String, i As Long, tmpSprite As Long, tmpAccess As Long, tmpClass As Long, tmpUsergroup As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerChars
+
+ tmpUsergroup = GetVar(App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini", "ACCOUNT", "Usergroup")
+ Buffer.WriteLong tmpUsergroup
+
+ ' loop through each character. clear, load, add. repeat.
+ For i = 1 To MAX_CHARS
+ tmpName = GetVar(App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini", "CHAR" & i, "Name")
+ tmpSprite = Val(GetVar(App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini", "CHAR" & i, "Sprite"))
+ tmpAccess = Val(GetVar(App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini", "CHAR" & i, "Access"))
+ tmpClass = Val(GetVar(App.Path & "\data\accounts\" & SanitiseString(Trim$(Player(index).Login)) & ".ini", "CHAR" & i, "Class"))
+ Buffer.WriteString tmpName
+ Buffer.WriteLong tmpSprite
+ Buffer.WriteLong tmpAccess
+ Buffer.WriteLong tmpClass
+ Next
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendCancelAnimation(ByVal index As Long)
+Dim Buffer As clsBuffer
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SCancelAnimation
+ Buffer.WriteLong index
+ SendDataToMap GetPlayerMap(index), Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendPlayerVariables(ByVal index As Long)
+Dim Buffer As clsBuffer, i As Long
+
+ Set Buffer = New clsBuffer
+ Buffer.WriteLong SPlayerVariables
+ For i = 1 To MAX_BYTE
+ Buffer.WriteLong Player(index).Variable(i)
+ Next
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendCheckForMap(index As Long, mapnum As Long)
+Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SCheckForMap
+ Buffer.WriteLong mapnum
+ Buffer.WriteLong MapCRC32(mapnum).MapDataCRC
+ Buffer.WriteLong MapCRC32(mapnum).MapTileCRC
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
+
+Sub SendEvent(index As Long)
+Dim Buffer As clsBuffer
+ Set Buffer = New clsBuffer
+
+ Buffer.WriteLong SEvent
+ If TempPlayer(index).inEvent Then
+ Buffer.WriteLong 1
+ Else
+ Buffer.WriteLong 0
+ End If
+ Buffer.WriteLong TempPlayer(index).eventNum
+ Buffer.WriteLong TempPlayer(index).pageNum
+ Buffer.WriteLong TempPlayer(index).commandNum
+
+ SendDataTo index, Buffer.ToArray()
+ Set Buffer = Nothing
+End Sub
diff --git a/server/src/modSysTray.bas b/server/src/modSysTray.bas
new file mode 100644
index 0000000..7bf3290
--- /dev/null
+++ b/server/src/modSysTray.bas
@@ -0,0 +1,71 @@
+Attribute VB_Name = "modSysTray"
+Option Explicit
+
+Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
+Public Const KEYEVENTF_KEYUP = &H2
+Public Const VK_LWIN = &H5B
+
+'Declare a user-defined variable to pass to the Shell_NotifyIcon
+'function.
+Public Type NOTIFYICONDATA
+ cbSize As Long
+ hWnd As Long
+ uId As Long
+ uFlags As Long
+ uCallBackMessage As Long
+ hIcon As Long
+ szTip As String * 64
+End Type
+
+'Declare the constants for the API function. These constants can be
+'found in the header file Shellapi.h.
+'The following constants are the messages sent to the
+'Shell_NotifyIcon function to add, modify, or delete an icon from the System Tray
+Public Const NIM_ADD = &H0
+Public Const NIM_MODIFY = &H1
+Public Const NIM_DELETE = &H2
+'The following constant is the message sent when a mouse event occurs
+'within the rectangular boundaries of the icon in the System Tray
+'area.
+Public Const WM_MOUSEMOVE = &H200
+'The following constants are the flags that indicate the valid
+'members of the NOTIFYICONDATA data type.
+Public Const NIF_MESSAGE = &H1
+Public Const NIF_ICON = &H2
+Public Const NIF_TIP = &H4
+'The following constants are used to determine the mouse input on the
+'the icon in the taskbar status area.
+'Left-click constants.
+Public Const WM_LBUTTONDBLCLK = &H203 'Double-click
+Public Const WM_LBUTTONDOWN = &H201 'Button down
+Public Const WM_LBUTTONUP = &H202 'Button up
+'Right-click constants.
+Public Const WM_RBUTTONDBLCLK = &H206 'Double-click
+Public Const WM_RBUTTONDOWN = &H204 'Button down
+Public Const WM_RBUTTONUP = &H205 'Button up
+'Declare the API function call.
+Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
+'Dimension a variable as the user-defined data type.
+Global nid As NOTIFYICONDATA
+
+Public Sub DestroySystemTray()
+ nid.cbSize = Len(nid)
+ nid.hWnd = frmServer.hWnd
+ nid.uId = vbNull
+ nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
+ nid.uCallBackMessage = WM_MOUSEMOVE
+ nid.hIcon = frmServer.Icon
+ nid.szTip = GAME_NAME & " Server" & vbNullChar
+ Call Shell_NotifyIcon(NIM_DELETE, nid) ' Add to the sys tray
+End Sub
+
+Public Sub LoadSystemTray()
+ nid.cbSize = Len(nid)
+ nid.hWnd = frmServer.hWnd
+ nid.uId = vbNull
+ nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
+ nid.uCallBackMessage = WM_MOUSEMOVE
+ nid.hIcon = frmServer.Icon
+ nid.szTip = GAME_NAME & " Server" & vbNullChar 'You can add your game name or something.
+ Call Shell_NotifyIcon(NIM_ADD, nid) 'Add to the sys tray
+End Sub
diff --git a/server/src/modTypes.bas b/server/src/modTypes.bas
new file mode 100644
index 0000000..8dcb913
--- /dev/null
+++ b/server/src/modTypes.bas
@@ -0,0 +1,521 @@
+Attribute VB_Name = "modTypes"
+Option Explicit
+
+' Public data structures
+Public Map(1 To MAX_MAPS) As MapRec
+Public MapCRC32(1 To MAX_MAPS) As MapCRCStruct
+Public MapCache(1 To MAX_MAPS) As Cache
+Public TempTile(1 To MAX_MAPS) As TempTileRec
+Public PlayersOnMap(1 To MAX_MAPS) As Long
+Public ResourceCache(1 To MAX_MAPS) As ResourceCacheRec
+Public Player(1 To MAX_PLAYERS) As PlayerRec
+Public TempPlayer(1 To MAX_PLAYERS) As TempPlayerRec
+Public Class() As ClassRec
+Public Item(1 To MAX_ITEMS) As ItemRec
+Public Npc(1 To MAX_NPCS) As NpcRec
+Public MapItem(1 To MAX_MAPS, 1 To MAX_MAP_ITEMS) As MapItemRec
+Public MapNpc(1 To MAX_MAPS) As MapNpcDataRec
+Public Shop(1 To MAX_SHOPS) As ShopRec
+Public Spell(1 To MAX_SPELLS) As SpellRec
+Public Resource(1 To MAX_RESOURCES) As ResourceRec
+Public Animation(1 To MAX_ANIMATIONS) As AnimationRec
+Public Party(1 To MAX_PARTYS) As PartyRec
+Public Conv(1 To MAX_CONVS) As ConvWrapperRec
+Public Options As OptionsRec
+
+Public Type MapCRCStruct
+ MapDataCRC As Long
+ MapTileCRC As Long
+End Type
+
+Private Type OptionsRec
+ MOTD As String
+End Type
+
+Public Type PartyRec
+ Leader As Long
+ Member(1 To MAX_PARTY_MEMBERS) As Long
+ MemberCount As Long
+End Type
+
+Public Type PlayerInvRec
+ Num As Long
+ Value As Long
+ Bound As Byte
+End Type
+
+Public Type PlayerSpellRec
+ Spell As Long
+ Uses As Long
+End Type
+
+Private Type Cache
+ Data() As Byte
+End Type
+
+Public Type HotbarRec
+ Slot As Long
+ sType As Byte
+End Type
+
+Public Type PlayerRec
+ ' Account
+ Login As String
+
+ ' General
+ Name As String * ACCOUNT_LENGTH
+ Sex As Byte
+ Class As Long
+ Sprite As Long
+ Level As Byte
+ exp As Long
+ Access As Byte
+ PK As Byte
+
+ ' Vitals
+ Vital(1 To Vitals.Vital_Count - 1) As Long
+
+ ' Stats
+ Stat(1 To Stats.Stat_Count - 1) As Byte
+ POINTS As Long
+
+ ' Worn equipment
+ Equipment(1 To Equipment.Equipment_Count - 1) As Long
+
+ ' Inventory
+ Inv(1 To MAX_INV) As PlayerInvRec
+ Spell(1 To MAX_PLAYER_SPELLS) As PlayerSpellRec
+ Bank(1 To MAX_BANK) As PlayerInvRec
+
+ ' Hotbar
+ Hotbar(1 To MAX_HOTBAR) As HotbarRec
+
+ ' Position
+ Map As Long
+ x As Byte
+ y As Byte
+ dir As Byte
+
+ ' Variables
+ Variable(1 To MAX_BYTE) As Long
+
+ ' Tutorial
+ TutorialState As Byte
+
+ ' Banned
+ isBanned As Byte
+ isMuted As Byte
+
+ ' character selection
+ charNum As Long
+
+ ' usergroup
+ Usergroup As Long
+End Type
+
+Public Type SpellBufferRec
+ Spell As Long
+ Timer As Long
+ target As Long
+ tType As Byte
+End Type
+
+Public Type DoTRec
+ Used As Boolean
+ Spell As Long
+ Timer As Long
+ Caster As Long
+ StartTime As Long
+End Type
+
+Public Type TempPlayerRec
+ ' Non saved local vars
+ Buffer As clsBuffer
+ InGame As Boolean
+ AttackTimer As Long
+ DataTimer As Long
+ DataBytes As Long
+ DataPackets As Long
+ targetType As Byte
+ target As Long
+ GettingMap As Byte
+ SpellCD(1 To MAX_PLAYER_SPELLS) As Long
+ InShop As Long
+ StunTimer As Long
+ StunDuration As Long
+ InBank As Boolean
+ inEvent As Boolean
+ eventNum As Long
+ pageNum As Long
+ commandNum As Long
+ ' trade
+ TradeRequest As Long
+ InTrade As Long
+ TradeOffer(1 To MAX_INV) As PlayerInvRec
+ AcceptTrade As Boolean
+ ' dot/hot
+ DoT(1 To MAX_DOTS) As DoTRec
+ HoT(1 To MAX_DOTS) As DoTRec
+ ' spell buffer
+ spellBuffer As SpellBufferRec
+ ' regen
+ stopRegen As Boolean
+ stopRegenTimer As Long
+ ' party
+ inParty As Long
+ partyInvite As Long
+ ' chat
+ inChatWith As Long
+ curChat As Long
+ c_mapNum As Long
+ c_mapNpcNum As Long
+ ' food
+ foodItem(1 To Vitals.Vital_Count - 1) As Long
+ foodTick(1 To Vitals.Vital_Count - 1) As Long
+ foodTimer(1 To Vitals.Vital_Count - 1) As Long
+End Type
+
+Private Type TempEventRec
+ x As Long
+ y As Long
+ SelfSwitch As Byte
+End Type
+
+Private Type EventCommandRec
+ Type As Byte
+ Text As String
+ colour As Long
+ Channel As Byte
+ targetType As Byte
+ target As Long
+End Type
+
+Private Type EventPageRec
+ chkPlayerVar As Byte
+ chkSelfSwitch As Byte
+ chkHasItem As Byte
+
+ PlayerVarNum As Long
+ SelfSwitchNum As Long
+ HasItemNum As Long
+
+ PlayerVariable As Long
+
+ GraphicType As Byte
+ Graphic As Long
+ GraphicX As Long
+ GraphicY As Long
+
+ MoveType As Byte
+ MoveSpeed As Byte
+ MoveFreq As Byte
+
+ WalkAnim As Byte
+ StepAnim As Byte
+ DirFix As Byte
+ WalkThrough As Byte
+
+ Priority As Byte
+ Trigger As Byte
+
+ CommandCount As Long
+ Commands() As EventCommandRec
+End Type
+
+Private Type EventRec
+ Name As String
+ x As Long
+ y As Long
+ PageCount As Long
+ EventPage() As EventPageRec
+End Type
+
+Private Type MapDataRec
+ Name As String
+ Music As String
+ Moral As Byte
+
+ Up As Long
+ Down As Long
+ left As Long
+ Right As Long
+
+ BootMap As Long
+ BootX As Byte
+ BootY As Byte
+
+ MaxX As Byte
+ MaxY As Byte
+
+ BossNpc As Long
+
+ Npc(1 To MAX_MAP_NPCS) As Long
+End Type
+
+Private Type TileDataRec
+ x As Long
+ y As Long
+ Tileset As Long
+End Type
+
+Public Type TileRec
+ Layer(1 To MapLayer.Layer_Count - 1) As TileDataRec
+ Autotile(1 To MapLayer.Layer_Count - 1) As Byte
+
+ Type As Byte
+ Data1 As Long
+ Data2 As Long
+ Data3 As Long
+ Data4 As Long
+ Data5 As Long
+ DirBlock As Byte
+End Type
+
+Private Type MapTileRec
+ EventCount As Long
+ Tile() As TileRec
+ Events() As EventRec
+End Type
+
+Private Type MapRec
+ MapData As MapDataRec
+ TileData As MapTileRec
+End Type
+
+Private Type ClassRec
+ Name As String * NAME_LENGTH
+ Stat(1 To Stats.Stat_Count - 1) As Byte
+ MaleSprite() As Long
+ FemaleSprite() As Long
+
+ startItemCount As Long
+ StartItem() As Long
+ StartValue() As Long
+
+ startSpellCount As Long
+ StartSpell() As Long
+End Type
+
+Private Type ItemRec
+ Name As String * NAME_LENGTH
+ Desc As String * 255
+ Sound As String * NAME_LENGTH
+
+ Pic As Long
+
+ Type As Byte
+ Data1 As Long
+ Data2 As Long
+ Data3 As Long
+ ClassReq As Long
+ AccessReq As Long
+ LevelReq As Long
+ Mastery As Byte
+ price As Long
+ Add_Stat(1 To Stats.Stat_Count - 1) As Byte
+ Rarity As Byte
+ Speed As Long
+ Handed As Long
+ BindType As Byte
+ Stat_Req(1 To Stats.Stat_Count - 1) As Byte
+ Animation As Long
+ Paperdoll As Long
+
+ ' consume
+ AddHP As Long
+ AddMP As Long
+ AddEXP As Long
+ CastSpell As Long
+ instaCast As Byte
+
+ ' food
+ HPorSP As Long
+ FoodPerTick As Long
+ FoodTickCount As Long
+ FoodInterval As Long
+
+ ' requirements
+ proficiency As Long
+End Type
+
+Private Type MapItemRec
+ Num As Long
+ Value As Long
+ x As Byte
+ y As Byte
+ ' ownership + despawn
+ playerName As String
+ playerTimer As Long
+ canDespawn As Boolean
+ despawnTimer As Long
+ Bound As Boolean
+End Type
+
+Private Type NpcRec
+ Name As String * NAME_LENGTH
+ AttackSay As String * 100
+ Sound As String * NAME_LENGTH
+
+ Sprite As Long
+ SpawnSecs As Long
+ Behaviour As Byte
+ Range As Byte
+ Stat(1 To Stats.Stat_Count - 1) As Byte
+ HP As Long
+ exp As Long
+ Animation As Long
+ damage As Long
+ Level As Long
+ Conv As Long
+
+ ' Npc drops
+ DropChance(1 To MAX_NPC_DROPS) As Double
+ DropItem(1 To MAX_NPC_DROPS) As Byte
+ DropItemValue(1 To MAX_NPC_DROPS) As Integer
+
+ ' Casting
+ Spirit As Long
+ Spell(1 To MAX_NPC_SPELLS) As Long
+End Type
+
+Private Type MapNpcRec
+ Num As Long
+ target As Long
+ targetType As Byte
+ Vital(1 To Vitals.Vital_Count - 1) As Long
+ x As Byte
+ y As Byte
+ dir As Byte
+ ' For server use only
+ SpawnWait As Long
+ AttackTimer As Long
+ StunDuration As Long
+ StunTimer As Long
+ ' regen
+ stopRegen As Boolean
+ stopRegenTimer As Long
+ ' dot/hot
+ DoT(1 To MAX_DOTS) As DoTRec
+ HoT(1 To MAX_DOTS) As DoTRec
+ ' chat
+ c_lastDir As Byte
+ c_inChatWith As Long
+ ' spell casting
+ spellBuffer As SpellBufferRec
+ SpellCD(1 To MAX_NPC_SPELLS) As Long
+End Type
+
+Private Type MapNpcDataRec
+ Npc(1 To MAX_MAP_NPCS) As MapNpcRec
+End Type
+
+Private Type TradeItemRec
+ Item As Long
+ ItemValue As Long
+ costitem As Long
+ costvalue As Long
+End Type
+
+Private Type ShopRec
+ Name As String * NAME_LENGTH
+ BuyRate As Long
+ TradeItem(1 To MAX_TRADES) As TradeItemRec
+End Type
+
+Private Type SpellRec
+ Name As String * NAME_LENGTH
+ Desc As String * 255
+ Sound As String * NAME_LENGTH
+
+ Type As Byte
+ mpCost As Long
+ LevelReq As Long
+ AccessReq As Long
+ ClassReq As Long
+ CastTime As Long
+ CDTime As Long
+ Icon As Long
+ Map As Long
+ x As Long
+ y As Long
+ dir As Byte
+ Vital As Long
+ Duration As Long
+ Interval As Long
+ Range As Byte
+ IsAoE As Boolean
+ AoE As Long
+ CastAnim As Long
+ SpellAnim As Long
+ StunDuration As Long
+
+ ' ranking
+ UniqueIndex As Long
+ NextRank As Long
+ NextUses As Long
+End Type
+
+Private Type TempTileRec
+ DoorOpen() As Byte
+ DoorTimer As Long
+End Type
+
+Private Type TempMapDataRec
+ Npc() As MapNpcRec
+End Type
+
+Private Type MapResourceRec
+ ResourceState As Byte
+ ResourceTimer As Long
+ x As Long
+ y As Long
+ cur_health As Long
+End Type
+
+Private Type ResourceCacheRec
+ Resource_Count As Long
+ ResourceData() As MapResourceRec
+End Type
+
+Private Type ResourceRec
+ Name As String * NAME_LENGTH
+ SuccessMessage As String * NAME_LENGTH
+ EmptyMessage As String * NAME_LENGTH
+ Sound As String * NAME_LENGTH
+
+ ResourceType As Byte
+ ResourceImage As Long
+ ExhaustedImage As Long
+ ItemReward As Long
+ ToolRequired As Long
+ health As Long
+ RespawnTime As Long
+ WalkThrough As Boolean
+ Animation As Long
+End Type
+
+Private Type AnimationRec
+ Name As String * NAME_LENGTH
+ Sound As String * NAME_LENGTH
+
+ Sprite(0 To 1) As Long
+ Frames(0 To 1) As Long
+ LoopCount(0 To 1) As Long
+ LoopTime(0 To 1) As Long
+End Type
+
+Private Type ConvRec
+ Conv As String
+ rText(1 To 4) As String
+ rTarget(1 To 4) As Long
+ Event As Long
+ Data1 As Long
+ Data2 As Long
+ Data3 As Long
+End Type
+
+Private Type ConvWrapperRec
+ Name As String * NAME_LENGTH
+ chatCount As Long
+ Conv() As ConvRec
+End Type
diff --git a/updater/client/Autoupdater.vbp b/updater/client/Autoupdater.vbp
new file mode 100644
index 0000000..7d1bc00
--- /dev/null
+++ b/updater/client/Autoupdater.vbp
@@ -0,0 +1,37 @@
+Type=Exe
+Form=src\frmMain.frm
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
+Module=modMain; src\modMain.bas
+Class=cBinaryFileStream; src\cBinaryFileStream.cls
+Class=cCRC32; src\cCRC32.cls
+UserControl=src\NetGrab.ctl
+IconForm="frmMain"
+Startup="Sub Main"
+HelpFile=""
+Title="Autoupdater"
+ExeName32="Crystalshire.exe"
+Command32=""
+Name="Autoupdater"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Robin Perris Corp."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
diff --git a/updater/client/src/NetGrab.ctl b/updater/client/src/NetGrab.ctl
new file mode 100644
index 0000000..99bc1d8
--- /dev/null
+++ b/updater/client/src/NetGrab.ctl
@@ -0,0 +1,240 @@
+VERSION 5.00
+Begin VB.UserControl NetGrab
+ CanGetFocus = 0 'False
+ ClientHeight = 540
+ ClientLeft = 0
+ ClientTop = 0
+ ClientWidth = 525
+ InvisibleAtRuntime= -1 'True
+ Picture = "NetGrab.ctx":0000
+ ScaleHeight = 540
+ ScaleWidth = 525
+ ToolboxBitmap = "NetGrab.ctx":0606
+End
+Attribute VB_Name = "NetGrab"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' *********************************************************************
+' Copyright ©2008 Karl E. Peterson, All Rights Reserved
+' http://vb.mvps.org/
+' *********************************************************************
+' You are free to use this code within your own applications, but you
+' are expressly forbidden from selling or otherwise distributing this
+' source code without prior written consent.
+' *********************************************************************
+Option Explicit
+
+' Win32 API declarations
+Private Declare Function GetTickCount Lib "kernel32" () As Long
+
+' Member variables
+Private m_Busy As Boolean
+Private m_Key As Long
+Private m_Bytes() As Byte
+Private m_nBytes As Long
+Private m_Duration As Long
+
+' =====================================================================
+' Set this conditional constant to False if you're =================
+' using this UserControl in a VB5 project. === READ THIS ===
+#Const VB6 = True ' =================
+' =====================================================================
+
+' Events
+Public Event DownloadComplete(ByVal nBytes As Long)
+Public Event DownloadFailed(ByVal ErrNum As Long, ByVal ErrDesc As String)
+#If VB6 Then
+Public Event DownloadProgress(ByVal nBytes As Long)
+#End If
+
+' **************************************************************
+' Initialization and Termination
+' **************************************************************
+Private Sub UserControl_Initialize()
+ ' Nothing to do, really...
+End Sub
+
+Private Sub UserControl_InitProperties()
+ ' Set default property values.
+End Sub
+
+Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
+ ' Read properties from storage.
+End Sub
+
+Private Sub UserControl_Terminate()
+ ' Clean up!
+End Sub
+
+Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
+ ' Write propertis to storage.
+End Sub
+
+' **************************************************************
+' UserControl Events
+' **************************************************************
+Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
+ ' Record duration of download.
+ m_Duration = Abs(GetTickCount - m_Key)
+ ' Reset key to indicate no current download.
+ Debug.Print CStr(m_Key); " - "; TicksToTime(GetTickCount); " - done"
+ m_Key = 0
+ ' Extract downloaded data from AsyncProp
+ With AsyncProp
+ On Error GoTo BadDownload
+ If .AsyncType = vbAsyncTypeByteArray Then
+ ' Cache copy of downloaded bytes
+ m_Bytes = .Value
+ m_nBytes = UBound(m_Bytes) + 1
+ RaiseEvent DownloadComplete(m_nBytes)
+ End If
+ End With
+ Exit Sub
+BadDownload:
+ m_nBytes = 0
+ RaiseEvent DownloadFailed(Err.Number, Err.Description)
+End Sub
+
+#If VB6 Then
+Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
+ ' Extract downloaded data from AsyncProp
+ With AsyncProp
+ On Error GoTo BadProgress
+ If .AsyncType = vbAsyncTypeByteArray Then
+ ' Cache copy of downloaded bytes
+ m_Bytes = .Value
+ m_nBytes = UBound(m_Bytes) + 1
+ RaiseEvent DownloadProgress(m_nBytes)
+ End If
+ End With
+ Exit Sub
+BadProgress:
+ ' No need to raise an event, as progress may resume?
+End Sub
+#End If
+
+Private Sub UserControl_AmbientChanged(PropertyName As String)
+ On Error Resume Next
+ Select Case PropertyName
+' Case "DisplayName"
+' Call UpdateDisplayName
+ Case Else
+ Debug.Print PropertyName
+ End Select
+End Sub
+
+Private Sub UserControl_Resize()
+ Static Busy As Boolean
+ ' Restrict size to iconic representation
+ If Busy Then Exit Sub
+ Busy = True
+ With UserControl
+ .Width = .ScaleX(.Picture.Width, vbHimetric, .ScaleMode)
+ .Height = .ScaleX(.Picture.Height, vbHimetric, .ScaleMode)
+ End With
+ Busy = False
+End Sub
+
+' **********************************************
+' Non-Persisted Properties (read-only)
+' **********************************************
+Public Property Get Busy() As Boolean
+ ' An open key means still downloading.
+ Busy = (m_Key <> 0)
+End Property
+
+#If VB6 Then
+Public Property Get Bytes() As Byte()
+#Else
+Public Property Get Bytes() As Variant
+Attribute Bytes.VB_MemberFlags = "400"
+#End If
+ ' NOTE: Change conditional constant at top
+ ' of module to match target language!
+ Bytes = m_Bytes()
+End Property
+
+Public Property Get Duration() As Long
+ ' Return number of milliseconds last transfer took.
+ Duration = m_Duration
+End Property
+
+' **************************************************************
+' Public Methods
+' **************************************************************
+Public Sub DownloadCancel()
+ ' Attempt to cancel pending download.
+ On Error Resume Next
+ UserControl.CancelAsyncRead CStr(m_Key)
+ Debug.Print CStr(m_Key); " - "; TicksToTime(GetTickCount); " - cancel"
+ If Err.Number Then
+ Debug.Print "CancelAsyncRead Error"; Err.Number, Err.Description
+ End If
+End Sub
+
+#If VB6 Then
+Public Sub DownloadStart(ByVal URL As String, Optional ByVal Mode As AsyncReadConstants = vbAsyncReadResynchronize)
+#Else
+Public Sub DownloadStart(ByVal URL As String)
+#End If
+ If Len(URL) Then
+ ' Already downloading something, need to cancel!
+ If m_Key Then Me.DownloadCancel
+
+ ' Reset duration tracker.
+ m_Duration = 0
+
+ ' Use current time as PropertyName.
+ m_Key = GetTickCount()
+ Debug.Print CStr(m_Key); " - "; TicksToTime(m_Key); " - "; URL
+
+ ' Request user-specified file from web.
+ On Error Resume Next
+ #If VB6 Then
+ UserControl.AsyncRead URL, vbAsyncTypeByteArray, CStr(m_Key), Mode
+ #Else
+ UserControl.AsyncRead URL, vbAsyncTypeByteArray, CStr(m_Key)
+ #End If
+ If Err.Number Then
+ Debug.Print "AsyncRead Error"; Err.Number, Err.Description
+ End If
+ End If
+End Sub
+
+Public Function SaveAs(ByVal FileName As String) As Boolean
+ Dim hFile As Long
+
+ ' Bail, if no data has been downloaded.
+ If m_nBytes = 0 Then Exit Function
+
+ ' Since this is binary, we need to delete existing crud.
+ On Error Resume Next
+ Kill FileName
+
+ ' Okay, now we just spit out what was given.
+ On Error GoTo Hell
+ hFile = FreeFile
+ Open FileName For Binary As #hFile
+ Put #hFile, , m_Bytes
+ Close #hFile
+Hell:
+ SaveAs = Not CBool(Err.Number)
+End Function
+
+' **************************************************************
+' Private Methods
+' **************************************************************
+Private Function TicksToTime(ByVal Ticks As Long) As Date
+ Static Calibrated As Boolean
+ Static Zero As Date
+ ' Need to calibrate just once.
+ If Not Calibrated Then
+ Zero = DateAdd("s", -(GetTickCount / 1000), Now)
+ Calibrated = True
+ End If
+ ' Calculate offset from Z-time.
+ TicksToTime = DateAdd("s", Ticks / 1000, Zero)
+End Function
+
diff --git a/updater/client/src/NetGrab.ctx b/updater/client/src/NetGrab.ctx
new file mode 100644
index 0000000..10ee625
Binary files /dev/null and b/updater/client/src/NetGrab.ctx differ
diff --git a/updater/client/src/cBinaryFileStream.cls b/updater/client/src/cBinaryFileStream.cls
new file mode 100644
index 0000000..9f7f022
--- /dev/null
+++ b/updater/client/src/cBinaryFileStream.cls
@@ -0,0 +1,98 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+ Persistable = 0 'NotPersistable
+ DataBindingBehavior = 0 'vbNone
+ DataSourceBehavior = 0 'vbNone
+ MTSTransactionMode = 0 'NotAnMTSObject
+END
+Attribute VB_Name = "cBinaryFileStream"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private m_sFile As String
+Private m_iFile As Integer
+Private m_iLen As Long
+Private m_iOffset As Long
+
+Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
+ lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
+
+Public Property Get File() As String
+ File = m_sFile
+End Property
+Public Property Let File(ByVal sFile As String)
+ Dispose
+ m_sFile = sFile
+ Dim lErr As Long
+ If (FileExists(m_sFile, lErr)) Then
+ m_iFile = FreeFile
+ Open m_sFile For Binary Access Read Lock Write As #m_iFile
+ m_iLen = LOF(m_iFile)
+ Else
+ Err.Raise lErr, App.EXEName & ".File"
+ End If
+End Property
+
+Private Function FileExists(ByVal sFile As String, ByRef lErr As Long) As Boolean
+
+ lErr = 0
+ On Error Resume Next
+ Dim sDir As String
+ sDir = Dir(sFile)
+ lErr = Err.Number
+ On Error GoTo 0
+
+ If (lErr = 0) Then
+ If (Len(sDir) > 0) Then
+ FileExists = True
+ Else
+ lErr = 53
+ End If
+ End If
+
+End Function
+
+Public Property Get Length() As Long
+ Length = m_iLen
+End Property
+
+Public Function Read( _
+ buffer() As Byte, _
+ ByVal readSize As Long _
+ ) As Long
+
+ Dim lReadSize As Long
+ lReadSize = readSize
+ If (m_iOffset + lReadSize >= m_iLen) Then
+ readSize = m_iLen - m_iOffset
+ If (readSize > 0) Then
+ ReDim newBuffer(0 To readSize - 1) As Byte
+ Get #m_iFile, , newBuffer
+ CopyMemory buffer(0), newBuffer(0), readSize
+ Else
+ Dispose
+ End If
+ m_iOffset = m_iOffset + readSize
+ Else
+ ' Can read
+ Get #m_iFile, , buffer
+ m_iOffset = m_iOffset + readSize
+ End If
+ Read = readSize
+
+End Function
+
+Public Sub Dispose()
+ If (m_iFile) Then
+ Close #m_iFile
+ m_iFile = 0
+ End If
+End Sub
+
+Private Sub Class_Terminate()
+ Dispose
+End Sub
diff --git a/updater/client/src/cCRC32.cls b/updater/client/src/cCRC32.cls
new file mode 100644
index 0000000..980a6ed
--- /dev/null
+++ b/updater/client/src/cCRC32.cls
@@ -0,0 +1,89 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "cCRC32"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' This code is taken from the VB.NET CRC32 algorithm
+' provided by Paul (wpsjr1@succeed.net) - Excellent work!
+
+Private crc32Table() As Long
+Private Const BUFFER_SIZE As Long = 8192
+
+Public Function GetByteArrayCrc32(ByRef buffer() As Byte) As Long
+
+ Dim crc32Result As Long
+ crc32Result = &HFFFFFFFF
+
+ Dim i As Integer
+ Dim iLookup As Integer
+
+ For i = LBound(buffer) To UBound(buffer)
+ iLookup = (crc32Result And &HFF) Xor buffer(i)
+ crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And 16777215 ' nasty shr 8 with vb :/
+ crc32Result = crc32Result Xor crc32Table(iLookup)
+ Next i
+
+ GetByteArrayCrc32 = Not (crc32Result)
+
+End Function
+
+Public Function GetFileCrc32(ByRef stream As cBinaryFileStream) As Long
+
+ Dim crc32Result As Long
+ crc32Result = &HFFFFFFFF
+
+ Dim buffer(0 To BUFFER_SIZE - 1) As Byte
+ Dim readSize As Long
+ readSize = BUFFER_SIZE
+
+ Dim count As Integer
+ count = stream.Read(buffer, readSize)
+
+ Dim i As Integer
+ Dim iLookup As Integer
+ Dim tot As Integer
+
+ Do While (count > 0)
+ For i = 0 To count - 1
+ iLookup = (crc32Result And &HFF) Xor buffer(i)
+ crc32Result = ((crc32Result And &HFFFFFF00) \ &H100) And 16777215 ' nasty shr 8 with vb :/
+ crc32Result = crc32Result Xor crc32Table(iLookup)
+ Next i
+ count = stream.Read(buffer, readSize)
+ Loop
+
+ GetFileCrc32 = Not (crc32Result)
+
+End Function
+
+Private Sub Class_initialize()
+
+ ' This is the official polynomial used by CRC32 in PKZip.
+ ' Often the polynomial is shown reversed (04C11DB7).
+ Dim dwPolynomial As Long
+ dwPolynomial = &HEDB88320
+ Dim i As Integer, j As Integer
+
+ ReDim crc32Table(256)
+ Dim dwCrc As Long
+
+ For i = 0 To 255
+ dwCrc = i
+ For j = 8 To 1 Step -1
+ If (dwCrc And 1) Then
+ dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
+ dwCrc = dwCrc Xor dwPolynomial
+ Else
+ dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
+ End If
+ Next j
+ crc32Table(i) = dwCrc
+ Next i
+
+End Sub
diff --git a/updater/client/src/frmMain.frm b/updater/client/src/frmMain.frm
new file mode 100644
index 0000000..a815a48
--- /dev/null
+++ b/updater/client/src/frmMain.frm
@@ -0,0 +1,225 @@
+VERSION 5.00
+Begin VB.Form frmMain
+ BorderStyle = 1 'Fixed Single
+ Caption = "GameName"
+ ClientHeight = 5625
+ ClientLeft = 45
+ ClientTop = 375
+ ClientWidth = 5445
+ Icon = "frmMain.frx":0000
+ LinkTopic = "Form1"
+ MaxButton = 0 'False
+ MinButton = 0 'False
+ Picture = "frmMain.frx":5F32
+ ScaleHeight = 375
+ ScaleMode = 3 'Pixel
+ ScaleWidth = 363
+ StartUpPosition = 2 'CenterScreen
+ Begin Autoupdater.NetGrab NetGrab
+ Left = 0
+ Top = 0
+ _ExtentX = 847
+ _ExtentY = 847
+ End
+ Begin VB.Image imgPlay_Hover
+ Height = 360
+ Left = 4560
+ Picture = "frmMain.frx":69F10
+ Top = 6360
+ Visible = 0 'False
+ Width = 1050
+ End
+ Begin VB.Image imgPlay_Norm
+ Height = 360
+ Left = 4560
+ Picture = "frmMain.frx":6B332
+ Top = 6840
+ Visible = 0 'False
+ Width = 1050
+ End
+ Begin VB.Image imgRight
+ Height = 105
+ Left = 2760
+ Picture = "frmMain.frx":6C754
+ Top = 1200
+ Visible = 0 'False
+ Width = 105
+ End
+ Begin VB.Image imgLeft
+ Height = 105
+ Left = 2640
+ Picture = "frmMain.frx":6C83E
+ Top = 1200
+ Visible = 0 'False
+ Width = 105
+ End
+ Begin VB.Label lblChanges
+ BackStyle = 0 'Transparent
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 2250
+ Left = 930
+ TabIndex = 4
+ Top = 1410
+ Width = 3600
+ End
+ Begin VB.Label lblHeader
+ Alignment = 2 'Center
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "Version 1.5.0"
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00FFFFFF&
+ Height = 195
+ Left = 2070
+ TabIndex = 3
+ Top = 1140
+ Width = 1305
+ End
+ Begin VB.Label lblTransfer
+ Alignment = 2 'Center
+ BackStyle = 0 'Transparent
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 6.75
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ ForeColor = &H00C0FFFF&
+ Height = 255
+ Left = 840
+ TabIndex = 2
+ Top = 4770
+ Width = 3780
+ End
+ Begin VB.Label lblProgress2
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "Attempting connection."
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 400
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 195
+ Left = 960
+ TabIndex = 1
+ Top = 4290
+ Width = 1965
+ End
+ Begin VB.Label lblProgress
+ AutoSize = -1 'True
+ BackStyle = 0 'Transparent
+ Caption = "Connecting to server."
+ BeginProperty Font
+ Name = "Verdana"
+ Size = 8.25
+ Charset = 0
+ Weight = 700
+ Underline = 0 'False
+ Italic = 0 'False
+ Strikethrough = 0 'False
+ EndProperty
+ Height = 195
+ Left = 960
+ TabIndex = 0
+ Top = 4050
+ Width = 2100
+ End
+ Begin VB.Image imgPlay
+ Height = 360
+ Left = 3495
+ Picture = "frmMain.frx":6C928
+ Top = 4110
+ Visible = 0 'False
+ Width = 1050
+ End
+ Begin VB.Image imgBar
+ Height = 240
+ Left = 750
+ Picture = "frmMain.frx":6DD4A
+ Top = 4740
+ Width = 3960
+ End
+End
+Attribute VB_Name = "frmMain"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private buttonHover As Boolean
+
+Private Sub Form_Unload(Cancel As Integer)
+ End
+End Sub
+
+Private Sub imgLeft_Click()
+ ShowUpdate curUpdate - 1
+End Sub
+
+Private Sub imgPlay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
+ Shell "bin\client.exe", vbNormalFocus
+ End
+End Sub
+
+Private Sub imgPlay_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
+ If Not buttonHover Then
+ imgPlay.Picture = imgPlay_Hover.Picture
+ buttonHover = True
+ End If
+End Sub
+
+Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
+ If buttonHover Then
+ imgPlay.Picture = imgPlay_Norm.Picture
+ buttonHover = False
+ End If
+End Sub
+
+Private Sub imgRight_Click()
+ ShowUpdate curUpdate + 1
+End Sub
+
+Private Sub NetGrab_downloadComplete(ByVal nBytes As Long)
+ DownloadComplete = True
+ If gettingCRC Then
+ CRCDump = StrConv(NetGrab.Bytes, vbUnicode)
+ Else
+ currentBytes = currentBytes + tempBytes
+ tempBytes = 0
+ End If
+End Sub
+
+Private Sub NetGrab_DownloadFailed(ByVal ErrNum As Long, ByVal ErrDesc As String)
+ failedDownload = True
+ DownloadComplete = True
+End Sub
+
+Private Sub NetGrab_DownloadProgress(ByVal nBytes As Long)
+ tempBytes = nBytes
+End Sub
diff --git a/updater/client/src/frmMain.frx b/updater/client/src/frmMain.frx
new file mode 100644
index 0000000..e9fd414
Binary files /dev/null and b/updater/client/src/frmMain.frx differ
diff --git a/updater/client/src/modDownload.bas b/updater/client/src/modDownload.bas
new file mode 100644
index 0000000..3ec3582
--- /dev/null
+++ b/updater/client/src/modDownload.bas
@@ -0,0 +1,4 @@
+Attribute VB_Name = "modDownload"
+Option Explicit
+
+
diff --git a/updater/client/src/modMain.bas b/updater/client/src/modMain.bas
new file mode 100644
index 0000000..0629e9c
--- /dev/null
+++ b/updater/client/src/modMain.bas
@@ -0,0 +1,426 @@
+Attribute VB_Name = "modMain"
+Option Explicit
+
+Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyname As Any, ByVal lpdefault As String, ByVal lpreturnedstring As String, ByVal nsize As Long, ByVal lpfilename As String) As Long
+
+Public Const GAMENAME As String = "Crystalshire"
+Public Const GAMEURL As String = "http://www.crystalshire.com/updater/"
+
+Public DownloadComplete As Boolean
+Public failedDownload As Boolean
+Public gettingCRC As Boolean
+Public CRCDump As String
+
+Public downloadBytes As Long, currentBytes As Long, tempBytes As Long
+
+Public clientCRC() As String, serverCRC() As String
+Public clientCount As Long, serverCount As Long
+Public downloadFiles() As String, downloadCount As Long
+
+Public maxBarWidth As Long
+
+Public updateCount As Long
+Public update() As UpdateUDT
+Public curUpdate As Long
+Type UpdateUDT
+ header As String
+ lineCount As Long
+ strLine() As String
+End Type
+
+Sub Main()
+Dim tmpString As String, i As Long, checkSum As String, strOffset As Long, fileSize As Long
+
+ ' set the form
+ frmMain.Caption = GAMENAME & " - v1.8.0"
+ frmMain.Show
+
+ ' set the bar width
+ maxBarWidth = frmMain.imgBar.Width
+ frmMain.imgBar.Width = 0
+
+ ' load the changelog
+ LoadChangeLog
+ ShowUpdate updateCount
+
+ ' download the update ini
+ frmMain.NetGrab.DownloadStart GAMEURL & "files/bin/changelog.ini"
+ ' loop around until the file is downloaded
+ Do Until DownloadComplete
+ Sleep 25
+ DoEvents
+ Loop
+ DownloadComplete = False
+
+ ' check if the file could download
+ If failedDownload Then
+ SetProgress "Connection failed.", "Try the game anyway."
+ frmMain.NetGrab.DownloadCancel
+ frmMain.imgPlay.Visible = True
+ frmMain.imgBar.Width = maxBarWidth
+ Exit Sub
+ End If
+
+ ' create folder if it doesn't exist
+ ChkDir App.Path & "/", "bin"
+ ' save file
+ frmMain.NetGrab.SaveAs App.Path & "/bin/changelog.ini"
+
+ ' we've downloaded
+ SetProgress "Found update.", "Parsing data."
+
+ ' load the changelog
+ LoadChangeLog
+ ShowUpdate updateCount
+
+ ' update form
+ DoEvents
+
+ ' list all files
+ tmpString = FindFiles(App.Path, App.Path & "\")
+ clientCRC = Split(tmpString, ",")
+ clientCount = UBound(clientCRC)
+
+ ' set the file downloading whilst we calculate our own checksums
+ gettingCRC = True
+ frmMain.NetGrab.DownloadStart GAMEURL & "crc.txt"
+
+ ' loop through and get the checksums + file sizes
+ strOffset = Len(App.Path) + 1
+ For i = 0 To clientCount
+ If Len(clientCRC(i)) > 0 Then
+ checkSum = GetFileCRC(clientCRC(i), fileSize)
+ clientCRC(i) = Replace$(clientCRC(i), "\", "/")
+ clientCRC(i) = Mid$(clientCRC(i), strOffset) & "," & checkSum & "," & fileSize
+ Sleep 1
+ DoEvents
+ End If
+ Next
+
+ ' loop around until the file is downloaded
+ Do Until DownloadComplete
+ Sleep 25
+ DoEvents
+ Loop
+ DownloadComplete = False
+
+ ' no longer getting CRC
+ gettingCRC = False
+
+ ' split string
+ serverCRC() = Split(CRCDump, "|")
+ strOffset = 6
+ ' loop through and trim
+ serverCount = UBound(serverCRC)
+ For i = 0 To serverCount
+ serverCRC(i) = Mid$(serverCRC(i), strOffset)
+ Next
+
+ ' check for the update.exe
+ If CheckSingleFile("update.exe") Then
+ SetProgress "Updating updater.", "Downloading now."
+ DownloadFile GAMEURL & "files/bin/update.exe", App.Path & "\bin\update.exe"
+ End If
+
+ ' check for new crystalshire.exe
+ If CheckSingleFile("crystalshire.dat") Then
+ SetProgress "Updating updater.", "Downloading now."
+ DownloadFile GAMEURL & "files/bin/crystalshire.dat", App.Path & "\bin\crystalshire.dat"
+ ' close down and let the update.exe do its work
+ Shell "bin\update.exe", vbNormalFocus
+ End
+ End If
+
+ ' compare file CRCs - make a list of files needed to download
+ For i = 0 To serverCount
+ CompareCRC i
+ Next
+
+ ' update
+ If downloadCount > 0 Then
+ SetProgress "Found updated files.", "Attempting download."
+ Else
+ SetProgress "No updates found.", "Enjoy the game!"
+ frmMain.imgPlay.Visible = True
+ frmMain.imgBar.Width = maxBarWidth
+ Exit Sub
+ End If
+
+ ' start downloading the updated files!
+ SetProgress "Found file update.", "Downloading now."
+ DownloadUpdates
+End Sub
+
+Sub DownloadFile(URL As String, TargetFile As String)
+ ' download it
+ frmMain.NetGrab.DownloadStart URL
+ ' loop around until the file is downloaded
+ Do Until DownloadComplete
+ Sleep 25
+ DoEvents
+ Loop
+ DownloadComplete = False
+ ' save it
+ frmMain.NetGrab.SaveAs TargetFile
+End Sub
+
+Function CheckSingleFile(FileName As String) As Boolean
+Dim updateString() As String, i As Long, clientStr() As String, serverStr() As String, x As Long
+
+ For i = 0 To serverCount
+ If Len(serverCRC(i)) > 0 Then
+ updateString() = Split(serverCRC(i), ",")
+ updateString() = Split(updateString(0), "/")
+ If updateString(UBound(updateString)) = FileName Then
+ ' make sure the file exists
+ serverStr() = Split(serverCRC(i), ",")
+ If Not FileExist(App.Path & serverStr(0)) Then
+ CheckSingleFile = True
+ Exit Function
+ End If
+ ' loop through and find matching client file
+ For x = 0 To clientCount
+ If Len(clientCRC(x)) > 0 Then
+ clientStr() = Split(clientCRC(x), ",")
+ ' compare names
+ If clientStr(0) = serverStr(0) Then
+ ' compare checksums
+ If LCase$(clientStr(1)) <> LCase$(serverStr(1)) Then
+ CheckSingleFile = True
+ Exit Function
+ End If
+ End If
+ End If
+ Next
+ End If
+ End If
+ Next
+
+ CheckSingleFile = False
+End Function
+
+Sub DownloadUpdates()
+Dim i As Long, x As Long, updateString() As String, count As Long, localPath As String, builtPath As String
+ ' Set the string
+ UpdateProgressBar
+
+ ' go through the files needed
+ For i = 1 To downloadCount
+ ' set it downloading
+ frmMain.NetGrab.DownloadStart GAMEURL & "files" & downloadFiles(i)
+ ' make all the directories we need
+ updateString() = Split(downloadFiles(i), "/")
+ count = UBound(updateString)
+ builtPath = vbNullString
+ For x = 1 To count - 1
+ ChkDir App.Path & "\" & builtPath, updateString(x)
+ builtPath = builtPath & updateString(x) & "\"
+ Next
+ ' update
+ SetProgress "Downloading file.", updateString(count)
+ ' update bar
+ UpdateProgressBar
+ ' loop through until the download completes
+ DownloadComplete = False
+ Do While Not DownloadComplete
+ UpdateProgressBar
+ DoEvents
+ Loop
+ ' download complete
+ localPath = Replace$(downloadFiles(i), "/", "\")
+ frmMain.NetGrab.SaveAs App.Path & localPath
+ Next
+
+ ' all downloads complete - max out bar if not already
+ frmMain.imgBar.Width = maxBarWidth
+ frmMain.lblTransfer = "Transfer completed."
+ ' let them know
+ SetProgress "Update complete.", "Enjoy the game!"
+ frmMain.imgPlay.Visible = True
+End Sub
+
+Public Sub ChkDir(ByVal tDir As String, ByVal tName As String)
+ If LCase$(Dir$(tDir & tName, vbDirectory)) <> tName Then Call MkDir(tDir & tName)
+End Sub
+
+Sub UpdateProgressBar()
+Dim percent As Long, progressP As Long, value As Long, sString As String
+ If downloadBytes = 0 Then Exit Sub
+ ' label
+ sString = GetByteString(currentBytes + tempBytes) & "/" & GetByteString(downloadBytes)
+ If frmMain.lblTransfer.Caption <> sString Then frmMain.lblTransfer.Caption = sString
+ ' bar
+ value = ((currentBytes + tempBytes) / downloadBytes) * maxBarWidth
+ With frmMain.imgBar
+ If .Width <> value Then .Width = value
+ End With
+End Sub
+
+Function GetByteString(Bytes As Long) As String
+ If Bytes >= 1000000 Then
+ GetByteString = Format$(Bytes / 1000000, "0.0") & "mB"
+ Else
+ GetByteString = Format$(Bytes / 1000, "0") & "kB"
+ End If
+End Function
+
+Sub CompareCRC(serverIndex As Long)
+Dim clientStr() As String, serverStr() As String, i As Long, updateString() As String, count As Long
+ ' exit out early if the file doesn't exist
+ If Len(serverCRC(serverIndex)) = 0 Then Exit Sub
+ ' find the file path
+ serverStr() = Split(serverCRC(serverIndex), ",")
+ ' make sure the file exists
+ If Not FileExist(App.Path & serverStr(0)) Then
+ AddDownloadQueue serverStr(0), serverStr(2)
+ Exit Sub
+ End If
+ ' update
+ updateString() = Split(serverStr(0), "/")
+ count = UBound(updateString)
+ SetProgress "Comparing CRC32.", updateString(count)
+ ' loop through and find matching client file
+ For i = 0 To clientCount
+ If Len(clientCRC(i)) > 0 Then
+ clientStr() = Split(clientCRC(i), ",")
+ ' compare names
+ If clientStr(0) = serverStr(0) Then
+ ' compare checksums
+ If LCase$(clientStr(1)) <> LCase$(serverStr(1)) Then AddDownloadQueue serverStr(0), serverStr(2)
+ Exit Sub
+ End If
+ End If
+ Next
+End Sub
+
+Sub AddDownloadQueue(FileName As String, Bytes As String)
+Dim index As Long
+ downloadCount = downloadCount + 1
+ ReDim Preserve downloadFiles(1 To downloadCount)
+ index = UBound(downloadFiles)
+ downloadFiles(index) = FileName
+ ' add bytes to the max count
+ downloadBytes = downloadBytes + Val(Bytes)
+End Sub
+
+Function ReadTxtFile(strPath As String) As String
+ On Error GoTo ErrTrap
+ Dim intFileNumber As Integer
+
+ If Dir(strPath) = "" Then Exit Function
+ intFileNumber = FreeFile
+ Open strPath For Input As #intFileNumber
+
+ ReadTxtFile = Input(LOF(intFileNumber), #intFileNumber)
+ErrTrap:
+ Close #intFileNumber
+End Function
+
+Sub SetProgress(string1 As String, string2 As String)
+ frmMain.lblProgress.Caption = string1
+ frmMain.lblProgress2.Caption = string2
+End Sub
+
+Function GetFileCRC(FileName As String, Optional ByRef fileSize As Long = 0) As String
+ Dim cStream As New cBinaryFileStream
+ Dim cCRC32 As New cCRC32
+ Dim lCRC32 As Long
+
+ cStream.File = FileName
+ lCRC32 = cCRC32.GetFileCrc32(cStream)
+ GetFileCRC = Hex(lCRC32)
+ fileSize = cStream.Length
+End Function
+
+Function FindFiles(ByVal sSearchDir As String, ByVal Path As String) As String
+Dim aList() As String
+Dim nDir As Integer
+Dim i As Integer
+Dim s As String
+Dim fn As String
+
+If Right$(Path, 1) <> "\" Then Path = Path & "\"
+
+fn = Dir$(Path & "*.*", vbDirectory)
+While Len(fn)
+ If (fn <> "..") And (fn <> ".") Then
+ If GetAttr(Path & fn) And vbDirectory Then
+ ReDim Preserve aList(nDir)
+ aList(nDir) = fn
+ nDir = nDir + 1
+ Else
+ s = s & Path & fn & ","
+ End If
+ End If
+ fn = Dir$
+Wend
+
+For i = 0 To nDir - 1
+ s = s & FindFiles(aList(i), Path & aList(i) & "\") & ","
+Next i
+FindFiles = s
+Erase aList
+End Function
+
+Public Function FileExist(ByVal FileName As String) As Boolean
+ If LenB(Dir$(FileName)) > 0 Then
+ FileExist = True
+ End If
+End Function
+
+Public Function GetVar(File As String, header As String, Var As String) As String
+ Dim sSpaces As String ' Max string length
+ Dim szReturn As String ' Return default value if not found
+ szReturn = vbNullString
+ sSpaces = Space$(5000)
+ Call GetPrivateProfileString$(header, Var, szReturn, sSpaces, Len(sSpaces), File)
+ GetVar = RTrim$(sSpaces)
+ GetVar = Left$(GetVar, Len(GetVar) - 1)
+End Function
+
+Sub LoadChangeLog()
+Dim FileName As String, i As Long, x As Long
+ FileName = App.Path & "\bin\changelog.ini"
+ If Not FileExist(FileName) Then Exit Sub
+ updateCount = GetVar(FileName, "General", "UpdateCount")
+ ReDim update(1 To updateCount) As UpdateUDT
+ For i = 1 To updateCount
+ update(i).header = GetVar(FileName, "Update" & i, "Header")
+ update(i).lineCount = GetVar(FileName, "Update" & i, "Lines")
+ ReDim update(i).strLine(1 To update(i).lineCount) As String
+ For x = 1 To update(i).lineCount
+ update(i).strLine(x) = GetVar(FileName, "Update" & i, "String" & x)
+ Next
+ Next
+End Sub
+
+Sub ShowUpdate(ByVal updateNum As Long)
+Dim i As Long
+ frmMain.lblChanges.Caption = vbNullString
+ frmMain.lblHeader.Caption = vbNullString
+ If updateNum = 0 Then
+ frmMain.lblHeader.Caption = "Version Unknown"
+ frmMain.lblChanges.Caption = "Cannot find changelog."
+ Exit Sub
+ End If
+ frmMain.lblHeader.Caption = update(updateNum).header
+ For i = 1 To update(updateNum).lineCount
+ frmMain.lblChanges.Caption = frmMain.lblChanges.Caption & update(updateNum).strLine(i) & vbNewLine
+ Next
+ curUpdate = updateNum
+ With frmMain
+ If curUpdate > 1 Then
+ .imgLeft.Visible = True
+ .imgLeft.Left = .lblHeader.Left - 12
+ Else
+ .imgLeft.Visible = False
+ End If
+ If curUpdate < updateCount Then
+ .imgRight.Visible = True
+ .imgRight.Left = .lblHeader.Left + .lblHeader.Width + 5
+ Else
+ .imgRight.Visible = False
+ End If
+ End With
+End Sub
diff --git a/updater/server/crc.php b/updater/server/crc.php
new file mode 100644
index 0000000..8a46bb3
--- /dev/null
+++ b/updater/server/crc.php
@@ -0,0 +1,57 @@
+
\ No newline at end of file
diff --git a/updater/update/src/frmEmpty.frm b/updater/update/src/frmEmpty.frm
new file mode 100644
index 0000000..f0a2174
--- /dev/null
+++ b/updater/update/src/frmEmpty.frm
@@ -0,0 +1,18 @@
+VERSION 5.00
+Begin VB.Form frmEmpty
+ Caption = "Form1"
+ ClientHeight = 3615
+ ClientLeft = 120
+ ClientTop = 450
+ ClientWidth = 4920
+ Icon = "frmEmpty.frx":0000
+ LinkTopic = "Form1"
+ ScaleHeight = 3615
+ ScaleWidth = 4920
+ StartUpPosition = 3 'Windows Default
+End
+Attribute VB_Name = "frmEmpty"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
diff --git a/updater/update/src/frmEmpty.frx b/updater/update/src/frmEmpty.frx
new file mode 100644
index 0000000..a172378
Binary files /dev/null and b/updater/update/src/frmEmpty.frx differ
diff --git a/updater/update/src/modMain.bas b/updater/update/src/modMain.bas
new file mode 100644
index 0000000..1505e11
--- /dev/null
+++ b/updater/update/src/modMain.bas
@@ -0,0 +1,60 @@
+Attribute VB_Name = "modMain"
+Option Explicit
+
+Private filePath As String
+
+Sub Main()
+ ' generate the file path
+ filePath = Replace$(App.Path, "\bin", vbNullString)
+ ' check if there's a new updater
+ If FileExist(App.Path & "\crystalshire.dat") Then
+ ' found the file - delete the normal updater then rename and move this one
+ Do Until Delete(filePath & "\Crystalshire.exe")
+ DoEvents
+ Loop
+ ' copy data file
+ Delete App.Path & "\tmp.dat"
+ Copy App.Path & "\crystalshire.dat", App.Path & "\tmp.dat"
+ ' rename the tmp data file
+ Rename App.Path & "\tmp.dat", App.Path & "\Crystalshire.exe"
+ ' move it and kill the data file
+ Copy App.Path & "\Crystalshire.exe", filePath & "\Crystalshire.exe"
+ Delete App.Path & "\Crystalshire.exe"
+ End If
+ ' load updater and end
+ If FileExist(filePath & "\Crystalshire.exe") Then Shell filePath & "\Crystalshire.exe", vbNormalFocus
+ End
+End Sub
+
+Function Delete(theName As String) As Boolean
+On Error GoTo errorhandler
+ If FileExist(theName) Then Kill theName
+ Delete = True
+ Exit Function
+errorhandler:
+ Delete = False
+End Function
+
+Function Copy(oldName As String, newName As String)
+On Error GoTo errorhandler
+ FileCopy oldName, newName
+ Copy = True
+ Exit Function
+errorhandler:
+ Copy = False
+End Function
+
+Function Rename(oldName As String, newName As String) As Boolean
+On Error GoTo errorhandler
+ Name oldName As newName
+ Rename = True
+ Exit Function
+errorhandler:
+ Rename = False
+End Function
+
+Function FileExist(ByVal FileName As String) As Boolean
+ If LenB(Dir$(FileName)) > 0 Then
+ FileExist = True
+ End If
+End Function
diff --git a/updater/update/update.vbp b/updater/update/update.vbp
new file mode 100644
index 0000000..cf305cb
--- /dev/null
+++ b/updater/update/update.vbp
@@ -0,0 +1,35 @@
+Type=Exe
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
+Module=modMain; src\modMain.bas
+Form=src\frmEmpty.frm
+IconForm="frmEmpty"
+Startup="Sub Main"
+HelpFile=""
+Title="update"
+ExeName32="update.exe"
+Command32=""
+Name="update"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Robin Perris Corp."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+DebugStartupOption=0