Initial commit: ROW Client source code
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,497 @@
|
||||
VERSION 5.00
|
||||
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
||||
Begin VB.Form DS3DPositionForm
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "DS 3D Positioning"
|
||||
ClientHeight = 5565
|
||||
ClientLeft = 930
|
||||
ClientTop = 330
|
||||
ClientWidth = 5055
|
||||
Icon = "Sound3D.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 5565
|
||||
ScaleWidth = 5055
|
||||
Begin VB.Timer tmrUpdate
|
||||
Interval = 50
|
||||
Left = 4260
|
||||
Top = 2100
|
||||
End
|
||||
Begin MSComDlg.CommonDialog cdlFile
|
||||
Left = 3780
|
||||
Top = 2040
|
||||
_ExtentX = 847
|
||||
_ExtentY = 847
|
||||
_Version = 393216
|
||||
End
|
||||
Begin VB.PictureBox picDraw
|
||||
BackColor = &H00FFFFFF&
|
||||
FillStyle = 7 'Diagonal Cross
|
||||
Height = 2775
|
||||
Left = 120
|
||||
ScaleHeight = 181
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 317
|
||||
TabIndex = 7
|
||||
TabStop = 0 'False
|
||||
Top = 2640
|
||||
Width = 4815
|
||||
End
|
||||
Begin VB.PictureBox picContainer
|
||||
Height = 1755
|
||||
Index = 0
|
||||
Left = 120
|
||||
ScaleHeight = 1695
|
||||
ScaleWidth = 4755
|
||||
TabIndex = 10
|
||||
TabStop = 0 'False
|
||||
Top = 120
|
||||
Width = 4815
|
||||
Begin VB.TextBox txtSound
|
||||
BackColor = &H8000000F&
|
||||
Height = 315
|
||||
Left = 960
|
||||
Locked = -1 'True
|
||||
TabIndex = 13
|
||||
Top = 120
|
||||
Width = 3735
|
||||
End
|
||||
Begin VB.CommandButton cmdSound
|
||||
Caption = "Sound..."
|
||||
Enabled = 0 'False
|
||||
Height = 315
|
||||
Left = 60
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdPlay
|
||||
Caption = "Play"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 1200
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdPause
|
||||
Caption = "Pause"
|
||||
Height = 375
|
||||
Left = 1020
|
||||
TabIndex = 4
|
||||
Top = 1200
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdStop
|
||||
Caption = "Stop"
|
||||
Height = 375
|
||||
Left = 1920
|
||||
TabIndex = 5
|
||||
Top = 1200
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.CheckBox chLoop
|
||||
Caption = "Loop Play"
|
||||
Height = 315
|
||||
Left = 2760
|
||||
TabIndex = 6
|
||||
Top = 1260
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.HScrollBar scrlVol
|
||||
Height = 255
|
||||
LargeChange = 20
|
||||
Left = 840
|
||||
Max = 0
|
||||
Min = -3000
|
||||
SmallChange = 500
|
||||
TabIndex = 1
|
||||
Top = 540
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.HScrollBar scrlAngle
|
||||
Height = 255
|
||||
LargeChange = 20
|
||||
Left = 840
|
||||
Max = 360
|
||||
Min = -360
|
||||
SmallChange = 10
|
||||
TabIndex = 2
|
||||
Top = 840
|
||||
Value = -90
|
||||
Width = 3855
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Volume"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 12
|
||||
Top = 600
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Direction"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 900
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Begin VB.Label Label5
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Click and drag the red triangle around with the left mouse button to change the sound position."
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 2160
|
||||
Width = 4755
|
||||
End
|
||||
Begin VB.Label Label4
|
||||
BackStyle = 0 'Transparent
|
||||
Caption = "Sound Positions"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 8.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 8
|
||||
Top = 1920
|
||||
Width = 1575
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "DS3DPositionForm"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
'
|
||||
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
||||
'
|
||||
' File: Sound3d.frm
|
||||
'
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
'API declare for windows folder
|
||||
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
|
||||
|
||||
Dim dx As New DirectX8 'Our DirectX object
|
||||
Dim ds As DirectSound8 'Our DirectSound object
|
||||
Dim dsBuffer As DirectSoundSecondaryBuffer8 'Our SoundBuffer
|
||||
Dim ds3dBuffer As DirectSound3DBuffer8 'We need to get a 3DSoundBuffer
|
||||
Dim oPos As D3DVECTOR 'Position
|
||||
Dim fMouseDown As Boolean 'Is the mouse down?
|
||||
|
||||
Private Sub cmdSound_Click()
|
||||
|
||||
Static sCurDir As String
|
||||
Static lFilter As Long
|
||||
Dim dsBuf As DSBUFFERDESC
|
||||
|
||||
'Now we should load a wave file
|
||||
'Ask them for a file to load
|
||||
With cdlFile
|
||||
.flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
|
||||
.FilterIndex = lFilter
|
||||
.Filter = "Wave Files (*.wav)|*.wav"
|
||||
.FileName = vbNullString
|
||||
If sCurDir = vbNullString Then
|
||||
'Set the init folder to \windows\media if it exists. If not, set it to the \windows folder
|
||||
Dim sWindir As String
|
||||
sWindir = Space$(255)
|
||||
If GetWindowsDirectory(sWindir, 255) = 0 Then
|
||||
'We couldn't get the windows folder for some reason, use the c:\
|
||||
.InitDir = "C:\"
|
||||
Else
|
||||
Dim sMedia As String
|
||||
sWindir = Left$(sWindir, InStr(sWindir, Chr$(0)) - 1)
|
||||
If Right$(sWindir, 1) = "\" Then
|
||||
sMedia = sWindir & "Media"
|
||||
Else
|
||||
sMedia = sWindir & "\Media"
|
||||
End If
|
||||
If Dir$(sMedia, vbDirectory) <> vbNullString Then
|
||||
.InitDir = sMedia
|
||||
Else
|
||||
.InitDir = sWindir
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
.InitDir = sCurDir
|
||||
End If
|
||||
.ShowOpen ' Display the Open dialog box
|
||||
If .FileName = vbNullString Then
|
||||
Exit Sub 'We didn't click anything exit
|
||||
End If
|
||||
'Save the current information
|
||||
sCurDir = GetFolder(.FileName)
|
||||
lFilter = .FilterIndex
|
||||
|
||||
'Save the filename for later use
|
||||
If Not (dsBuffer Is Nothing) Then dsBuffer.Stop
|
||||
Set dsBuffer = Nothing
|
||||
txtSound.Text = vbNullString
|
||||
dsBuf.lFlags = DSBCAPS_CTRL3D Or DSBCAPS_CTRLVOLUME
|
||||
'Before we load the 3D dialog check to see if this is a mono file
|
||||
On Error Resume Next
|
||||
Set dsBuffer = ds.CreateSoundBufferFromFile(.FileName, dsBuf)
|
||||
If Err Then
|
||||
'First check to see if this is a stereo wav file
|
||||
If (dsBuf.fxFormat.nChannels > 1) And (Err.Number = 5) Then 'Yup
|
||||
MsgBox "You must load a mono wave file to control 3D sound. Stereo wave files are not supported.", vbOKOnly Or vbInformation, "Couldn't load"
|
||||
Else
|
||||
MsgBox "Could not load this wave file." & vbCrLf & "Format is not supported.", vbOKOnly Or vbInformation, "Couldn't load"
|
||||
End If
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'Now we need to get the 3D virtualization params
|
||||
Dim f3DParams As New frm3DAlg
|
||||
|
||||
f3DParams.Show vbModal, Me
|
||||
If f3DParams.OKHit Then
|
||||
If f3DParams.optFull Then dsBuf.guid3DAlgorithm = GUID_DS3DALG_HRTF_FULL
|
||||
If f3DParams.optHalf Then dsBuf.guid3DAlgorithm = GUID_DS3DALG_HRTF_LIGHT
|
||||
If f3DParams.optNone Then dsBuf.guid3DAlgorithm = GUID_DS3DALG_NO_VIRTUALIZATION
|
||||
Else
|
||||
Set dsBuffer = Nothing
|
||||
Exit Sub
|
||||
End If
|
||||
On Error Resume Next
|
||||
Set dsBuffer = ds.CreateSoundBufferFromFile(.FileName, dsBuf)
|
||||
If Err Then
|
||||
MsgBox "Could not create the sound buffer.", vbOKOnly Or vbInformation, "Couldn't load"
|
||||
Exit Sub
|
||||
End If
|
||||
txtSound.Text = .FileName
|
||||
EnablePlayUI True
|
||||
Set ds3dBuffer = dsBuffer.GetDirectSound3DBuffer
|
||||
ds3dBuffer.SetConeAngles DS3D_MINCONEANGLE, 100, DS3D_IMMEDIATE
|
||||
ds3dBuffer.SetConeOutsideVolume -400, DS3D_IMMEDIATE
|
||||
' position our sound
|
||||
ds3dBuffer.SetPosition oPos.x / 50, 0, oPos.z / 50, DS3D_IMMEDIATE
|
||||
'Update the volume
|
||||
scrlVol_Change
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
|
||||
|
||||
On Local Error Resume Next
|
||||
Set ds = dx.DirectSoundCreate(vbNullString) 'Create a default DirectSound object
|
||||
'We couldn't create the DSound object. End the app now
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox "Could not initialize DirectSound." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
|
||||
Unload Me
|
||||
End
|
||||
End If
|
||||
'Set the coop level
|
||||
ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
|
||||
|
||||
'Show the form
|
||||
Me.Show
|
||||
oPos.x = 0: oPos.z = 5
|
||||
'- Make sure we pickup the correct volume and orientation
|
||||
scrlAngle_Change
|
||||
scrlVol_Change
|
||||
|
||||
DrawPositions
|
||||
EnablePlayUI True
|
||||
cmdPlay.Enabled = False
|
||||
cmdSound.SetFocus
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPlay_Click()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
|
||||
'Play plays the sound from the current position
|
||||
'if the sound was paused using the stop command
|
||||
'then play will begin where it last left off
|
||||
dsBuffer.Play chLoop.Value 'Checked = 1 (looping), Unchecked = 0 (Default)
|
||||
EnablePlayUI False
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStop_Click()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
|
||||
dsBuffer.Stop
|
||||
dsBuffer.SetCurrentPosition 0 'Reset the position since Stop doesn't
|
||||
EnablePlayUI True
|
||||
End Sub
|
||||
|
||||
Private Sub cmdPause_Click()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
dsBuffer.Stop 'Stop doesn't reset the position
|
||||
End Sub
|
||||
|
||||
'They've changed the volume. Update it
|
||||
Private Sub scrlVol_Change()
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
dsBuffer.SetVolume scrlVol.Value
|
||||
End Sub
|
||||
|
||||
Private Sub scrlVol_Scroll()
|
||||
scrlVol_Change
|
||||
End Sub
|
||||
|
||||
'They've changed the angle. Update it
|
||||
Private Sub scrlAngle_Change()
|
||||
|
||||
'We need to calculate a vector of what direction the sound is traveling in.
|
||||
Dim x As Single
|
||||
Dim z As Single
|
||||
'we take the current angle in degrees convert to radians
|
||||
'and get the cos or sin to find the direction from an angle
|
||||
x = 5 * Cos(3.141 * scrlAngle.Value / 180)
|
||||
z = 5 * Sin(3.141 * scrlAngle.Value / 180)
|
||||
|
||||
'Update the UI
|
||||
DrawPositions
|
||||
If dsBuffer Is Nothing Then Exit Sub
|
||||
ds3dBuffer.SetConeOrientation x, 0, z, DS3D_IMMEDIATE
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub scrlAngle_Scroll()
|
||||
scrlAngle_Change
|
||||
End Sub
|
||||
|
||||
Sub UpdatePosition(x As Single, z As Single)
|
||||
On Error Resume Next
|
||||
oPos.x = x - picDraw.ScaleWidth / 2
|
||||
oPos.z = z - picDraw.ScaleHeight / 2
|
||||
|
||||
DrawPositions
|
||||
|
||||
'the zero at the end indicates we want the postion updated immediately
|
||||
If ds3dBuffer Is Nothing Then Exit Sub
|
||||
|
||||
ds3dBuffer.SetPosition oPos.x / 50, 0, oPos.z / 50, DS3D_IMMEDIATE
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, x As Single, z As Single)
|
||||
On Error Resume Next
|
||||
If Button = vbLeftButton Then
|
||||
UpdatePosition x, z
|
||||
fMouseDown = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, x As Single, z As Single)
|
||||
On Error Resume Next
|
||||
If Not fMouseDown Then Exit Sub
|
||||
If Button = vbLeftButton Then
|
||||
'Only update the position if it is outside of the box
|
||||
If x < 0 Or z < 0 Or x > picDraw.ScaleWidth Or z > picDraw.ScaleHeight Then Exit Sub
|
||||
UpdatePosition x, z
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
|
||||
On Error Resume Next
|
||||
fMouseDown = False
|
||||
End Sub
|
||||
|
||||
Private Sub picDraw_Paint()
|
||||
DrawPositions
|
||||
End Sub
|
||||
|
||||
Sub DrawPositions()
|
||||
Dim x As Integer
|
||||
Dim z As Integer
|
||||
|
||||
picDraw.Cls
|
||||
|
||||
'listener is in center and is black
|
||||
DrawTriangle 0, picDraw.ScaleWidth / 2, picDraw.ScaleHeight / 2, 90
|
||||
|
||||
'draw sound as RED
|
||||
x = CInt(oPos.x) + picDraw.ScaleWidth / 2
|
||||
z = CInt(oPos.z) + picDraw.ScaleHeight / 2
|
||||
DrawTriangle RGB(256, 0, 0), x, z, scrlAngle.Value
|
||||
|
||||
End Sub
|
||||
|
||||
'Draw a triangle representing where we are
|
||||
Sub DrawTriangle(col As Long, x As Integer, z As Integer, ByVal a As Single)
|
||||
|
||||
Dim x1 As Integer
|
||||
Dim z1 As Integer
|
||||
Dim x2 As Integer
|
||||
Dim z2 As Integer
|
||||
Dim x3 As Integer
|
||||
Dim z3 As Integer
|
||||
|
||||
a = 3.141 * (a - 90) / 180
|
||||
Dim q As Integer
|
||||
q = 10
|
||||
|
||||
x1 = q * Sin(a) + x
|
||||
z1 = q * Cos(a) + z
|
||||
|
||||
x2 = q * Sin(a + 3.141 / 1.3) + x
|
||||
z2 = q * Cos(a + 3.141 / 1.3) + z
|
||||
|
||||
x3 = q * Sin(a - 3.141 / 1.3) + x
|
||||
z3 = q * Cos(a - 3.141 / 1.3) + z
|
||||
|
||||
picDraw.Line (x1, z1)-(x2, z2), col
|
||||
picDraw.Line (x1, z1)-(x3, z3), col
|
||||
picDraw.Line (x2, z2)-(x3, z3), col
|
||||
End Sub
|
||||
|
||||
Private Function GetFolder(ByVal sFile As String) As String
|
||||
Dim lCount As Long
|
||||
|
||||
For lCount = Len(sFile) To 1 Step -1
|
||||
If Mid$(sFile, lCount, 1) = "\" Then
|
||||
GetFolder = Left$(sFile, lCount)
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
GetFolder = vbNullString
|
||||
End Function
|
||||
|
||||
Private Sub EnablePlayUI(ByVal fEnable As Boolean)
|
||||
On Error Resume Next
|
||||
If fEnable Then
|
||||
chLoop.Enabled = True
|
||||
cmdPlay.Enabled = True
|
||||
cmdPause.Enabled = False
|
||||
cmdStop.Enabled = False
|
||||
cmdSound.Enabled = True
|
||||
cmdPlay.SetFocus
|
||||
Else
|
||||
chLoop.Enabled = False
|
||||
cmdPlay.Enabled = False
|
||||
cmdStop.Enabled = True
|
||||
cmdPause.Enabled = True
|
||||
cmdSound.Enabled = False
|
||||
cmdStop.SetFocus
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub tmrUpdate_Timer()
|
||||
If Not (dsBuffer Is Nothing) Then
|
||||
If (dsBuffer.GetStatus And DSBSTATUS_PLAYING) <> DSBSTATUS_PLAYING Then
|
||||
If cmdPlay.Enabled = False Then
|
||||
EnablePlayUI True
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Reference in New Issue
Block a user