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