486 lines
14 KiB
Plaintext
486 lines
14 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmSoundEdit
|
|
Caption = "Sound Edit"
|
|
ClientHeight = 4995
|
|
ClientLeft = 60
|
|
ClientTop = 345
|
|
ClientWidth = 6180
|
|
Icon = "frmSoundEdit.frx":0000
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
ScaleHeight = 4995
|
|
ScaleWidth = 6180
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.CommandButton cmdDelete
|
|
Caption = "&Delete sound from SOC"
|
|
Height = 495
|
|
Left = 5040
|
|
Style = 1 'Graphical
|
|
TabIndex = 13
|
|
Top = 4320
|
|
Width = 1095
|
|
End
|
|
Begin VB.CommandButton cmdSave
|
|
Caption = "&Save"
|
|
Height = 495
|
|
Left = 3840
|
|
TabIndex = 6
|
|
Top = 4320
|
|
Width = 1095
|
|
End
|
|
Begin VB.CommandButton cmdReload
|
|
Caption = "&Load Code Default"
|
|
Height = 495
|
|
Left = 2640
|
|
Style = 1 'Graphical
|
|
TabIndex = 5
|
|
Top = 4320
|
|
Width = 1095
|
|
End
|
|
Begin VB.Frame frmSpecial
|
|
Caption = "Special Properties"
|
|
Height = 3375
|
|
Left = 2640
|
|
TabIndex = 4
|
|
Top = 840
|
|
Width = 3495
|
|
Begin VB.CheckBox chkTotallySingle
|
|
Caption = "Make sure only one sound of this is playing at a time on any sound channel."
|
|
Height = 615
|
|
Left = 120
|
|
TabIndex = 12
|
|
Tag = "1"
|
|
Top = 2640
|
|
Width = 3255
|
|
End
|
|
Begin VB.CheckBox chkEightEx
|
|
Caption = "Sound can be heard across 8x the distance"
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 10
|
|
Tag = "16"
|
|
Top = 2160
|
|
Width = 2295
|
|
End
|
|
Begin VB.CheckBox chkOutside
|
|
Caption = "Volume dependent on how close you are to outside"
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 9
|
|
Tag = "4"
|
|
Top = 360
|
|
Width = 2295
|
|
End
|
|
Begin VB.CheckBox chkFourEx
|
|
Caption = "Sound can be heard across 4x the distance"
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 8
|
|
Tag = "8"
|
|
Top = 1560
|
|
Width = 2055
|
|
End
|
|
Begin VB.CheckBox chkMultiple
|
|
Caption = "More than one of this sound can be played per object at a time (i.e., thunder)"
|
|
Height = 615
|
|
Left = 120
|
|
TabIndex = 7
|
|
Tag = "2"
|
|
Top = 840
|
|
Width = 2535
|
|
End
|
|
Begin VB.Label Label1
|
|
Caption = "Combine for 32x"
|
|
Height = 495
|
|
Left = 2760
|
|
TabIndex = 11
|
|
Top = 1800
|
|
Width = 615
|
|
End
|
|
Begin VB.Line Line4
|
|
X1 = 2400
|
|
X2 = 2640
|
|
Y1 = 2400
|
|
Y2 = 2400
|
|
End
|
|
Begin VB.Line Line2
|
|
X1 = 2400
|
|
X2 = 2640
|
|
Y1 = 1800
|
|
Y2 = 1800
|
|
End
|
|
Begin VB.Line Line1
|
|
X1 = 2640
|
|
X2 = 2640
|
|
Y1 = 2400
|
|
Y2 = 1800
|
|
End
|
|
End
|
|
Begin VB.ComboBox cmbPriority
|
|
Height = 315
|
|
ItemData = "frmSoundEdit.frx":0442
|
|
Left = 3360
|
|
List = "frmSoundEdit.frx":0444
|
|
TabIndex = 2
|
|
Top = 120
|
|
Width = 855
|
|
End
|
|
Begin VB.CheckBox chkSingularity
|
|
Caption = "Only one can be played at a time per object."
|
|
Height = 255
|
|
Left = 2640
|
|
TabIndex = 1
|
|
Top = 480
|
|
Width = 3495
|
|
End
|
|
Begin VB.ListBox lstSounds
|
|
Height = 4740
|
|
Left = 120
|
|
TabIndex = 0
|
|
Top = 120
|
|
Width = 2415
|
|
End
|
|
Begin VB.Line Line3
|
|
X1 = 0
|
|
X2 = 720
|
|
Y1 = 0
|
|
Y2 = 0
|
|
End
|
|
Begin VB.Label lblPriority
|
|
Alignment = 1 'Right Justify
|
|
Caption = "Priority:"
|
|
Height = 255
|
|
Left = 2640
|
|
TabIndex = 3
|
|
Top = 120
|
|
Width = 615
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmSoundEdit"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Private Sub cmdDelete_Click()
|
|
Call WriteSound(True)
|
|
End Sub
|
|
|
|
Private Sub cmdReload_Click()
|
|
Call ClearForm
|
|
If InStr(lstSounds.List(lstSounds.ListIndex), "(free slot)") = 0 Then
|
|
Call LoadSoundInfo(lstSounds.ListIndex)
|
|
Else
|
|
MsgBox "Free slots do not have a code default."
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub cmdSave_Click()
|
|
Call WriteSound(False)
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
Call Reload
|
|
End Sub
|
|
|
|
Private Sub ClearForm()
|
|
cmbPriority.Text = ""
|
|
chkSingularity.Value = 0
|
|
chkOutside.Value = 0
|
|
chkMultiple.Value = 0
|
|
chkFourEx.Value = 0
|
|
chkEightEx.Value = 0
|
|
chkTotallySingle.Value = 0
|
|
End Sub
|
|
|
|
Private Sub Reload()
|
|
Call ClearForm
|
|
Call LoadCode
|
|
lstSounds.ListIndex = 0
|
|
End Sub
|
|
|
|
Private Sub LoadCode()
|
|
Dim myFSO As New Scripting.FileSystemObject
|
|
Dim ts As TextStream
|
|
Dim line As String
|
|
Dim number As Integer
|
|
Dim startclip As Integer, endclip As Integer
|
|
Dim addstring As String
|
|
Dim i As Integer, numfreeslots As Integer
|
|
|
|
ChDir SourcePath
|
|
Set ts = myFSO.OpenTextFile("sounds.h", ForReading, False)
|
|
|
|
Do While InStr(ts.ReadLine, "List of sounds (don't modify this comment!)") = 0
|
|
Loop
|
|
|
|
ts.SkipLine ' typedef enum
|
|
ts.SkipLine ' {
|
|
|
|
line = ts.ReadLine
|
|
number = 0
|
|
|
|
lstSounds.Clear
|
|
|
|
Do While InStr(line, "sfx_freeslot0") = 0
|
|
startclip = InStr(line, "sfx_")
|
|
If InStr(line, "sfx_") <> 0 Then
|
|
endclip = InStr(line, ",")
|
|
line = Mid(line, startclip, endclip - startclip)
|
|
addstring = number & " - " & line
|
|
lstSounds.AddItem addstring
|
|
number = number + 1
|
|
End If
|
|
line = ts.ReadLine
|
|
Loop
|
|
|
|
ts.Close
|
|
Set myFSO = Nothing
|
|
|
|
'Populate the free slots!
|
|
numfreeslots = 800
|
|
|
|
For i = 1 To numfreeslots
|
|
If i < 10 Then
|
|
addstring = number & " - " & "sfx_fre00" & i & " (free slot)"
|
|
ElseIf i < 100 Then
|
|
addstring = number & " - " & "sfx_fre0" & i & " (free slot)"
|
|
Else
|
|
addstring = number & " - " & "sfx_fre" & i & " (free slot)"
|
|
End If
|
|
lstSounds.AddItem addstring
|
|
number = number + 1
|
|
Next
|
|
|
|
For i = 0 To 127
|
|
cmbPriority.AddItem i
|
|
Next
|
|
End Sub
|
|
|
|
Private Sub lstSounds_Click()
|
|
Call ClearForm
|
|
If InStr(lstSounds.List(lstSounds.ListIndex), "(free slot)") = 0 Then
|
|
Call LoadSoundInfo(lstSounds.ListIndex)
|
|
End If
|
|
Call LoadSOCSoundInfo(lstSounds.ListIndex)
|
|
End Sub
|
|
|
|
Private Sub LoadSOCSoundInfo(SoundNum As Integer)
|
|
Dim myFSO As New Scripting.FileSystemObject
|
|
Dim ts As TextStream
|
|
Dim line As String
|
|
Dim word As String
|
|
Dim word2 As String
|
|
|
|
Set ts = myFSO.OpenTextFile(SOCFile, ForReading, False)
|
|
|
|
SOCLoad:
|
|
Do While Not ts.AtEndOfStream
|
|
line = ts.ReadLine
|
|
|
|
If Left(line, 1) = "#" Then GoTo SOCLoad
|
|
|
|
If Left(line, 1) = vbCrLf Then GoTo SOCLoad
|
|
|
|
If Len(line) < 1 Then GoTo SOCLoad
|
|
|
|
word = FirstToken(line)
|
|
word2 = SecondToken(line)
|
|
|
|
If UCase(word) = "SOUND" And Val(word2) = SoundNum Then
|
|
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
|
line = ts.ReadLine
|
|
word = UCase(FirstToken(line))
|
|
word2 = UCase(SecondTokenEqual(line))
|
|
|
|
If word = "SINGULAR" Then
|
|
If Val(word2) = 1 Then
|
|
chkSingularity.Value = 1
|
|
Else
|
|
chkSingularity.Value = 0
|
|
End If
|
|
ElseIf word = "PRIORITY" Then
|
|
cmbPriority.Text = Val(word2)
|
|
ElseIf word = "FLAGS" Then
|
|
ProcessSoundFlags (Val(word2))
|
|
ElseIf Len(line) > 0 And Left(line, 1) <> "#" Then
|
|
MsgBox "Error in SOC!" & vbCrLf & "Unknown line: " & line
|
|
End If
|
|
Loop
|
|
Exit Do
|
|
End If
|
|
Loop
|
|
|
|
ts.Close
|
|
Set myFSO = Nothing
|
|
End Sub
|
|
|
|
Private Sub LoadSoundInfo(StateNum As Integer)
|
|
Dim myFSO As New Scripting.FileSystemObject
|
|
Dim ts As TextStream
|
|
Dim line As String
|
|
Dim number As Integer
|
|
Dim startclip As Integer, endclip As Integer
|
|
Dim token As String
|
|
Dim frame As Long
|
|
|
|
ChDir SourcePath
|
|
Set ts = myFSO.OpenTextFile("sounds.c", ForReading, False)
|
|
|
|
Do While InStr(ts.ReadLine, "S_sfx[0] needs to be a dummy for odd reasons.") = 0
|
|
Loop
|
|
|
|
number = 0
|
|
|
|
Do While number <> StateNum
|
|
Do While InStr(ts.ReadLine, """") = 0
|
|
Loop
|
|
number = number + 1
|
|
Loop
|
|
|
|
Do While InStr(line, """") = 0
|
|
line = ts.ReadLine
|
|
Loop
|
|
|
|
startclip = InStr(line, """") + 1
|
|
line = Mid(line, startclip, Len(line) - startclip)
|
|
endclip = InStr(line, """") - 1
|
|
token = TrimComplete(Left(line, endclip))
|
|
|
|
'txtName.Text = line
|
|
|
|
startclip = InStr(line, ",") + 1
|
|
line = Mid(line, startclip, Len(line) - startclip)
|
|
endclip = InStr(line, ",") - 1
|
|
token = TrimComplete(Left(line, endclip))
|
|
|
|
If token = "true" Then
|
|
chkSingularity.Value = 1
|
|
Else
|
|
chkSingularity.Value = 0
|
|
End If
|
|
|
|
startclip = InStr(line, ",") + 1
|
|
line = Mid(line, startclip, Len(line) - startclip)
|
|
endclip = InStr(line, ",") - 1
|
|
token = TrimComplete(Left(line, endclip))
|
|
cmbPriority.Text = token
|
|
|
|
startclip = InStr(line, ",") + 1
|
|
line = Mid(line, startclip, Len(line) - startclip)
|
|
endclip = InStr(line, ",") - 1
|
|
token = TrimComplete(Left(line, endclip))
|
|
|
|
ProcessSoundFlags (Val(token))
|
|
|
|
ts.Close
|
|
Set myFSO = Nothing
|
|
End Sub
|
|
|
|
Private Sub ProcessSoundFlags(flags As Long)
|
|
|
|
chkTotallySingle.Value = 0
|
|
chkMultiple.Value = 0
|
|
chkOutside.Value = 0
|
|
chkFourEx.Value = 0
|
|
chkEightEx.Value = 0
|
|
|
|
If flags = -1 Then
|
|
Exit Sub
|
|
End If
|
|
|
|
If flags And 1 Then
|
|
chkTotallySingle.Value = 1
|
|
End If
|
|
|
|
If flags And 2 Then
|
|
chkMultiple.Value = 1
|
|
End If
|
|
|
|
If flags And 4 Then
|
|
chkOutside.Value = 1
|
|
End If
|
|
|
|
If flags And 8 Then
|
|
chkFourEx.Value = 1
|
|
End If
|
|
|
|
If flags And 16 Then
|
|
chkEightEx.Value = 1
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub WriteSound(Remove As Boolean)
|
|
Dim myFSOSource As New Scripting.FileSystemObject
|
|
Dim tsSource As TextStream
|
|
Dim myFSOTarget As New Scripting.FileSystemObject
|
|
Dim tsTarget As TextStream
|
|
Dim line As String
|
|
Dim word As String
|
|
Dim word2 As String
|
|
Dim flags As Long
|
|
Dim soundfound As Boolean
|
|
|
|
soundfound = False
|
|
|
|
Set tsSource = myFSOSource.OpenTextFile(SOCFile, ForReading, False)
|
|
Set tsTarget = myFSOTarget.OpenTextFile(SOCTemp, ForWriting, True)
|
|
|
|
Do While Not tsSource.AtEndOfStream
|
|
line = tsSource.ReadLine
|
|
word = UCase(FirstToken(line))
|
|
word2 = UCase(SecondToken(line))
|
|
|
|
'If the current sound exists in the SOC, delete it.
|
|
If word = "SOUND" And Val(word2) = lstSounds.ListIndex Then
|
|
soundfound = True
|
|
Do While Len(TrimComplete(tsSource.ReadLine)) > 0 And Not (tsSource.AtEndOfStream)
|
|
Loop
|
|
Else
|
|
tsTarget.WriteLine line
|
|
End If
|
|
Loop
|
|
|
|
tsSource.Close
|
|
Set myFSOSource = Nothing
|
|
|
|
If Remove = False Then
|
|
If line <> "" Then tsTarget.WriteLine ""
|
|
|
|
tsTarget.WriteLine "SOUND " & lstSounds.ListIndex
|
|
cmbPriority.Text = TrimComplete(cmbPriority.Text)
|
|
If cmbPriority.Text <> "" Then tsTarget.WriteLine "PRIORITY = " & Val(cmbPriority.Text)
|
|
If chkSingularity.Value = 1 Then tsTarget.WriteLine "SINGULAR = 1"
|
|
|
|
flags = 0
|
|
|
|
If chkOutside.Value = 1 Then flags = flags + Val(chkOutside.Tag)
|
|
If chkMultiple.Value = 1 Then flags = flags + Val(chkMultiple.Tag)
|
|
If chkFourEx.Value = 1 Then flags = flags + Val(chkFourEx.Tag)
|
|
If chkEightEx.Value = 1 Then flags = flags + Val(chkEightEx.Tag)
|
|
If chkTotallySingle.Value = 1 Then flags = flags + Val(chkTotallySingle.Tag)
|
|
|
|
If flags > 0 Then tsTarget.WriteLine "FLAGS = " & flags
|
|
End If
|
|
|
|
tsTarget.Close
|
|
Set myFSOTarget = Nothing
|
|
|
|
FileCopy SOCTemp, SOCFile
|
|
|
|
Kill SOCTemp
|
|
|
|
If Remove = True Then
|
|
If soundfound = True Then
|
|
MsgBox "Sound removed from SOC."
|
|
Else
|
|
MsgBox "Sound not found in SOC."
|
|
End If
|
|
Else
|
|
MsgBox "Sound Saved."
|
|
End If
|
|
End Sub
|
|
|