mirror of
https://git.do.srb2.org/STJr/SOCEdit.git
synced 2024-11-12 23:44:10 +00:00
Initial commit.
This commit is contained in:
Ronald Kinard
commit
b22f71b2dd
28 changed files with 8376 additions and 0 deletions
96
Global.bas
Normal file
96
Global.bas
Normal file
|
|
@ -0,0 +1,96 @@
|
|||
Attribute VB_Name = "Module1"
|
||||
Option Explicit
|
||||
Public SOCFile As String
|
||||
Public SOCTemp As String
|
||||
Public SourcePath As String
|
||||
|
||||
Public Function FirstToken(ByVal line As String)
|
||||
Dim index As Integer
|
||||
|
||||
index = InStr(line, " ") - 1
|
||||
|
||||
If index < 1 Then
|
||||
index = Len(line)
|
||||
End If
|
||||
|
||||
FirstToken = TrimComplete(Left(line, index))
|
||||
End Function
|
||||
|
||||
Public Function SecondToken(ByVal line As String)
|
||||
Dim startclip As Integer
|
||||
Dim endclip As Integer
|
||||
|
||||
startclip = InStr(line, " ")
|
||||
|
||||
startclip = startclip + 1
|
||||
|
||||
SecondToken = TrimComplete(Mid(line, startclip, Len(line)))
|
||||
End Function
|
||||
|
||||
Public Function SecondTokenEqual(ByVal line As String)
|
||||
Dim startclip As Integer
|
||||
Dim endclip As Integer
|
||||
|
||||
startclip = InStr(line, "=")
|
||||
|
||||
startclip = startclip + 2
|
||||
|
||||
line = Mid(line, startclip, Len(line))
|
||||
|
||||
SecondTokenEqual = TrimComplete(line)
|
||||
End Function
|
||||
|
||||
Public Function TrimComplete(ByVal sValue As String) As String
|
||||
Dim sAns As String
|
||||
Dim sWkg As String
|
||||
Dim sChar As String
|
||||
Dim lLen As Long
|
||||
Dim lCtr As Long
|
||||
|
||||
sAns = sValue
|
||||
lLen = Len(sValue)
|
||||
|
||||
If lLen > 0 Then
|
||||
'Ltrim
|
||||
For lCtr = 1 To lLen
|
||||
sChar = Mid(sAns, lCtr, 1)
|
||||
If Asc(sChar) > 32 Then Exit For
|
||||
Next
|
||||
|
||||
sAns = Mid(sAns, lCtr)
|
||||
lLen = Len(sAns)
|
||||
|
||||
'Rtrim
|
||||
If lLen > 0 Then
|
||||
For lCtr = lLen To 1 Step -1
|
||||
sChar = Mid(sAns, lCtr, 1)
|
||||
If Asc(sChar) > 32 Then Exit For
|
||||
Next
|
||||
End If
|
||||
sAns = Left$(sAns, lCtr)
|
||||
End If
|
||||
|
||||
TrimComplete = sAns
|
||||
End Function
|
||||
|
||||
Public Function RTrimComplete(ByVal sValue As String) As String
|
||||
Dim sAns As String
|
||||
Dim sWkg As String
|
||||
Dim sChar As String
|
||||
Dim lLen As Long
|
||||
Dim lCtr As Long
|
||||
|
||||
sAns = sValue
|
||||
lLen = Len(sValue)
|
||||
|
||||
'Rtrim
|
||||
If lLen > 0 Then
|
||||
For lCtr = lLen To 1 Step -1
|
||||
sChar = Mid(sAns, lCtr, 1)
|
||||
If Asc(sChar) > 32 Then Exit For
|
||||
Next
|
||||
End If
|
||||
sAns = Left$(sAns, lCtr)
|
||||
|
||||
RTrimComplete = sAns
|
||||
End Function
|
||||
7
README.md
Normal file
7
README.md
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
# SRB2 SOC Editor
|
||||
|
||||
## License
|
||||
|
||||
Copyright (C) Sonic Team Junior, 2015
|
||||
|
||||
This code is made available under the terms of the GNU General Public License, version 2. You can see a copy of that [here](http://www.gnu.org/licenses/gpl-2.0.html).
|
||||
53
SOCEdit.vbp
Normal file
53
SOCEdit.vbp
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\WINNT\system32\stdole2.tlb#OLE Automation
|
||||
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#..\..\..\WINNT\system32\scrrun.dll#Microsoft Scripting Runtime
|
||||
Form=Things.frm
|
||||
Module=Module1; Global.bas
|
||||
Form=frmStateEdit.frm
|
||||
Form=frmLevelHeader.frm
|
||||
Form=frmHub.frm
|
||||
Form=frmMaincfg.frm
|
||||
Form=frmUnlockablesEdit.frm
|
||||
Form=frmEmblemEdit.frm
|
||||
Form=frmSoundEdit.frm
|
||||
Form=frmCharacterEdit.frm
|
||||
Form=frmCutsceneEdit.frm
|
||||
Form=frmHelp.frm
|
||||
Form=frmHUDEdit.frm
|
||||
IconForm="frmThingEdit"
|
||||
Startup="frmHub"
|
||||
HelpFile=""
|
||||
Title="SOC Editor"
|
||||
ExeName32="SOCEdit.exe"
|
||||
Path32="..\..\..\srb2demo2\SOCEdit"
|
||||
Command32=""
|
||||
Name="SOCEditor"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=0
|
||||
MinorVer=7
|
||||
RevisionVer=7
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionComments="http://www.srb2.org/"
|
||||
VersionCompanyName="Sonic Team Junior"
|
||||
VersionFileDescription="For SRB2 v1.09.4"
|
||||
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
|
||||
|
||||
[MS Transaction Server]
|
||||
AutoRefresh=1
|
||||
1895
Things.frm
Normal file
1895
Things.frm
Normal file
File diff suppressed because it is too large
Load diff
BIN
Things.frx
Normal file
BIN
Things.frx
Normal file
Binary file not shown.
320
frmCharacterEdit.frm
Normal file
320
frmCharacterEdit.frm
Normal file
|
|
@ -0,0 +1,320 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmCharacterEdit
|
||||
Caption = "Character Edit"
|
||||
ClientHeight = 3345
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4680
|
||||
Icon = "frmCharacterEdit.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 3345
|
||||
ScaleWidth = 4680
|
||||
Begin VB.CommandButton cmdExample
|
||||
Caption = "Show Me An &Example"
|
||||
Height = 495
|
||||
Left = 1320
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 14
|
||||
Top = 2400
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CheckBox chkEnabled
|
||||
Caption = "Enable this player selection."
|
||||
Height = 495
|
||||
Left = 1080
|
||||
TabIndex = 13
|
||||
Top = 1560
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.CommandButton cmdDelete
|
||||
Caption = "&Delete from SOC"
|
||||
Height = 495
|
||||
Left = 120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 12
|
||||
Top = 2760
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 2160
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.TextBox txtSkinname
|
||||
Height = 285
|
||||
Left = 3240
|
||||
TabIndex = 9
|
||||
Top = 1200
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtPicname
|
||||
Height = 285
|
||||
Left = 3240
|
||||
MaxLength = 8
|
||||
TabIndex = 7
|
||||
Top = 840
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.TextBox txtMenuposition
|
||||
Height = 285
|
||||
Left = 3240
|
||||
MaxLength = 3
|
||||
TabIndex = 5
|
||||
Top = 480
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtPlayername
|
||||
Height = 285
|
||||
Left = 3240
|
||||
MaxLength = 64
|
||||
TabIndex = 3
|
||||
Top = 120
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtPlayertext
|
||||
Height = 1455
|
||||
Left = 2640
|
||||
MultiLine = -1 'True
|
||||
TabIndex = 1
|
||||
Top = 1800
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.ListBox lstPlayers
|
||||
Height = 1815
|
||||
ItemData = "frmCharacterEdit.frx":0442
|
||||
Left = 120
|
||||
List = "frmCharacterEdit.frx":0461
|
||||
TabIndex = 0
|
||||
Top = 240
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.Label lblSkinname
|
||||
Caption = "Name of player (skin) to use:"
|
||||
Height = 255
|
||||
Left = 1080
|
||||
TabIndex = 10
|
||||
Top = 1200
|
||||
Width = 2055
|
||||
End
|
||||
Begin VB.Label lblPicname
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Picture to display:"
|
||||
Height = 255
|
||||
Left = 1560
|
||||
TabIndex = 8
|
||||
Top = 840
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.Label lblMenuposition
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Vertical menu position:"
|
||||
Height = 255
|
||||
Left = 1320
|
||||
TabIndex = 6
|
||||
Top = 480
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.Label lblPlayername
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Displayed name of player:"
|
||||
Height = 255
|
||||
Left = 1320
|
||||
TabIndex = 4
|
||||
Top = 120
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.Label lblPlayertext
|
||||
Caption = "Short Description:"
|
||||
Height = 255
|
||||
Left = 2640
|
||||
TabIndex = 2
|
||||
Top = 1560
|
||||
Width = 1455
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmCharacterEdit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdDelete_Click()
|
||||
Call WriteCharacter(True)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdExample_Click()
|
||||
txtPlayername.Text = "SONIC"
|
||||
txtMenuposition.Text = "20"
|
||||
txtPicname.Text = "SONCCHAR"
|
||||
txtSkinname.Text = "SONIC"
|
||||
chkEnabled.Value = 1
|
||||
txtPlayertext.Text = " Fastest" & vbCrLf & " Speed Thok" & vbCrLf & " Not a good pick" & vbCrLf & "for starters, but when" & vbCrLf & "controlled properly," & vbCrLf & "Sonic is the most" & vbCrLf & "powerful of the three."
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
Call WriteCharacter(False)
|
||||
End Sub
|
||||
|
||||
Private Sub ClearForm()
|
||||
txtPlayername.Text = ""
|
||||
txtMenuposition.Text = ""
|
||||
txtPicname.Text = ""
|
||||
txtSkinname.Text = ""
|
||||
chkEnabled.Value = 0
|
||||
txtPlayertext.Text = ""
|
||||
End Sub
|
||||
|
||||
Private Sub ReadSOCPlayer(num 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) = "CHARACTER" And Val(word2) = num Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "PLAYERTEXT" Then
|
||||
Dim startclip As Integer, endclip As Integer
|
||||
startclip = InStr(line, "=")
|
||||
|
||||
startclip = startclip + 2
|
||||
|
||||
line = Mid(line, startclip, Len(line))
|
||||
|
||||
txtPlayertext.Text = line & vbCrLf
|
||||
|
||||
Do While InStr(line, "#") = 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine & vbCrLf
|
||||
txtPlayertext.Text = txtPlayertext.Text & line
|
||||
Loop
|
||||
|
||||
txtPlayertext.Text = RTrimComplete(txtPlayertext.Text)
|
||||
If Right(txtPlayertext.Text, 1) = "#" Then
|
||||
txtPlayertext.Text = Left(txtPlayertext.Text, Len(txtPlayertext.Text) - 1)
|
||||
End If
|
||||
ElseIf word = "PLAYERNAME" Then
|
||||
txtPlayername.Text = word2
|
||||
ElseIf word = "MENUPOSITION" Then
|
||||
txtMenuposition.Text = Val(word2)
|
||||
ElseIf word = "PICNAME" Then
|
||||
txtPicname.Text = word2
|
||||
ElseIf word = "STATUS" Then
|
||||
If Val(word2) = 32 Then
|
||||
chkEnabled.Value = 1
|
||||
Else
|
||||
chkEnabled.Value = 0
|
||||
End If
|
||||
ElseIf word = "SKINNAME" Then
|
||||
txtSkinname.Text = 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 lstPlayers_Click()
|
||||
Call ClearForm
|
||||
Call ReadSOCPlayer(lstPlayers.ListIndex)
|
||||
End Sub
|
||||
|
||||
Private Sub WriteCharacter(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 charfound As Boolean
|
||||
|
||||
charfound = 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 character exists in the SOC, delete it.
|
||||
If word = "CHARACTER" And Val(word2) = lstPlayers.ListIndex Then
|
||||
charfound = 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 "CHARACTER " & lstPlayers.ListIndex
|
||||
txtPlayername.Text = TrimComplete(txtPlayername.Text)
|
||||
txtMenuposition.Text = TrimComplete(txtMenuposition.Text)
|
||||
txtPicname.Text = TrimComplete(txtPicname.Text)
|
||||
txtSkinname.Text = TrimComplete(txtSkinname.Text)
|
||||
If txtPlayername.Text <> "" Then tsTarget.WriteLine "PLAYERNAME = " & txtPlayername.Text
|
||||
If txtMenuposition.Text <> "" Then tsTarget.WriteLine "MENUPOSITION = " & Val(txtMenuposition.Text)
|
||||
If txtPicname.Text <> "" Then tsTarget.WriteLine "PICNAME = " & txtPicname.Text
|
||||
If txtSkinname.Text <> "" Then tsTarget.WriteLine "SKINNAME = " & txtSkinname.Text
|
||||
If chkEnabled.Value = 1 Then
|
||||
tsTarget.WriteLine "STATUS = 32"
|
||||
Else
|
||||
tsTarget.WriteLine "STATUS = 0"
|
||||
End If
|
||||
If txtPlayertext.Text <> "" Then tsTarget.WriteLine "PLAYERTEXT = " & txtPlayertext.Text & "#"
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
If charfound = True Then
|
||||
MsgBox "Player choice removed from SOC."
|
||||
Else
|
||||
MsgBox "Player choice not found in SOC."
|
||||
End If
|
||||
Else
|
||||
MsgBox "Character Saved."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
BIN
frmCharacterEdit.frx
Normal file
BIN
frmCharacterEdit.frx
Normal file
Binary file not shown.
1365
frmCutsceneEdit.frm
Normal file
1365
frmCutsceneEdit.frm
Normal file
File diff suppressed because it is too large
Load diff
BIN
frmCutsceneEdit.frx
Normal file
BIN
frmCutsceneEdit.frx
Normal file
Binary file not shown.
384
frmEmblemEdit.frm
Normal file
384
frmEmblemEdit.frm
Normal file
|
|
@ -0,0 +1,384 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmEmblemEdit
|
||||
Caption = "Emblem Edit"
|
||||
ClientHeight = 2865
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5160
|
||||
Icon = "frmEmblemEdit.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 2865
|
||||
ScaleWidth = 5160
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CommandButton cmdDelete
|
||||
Caption = "&Delete Last Emblem"
|
||||
Height = 735
|
||||
Left = 1560
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 17
|
||||
Top = 600
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdAdd
|
||||
Caption = "&Add"
|
||||
Height = 375
|
||||
Left = 1560
|
||||
TabIndex = 16
|
||||
Top = 120
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save Emblem"
|
||||
Height = 495
|
||||
Left = 4200
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 13
|
||||
Top = 2280
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CommandButton cmdReload
|
||||
Caption = "&Reload"
|
||||
Height = 495
|
||||
Left = 3120
|
||||
TabIndex = 12
|
||||
Top = 2280
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.TextBox txtPlayernum
|
||||
Height = 285
|
||||
Left = 4320
|
||||
MaxLength = 3
|
||||
TabIndex = 9
|
||||
Top = 1800
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.TextBox txtMapnum
|
||||
Height = 285
|
||||
Left = 4320
|
||||
MaxLength = 4
|
||||
TabIndex = 7
|
||||
Top = 1320
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.TextBox txtZ
|
||||
Height = 285
|
||||
Left = 4320
|
||||
MaxLength = 5
|
||||
TabIndex = 3
|
||||
Top = 960
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.TextBox txtY
|
||||
Height = 285
|
||||
Left = 4320
|
||||
MaxLength = 5
|
||||
TabIndex = 2
|
||||
Top = 600
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.TextBox txtX
|
||||
Height = 285
|
||||
Left = 4320
|
||||
MaxLength = 5
|
||||
TabIndex = 1
|
||||
Top = 240
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.ListBox lstEmblems
|
||||
Height = 2400
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Caption = "Emblem #s must be linear, sorry!"
|
||||
Height = 495
|
||||
Left = 1560
|
||||
TabIndex = 18
|
||||
Top = 2400
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.Label lblNumEmblems
|
||||
Caption = "# of Emblems:"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 15
|
||||
Top = 2520
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblNote2
|
||||
Caption = "Don't forget to set Game Data file and # of Emblems in Global Game Settings!"
|
||||
Height = 855
|
||||
Left = 1560
|
||||
TabIndex = 14
|
||||
Top = 1440
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.Label lblNote
|
||||
Appearance = 0 'Flat
|
||||
BorderStyle = 1 'Fixed Single
|
||||
Caption = "Note: Enter map coordinates, not game coordinates. (I.e., 128, not 8388608)"
|
||||
ForeColor = &H80000008&
|
||||
Height = 1095
|
||||
Left = 2640
|
||||
TabIndex = 11
|
||||
Top = 120
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblPlayernum
|
||||
Caption = "Player # (255 for all players):"
|
||||
Height = 495
|
||||
Left = 3240
|
||||
TabIndex = 10
|
||||
Top = 1680
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblMapnum
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Map #:"
|
||||
Height = 255
|
||||
Left = 3600
|
||||
TabIndex = 8
|
||||
Top = 1320
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblZ
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Z:"
|
||||
Height = 255
|
||||
Left = 3960
|
||||
TabIndex = 6
|
||||
Top = 960
|
||||
Width = 255
|
||||
End
|
||||
Begin VB.Label lblY
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Y:"
|
||||
Height = 255
|
||||
Left = 3960
|
||||
TabIndex = 5
|
||||
Top = 600
|
||||
Width = 255
|
||||
End
|
||||
Begin VB.Label lblX
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "X:"
|
||||
Height = 255
|
||||
Left = 3960
|
||||
TabIndex = 4
|
||||
Top = 240
|
||||
Width = 255
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmEmblemEdit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdAdd_Click()
|
||||
lstEmblems.AddItem "Emblem " & lstEmblems.ListCount + 1
|
||||
lstEmblems.ListIndex = lstEmblems.ListCount - 1
|
||||
lblNumEmblems.Caption = "# of Emblems: " & lstEmblems.ListCount
|
||||
txtX.Text = 0
|
||||
txtY.Text = 0
|
||||
txtZ.Text = 0
|
||||
txtPlayernum.Text = 255
|
||||
txtMapnum.Text = 1
|
||||
End Sub
|
||||
|
||||
Private Sub cmdDelete_Click()
|
||||
Call WriteEmblem(True)
|
||||
lstEmblems.RemoveItem lstEmblems.ListCount - 1
|
||||
lstEmblems.ListIndex = lstEmblems.ListCount - 1
|
||||
lblNumEmblems.Caption = "# of Emblems: " & lstEmblems.ListCount
|
||||
End Sub
|
||||
|
||||
Private Sub cmdReload_Click()
|
||||
Call Reload
|
||||
End Sub
|
||||
|
||||
Private Sub Reload()
|
||||
lstEmblems.Clear
|
||||
txtX.Text = ""
|
||||
txtY.Text = ""
|
||||
txtZ.Text = ""
|
||||
txtMapnum.Text = ""
|
||||
txtPlayernum.Text = ""
|
||||
lblNumEmblems.Caption = "# of Emblems: " & lstEmblems.ListCount
|
||||
Call ReadSOCEmblems
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
If lstEmblems.ListCount <= 0 Then
|
||||
MsgBox "You have no emblems to save!"
|
||||
Else
|
||||
Call WriteEmblem(False)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Call Reload
|
||||
End Sub
|
||||
|
||||
Private Sub ReadSOCEmblems()
|
||||
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)
|
||||
|
||||
lstEmblems.Clear
|
||||
|
||||
EmblemLoad:
|
||||
Do While Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
|
||||
If Left(line, 1) = "#" Then GoTo EmblemLoad
|
||||
|
||||
If Left(line, 1) = vbCrLf Then GoTo EmblemLoad
|
||||
|
||||
If Len(line) < 1 Then GoTo EmblemLoad
|
||||
|
||||
word = FirstToken(line)
|
||||
word2 = SecondToken(line)
|
||||
|
||||
If UCase(word) = "EMBLEM" Then
|
||||
lstEmblems.AddItem ("Emblem " & Val(word2))
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub ReadSOCEmblemNum(num 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)
|
||||
|
||||
EmblemLoad:
|
||||
Do While Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
|
||||
If Left(line, 1) = "#" Then GoTo EmblemLoad
|
||||
|
||||
If Left(line, 1) = vbCrLf Then GoTo EmblemLoad
|
||||
|
||||
If Len(line) < 1 Then GoTo EmblemLoad
|
||||
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondToken(line))
|
||||
|
||||
If word = "EMBLEM" Then
|
||||
If Val(word2) = num Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "X" Then
|
||||
txtX.Text = Val(word2)
|
||||
ElseIf word = "Y" Then
|
||||
txtY.Text = Val(word2)
|
||||
ElseIf word = "Z" Then
|
||||
txtZ.Text = Val(word2)
|
||||
ElseIf word = "PLAYERNUM" Then
|
||||
txtPlayernum.Text = Val(word2)
|
||||
ElseIf word = "MAPNUM" Then
|
||||
txtMapnum.Text = Val(word2)
|
||||
ElseIf Len(line) > 0 And Left(line, 1) <> "#" Then
|
||||
MsgBox "Error in SOC with Emblem " & num & vbCrLf & "Unknown line: " & line
|
||||
End If
|
||||
Loop
|
||||
Exit Do
|
||||
End If
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub lstEmblems_Click()
|
||||
Dim i As Integer
|
||||
|
||||
i = InStr(lstEmblems.List(lstEmblems.ListIndex), " ") + 1
|
||||
|
||||
i = Mid(lstEmblems.List(lstEmblems.ListIndex), i, Len(lstEmblems.List(lstEmblems.ListIndex)) - i + 1)
|
||||
i = Val(i)
|
||||
Call ReadSOCEmblemNum(i)
|
||||
End Sub
|
||||
|
||||
Private Sub WriteEmblem(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 i As Integer
|
||||
|
||||
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))
|
||||
i = InStr(lstEmblems.List(lstEmblems.ListIndex), " ") + 1
|
||||
|
||||
i = Mid(lstEmblems.List(lstEmblems.ListIndex), i, Len(lstEmblems.List(lstEmblems.ListIndex)) - i + 1)
|
||||
i = Val(i)
|
||||
|
||||
'If the current emblem exists in the SOC, delete it.
|
||||
If word = "EMBLEM" And Val(word2) = i Then
|
||||
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 UCase(lstEmblems.List(lstEmblems.ListIndex))
|
||||
txtX.Text = TrimComplete(txtX.Text)
|
||||
txtY.Text = TrimComplete(txtY.Text)
|
||||
txtZ.Text = TrimComplete(txtZ.Text)
|
||||
txtMapnum.Text = TrimComplete(txtMapnum.Text)
|
||||
txtPlayernum.Text = TrimComplete(txtPlayernum.Text)
|
||||
If txtX.Text <> "" Then tsTarget.WriteLine "X = " & Val(txtX.Text)
|
||||
If txtY.Text <> "" Then tsTarget.WriteLine "Y = " & Val(txtY.Text)
|
||||
If txtZ.Text <> "" Then tsTarget.WriteLine "Z = " & Val(txtZ.Text)
|
||||
If txtMapnum.Text <> "" Then tsTarget.WriteLine "MAPNUM = " & Val(txtMapnum.Text)
|
||||
If txtPlayernum.Text <> "" Then tsTarget.WriteLine "PLAYERNUM = " & Val(txtPlayernum.Text)
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
MsgBox "Emblem deleted."
|
||||
Else
|
||||
MsgBox "Emblem Saved."
|
||||
End If
|
||||
End Sub
|
||||
BIN
frmEmblemEdit.frx
Normal file
BIN
frmEmblemEdit.frx
Normal file
Binary file not shown.
315
frmHUDEdit.frm
Normal file
315
frmHUDEdit.frm
Normal file
|
|
@ -0,0 +1,315 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmHUDEdit
|
||||
Caption = "HUD Edit"
|
||||
ClientHeight = 2505
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 5160
|
||||
Icon = "frmHUDEdit.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 2505
|
||||
ScaleWidth = 5160
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CommandButton cmdCodeDefault
|
||||
Caption = "&Load Code Default"
|
||||
Height = 375
|
||||
Left = 3480
|
||||
TabIndex = 9
|
||||
Top = 1080
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.CommandButton cmdDelete
|
||||
Caption = "&Delete from SOC"
|
||||
Height = 375
|
||||
Left = 3480
|
||||
TabIndex = 7
|
||||
Top = 2040
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save Changes"
|
||||
Height = 375
|
||||
Left = 3480
|
||||
TabIndex = 6
|
||||
Top = 1560
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.TextBox txtY
|
||||
Height = 285
|
||||
Left = 4080
|
||||
MaxLength = 3
|
||||
TabIndex = 3
|
||||
Top = 720
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.TextBox txtX
|
||||
Height = 285
|
||||
Left = 4080
|
||||
MaxLength = 3
|
||||
TabIndex = 2
|
||||
Top = 360
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.ListBox lstHUD
|
||||
Height = 2010
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 360
|
||||
Width = 3255
|
||||
End
|
||||
Begin VB.Label lblNote
|
||||
Caption = "HUD items are placed on a 320x200 grid."
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 8
|
||||
Top = 120
|
||||
Width = 3015
|
||||
End
|
||||
Begin VB.Label lblY
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Y:"
|
||||
Height = 255
|
||||
Left = 3600
|
||||
TabIndex = 5
|
||||
Top = 720
|
||||
Width = 375
|
||||
End
|
||||
Begin VB.Label lblX
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "X:"
|
||||
Height = 255
|
||||
Left = 3720
|
||||
TabIndex = 4
|
||||
Top = 360
|
||||
Width = 255
|
||||
End
|
||||
Begin VB.Label lblHUDItems
|
||||
Caption = "HUD Items:"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmHUDEdit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdCodeDefault_Click()
|
||||
LoadHUDInfo (lstHUD.ListIndex)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdDelete_Click()
|
||||
Call WriteHUDItem(True)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
Call WriteHUDItem(False)
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Call Reload
|
||||
End Sub
|
||||
|
||||
Private Sub Reload()
|
||||
txtX.Text = ""
|
||||
txtY.Text = ""
|
||||
Call LoadCode
|
||||
lstHUD.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
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("st_stuff.h", ForReading, False)
|
||||
|
||||
Do While ts.ReadLine <> "/** HUD location information (don't move this comment)"
|
||||
Loop
|
||||
|
||||
ts.ReadLine ' */
|
||||
ts.ReadLine ' typedef struct
|
||||
ts.ReadLine ' {
|
||||
ts.ReadLine ' int x, y;
|
||||
ts.ReadLine ' } hudinfo_t;
|
||||
ts.ReadLine '
|
||||
ts.ReadLine ' typedef enum
|
||||
ts.ReadLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
lstHUD.Clear
|
||||
|
||||
Do While InStr(line, "NUMHUDITEMS") = 0
|
||||
startclip = InStr(line, "HUD_")
|
||||
If InStr(line, "HUD_") <> 0 Then
|
||||
endclip = InStr(line, ",")
|
||||
line = Mid(line, startclip, endclip - startclip)
|
||||
addstring = number & " - " & line
|
||||
lstHUD.AddItem addstring
|
||||
number = number + 1
|
||||
End If
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub lstHUD_Click()
|
||||
LoadHUDInfo (lstHUD.ListIndex)
|
||||
Call ReadSOC(lstHUD.ListIndex)
|
||||
End Sub
|
||||
|
||||
Private Sub LoadHUDInfo(HUDNum 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
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("st_stuff.c", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "hudinfo[NUMHUDITEMS] =") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' {
|
||||
line = ts.ReadLine ' First HUD item
|
||||
|
||||
number = 0
|
||||
|
||||
Do While number <> HUDNum
|
||||
line = ts.ReadLine
|
||||
number = number + 1
|
||||
Loop
|
||||
|
||||
startclip = InStr(line, "{") + 1
|
||||
endclip = InStr(line, ",")
|
||||
|
||||
txtX.Text = TrimComplete(Mid(line, startclip, endclip - startclip))
|
||||
|
||||
startclip = endclip + 2
|
||||
endclip = InStr(startclip, line, "}") - 1
|
||||
|
||||
txtY.Text = TrimComplete(Mid(line, startclip, endclip - startclip))
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub ReadSOC(HUDNum 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) = "HUDITEM" And Val(word2) = HUDNum Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "X" Then
|
||||
txtX.Text = Val(word2)
|
||||
ElseIf word = "Y" Then
|
||||
txtY.Text = 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 WriteHUDItem(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 hudremoved As Boolean
|
||||
|
||||
hudremoved = 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 item exists in the SOC, delete it.
|
||||
If word = "HUDITEM" And Val(word2) = lstHUD.ListIndex Then
|
||||
hudremoved = 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 "HUDITEM " & lstHUD.ListIndex
|
||||
txtX.Text = TrimComplete(txtX.Text)
|
||||
txtY.Text = TrimComplete(txtY.Text)
|
||||
If txtX.Text <> "" Then tsTarget.WriteLine "X = " & Val(txtX.Text)
|
||||
If txtY.Text <> "" Then tsTarget.WriteLine "Y = " & Val(txtY.Text)
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
If hudremoved = True Then
|
||||
MsgBox "HUD Item deleted from SOC."
|
||||
Else
|
||||
MsgBox "Couldn't find HUD Item in SOC."
|
||||
End If
|
||||
Else
|
||||
MsgBox "HUD Item Saved."
|
||||
End If
|
||||
End Sub
|
||||
BIN
frmHUDEdit.frx
Normal file
BIN
frmHUDEdit.frx
Normal file
Binary file not shown.
213
frmHelp.frm
Normal file
213
frmHelp.frm
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmHelp
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "Getting Started"
|
||||
ClientHeight = 7395
|
||||
ClientLeft = 45
|
||||
ClientTop = 330
|
||||
ClientWidth = 6360
|
||||
Icon = "frmHelp.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 7395
|
||||
ScaleWidth = 6360
|
||||
ShowInTaskbar = 0 'False
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
Begin VB.CommandButton cmdOK
|
||||
Caption = "&OK, I know what I'm doing now."
|
||||
Height = 495
|
||||
Left = 1920
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 8
|
||||
Top = 6840
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.Line Line9
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 4800
|
||||
Y2 = 4800
|
||||
End
|
||||
Begin VB.Line Line7
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 5400
|
||||
Y2 = 5400
|
||||
End
|
||||
Begin VB.Label Label12
|
||||
Caption = $"frmHelp.frx":0442
|
||||
Height = 615
|
||||
Left = 120
|
||||
TabIndex = 12
|
||||
Top = 4800
|
||||
Width = 6015
|
||||
End
|
||||
Begin VB.Line Line6
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 4200
|
||||
Y2 = 4200
|
||||
End
|
||||
Begin VB.Label Label11
|
||||
Caption = $"frmHelp.frx":04F8
|
||||
Height = 615
|
||||
Left = 120
|
||||
TabIndex = 11
|
||||
Top = 4200
|
||||
Width = 6015
|
||||
End
|
||||
Begin VB.Line Line8
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 6360
|
||||
Y2 = 6360
|
||||
End
|
||||
Begin VB.Line Line5
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 3720
|
||||
Y2 = 3720
|
||||
End
|
||||
Begin VB.Line Line4
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 2880
|
||||
Y2 = 2880
|
||||
End
|
||||
Begin VB.Line Line3
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 2400
|
||||
Y2 = 2400
|
||||
End
|
||||
Begin VB.Line Line2
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 1800
|
||||
Y2 = 1800
|
||||
End
|
||||
Begin VB.Line Line1
|
||||
X1 = 120
|
||||
X2 = 6120
|
||||
Y1 = 1200
|
||||
Y2 = 1200
|
||||
End
|
||||
Begin VB.Label Label10
|
||||
Caption = $"frmHelp.frx":05EC
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 10
|
||||
Top = 3720
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label9
|
||||
Caption = $"frmHelp.frx":068F
|
||||
Height = 615
|
||||
Left = 120
|
||||
TabIndex = 9
|
||||
Top = 1200
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label8
|
||||
Caption = $"frmHelp.frx":0772
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 7
|
||||
Top = 6360
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label7
|
||||
Caption = "However, if you have these settings in the SOC you are using, don't worry - the editor will not erase them from your file."
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 6
|
||||
Top = 5880
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label6
|
||||
Caption = $"frmHelp.frx":0816
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
Top = 5400
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label5
|
||||
Caption = $"frmHelp.frx":08A9
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 8.25
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 855
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 2880
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label4
|
||||
Caption = $"frmHelp.frx":09B1
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 3
|
||||
Top = 2400
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label3
|
||||
Caption = $"frmHelp.frx":0A5A
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 2
|
||||
Top = 1920
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label2
|
||||
Caption = "Finally! A way to easily edit SOC files! I know you're anxious to get started, but here are some things you should know first:"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 9.75
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 600
|
||||
Width = 6135
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Caption = "How To Use This Program"
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 13.5
|
||||
Charset = 0
|
||||
Weight = 700
|
||||
Underline = -1 'True
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 3855
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmHelp"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdOK_Click()
|
||||
frmHelp.Hide
|
||||
End Sub
|
||||
BIN
frmHelp.frx
Normal file
BIN
frmHelp.frx
Normal file
Binary file not shown.
429
frmHub.frm
Normal file
429
frmHub.frm
Normal file
|
|
@ -0,0 +1,429 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmHub
|
||||
Caption = "SOC Editor"
|
||||
ClientHeight = 6960
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4920
|
||||
Icon = "frmHub.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 6960
|
||||
ScaleWidth = 4920
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CommandButton cmdCreateBlank
|
||||
Caption = "Make a &Blank SOC"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 22
|
||||
Top = 2520
|
||||
Width = 2055
|
||||
End
|
||||
Begin VB.CommandButton cmdUnlockables
|
||||
Caption = "Edit &Unlockables"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 2760
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 21
|
||||
Top = 6360
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdAuthor
|
||||
Caption = "Enter &Author Info"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 19
|
||||
Top = 3960
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdHelp
|
||||
Caption = "Getting Starte&d / READ ME FIRST!"
|
||||
Height = 495
|
||||
Left = 480
|
||||
TabIndex = 18
|
||||
Top = 2880
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.CommandButton cmdEditCutscenes
|
||||
Caption = "Edit C&utscenes"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 17
|
||||
Top = 6360
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdCharacterEdit
|
||||
Caption = "Edit &Character Select Screen"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 16
|
||||
Top = 5760
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.PictureBox Picture1
|
||||
Height = 1965
|
||||
Left = 2760
|
||||
Picture = "frmHub.frx":0442
|
||||
ScaleHeight = 1905
|
||||
ScaleWidth = 1905
|
||||
TabIndex = 15
|
||||
Top = 3960
|
||||
Width = 1965
|
||||
End
|
||||
Begin VB.CommandButton cmdSoundEdit
|
||||
Caption = "Edit &Sounds"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 14
|
||||
Top = 5160
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdEmblemEdit
|
||||
Caption = "Edit &Emblem Locations"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 13
|
||||
Top = 4560
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdHUDEdit
|
||||
Caption = "Edit &HUD Coordinates"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 1440
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 12
|
||||
Top = 3960
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdMaincfg
|
||||
Caption = "Edit &Global Game Settings"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 1440
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 11
|
||||
Top = 4560
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.DriveListBox Drive2
|
||||
Height = 315
|
||||
Left = 2640
|
||||
TabIndex = 9
|
||||
Top = 360
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.DirListBox Dir2
|
||||
Height = 1665
|
||||
Left = 2520
|
||||
TabIndex = 8
|
||||
Top = 720
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.FileListBox File1
|
||||
Height = 1455
|
||||
Left = 2520
|
||||
Pattern = "*.soc"
|
||||
TabIndex = 7
|
||||
Top = 2400
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.DriveListBox Drive1
|
||||
Height = 315
|
||||
Left = 120
|
||||
TabIndex = 6
|
||||
Top = 360
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.DirListBox Dir1
|
||||
Height = 1665
|
||||
Left = 120
|
||||
TabIndex = 4
|
||||
Top = 720
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.CommandButton cmdAbout
|
||||
Caption = "&About"
|
||||
Height = 375
|
||||
Left = 3960
|
||||
TabIndex = 3
|
||||
Top = 6000
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.CommandButton cmdStateEdit
|
||||
Caption = "Edit St&ates"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 1440
|
||||
TabIndex = 2
|
||||
Top = 6360
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdLevelHeader
|
||||
Caption = "Edit &Level Headers"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 1440
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 1
|
||||
Top = 5160
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdThingEdit
|
||||
Caption = "Edit &Things"
|
||||
Enabled = 0 'False
|
||||
Height = 495
|
||||
Left = 1440
|
||||
TabIndex = 0
|
||||
Top = 5760
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblAuthor
|
||||
Caption = "Modification By:"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 20
|
||||
Top = 3480
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.Label lblSOCFile
|
||||
Caption = "SOC File to use (double click):"
|
||||
Height = 255
|
||||
Left = 2640
|
||||
TabIndex = 10
|
||||
Top = 120
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.Label lblSourcePath
|
||||
Caption = "Path to SRB2 Source Code:"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 5
|
||||
Top = 120
|
||||
Width = 2175
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmHub"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdAbout_Click()
|
||||
MsgBox App.Title & " v" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & "By " & App.CompanyName & vbCrLf & "(SSNTails)" & vbCrLf & App.Comments & vbCrLf & App.FileDescription
|
||||
End Sub
|
||||
|
||||
Private Sub cmdAuthor_Click()
|
||||
Dim Response As String
|
||||
|
||||
Response$ = InputBox("Enter name to appear on credits (type in NOBODY to delete):", "Modification By", GetAuthor)
|
||||
|
||||
If Response = "" Then Exit Sub
|
||||
|
||||
Response = TrimComplete(Response)
|
||||
|
||||
If UCase(Response) = "NOBODY" Then
|
||||
Call WriteAuthor(True, Response)
|
||||
lblAuthor.Caption = "Modification By: "
|
||||
Else
|
||||
Call WriteAuthor(False, Response)
|
||||
lblAuthor.Caption = "Modification By: " & Response
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCharacterEdit_Click()
|
||||
frmCharacterEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCreateBlank_Click()
|
||||
Dim socname As String
|
||||
|
||||
socname = InputBox("This file will be created in the directory you have selected on the main window." & vbCrLf & vbCrLf & "Enter the filename you want (do not include .SOC at the end):", "Make A Blank SOC")
|
||||
Trim (socname)
|
||||
|
||||
If InStr(LCase(socname), ".soc") > 0 Then
|
||||
MsgBox "The thing says not to include the .SOC at the end, stupid.", vbOKOnly, "You goofed!"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Len(socname) > 0 Then
|
||||
socname = socname & ".soc"
|
||||
|
||||
Dim myFSOSOC As New Scripting.FileSystemObject
|
||||
Dim tsSOC As TextStream
|
||||
|
||||
Set tsSOC = myFSOSOC.OpenTextFile(File1.Path & "\" & socname, ForWriting, True)
|
||||
tsSOC.Close
|
||||
Set myFSOSOC = Nothing
|
||||
|
||||
MsgBox "Blank SOC named " & socname & " created in " & File1.Path, vbOKOnly, "Success!"
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdEditCutscenes_Click()
|
||||
frmCutsceneEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdEmblemEdit_Click()
|
||||
frmEmblemEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdHelp_Click()
|
||||
frmHelp.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdHUDEdit_Click()
|
||||
frmHUDEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdLevelHeader_Click()
|
||||
frmLevelHeader.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdMaincfg_Click()
|
||||
frmMaincfg.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSoundEdit_Click()
|
||||
frmSoundEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdStateEdit_Click()
|
||||
frmStateEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdThingEdit_Click()
|
||||
frmThingEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub cmdUnlockables_Click()
|
||||
frmUnlockablesEdit.Show vbModal, Me
|
||||
End Sub
|
||||
|
||||
Private Sub Dir1_Change()
|
||||
SourcePath = Dir1.Path
|
||||
End Sub
|
||||
|
||||
Private Sub Dir2_Change()
|
||||
File1.Path = Dir2.Path
|
||||
End Sub
|
||||
|
||||
Private Sub Drive1_Change()
|
||||
Dir1.Path = Drive1.Drive
|
||||
End Sub
|
||||
|
||||
Private Sub Drive2_Change()
|
||||
Dir2.Path = Drive2.Drive
|
||||
End Sub
|
||||
|
||||
Private Sub File1_DblClick()
|
||||
SOCTemp = File1.Path & "\" & "socedit.tmp"
|
||||
SOCFile = File1.Path & "\" & File1.List(File1.ListIndex)
|
||||
MsgBox "You are now using the file: " & vbCrLf & SOCFile
|
||||
cmdLevelHeader.Enabled = True
|
||||
cmdThingEdit.Enabled = True
|
||||
cmdStateEdit.Enabled = True
|
||||
cmdHUDEdit.Enabled = True
|
||||
cmdMaincfg.Enabled = True
|
||||
cmdEmblemEdit.Enabled = True
|
||||
cmdSoundEdit.Enabled = True
|
||||
cmdCharacterEdit.Enabled = True
|
||||
cmdEditCutscenes.Enabled = True
|
||||
cmdAuthor.Enabled = True
|
||||
cmdUnlockables.Enabled = True
|
||||
lblAuthor.Caption = "Modification By: " & GetAuthor
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
SourcePath = App.Path
|
||||
Dir1.Path = SourcePath
|
||||
End Sub
|
||||
|
||||
Private Function GetAuthor() As String
|
||||
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) = "MODBY" Then
|
||||
GetAuthor = word2
|
||||
Exit Do
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Function
|
||||
|
||||
Private Sub WriteAuthor(Remove As Boolean, ModderName As String)
|
||||
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
|
||||
|
||||
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 entry exists in the SOC, delete it.
|
||||
If word <> "MODBY" Then
|
||||
tsTarget.WriteLine line
|
||||
End If
|
||||
Loop
|
||||
|
||||
tsSource.Close
|
||||
Set myFSOSource = Nothing
|
||||
|
||||
If Remove = False Then
|
||||
If line <> "" Then tsTarget.WriteLine ""
|
||||
|
||||
tsTarget.WriteLine "ModBy " & ModderName
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
MsgBox "Name removed."
|
||||
Else
|
||||
MsgBox "Name Saved."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
BIN
frmHub.frx
Normal file
BIN
frmHub.frx
Normal file
Binary file not shown.
839
frmLevelHeader.frm
Normal file
839
frmLevelHeader.frm
Normal file
|
|
@ -0,0 +1,839 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmLevelHeader
|
||||
Caption = "Level Header Info"
|
||||
ClientHeight = 5250
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 7650
|
||||
Icon = "frmLevelHeader.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 5250
|
||||
ScaleWidth = 7650
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.TextBox txtRunSOC
|
||||
Height = 285
|
||||
Left = 6240
|
||||
MaxLength = 8
|
||||
TabIndex = 49
|
||||
Top = 4680
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CheckBox chkLevelSelect
|
||||
Caption = "Show on Host Game selection menu"
|
||||
Height = 375
|
||||
Left = 1680
|
||||
TabIndex = 48
|
||||
Top = 4800
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.CheckBox chkTimeAttack
|
||||
Caption = "Include in Time Attack calculations"
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 47
|
||||
Top = 4440
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.CheckBox chkNoReload
|
||||
Caption = "Retain level state when player dies."
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 46
|
||||
Top = 4080
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save Map"
|
||||
Height = 735
|
||||
Left = 120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 45
|
||||
Top = 4440
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdRename
|
||||
Caption = "&Rename Map"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 44
|
||||
Top = 3960
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdDelete
|
||||
Caption = "&Delete Map"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 43
|
||||
Top = 3480
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CommandButton cmdAddMap
|
||||
Caption = "&Add Map"
|
||||
Height = 375
|
||||
Left = 120
|
||||
TabIndex = 42
|
||||
Top = 3000
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CheckBox chkNossmusic
|
||||
Caption = "Disable Super Sonic music changes"
|
||||
Height = 255
|
||||
Left = 4560
|
||||
TabIndex = 29
|
||||
Top = 1200
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.CheckBox chkHidden
|
||||
Caption = "Don't show on level selection menu"
|
||||
Height = 255
|
||||
Left = 4560
|
||||
TabIndex = 28
|
||||
Top = 480
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.TextBox txtCountdown
|
||||
Height = 285
|
||||
Left = 6360
|
||||
MaxLength = 3
|
||||
TabIndex = 26
|
||||
Top = 840
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.TextBox txtCutscenenum
|
||||
Height = 285
|
||||
Left = 4440
|
||||
MaxLength = 3
|
||||
TabIndex = 25
|
||||
Top = 3720
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtPrecutscenenum
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 3
|
||||
TabIndex = 22
|
||||
Top = 3720
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.CheckBox chkScriptislump
|
||||
Caption = "Script is a lump in WAD, not a file"
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 21
|
||||
Top = 3360
|
||||
Width = 2775
|
||||
End
|
||||
Begin VB.TextBox txtScriptname
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 191
|
||||
TabIndex = 19
|
||||
Top = 3000
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.TextBox txtSkynum
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 4
|
||||
TabIndex = 17
|
||||
Top = 2640
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.ComboBox cmbWeather
|
||||
Height = 315
|
||||
ItemData = "frmLevelHeader.frx":0442
|
||||
Left = 2640
|
||||
List = "frmLevelHeader.frx":0458
|
||||
TabIndex = 15
|
||||
Top = 2280
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.TextBox txtForcecharacter
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 2
|
||||
TabIndex = 13
|
||||
Top = 1920
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.ComboBox cmbMusicslot
|
||||
Height = 315
|
||||
Left = 2640
|
||||
TabIndex = 11
|
||||
Top = 1560
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.TextBox txtNextlevel
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 4
|
||||
TabIndex = 9
|
||||
Top = 1200
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Frame frmTypeOfLevel
|
||||
Caption = "Type of Level"
|
||||
Height = 2775
|
||||
Left = 5040
|
||||
TabIndex = 8
|
||||
Top = 1680
|
||||
Width = 2535
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Christmas"
|
||||
Height = 255
|
||||
Index = 11
|
||||
Left = 1440
|
||||
TabIndex = 41
|
||||
Tag = "1024"
|
||||
Top = 960
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "2D"
|
||||
Height = 255
|
||||
Index = 10
|
||||
Left = 1440
|
||||
TabIndex = 40
|
||||
Tag = "512"
|
||||
Top = 720
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Mario"
|
||||
Height = 255
|
||||
Index = 9
|
||||
Left = 120
|
||||
TabIndex = 39
|
||||
Tag = "256"
|
||||
Top = 2400
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Sonic Adventure"
|
||||
Height = 255
|
||||
Index = 8
|
||||
Left = 120
|
||||
TabIndex = 38
|
||||
Tag = "128"
|
||||
Top = 2160
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "NiGHTS"
|
||||
Height = 255
|
||||
Index = 7
|
||||
Left = 120
|
||||
TabIndex = 37
|
||||
Tag = "64"
|
||||
Top = 1920
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Chaos"
|
||||
Height = 255
|
||||
Index = 6
|
||||
Left = 120
|
||||
TabIndex = 36
|
||||
Tag = "32"
|
||||
Top = 1680
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Capture the Flag"
|
||||
Height = 255
|
||||
Index = 5
|
||||
Left = 120
|
||||
TabIndex = 35
|
||||
Tag = "16"
|
||||
Top = 1440
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Tag"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 120
|
||||
TabIndex = 34
|
||||
Tag = "8"
|
||||
Top = 1200
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Match"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 120
|
||||
TabIndex = 33
|
||||
Tag = "4"
|
||||
Top = 960
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Race"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 120
|
||||
TabIndex = 32
|
||||
Tag = "2"
|
||||
Top = 720
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Cooperative"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 120
|
||||
TabIndex = 31
|
||||
Tag = "1"
|
||||
Top = 480
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.CheckBox chkTypeoflevel
|
||||
Caption = "Single Player"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 120
|
||||
TabIndex = 30
|
||||
Tag = "4096"
|
||||
Top = 240
|
||||
Width = 1215
|
||||
End
|
||||
End
|
||||
Begin VB.CheckBox chkNozone
|
||||
Caption = "Don't show ""ZONE"" after Level Name"
|
||||
Height = 255
|
||||
Left = 4560
|
||||
TabIndex = 7
|
||||
Top = 120
|
||||
Width = 3015
|
||||
End
|
||||
Begin VB.TextBox txtAct
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 2
|
||||
TabIndex = 5
|
||||
Top = 840
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtInterscreen
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 8
|
||||
TabIndex = 3
|
||||
Top = 480
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.ListBox lstMaps
|
||||
Height = 2790
|
||||
Left = 120
|
||||
Sorted = -1 'True
|
||||
TabIndex = 2
|
||||
Top = 120
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.TextBox txtLevelName
|
||||
Height = 285
|
||||
Left = 2640
|
||||
MaxLength = 32
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 1815
|
||||
End
|
||||
Begin VB.Label lblRunSOC
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Run SOC at level load (lump name):"
|
||||
Height = 495
|
||||
Left = 4440
|
||||
TabIndex = 50
|
||||
Top = 4560
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblCountdown
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Level Timer (seconds):"
|
||||
Height = 255
|
||||
Left = 4560
|
||||
TabIndex = 27
|
||||
Top = 840
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblCutscenenum
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Cutscene to play after level:"
|
||||
Height = 495
|
||||
Left = 3240
|
||||
TabIndex = 24
|
||||
Top = 3600
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblPrecutscenenum
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Cutscene to play before level:"
|
||||
Height = 375
|
||||
Left = 1320
|
||||
TabIndex = 23
|
||||
Top = 3600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblScriptName
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Script Name:"
|
||||
Height = 255
|
||||
Left = 1440
|
||||
TabIndex = 20
|
||||
Top = 3000
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblSkynum
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Sky #:"
|
||||
Height = 255
|
||||
Left = 1800
|
||||
TabIndex = 18
|
||||
Top = 2640
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label Label1
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Weather:"
|
||||
Height = 255
|
||||
Left = 1680
|
||||
TabIndex = 16
|
||||
Top = 2280
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.Label lblForcecharacter
|
||||
Caption = "Force Character #:"
|
||||
Height = 375
|
||||
Left = 1440
|
||||
TabIndex = 14
|
||||
Top = 1800
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblMusicslot
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Music:"
|
||||
Height = 255
|
||||
Left = 1800
|
||||
TabIndex = 12
|
||||
Top = 1560
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblNextlevel
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Next Level:"
|
||||
Height = 255
|
||||
Left = 1440
|
||||
TabIndex = 10
|
||||
Top = 1200
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblAct
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Act:"
|
||||
Height = 255
|
||||
Left = 2040
|
||||
TabIndex = 6
|
||||
Top = 840
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.Label lblInterscreen
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Intermission BG:"
|
||||
Height = 255
|
||||
Left = 1320
|
||||
TabIndex = 4
|
||||
Top = 480
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblLevelName
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Level Name:"
|
||||
Height = 255
|
||||
Left = 1560
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmLevelHeader"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdAddMap_Click()
|
||||
Dim Response As String
|
||||
Dim NewNum As Integer
|
||||
|
||||
Response$ = InputBox("Enter the new level (NUMBER ONLY):")
|
||||
|
||||
If Response = "" Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
NewNum = Val(TrimComplete(Response))
|
||||
|
||||
lstMaps.AddItem "Level " & NewNum
|
||||
lstMaps.ListIndex = lstMaps.ListCount - 1
|
||||
End Sub
|
||||
|
||||
Private Sub cmdDelete_Click()
|
||||
Dim i As Integer
|
||||
|
||||
If MsgBox("Delete this level header?", vbYesNo) = vbNo Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
|
||||
|
||||
i = Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1)
|
||||
i = Val(i)
|
||||
Call WriteLevel(True, i)
|
||||
lstMaps.RemoveItem lstMaps.ListIndex
|
||||
|
||||
If lstMaps.ListCount > 0 Then
|
||||
lstMaps.ListIndex = 0
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdRename_Click()
|
||||
Dim Response As String
|
||||
Dim NewNum As Integer
|
||||
Dim i As Integer
|
||||
|
||||
Response$ = InputBox("Rename level to (NUMBER ONLY):")
|
||||
|
||||
If Response = "" Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
NewNum = Val(TrimComplete(Response))
|
||||
|
||||
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
|
||||
|
||||
i = Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1)
|
||||
i = Val(i)
|
||||
Call WriteLevel(True, i)
|
||||
lstMaps.List(lstMaps.ListIndex) = "Level " & NewNum
|
||||
Call cmdSave_Click
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
Dim i As Integer
|
||||
|
||||
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
|
||||
|
||||
i = Val(Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1))
|
||||
Call WriteLevel(False, i)
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Call LoadMusic
|
||||
Call LoadSOCMaps
|
||||
If lstMaps.ListCount > 0 Then lstMaps.ListIndex = 0
|
||||
End Sub
|
||||
|
||||
Private Sub LoadSOCMaps()
|
||||
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)
|
||||
|
||||
lstMaps.Clear
|
||||
|
||||
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) = "LEVEL" Then
|
||||
lstMaps.AddItem ("Level " & Val(word2))
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub LoadMusic()
|
||||
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
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("sounds.h", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "Music list (don't edit this comment!)") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' typedef enum
|
||||
ts.SkipLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
cmbMusicslot.Clear
|
||||
|
||||
Do While InStr(line, "NUMMUSIC") = 0
|
||||
startclip = InStr(line, "mus_")
|
||||
If InStr(line, "mus_") <> 0 Then
|
||||
endclip = InStr(line, ",")
|
||||
line = Mid(line, startclip, endclip - startclip)
|
||||
addstring = number & " - " & line
|
||||
cmbMusicslot.AddItem addstring
|
||||
number = number + 1
|
||||
End If
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub ClearForm()
|
||||
Dim j As Integer
|
||||
|
||||
txtLevelName.Text = ""
|
||||
txtInterscreen.Text = ""
|
||||
txtAct.Text = ""
|
||||
txtNextlevel.Text = ""
|
||||
cmbMusicslot.Text = ""
|
||||
txtForcecharacter.Text = ""
|
||||
cmbWeather.Text = ""
|
||||
txtSkynum.Text = ""
|
||||
txtScriptname.Text = ""
|
||||
chkScriptislump.Value = 0
|
||||
txtPrecutscenenum.Text = ""
|
||||
txtCutscenenum.Text = ""
|
||||
txtRunSOC.Text = ""
|
||||
chkNozone.Value = 0
|
||||
chkHidden.Value = 0
|
||||
txtCountdown.Text = ""
|
||||
chkNossmusic.Value = 0
|
||||
chkNoReload.Value = 0
|
||||
chkTimeAttack.Value = 0
|
||||
chkLevelSelect = 0
|
||||
|
||||
For j = 0 To 11
|
||||
chkTypeoflevel(j).Value = 0
|
||||
Next j
|
||||
End Sub
|
||||
|
||||
Private Sub lstMaps_Click()
|
||||
Dim startclip As Integer
|
||||
Call ClearForm
|
||||
startclip = InStr(lstMaps.List(lstMaps.ListIndex), " ")
|
||||
Call LoadSOCMapInfo(Val(Mid(lstMaps.List(lstMaps.ListIndex), startclip + 1, Len(lstMaps.List(lstMaps.ListIndex)))))
|
||||
End Sub
|
||||
|
||||
Private Sub LoadSOCMapInfo(num 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 = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondToken(line))
|
||||
|
||||
If word = "LEVEL" Then
|
||||
If Val(word2) = num Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "LEVELNAME" Then
|
||||
txtLevelName.Text = word2
|
||||
ElseIf word = "INTERSCREEN" Then
|
||||
txtInterscreen.Text = word2
|
||||
ElseIf word = "ACT" Then
|
||||
txtAct.Text = Val(word2)
|
||||
ElseIf word = "NOZONE" Then
|
||||
chkNozone.Value = Val(word2)
|
||||
ElseIf word = "TYPEOFLEVEL" Then
|
||||
ProcessMapFlags (Val(word2))
|
||||
ElseIf word = "NEXTLEVEL" Then
|
||||
txtNextlevel.Text = Val(word2)
|
||||
ElseIf word = "MUSICSLOT" Then
|
||||
cmbMusicslot.ListIndex = Val(word2)
|
||||
ElseIf word = "FORCECHARACTER" Then
|
||||
txtForcecharacter.Text = Val(word2)
|
||||
ElseIf word = "WEATHER" Then
|
||||
cmbWeather.ListIndex = Val(word2)
|
||||
ElseIf word = "SKYNUM" Then
|
||||
txtSkynum.Text = Val(word2)
|
||||
ElseIf word = "SCRIPTNAME" Then
|
||||
txtScriptname.Text = word2
|
||||
ElseIf word = "SCRIPTISLUMP" Then
|
||||
chkScriptislump.Value = Val(word2)
|
||||
ElseIf word = "PRECUTSCENENUM" Then
|
||||
txtPrecutscenenum.Text = Val(word2)
|
||||
ElseIf word = "CUTSCENENUM" Then
|
||||
txtCutscenenum.Text = Val(word2)
|
||||
ElseIf word = "COUNTDOWN" Then
|
||||
txtCountdown.Text = Val(word2)
|
||||
ElseIf word = "HIDDEN" Then
|
||||
chkHidden.Value = Val(word2)
|
||||
ElseIf word = "NOSSMUSIC" Then
|
||||
chkNossmusic.Value = Val(word2)
|
||||
ElseIf word = "NORELOAD" Then
|
||||
chkNoReload.Value = Val(word2)
|
||||
ElseIf word = "TIMEATTACK" Then
|
||||
chkTimeAttack.Value = Val(word2)
|
||||
ElseIf word = "LEVELSELECT" Then
|
||||
chkLevelSelect.Value = Val(word2)
|
||||
ElseIf word = "RUNSOC" Then
|
||||
txtRunSOC.Text = 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
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub ProcessMapFlags(flags As Long)
|
||||
Dim j As Integer
|
||||
|
||||
For j = 0 To 11
|
||||
If flags And chkTypeoflevel(j).Tag Then
|
||||
chkTypeoflevel(j).Value = 1
|
||||
Else
|
||||
chkTypeoflevel(j).Value = 0
|
||||
End If
|
||||
Next j
|
||||
End Sub
|
||||
|
||||
Private Sub WriteLevel(Remove As Boolean, Mapnum As Integer)
|
||||
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 i As Integer
|
||||
|
||||
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))
|
||||
|
||||
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
|
||||
|
||||
i = Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1)
|
||||
i = Val(i)
|
||||
'If the current level exists in the SOC, delete it.
|
||||
If word = "LEVEL" And Val(word2) = i Then
|
||||
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 UCase(lstMaps.List(lstMaps.ListIndex))
|
||||
txtLevelName.Text = TrimComplete(txtLevelName.Text)
|
||||
txtInterscreen.Text = TrimComplete(txtInterscreen.Text)
|
||||
txtAct.Text = TrimComplete(txtAct.Text)
|
||||
txtNextlevel.Text = TrimComplete(txtNextlevel.Text)
|
||||
cmbMusicslot.Text = TrimComplete(cmbMusicslot.Text)
|
||||
txtForcecharacter.Text = TrimComplete(txtForcecharacter.Text)
|
||||
cmbWeather.Text = TrimComplete(cmbWeather.Text)
|
||||
txtSkynum.Text = TrimComplete(txtSkynum.Text)
|
||||
txtScriptname.Text = TrimComplete(txtScriptname.Text)
|
||||
txtPrecutscenenum.Text = TrimComplete(txtPrecutscenenum.Text)
|
||||
txtCutscenenum.Text = TrimComplete(txtCutscenenum.Text)
|
||||
txtCountdown.Text = TrimComplete(txtCountdown.Text)
|
||||
txtRunSOC.Text = TrimComplete(txtRunSOC.Text)
|
||||
|
||||
If txtLevelName.Text <> "" Then tsTarget.WriteLine "LEVELNAME = " & txtLevelName.Text
|
||||
If txtInterscreen.Text <> "" Then tsTarget.WriteLine "INTERSCREEN = " & txtInterscreen.Text
|
||||
If txtAct.Text <> "" Then tsTarget.WriteLine "ACT = " & Val(txtAct.Text)
|
||||
If txtNextlevel.Text <> "" Then tsTarget.WriteLine "NEXTLEVEL = " & Val(txtNextlevel.Text)
|
||||
If cmbMusicslot.Text <> "" Then tsTarget.WriteLine "MUSICSLOT = " & cmbMusicslot.ListIndex
|
||||
If txtForcecharacter.Text <> "" Then tsTarget.WriteLine "FORCECHARACTER = " & Val(txtForcecharacter.Text)
|
||||
If cmbWeather.Text <> "" Then tsTarget.WriteLine "WEATHER = " & cmbWeather.ListIndex
|
||||
If txtSkynum.Text <> "" Then tsTarget.WriteLine "SKYNUM = " & Val(txtSkynum.Text)
|
||||
If txtScriptname.Text <> "" Then tsTarget.WriteLine "SCRIPTNAME = " & txtScriptname.Text
|
||||
If txtPrecutscenenum.Text <> "" Then tsTarget.WriteLine "PRECUTSCENENUM = " & Val(txtPrecutscenenum.Text)
|
||||
If txtCutscenenum.Text <> "" Then tsTarget.WriteLine "CUTSCENENUM = " & Val(txtCutscenenum.Text)
|
||||
If txtCountdown.Text <> "" Then tsTarget.WriteLine "COUNTDOWN = " & Val(txtCountdown.Text)
|
||||
If chkScriptislump.Value = 1 Then tsTarget.WriteLine "SCRIPTISLUMP = 1"
|
||||
If chkNozone.Value = 1 Then tsTarget.WriteLine "NOZONE = 1"
|
||||
If chkHidden.Value = 1 Then tsTarget.WriteLine "HIDDEN = 1"
|
||||
If chkNossmusic.Value = 1 Then tsTarget.WriteLine "NOSSMUSIC = 1"
|
||||
If chkNoReload.Value = 1 Then tsTarget.WriteLine "NORELOAD = 1"
|
||||
If chkTimeAttack.Value = 1 Then tsTarget.WriteLine "TIMEATTACK = 1"
|
||||
If chkLevelSelect.Value = 1 Then tsTarget.WriteLine "LEVELSELECT = 1"
|
||||
If txtRunSOC.Text <> "" Then tsTarget.WriteLine "RUNSOC = " & txtRunSOC.Text
|
||||
|
||||
flags = 0
|
||||
For i = 0 To 11
|
||||
If chkTypeoflevel(i).Value = 1 Then
|
||||
flags = flags + Val(chkTypeoflevel(i).Tag)
|
||||
End If
|
||||
Next
|
||||
|
||||
If flags > 0 Then tsTarget.WriteLine "TYPEOFLEVEL = " & flags
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
MsgBox "Level Deleted."
|
||||
Else
|
||||
MsgBox "Level Saved."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
BIN
frmLevelHeader.frx
Normal file
BIN
frmLevelHeader.frx
Normal file
Binary file not shown.
644
frmMaincfg.frm
Normal file
644
frmMaincfg.frm
Normal file
|
|
@ -0,0 +1,644 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmMaincfg
|
||||
Caption = "Global Game Settings"
|
||||
ClientHeight = 5295
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 9360
|
||||
Icon = "frmMaincfg.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 5295
|
||||
ScaleWidth = 9360
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.Frame frmReset
|
||||
Caption = "Reset Data (Be sure this is at the TOP of your SOC)"
|
||||
Height = 975
|
||||
Left = 4800
|
||||
TabIndex = 43
|
||||
Top = 4200
|
||||
Width = 4455
|
||||
Begin VB.CheckBox chkReset
|
||||
Caption = "Thing Properties"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 1680
|
||||
TabIndex = 46
|
||||
Tag = "4"
|
||||
Top = 240
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.CheckBox chkReset
|
||||
Caption = "States"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 240
|
||||
TabIndex = 45
|
||||
Tag = "2"
|
||||
Top = 600
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.CheckBox chkReset
|
||||
Caption = "Sprite Names"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 240
|
||||
TabIndex = 44
|
||||
Tag = "1"
|
||||
Top = 240
|
||||
Width = 1575
|
||||
End
|
||||
End
|
||||
Begin VB.CheckBox chkDisableSpeedAdjust
|
||||
Caption = "Disable speed adjustment of player animations depending on how fast they are moving."
|
||||
Height = 375
|
||||
Left = 1080
|
||||
TabIndex = 42
|
||||
Top = 4200
|
||||
Width = 3615
|
||||
End
|
||||
Begin VB.TextBox txtTitleScrollSpeed
|
||||
Height = 285
|
||||
Left = 4080
|
||||
TabIndex = 41
|
||||
Top = 1920
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.CheckBox chkLoopTitle
|
||||
Caption = "Loop the title screen music?"
|
||||
Height = 195
|
||||
Left = 1080
|
||||
TabIndex = 39
|
||||
Top = 3840
|
||||
Width = 2415
|
||||
End
|
||||
Begin VB.TextBox txtCreditsCutscene
|
||||
Height = 285
|
||||
Left = 4080
|
||||
TabIndex = 37
|
||||
Top = 1560
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 36
|
||||
Top = 3120
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.CommandButton cmdReload
|
||||
Caption = "&Reload"
|
||||
Height = 495
|
||||
Left = 120
|
||||
TabIndex = 35
|
||||
Top = 2520
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.TextBox txtNumemblems
|
||||
Height = 285
|
||||
Left = 4080
|
||||
MaxLength = 2
|
||||
TabIndex = 33
|
||||
Top = 3360
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtGamedata
|
||||
Height = 285
|
||||
Left = 3240
|
||||
MaxLength = 64
|
||||
TabIndex = 31
|
||||
Top = 2880
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtExeccfg
|
||||
Height = 285
|
||||
Left = 3240
|
||||
TabIndex = 9
|
||||
Top = 2400
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Frame frmTimers
|
||||
Caption = "Timers (35 = 1 second)"
|
||||
Height = 3975
|
||||
Left = 4800
|
||||
TabIndex = 8
|
||||
Top = 120
|
||||
Width = 4455
|
||||
Begin VB.TextBox txtGameovertics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 29
|
||||
Top = 3480
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtHelpertics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 27
|
||||
Top = 3120
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtParalooptics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 25
|
||||
Top = 2760
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtExtralifetics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 23
|
||||
Top = 2400
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtSpacetimetics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 21
|
||||
Top = 2040
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtUnderwatertics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 19
|
||||
Top = 1680
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtTailsflytics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 17
|
||||
Top = 1320
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtFlashingtics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 15
|
||||
Top = 960
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtSneakertics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 13
|
||||
Top = 600
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.TextBox txtInvulntics
|
||||
Height = 285
|
||||
Left = 3000
|
||||
TabIndex = 11
|
||||
Top = 240
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblGameovertics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Game Over Screen Time:"
|
||||
Height = 255
|
||||
Left = 960
|
||||
TabIndex = 30
|
||||
Top = 3480
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.Label lblHelpertics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "NiGHTS Nightopian Helper Time:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 28
|
||||
Top = 3120
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.Label lblParalooptics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "NiGHTS Paraloop Powerup Time:"
|
||||
Height = 255
|
||||
Left = 360
|
||||
TabIndex = 26
|
||||
Top = 2760
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.Label lblExtralifetics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Extra Life Music Duration:"
|
||||
Height = 255
|
||||
Left = 960
|
||||
TabIndex = 24
|
||||
Top = 2400
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.Label lblSpacetimetics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Space Breath Timeout:"
|
||||
Height = 255
|
||||
Left = 1200
|
||||
TabIndex = 22
|
||||
Top = 2040
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblUnderwatertics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Underwater Breath Timeout:"
|
||||
Height = 255
|
||||
Left = 840
|
||||
TabIndex = 20
|
||||
Top = 1680
|
||||
Width = 2055
|
||||
End
|
||||
Begin VB.Label lblTailsflytics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Tails Flying Time:"
|
||||
Height = 255
|
||||
Left = 1440
|
||||
TabIndex = 18
|
||||
Top = 1320
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.Label lblFlashingtics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Flashing Time After Being Hit:"
|
||||
Height = 255
|
||||
Left = 360
|
||||
TabIndex = 16
|
||||
Top = 960
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.Label lblSneakertics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Super Sneakers Time:"
|
||||
Height = 255
|
||||
Left = 240
|
||||
TabIndex = 14
|
||||
Top = 600
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.Label lblInvulntics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Invincibility Time:"
|
||||
Height = 255
|
||||
Left = 360
|
||||
TabIndex = 12
|
||||
Top = 240
|
||||
Width = 2535
|
||||
End
|
||||
End
|
||||
Begin VB.TextBox txtIntrotoplay
|
||||
Height = 285
|
||||
Left = 4080
|
||||
TabIndex = 6
|
||||
Top = 1200
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtRacestage_start
|
||||
Height = 285
|
||||
Left = 4080
|
||||
MaxLength = 4
|
||||
TabIndex = 4
|
||||
Top = 840
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtSpstage_start
|
||||
Height = 285
|
||||
Left = 4080
|
||||
MaxLength = 4
|
||||
TabIndex = 2
|
||||
Top = 480
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtSstage_start
|
||||
Height = 285
|
||||
Left = 4080
|
||||
MaxLength = 4
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.Label lblTitleScrollSpeed
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Scroll speed of title background:"
|
||||
Height = 255
|
||||
Left = 1560
|
||||
TabIndex = 40
|
||||
Top = 1920
|
||||
Width = 2415
|
||||
End
|
||||
Begin VB.Label lblCreditsCutscene
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Cutscene # to replace credits with:"
|
||||
Height = 255
|
||||
Left = 1080
|
||||
TabIndex = 38
|
||||
Top = 1560
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.Label lblNumemblems
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "# of LEVEL Emblems (Gamedata field must also be filled out):"
|
||||
Height = 375
|
||||
Left = 1440
|
||||
TabIndex = 34
|
||||
Top = 3240
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.Label lblGamedata
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Gamedata file (to save mod emblems and time data):"
|
||||
Height = 375
|
||||
Left = 960
|
||||
TabIndex = 32
|
||||
Top = 2760
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.Label lblExeccfg
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "CFG file to instantly execute upon loading this SOC:"
|
||||
Height = 495
|
||||
Left = 960
|
||||
TabIndex = 10
|
||||
Top = 2280
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.Label lblIntrotoplay
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Cutscene # to use for introduction:"
|
||||
Height = 255
|
||||
Left = 1440
|
||||
TabIndex = 7
|
||||
Top = 1200
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.Label lblRacestage_start
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Racing mode starts/loops back to this map #:"
|
||||
Height = 255
|
||||
Left = 720
|
||||
TabIndex = 5
|
||||
Top = 840
|
||||
Width = 3255
|
||||
End
|
||||
Begin VB.Label lblSpstage_start
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Single Player Game Starts on this map #:"
|
||||
Height = 255
|
||||
Left = 1080
|
||||
TabIndex = 3
|
||||
Top = 480
|
||||
Width = 2895
|
||||
End
|
||||
Begin VB.Label lblSstage_start
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "First Special Stage Map #:"
|
||||
Height = 255
|
||||
Left = 2040
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 1935
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmMaincfg"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Private Sub cmdReload_Click()
|
||||
Call Reload
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
Call WriteSettings
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Call Reload
|
||||
End Sub
|
||||
|
||||
Private Sub ClearForm()
|
||||
Dim i As Integer
|
||||
|
||||
txtSstage_start.Text = ""
|
||||
txtSpstage_start.Text = ""
|
||||
txtRacestage_start.Text = ""
|
||||
txtIntrotoplay.Text = ""
|
||||
txtExeccfg.Text = ""
|
||||
txtGamedata.Text = ""
|
||||
txtNumemblems.Text = ""
|
||||
txtInvulntics.Text = ""
|
||||
txtSneakertics.Text = ""
|
||||
txtFlashingtics.Text = ""
|
||||
txtTailsflytics.Text = ""
|
||||
txtUnderwatertics.Text = ""
|
||||
txtSpacetimetics.Text = ""
|
||||
txtExtralifetics.Text = ""
|
||||
txtParalooptics.Text = ""
|
||||
txtHelpertics.Text = ""
|
||||
txtGameovertics.Text = ""
|
||||
txtCreditsCutscene.Text = ""
|
||||
txtTitleScrollSpeed.Text = ""
|
||||
chkLoopTitle.Value = 0
|
||||
chkDisableSpeedAdjust.Value = 0
|
||||
|
||||
For i = 0 To 2
|
||||
chkReset(i).Value = 0
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
Private Sub Reload()
|
||||
Call ClearForm
|
||||
Call ReadSOCMaincfg
|
||||
End Sub
|
||||
|
||||
Private Sub ReadSOCMaincfg()
|
||||
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) = "MAINCFG" Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "SSTAGE_START" Then
|
||||
txtSstage_start.Text = Val(word2)
|
||||
ElseIf word = "SPSTAGE_START" Then
|
||||
txtSpstage_start.Text = Val(word2)
|
||||
ElseIf word = "RACESTAGE_START" Then
|
||||
txtRacestage_start.Text = Val(word2)
|
||||
ElseIf word = "INVULNTICS" Then
|
||||
txtInvulntics.Text = Val(word2)
|
||||
ElseIf word = "SNEAKERTICS" Then
|
||||
txtSneakertics.Text = Val(word2)
|
||||
ElseIf word = "FLASHINGTICS" Then
|
||||
txtFlashingtics.Text = Val(word2)
|
||||
ElseIf word = "TAILSFLYTICS" Then
|
||||
txtTailsflytics.Text = Val(word2)
|
||||
ElseIf word = "UNDERWATERTICS" Then
|
||||
txtUnderwatertics.Text = Val(word2)
|
||||
ElseIf word = "SPACETIMETICS" Then
|
||||
txtSpacetimetics.Text = Val(word2)
|
||||
ElseIf word = "EXTRALIFETICS" Then
|
||||
txtExtralifetics.Text = Val(word2)
|
||||
ElseIf word = "PARALOOPTICS" Then
|
||||
txtParalooptics.Text = Val(word2)
|
||||
ElseIf word = "HELPERTICS" Then
|
||||
txtHelpertics.Text = Val(word2)
|
||||
ElseIf word = "GAMEOVERTICS" Then
|
||||
txtGameovertics.Text = Val(word2)
|
||||
ElseIf word = "INTROTOPLAY" Then
|
||||
txtIntrotoplay.Text = Val(word2)
|
||||
ElseIf word = "CREDITSCUTSCENE" Then
|
||||
txtCreditsCutscene.Text = Val(word2)
|
||||
ElseIf word = "TITLESCROLLSPEED" Then
|
||||
txtTitleScrollSpeed.Text = Val(word2)
|
||||
ElseIf word = "LOOPTITLE" Then
|
||||
chkLoopTitle.Value = Val(word2)
|
||||
ElseIf word = "DISABLESPEEDADJUST" Then
|
||||
chkDisableSpeedAdjust.Value = Val(word2)
|
||||
ElseIf word = "GAMEDATA" Then
|
||||
txtGamedata.Text = word2
|
||||
ElseIf word = "NUMEMBLEMS" Then
|
||||
txtNumemblems.Text = Val(word2)
|
||||
ElseIf word = "RESETDATA" Then
|
||||
Dim resetflags As Integer
|
||||
Dim z As Integer
|
||||
|
||||
resetflags = Val(word2)
|
||||
|
||||
For z = 0 To 2
|
||||
If resetflags And chkReset(z).Tag Then
|
||||
chkReset(z).Value = 1
|
||||
Else
|
||||
chkReset(z).Value = 0
|
||||
End If
|
||||
Next z
|
||||
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 WriteSettings()
|
||||
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 i As Integer
|
||||
|
||||
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 category exists in the SOC, delete it.
|
||||
If word = "MAINCFG" Then
|
||||
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 line <> "" Then tsTarget.WriteLine ""
|
||||
|
||||
tsTarget.WriteLine "MAINCFG CATEGORY"
|
||||
txtSstage_start.Text = TrimComplete(txtSstage_start.Text)
|
||||
txtSpstage_start.Text = TrimComplete(txtSpstage_start.Text)
|
||||
txtRacestage_start.Text = TrimComplete(txtRacestage_start.Text)
|
||||
txtIntrotoplay.Text = TrimComplete(txtIntrotoplay.Text)
|
||||
txtCreditsCutscene.Text = TrimComplete(txtCreditsCutscene.Text)
|
||||
txtExeccfg.Text = TrimComplete(txtExeccfg.Text)
|
||||
txtGamedata.Text = TrimComplete(txtGamedata.Text)
|
||||
txtNumemblems.Text = TrimComplete(txtNumemblems.Text)
|
||||
txtInvulntics.Text = TrimComplete(txtInvulntics.Text)
|
||||
txtSneakertics.Text = TrimComplete(txtSneakertics.Text)
|
||||
txtFlashingtics.Text = TrimComplete(txtFlashingtics.Text)
|
||||
txtTailsflytics.Text = TrimComplete(txtTailsflytics.Text)
|
||||
txtUnderwatertics.Text = TrimComplete(txtUnderwatertics.Text)
|
||||
txtSpacetimetics.Text = TrimComplete(txtSpacetimetics.Text)
|
||||
txtExtralifetics.Text = TrimComplete(txtExtralifetics.Text)
|
||||
txtParalooptics.Text = TrimComplete(txtParalooptics.Text)
|
||||
txtHelpertics.Text = TrimComplete(txtHelpertics.Text)
|
||||
txtGameovertics.Text = TrimComplete(txtGameovertics.Text)
|
||||
txtTitleScrollSpeed.Text = TrimComplete(txtTitleScrollSpeed.Text)
|
||||
|
||||
If txtSstage_start.Text <> "" Then tsTarget.WriteLine "SSTAGE_START = " & Val(txtSstage_start.Text)
|
||||
If txtSpstage_start.Text <> "" Then tsTarget.WriteLine "SPSTAGE_START = " & Val(txtSpstage_start.Text)
|
||||
If txtRacestage_start.Text <> "" Then tsTarget.WriteLine "RACESTAGE_START = " & Val(txtRacestage_start.Text)
|
||||
If txtIntrotoplay.Text <> "" Then tsTarget.WriteLine "INTROTOPLAY = " & Val(txtIntrotoplay.Text)
|
||||
If txtCreditsCutscene.Text <> "" Then tsTarget.WriteLine "CREDITSCUTSCENE = " & Val(txtCreditsCutscene.Text)
|
||||
If txtExeccfg.Text <> "" Then tsTarget.WriteLine "EXECCFG = " & txtExeccfg.Text
|
||||
If txtGamedata.Text <> "" Then tsTarget.WriteLine "GAMEDATA = " & txtGamedata.Text
|
||||
If txtNumemblems.Text <> "" Then
|
||||
tsTarget.WriteLine "NUMEMBLEMS = " & Val(txtNumemblems.Text)
|
||||
EditedNumemblems = True
|
||||
End If
|
||||
If txtInvulntics.Text <> "" Then tsTarget.WriteLine "INVULNTICS = " & Val(txtInvulntics.Text)
|
||||
If txtSneakertics.Text <> "" Then tsTarget.WriteLine "SNEAKERTICS = " & Val(txtSneakertics.Text)
|
||||
If txtFlashingtics.Text <> "" Then tsTarget.WriteLine "FLASHINGTICS = " & Val(txtFlashingtics.Text)
|
||||
If txtTailsflytics.Text <> "" Then tsTarget.WriteLine "TAILSFLYTICS = " & Val(txtTailsflytics.Text)
|
||||
If txtUnderwatertics.Text <> "" Then tsTarget.WriteLine "UNDERWATERTICS = " & Val(txtUnderwatertics.Text)
|
||||
If txtSpacetimetics.Text <> "" Then tsTarget.WriteLine "SPACETIMETICS = " & Val(txtSpacetimetics.Text)
|
||||
If txtExtralifetics.Text <> "" Then tsTarget.WriteLine "EXTRALIFETICS = " & Val(txtExtralifetics.Text)
|
||||
If txtParalooptics.Text <> "" Then tsTarget.WriteLine "PARALOOPTICS = " & Val(txtParalooptics.Text)
|
||||
If txtHelpertics.Text <> "" Then tsTarget.WriteLine "HELPERTICS = " & Val(txtHelpertics.Text)
|
||||
If txtGameovertics.Text <> "" Then tsTarget.WriteLine "GAMEOVERTICS = " & Val(txtGameovertics.Text)
|
||||
If txtTitleScrollSpeed.Text <> "" Then tsTarget.WriteLine "TITLESCROLLSPEED = " & Val(txtTitleScrollSpeed.Text)
|
||||
If chkLoopTitle.Value = 1 Then tsTarget.WriteLine "LOOPTITLE = " & chkLoopTitle.Value
|
||||
If chkDisableSpeedAdjust.Value = 1 Then tsTarget.WriteLine "DISABLESPEEDADJUST = " & chkDisableSpeedAdjust.Value
|
||||
|
||||
flags = 0
|
||||
For i = 0 To 2
|
||||
If chkReset(i).Value = 1 Then
|
||||
flags = flags + Val(chkReset(i).Tag)
|
||||
End If
|
||||
Next
|
||||
|
||||
If flags > 0 Then tsTarget.WriteLine "RESETDATA = " & flags
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
MsgBox "Settings Saved."
|
||||
End Sub
|
||||
|
||||
BIN
frmMaincfg.frx
Normal file
BIN
frmMaincfg.frx
Normal file
Binary file not shown.
485
frmSoundEdit.frm
Normal file
485
frmSoundEdit.frm
Normal file
|
|
@ -0,0 +1,485 @@
|
|||
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
|
||||
|
||||
BIN
frmSoundEdit.frx
Normal file
BIN
frmSoundEdit.frx
Normal file
Binary file not shown.
940
frmStateEdit.frm
Normal file
940
frmStateEdit.frm
Normal file
|
|
@ -0,0 +1,940 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmStateEdit
|
||||
Caption = "State Edit"
|
||||
ClientHeight = 6750
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 8970
|
||||
Icon = "frmStateEdit.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 6750
|
||||
ScaleWidth = 8970
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.TextBox lblVar2Desc
|
||||
Height = 495
|
||||
Left = 4440
|
||||
Locked = -1 'True
|
||||
MultiLine = -1 'True
|
||||
ScrollBars = 2 'Vertical
|
||||
TabIndex = 25
|
||||
Top = 3000
|
||||
Width = 4455
|
||||
End
|
||||
Begin VB.TextBox lblVar1Desc
|
||||
Height = 495
|
||||
Left = 4440
|
||||
Locked = -1 'True
|
||||
MultiLine = -1 'True
|
||||
ScrollBars = 2 'Vertical
|
||||
TabIndex = 24
|
||||
Top = 2400
|
||||
Width = 4455
|
||||
End
|
||||
Begin VB.TextBox lblActionDesc
|
||||
Height = 735
|
||||
Left = 4440
|
||||
Locked = -1 'True
|
||||
MultiLine = -1 'True
|
||||
ScrollBars = 2 'Vertical
|
||||
TabIndex = 23
|
||||
Top = 1560
|
||||
Width = 4455
|
||||
End
|
||||
Begin VB.ListBox lstThings
|
||||
Height = 450
|
||||
ItemData = "frmStateEdit.frx":0442
|
||||
Left = 7440
|
||||
List = "frmStateEdit.frx":0444
|
||||
TabIndex = 22
|
||||
Top = 6120
|
||||
Visible = 0 'False
|
||||
Width = 975
|
||||
End
|
||||
Begin VB.TextBox txtFuncVar2
|
||||
Height = 285
|
||||
Left = 7200
|
||||
TabIndex = 19
|
||||
Top = 3600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.TextBox txtFuncVar1
|
||||
Height = 285
|
||||
Left = 5520
|
||||
TabIndex = 18
|
||||
Top = 3600
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdCopy
|
||||
Caption = "&Copy state to..."
|
||||
Height = 495
|
||||
Left = 6120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 17
|
||||
Top = 6120
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdDelete
|
||||
Caption = "&Delete State from SOC"
|
||||
Height = 495
|
||||
Left = 6120
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 16
|
||||
Top = 5520
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdReload
|
||||
Caption = "&Load Code Default"
|
||||
Height = 495
|
||||
Left = 4920
|
||||
Style = 1 'Graphical
|
||||
TabIndex = 15
|
||||
Top = 5520
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save"
|
||||
Height = 495
|
||||
Left = 7320
|
||||
TabIndex = 14
|
||||
Top = 5520
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.ComboBox cmbTranslucency
|
||||
Height = 315
|
||||
ItemData = "frmStateEdit.frx":0446
|
||||
Left = 6720
|
||||
List = "frmStateEdit.frx":045C
|
||||
TabIndex = 12
|
||||
Top = 5040
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.CheckBox chkFullbright
|
||||
Caption = "Make sprite full-brightness (unaffected by lighting)"
|
||||
Height = 495
|
||||
Left = 6240
|
||||
TabIndex = 11
|
||||
Top = 4440
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.ComboBox cmbNextstate
|
||||
Height = 315
|
||||
Left = 6120
|
||||
TabIndex = 9
|
||||
Top = 3960
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.ComboBox cmbAction
|
||||
Height = 315
|
||||
Left = 6000
|
||||
TabIndex = 7
|
||||
Top = 1200
|
||||
Width = 2295
|
||||
End
|
||||
Begin VB.TextBox txtTics
|
||||
Height = 285
|
||||
Left = 7800
|
||||
TabIndex = 5
|
||||
Top = 720
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtFrame
|
||||
Height = 285
|
||||
Left = 5880
|
||||
MaxLength = 2
|
||||
TabIndex = 3
|
||||
Top = 720
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.ComboBox cmbSprite
|
||||
Height = 315
|
||||
Left = 5880
|
||||
TabIndex = 1
|
||||
Top = 120
|
||||
Width = 2415
|
||||
End
|
||||
Begin VB.ListBox lstStates
|
||||
Height = 6495
|
||||
Left = 120
|
||||
TabIndex = 0
|
||||
Top = 120
|
||||
Width = 4215
|
||||
End
|
||||
Begin VB.Label lblFuncVar2
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Var2:"
|
||||
Height = 255
|
||||
Left = 6600
|
||||
TabIndex = 21
|
||||
Top = 3600
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.Label lblFuncVar1
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Var1:"
|
||||
Height = 255
|
||||
Left = 4920
|
||||
TabIndex = 20
|
||||
Top = 3600
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.Label lblTranslucency
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Translucency:"
|
||||
Height = 255
|
||||
Left = 5520
|
||||
TabIndex = 13
|
||||
Top = 5040
|
||||
Width = 1095
|
||||
End
|
||||
Begin VB.Label lblNextstate
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Next State:"
|
||||
Height = 255
|
||||
Left = 5160
|
||||
TabIndex = 10
|
||||
Top = 3960
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.Label lblAction
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Function to Call:"
|
||||
Height = 375
|
||||
Left = 5040
|
||||
TabIndex = 8
|
||||
Top = 1080
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.Label lblTics
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Tics (-1 for infinite duration):"
|
||||
Height = 495
|
||||
Left = 6480
|
||||
TabIndex = 6
|
||||
Top = 600
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblFrame
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Frame:"
|
||||
Height = 255
|
||||
Left = 5160
|
||||
TabIndex = 4
|
||||
Top = 720
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.Label lblSprite
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Sprite:"
|
||||
Height = 255
|
||||
Left = 5160
|
||||
TabIndex = 2
|
||||
Top = 120
|
||||
Width = 615
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmStateEdit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmbAction_Click()
|
||||
Dim myFSO As New Scripting.FileSystemObject
|
||||
Dim ts As TextStream
|
||||
Dim line As String
|
||||
Dim index As Integer
|
||||
Dim ActionName As String
|
||||
|
||||
ActionName = cmbAction.List(cmbAction.ListIndex)
|
||||
|
||||
If cmbAction.ListIndex = 0 Then
|
||||
lblActionDesc.Text = ""
|
||||
lblVar1Desc.Text = ""
|
||||
lblVar2Desc.Text = ""
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("p_enemy.c", ForReading, False)
|
||||
|
||||
Do While Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
|
||||
If Mid(line, 4, 9) = "Function:" And InStr(line, ActionName) > 0 Then
|
||||
ts.ReadLine ' //
|
||||
line = ts.ReadLine ' // Description:
|
||||
index = InStr(line, ":")
|
||||
lblActionDesc.Text = Mid(line, index + 2, Len(line) - (index + 1))
|
||||
|
||||
ts.ReadLine ' //
|
||||
line = ts.ReadLine ' // var1 =
|
||||
If InStr(line, "var1:") Then
|
||||
lblVar1Desc.Text = Mid(line, 4, Len(line) - 3)
|
||||
line = ts.ReadLine
|
||||
Do While Left(line, 7) <> "// var2"
|
||||
lblVar1Desc.Text = lblVar1Desc.Text & vbCrLf & TrimComplete(Mid(line, 4, Len(line) - 3))
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
Else
|
||||
lblVar1Desc.Text = Mid(line, 4, Len(line) - 3)
|
||||
End If
|
||||
|
||||
If Left(line, 7) <> "// var2" Then
|
||||
line = ts.ReadLine ' // var2 =
|
||||
End If
|
||||
|
||||
If InStr(line, "var2:") Then
|
||||
lblVar2Desc.Text = Mid(line, 4, Len(line) - 3)
|
||||
line = ts.ReadLine
|
||||
Do While Len(line) > 4
|
||||
lblVar2Desc.Text = lblVar2Desc.Text & vbCrLf & TrimComplete(Mid(line, 4, Len(line) - 3))
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
Else
|
||||
lblVar2Desc.Text = Mid(line, 4, Len(line) - 3)
|
||||
End If
|
||||
End If
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCopy_Click()
|
||||
Dim Response As String
|
||||
|
||||
Response$ = InputBox("Copy state to #:", "Copy State")
|
||||
|
||||
If Response = "" Then Exit Sub
|
||||
|
||||
Response = TrimComplete(Response)
|
||||
|
||||
Call WriteState(False, Val(Response))
|
||||
|
||||
MsgBox "State copied to #" & Val(Response)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdDelete_Click()
|
||||
Call WriteState(True, lstStates.ListIndex)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdReload_Click()
|
||||
Call ClearForm
|
||||
|
||||
If InStr(lstStates.List(lstStates.ListIndex), "S_FREESLOT") = 0 Then
|
||||
LoadStateInfo (lstStates.ListIndex)
|
||||
Else
|
||||
MsgBox "Free slots do not have a code default."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
If TrimComplete(txtFrame.Text) = "" And (chkFullbright.Value = 1 Or cmbTranslucency.ListIndex > 0) Then
|
||||
MsgBox "ERROR: Frame field required for fullbright/translucency."
|
||||
Exit Sub
|
||||
End If
|
||||
Call WriteState(False, lstStates.ListIndex)
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Call Reload
|
||||
lstStates.ListIndex = 0
|
||||
End Sub
|
||||
|
||||
Private Sub ClearForm()
|
||||
cmbNextstate.Text = ""
|
||||
cmbSprite.Text = ""
|
||||
txtFrame.Text = ""
|
||||
cmbAction.Text = ""
|
||||
txtFuncVar1.Text = ""
|
||||
txtFuncVar2.Text = ""
|
||||
lblActionDesc.Text = ""
|
||||
lblVar1Desc.Text = ""
|
||||
lblVar2Desc.Text = ""
|
||||
chkFullbright.Value = False
|
||||
cmbTranslucency.ListIndex = 0
|
||||
End Sub
|
||||
|
||||
Private Sub Reload()
|
||||
LoadStates
|
||||
LoadSprites
|
||||
LoadActions
|
||||
End Sub
|
||||
|
||||
Private Sub LoadStates()
|
||||
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 numfreeslots As Integer, i As Integer
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "Object states (don't modify this comment!)") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' typedef enum
|
||||
ts.SkipLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
lstStates.Clear
|
||||
|
||||
Do While InStr(line, "S_FIRSTFREESLOT") = 0
|
||||
startclip = InStr(line, "S_")
|
||||
If InStr(line, "S_") <> 0 Then
|
||||
endclip = InStr(line, ",")
|
||||
line = Mid(line, startclip, endclip - startclip)
|
||||
addstring = number & " - " & line
|
||||
lstStates.AddItem addstring
|
||||
cmbNextstate.AddItem addstring
|
||||
number = number + 1
|
||||
End If
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
|
||||
'Populate the free slots!
|
||||
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
|
||||
|
||||
line = ts.ReadLine
|
||||
Do While InStr(line, "#define NUMMOBJFREESLOTS") = 0
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
startclip = InStr(line, "SLOTS ") + 6
|
||||
numfreeslots = Val(Mid(line, startclip, Len(line) - startclip + 1)) * 6
|
||||
|
||||
For i = 1 To numfreeslots
|
||||
addstring = number & " - " & "S_FREESLOT" & i
|
||||
lstStates.AddItem addstring
|
||||
cmbNextstate.AddItem addstring
|
||||
number = number + 1
|
||||
Next
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub LoadSprites()
|
||||
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 numfreeslots As Integer, i As Integer
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "Hey, moron! If you change this table, don't forget about") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' typedef enum
|
||||
ts.SkipLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
cmbSprite.Clear
|
||||
|
||||
Do While InStr(line, "SPR_FIRSTFREESLOT") = 0
|
||||
startclip = InStr(line, "SPR_")
|
||||
If InStr(line, "SPR_") <> 0 Then
|
||||
endclip = InStr(line, ",")
|
||||
line = Mid(line, startclip, endclip - startclip)
|
||||
addstring = number & " - " & line
|
||||
cmbSprite.AddItem addstring
|
||||
number = number + 1
|
||||
End If
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
|
||||
'Populate the free slots!
|
||||
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
|
||||
|
||||
line = ts.ReadLine
|
||||
Do While InStr(line, "#define NUMMOBJFREESLOTS") = 0
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
startclip = InStr(line, "SLOTS ") + 6
|
||||
numfreeslots = Val(Mid(line, startclip, Len(line) - startclip + 1))
|
||||
|
||||
For i = 1 To numfreeslots
|
||||
If i < 10 Then
|
||||
addstring = number & " - " & "SPR_F00" & i & " (Free slot)"
|
||||
ElseIf i < 100 Then
|
||||
addstring = number & " - " & "SPR_F0" & i & " (Free slot)"
|
||||
Else
|
||||
addstring = number & " - " & "SPR_F" & i & " (Free slot)"
|
||||
End If
|
||||
|
||||
cmbSprite.AddItem addstring
|
||||
number = number + 1
|
||||
Next
|
||||
|
||||
ts.Close
|
||||
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub LoadActions()
|
||||
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
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("dehacked.c", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "actionpointer_t actionpointers[]") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
cmbAction.Clear
|
||||
|
||||
cmbAction.AddItem "None"
|
||||
|
||||
Do While InStr(line, "NULL") = 0
|
||||
startclip = InStr(line, "A_")
|
||||
If InStr(line, "A_") <> 0 Then
|
||||
endclip = InStr(line, "}")
|
||||
line = Mid(line, startclip, endclip - startclip)
|
||||
cmbAction.AddItem line
|
||||
number = number + 1
|
||||
End If
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub lstStates_Click()
|
||||
Call ClearForm
|
||||
|
||||
If InStr(lstStates.List(lstStates.ListIndex), "S_FREESLOT") = 0 Then
|
||||
LoadStateInfo (lstStates.ListIndex)
|
||||
End If
|
||||
|
||||
LoadSOCStateInfo (lstStates.ListIndex)
|
||||
End Sub
|
||||
|
||||
Private Sub LoadSOCStateInfo(StateNum As Integer)
|
||||
Dim myFSO As New Scripting.FileSystemObject
|
||||
Dim ts As TextStream
|
||||
Dim line As String
|
||||
Dim word As String
|
||||
Dim word2 As String
|
||||
Dim frameNum As Long
|
||||
|
||||
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) = "FRAME" And Val(word2) = StateNum Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "SPRITENUMBER" Then
|
||||
cmbSprite.ListIndex = Val(word2)
|
||||
ElseIf word = "SPRITESUBNUMBER" Then
|
||||
frameNum = Val(word2)
|
||||
|
||||
If frameNum >= 327680 Then ' 5 << 16
|
||||
cmbTranslucency.ListIndex = 5
|
||||
frameNum = frameNum And Not 327680
|
||||
ElseIf frameNum >= 262144 Then ' 4 << 16
|
||||
cmbTranslucency.ListIndex = 4
|
||||
frameNum = frameNum And Not 262144
|
||||
ElseIf frameNum >= 196608 Then ' 3 << 16
|
||||
cmbTranslucency.ListIndex = 3
|
||||
frameNum = frameNum And Not 196608
|
||||
ElseIf frameNum >= 131072 Then ' 2 << 16
|
||||
cmbTranslucency.ListIndex = 2
|
||||
frameNum = frameNum And Not 131072
|
||||
ElseIf frameNum >= 65536 Then ' 1 << 16
|
||||
cmbTranslucency.ListIndex = 1
|
||||
frameNum = frameNum And Not 65536
|
||||
End If
|
||||
|
||||
If frameNum >= 32768 Then
|
||||
chkFullbright.Value = 1
|
||||
frameNum = frameNum And Not 32768
|
||||
Else
|
||||
chkFullbright.Value = 0
|
||||
End If
|
||||
|
||||
txtFrame.Text = frameNum
|
||||
ElseIf word = "DURATION" Then
|
||||
txtTics.Text = Val(word2)
|
||||
ElseIf word = "NEXT" Then
|
||||
cmbNextstate.ListIndex = Val(word2)
|
||||
ElseIf word = "ACTION" Then
|
||||
Call FindComboIndex(cmbAction, UCase(SecondToken(line)))
|
||||
ElseIf word = "VAR1" Then
|
||||
txtFuncVar1.Text = Val(word2)
|
||||
ElseIf word = "VAR2" Then
|
||||
txtFuncVar2.Text = 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 LoadStateInfo(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
|
||||
Dim templine As String
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("info.c", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "Keep this comment directly above S_NULL") = 0
|
||||
Loop
|
||||
|
||||
number = 0
|
||||
|
||||
Do While number <> StateNum
|
||||
Do While InStr(ts.ReadLine, "SPR_") = 0
|
||||
Loop
|
||||
number = number + 1
|
||||
Loop
|
||||
|
||||
Do While InStr(line, "SPR_") = 0
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
startclip = InStr(line, "SPR_")
|
||||
line = Mid(line, startclip, Len(line) - startclip)
|
||||
endclip = InStr(line, ",") - 1
|
||||
token = Left(line, endclip)
|
||||
Call FindComboIndex(cmbSprite, token)
|
||||
|
||||
startclip = InStr(line, ",") + 1
|
||||
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
|
||||
endclip = InStr(line, ",") - 1
|
||||
frame = Val(Left(line, endclip))
|
||||
|
||||
If frame >= 32768 Then
|
||||
chkFullbright.Value = 1
|
||||
frame = frame - 32768
|
||||
Else
|
||||
chkFullbright.Value = 0
|
||||
End If
|
||||
|
||||
txtFrame.Text = frame
|
||||
|
||||
cmbTranslucency.ListIndex = 0
|
||||
|
||||
startclip = InStr(line, ",") + 1
|
||||
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
|
||||
endclip = InStr(line, ",") - 1
|
||||
txtTics.Text = Val(Left(line, endclip))
|
||||
|
||||
startclip = InStr(line, "{") + 1
|
||||
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
|
||||
endclip = InStr(line, "}") - 1
|
||||
cmbAction.Text = TrimComplete(Left(line, endclip))
|
||||
If cmbAction.Text = "NULL" Then cmbAction.Text = "None"
|
||||
|
||||
startclip = InStr(line, ",") + 1
|
||||
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
|
||||
endclip = InStr(line, ",") - 1
|
||||
templine = Left(line, endclip)
|
||||
|
||||
templine = TrimComplete(templine)
|
||||
'Check for *FRACUNIT values
|
||||
endclip = InStr(templine, "*FRACUNIT")
|
||||
If endclip <> 0 Then
|
||||
templine = Left(templine, endclip - 1)
|
||||
templine = Val(templine) * 65536
|
||||
End If
|
||||
'Check for crazy-odd MT_ usage
|
||||
endclip = InStr(templine, "MT_")
|
||||
If endclip <> 0 Then
|
||||
templine = FindThingNum(templine) & " - " & templine
|
||||
End If
|
||||
'Check for crazy-odd pw_ usage
|
||||
endclip = InStr(templine, "pw_")
|
||||
If endclip <> 0 Then
|
||||
templine = FindPowerNum(templine) & " - " & templine
|
||||
End If
|
||||
txtFuncVar1.Text = templine
|
||||
|
||||
startclip = InStr(line, ",") + 1
|
||||
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
|
||||
endclip = InStr(line, ",") - 1
|
||||
templine = Left(line, endclip)
|
||||
|
||||
templine = TrimComplete(templine)
|
||||
'Check for *FRACUNIT values
|
||||
endclip = InStr(templine, "*FRACUNIT")
|
||||
If endclip <> 0 Then
|
||||
templine = Left(templine, endclip - 1)
|
||||
templine = Val(templine) * 65536
|
||||
End If
|
||||
'Check for crazy-odd MT_ usage
|
||||
endclip = InStr(templine, "MT_")
|
||||
If endclip <> 0 Then
|
||||
templine = FindThingNum(templine) & " - " & templine
|
||||
End If
|
||||
'Check for crazy-odd pw_ usage
|
||||
endclip = InStr(templine, "pw_")
|
||||
If endclip <> 0 Then
|
||||
templine = FindPowerNum(templine) & " - " & templine
|
||||
End If
|
||||
txtFuncVar2.Text = templine
|
||||
|
||||
startclip = InStr(line, ",") + 1
|
||||
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
|
||||
endclip = InStr(line, "}") - 1
|
||||
Call FindComboIndex(cmbNextstate, TrimComplete(Left(line, endclip)))
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Sub FindComboIndex(ByRef Box As ComboBox, line As String)
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To Box.ListCount
|
||||
If InStr(UCase(Box.List(i)), UCase(line)) Then
|
||||
Box.ListIndex = i
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Private Sub WriteState(Remove As Boolean, num As Integer)
|
||||
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 statefound As Boolean
|
||||
|
||||
statefound = 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 = "FRAME" And Val(word2) = num Then
|
||||
statefound = 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 "FRAME " & num
|
||||
cmbSprite.Text = TrimComplete(cmbSprite.Text)
|
||||
txtFrame.Text = TrimComplete(txtFrame.Text)
|
||||
txtTics.Text = TrimComplete(txtTics.Text)
|
||||
cmbAction.Text = TrimComplete(cmbAction.Text)
|
||||
txtFuncVar1.Text = TrimComplete(txtFuncVar1.Text)
|
||||
txtFuncVar2.Text = TrimComplete(txtFuncVar2.Text)
|
||||
cmbNextstate.Text = TrimComplete(cmbNextstate.Text)
|
||||
cmbTranslucency.Text = TrimComplete(cmbTranslucency.Text)
|
||||
|
||||
If cmbSprite.Text <> "" Then tsTarget.WriteLine "SPRITENUMBER = " & cmbSprite.ListIndex
|
||||
|
||||
flags = Val(txtFrame.Text)
|
||||
If chkFullbright.Value = 1 Then flags = flags + 32768
|
||||
|
||||
' Grrr VB doesn't have bitshifts!!
|
||||
If cmbTranslucency.Text <> "" Then
|
||||
flags = flags + cmbTranslucency.ListIndex * 65536
|
||||
End If
|
||||
|
||||
If txtFrame.Text <> "" Then tsTarget.WriteLine "SPRITESUBNUMBER = " & flags
|
||||
If txtTics.Text <> "" Then tsTarget.WriteLine "DURATION = " & Val(txtTics.Text)
|
||||
If cmbNextstate.Text <> "" Then tsTarget.WriteLine "NEXT = " & cmbNextstate.ListIndex
|
||||
If cmbAction.Text <> "" Then tsTarget.WriteLine "ACTION " & cmbAction.Text
|
||||
If txtFuncVar1.Text <> "" Then tsTarget.WriteLine "VAR1 = " & Val(txtFuncVar1.Text)
|
||||
If txtFuncVar2.Text <> "" Then tsTarget.WriteLine "VAR2 = " & Val(txtFuncVar2.Text)
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
If statefound = True Then
|
||||
MsgBox "State removed from SOC."
|
||||
Else
|
||||
MsgBox "State not found in SOC."
|
||||
End If
|
||||
Else
|
||||
MsgBox "State Saved."
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub LoadThings()
|
||||
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 numfreeslots As Integer, i As Integer
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "Little flag for SOC editor (don't change this comment!)") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' typedef enum
|
||||
ts.SkipLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
lstThings.Clear
|
||||
|
||||
Do While InStr(line, "MT_FIRSTFREESLOT") = 0
|
||||
startclip = InStr(line, "MT_")
|
||||
If InStr(line, "MT_") <> 0 Then
|
||||
endclip = InStr(line, ",")
|
||||
line = Mid(line, startclip, endclip - startclip)
|
||||
lstThings.AddItem number & " - " & line
|
||||
number = number + 1
|
||||
End If
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
|
||||
'Populate the free slots!
|
||||
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
|
||||
|
||||
line = ts.ReadLine
|
||||
Do While InStr(line, "#define NUMMOBJFREESLOTS") = 0
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
startclip = InStr(line, "SLOTS ") + 6
|
||||
numfreeslots = Val(Mid(line, startclip, Len(line) - startclip + 1))
|
||||
|
||||
For i = 1 To numfreeslots
|
||||
lstThings.AddItem number & " - " & "MT_FREESLOT" & i
|
||||
number = number + 1
|
||||
Next
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Sub
|
||||
|
||||
Private Function FindThingNum(ThingName As String) As Integer
|
||||
Dim i As Integer
|
||||
Dim temp As String
|
||||
Dim startpoint As Integer
|
||||
Dim endpoint As Integer
|
||||
|
||||
lstThings.Clear
|
||||
LoadThings
|
||||
|
||||
For i = 0 To lstThings.ListCount - 1
|
||||
temp = lstThings.List(i)
|
||||
startpoint = InStr(temp, "-") + 2
|
||||
endpoint = Len(temp) - startpoint + 1
|
||||
temp = Mid(temp, startpoint, endpoint)
|
||||
If temp = ThingName Then
|
||||
FindThingNum = Val(lstThings.List(i))
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Private Function FindPowerNum(PowerName As String) As Integer
|
||||
Dim myFSO As New Scripting.FileSystemObject
|
||||
Dim ts As TextStream
|
||||
Dim line As String
|
||||
Dim number As Integer
|
||||
Dim startclip As Integer
|
||||
|
||||
ChDir SourcePath
|
||||
Set ts = myFSO.OpenTextFile("d_player.h", ForReading, False)
|
||||
|
||||
Do While InStr(ts.ReadLine, "Player powers. (don't edit this comment)") = 0
|
||||
Loop
|
||||
|
||||
ts.SkipLine ' typedef enum
|
||||
ts.SkipLine ' {
|
||||
|
||||
line = ts.ReadLine
|
||||
number = 0
|
||||
|
||||
Do While InStr(line, "NUMPOWERS") = 0
|
||||
startclip = InStr(line, PowerName)
|
||||
If startclip <> 0 Then
|
||||
FindPowerNum = number
|
||||
Exit Do
|
||||
End If
|
||||
number = number + 1
|
||||
line = ts.ReadLine
|
||||
Loop
|
||||
|
||||
ts.Close
|
||||
Set myFSO = Nothing
|
||||
End Function
|
||||
BIN
frmStateEdit.frx
Normal file
BIN
frmStateEdit.frx
Normal file
Binary file not shown.
391
frmUnlockablesEdit.frm
Normal file
391
frmUnlockablesEdit.frm
Normal file
|
|
@ -0,0 +1,391 @@
|
|||
VERSION 5.00
|
||||
Begin VB.Form frmUnlockablesEdit
|
||||
Caption = "Unlockables Edit"
|
||||
ClientHeight = 3675
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 8130
|
||||
Icon = "frmUnlockablesEdit.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
ScaleHeight = 3675
|
||||
ScaleWidth = 8130
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.CheckBox chkGrade
|
||||
Caption = "Must have beaten Ultimate"
|
||||
Height = 255
|
||||
Index = 4
|
||||
Left = 5400
|
||||
TabIndex = 20
|
||||
Tag = "1024"
|
||||
Top = 2160
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.CheckBox chkGrade
|
||||
Caption = "Must have beaten Very Hard"
|
||||
Height = 255
|
||||
Index = 3
|
||||
Left = 5400
|
||||
TabIndex = 19
|
||||
Tag = "128"
|
||||
Top = 1800
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.CheckBox chkGrade
|
||||
Caption = "Must have all emblems"
|
||||
Height = 255
|
||||
Index = 2
|
||||
Left = 5400
|
||||
TabIndex = 18
|
||||
Tag = "16"
|
||||
Top = 1440
|
||||
Width = 2055
|
||||
End
|
||||
Begin VB.CheckBox chkGrade
|
||||
Caption = "Must have gotten all 7 emeralds"
|
||||
Height = 255
|
||||
Index = 1
|
||||
Left = 5400
|
||||
TabIndex = 17
|
||||
Tag = "8"
|
||||
Top = 1080
|
||||
Width = 2655
|
||||
End
|
||||
Begin VB.CheckBox chkGrade
|
||||
Caption = "Game must be completed"
|
||||
Height = 255
|
||||
Index = 0
|
||||
Left = 5400
|
||||
TabIndex = 16
|
||||
Tag = "1"
|
||||
Top = 720
|
||||
Width = 2175
|
||||
End
|
||||
Begin VB.TextBox txtVar
|
||||
Height = 285
|
||||
Left = 4320
|
||||
TabIndex = 14
|
||||
Top = 2640
|
||||
Width = 615
|
||||
End
|
||||
Begin VB.ComboBox cmbType
|
||||
Height = 315
|
||||
ItemData = "frmUnlockablesEdit.frx":0442
|
||||
Left = 3360
|
||||
List = "frmUnlockablesEdit.frx":044C
|
||||
TabIndex = 12
|
||||
Top = 2160
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.TextBox txtNeededTime
|
||||
Height = 285
|
||||
Left = 4080
|
||||
TabIndex = 10
|
||||
Top = 1680
|
||||
Width = 855
|
||||
End
|
||||
Begin VB.TextBox txtNeededEmblems
|
||||
Height = 285
|
||||
Left = 4440
|
||||
TabIndex = 9
|
||||
Top = 1200
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.TextBox txtObjective
|
||||
Height = 285
|
||||
Left = 3240
|
||||
TabIndex = 7
|
||||
Top = 720
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.TextBox txtName
|
||||
Height = 285
|
||||
Left = 3240
|
||||
TabIndex = 5
|
||||
Top = 240
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.CommandButton cmdDelete
|
||||
Caption = "&Delete from SOC"
|
||||
Height = 375
|
||||
Left = 3480
|
||||
TabIndex = 3
|
||||
Top = 3120
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.CommandButton cmdSave
|
||||
Caption = "&Save Changes"
|
||||
Height = 375
|
||||
Left = 1800
|
||||
TabIndex = 2
|
||||
Top = 3120
|
||||
Width = 1575
|
||||
End
|
||||
Begin VB.ListBox lstUnlockables
|
||||
Height = 2985
|
||||
ItemData = "frmUnlockablesEdit.frx":046A
|
||||
Left = 120
|
||||
List = "frmUnlockablesEdit.frx":049B
|
||||
TabIndex = 0
|
||||
Top = 480
|
||||
Width = 1215
|
||||
End
|
||||
Begin VB.Label lblNote
|
||||
Caption = "Note: All requirements are combinable."
|
||||
Height = 495
|
||||
Left = 6000
|
||||
TabIndex = 22
|
||||
Top = 2760
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblOtherReqs
|
||||
Caption = "Other Requirements:"
|
||||
Height = 255
|
||||
Left = 5400
|
||||
TabIndex = 21
|
||||
Top = 360
|
||||
Width = 1935
|
||||
End
|
||||
Begin VB.Label lblVar
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Map # to warp to:"
|
||||
Height = 255
|
||||
Left = 2880
|
||||
TabIndex = 15
|
||||
Top = 2640
|
||||
Width = 1335
|
||||
End
|
||||
Begin VB.Label lblType
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Type of Unlockable:"
|
||||
Height = 255
|
||||
Left = 1800
|
||||
TabIndex = 13
|
||||
Top = 2160
|
||||
Width = 1455
|
||||
End
|
||||
Begin VB.Label lblNeededTime
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Needed time on Time Attack rank (in seconds):"
|
||||
Height = 375
|
||||
Left = 1440
|
||||
TabIndex = 11
|
||||
Top = 1560
|
||||
Width = 2535
|
||||
End
|
||||
Begin VB.Label lblNeededEmblems
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "# of Emblems Needed:"
|
||||
Height = 255
|
||||
Left = 2640
|
||||
TabIndex = 8
|
||||
Top = 1200
|
||||
Width = 1695
|
||||
End
|
||||
Begin VB.Label lblObjective
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Objective:"
|
||||
Height = 255
|
||||
Left = 2400
|
||||
TabIndex = 6
|
||||
Top = 720
|
||||
Width = 735
|
||||
End
|
||||
Begin VB.Label lblName
|
||||
Alignment = 1 'Right Justify
|
||||
Caption = "Name:"
|
||||
Height = 255
|
||||
Left = 2640
|
||||
TabIndex = 4
|
||||
Top = 240
|
||||
Width = 495
|
||||
End
|
||||
Begin VB.Label lblHUDItems
|
||||
Caption = "Unlockables:"
|
||||
Height = 255
|
||||
Left = 120
|
||||
TabIndex = 1
|
||||
Top = 240
|
||||
Width = 975
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "frmUnlockablesEdit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Sub cmdDelete_Click()
|
||||
Call WriteUnlockableItem(True)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdSave_Click()
|
||||
Call WriteUnlockableItem(False)
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Call Reload
|
||||
End Sub
|
||||
|
||||
Private Sub Reload()
|
||||
txtName.Text = ""
|
||||
txtObjective.Text = ""
|
||||
txtNeededEmblems.Text = ""
|
||||
txtNeededTime.Text = ""
|
||||
cmbType.Text = ""
|
||||
txtVar.Text = ""
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To chkGrade.Count - 1
|
||||
chkGrade(i).Value = 0
|
||||
Next i
|
||||
|
||||
lstUnlockables.ListIndex = 0
|
||||
End Sub
|
||||
|
||||
Private Sub lstUnlockables_Click()
|
||||
Call ReadSOC(lstUnlockables.ListIndex + 1)
|
||||
End Sub
|
||||
|
||||
Private Sub ReadSOC(UnlockableNum 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) = "UNLOCKABLE" And Val(word2) = UnlockableNum Then
|
||||
Do While Len(line) > 0 And Not ts.AtEndOfStream
|
||||
line = ts.ReadLine
|
||||
word = UCase(FirstToken(line))
|
||||
word2 = UCase(SecondTokenEqual(line))
|
||||
|
||||
If word = "NAME" Then
|
||||
txtName.Text = word2
|
||||
ElseIf word = "OBJECTIVE" Then
|
||||
txtObjective.Text = word2
|
||||
ElseIf word = "NEEDEDEMBLEMS" Then
|
||||
txtNeededEmblems.Text = Val(word2)
|
||||
ElseIf word = "NEEDEDTIME" Then
|
||||
txtNeededTime.Text = Val(word2)
|
||||
ElseIf word = "TYPE" Then
|
||||
cmbType.ListIndex = Val(word2)
|
||||
ElseIf word = "VAR" Then
|
||||
txtVar.Text = Val(word2)
|
||||
ElseIf word = "NEEDEDGRADE" Then
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To chkGrade.Count - 1
|
||||
If Val(word2) And chkGrade(i).Tag Then
|
||||
chkGrade(i).Tag = True
|
||||
End If
|
||||
Next i
|
||||
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 WriteUnlockableItem(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 unlockableremoved As Boolean
|
||||
|
||||
unlockableremoved = 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 item exists in the SOC, delete it.
|
||||
If word = "UNLOCKABLE" And Val(word2) = lstUnlockables.ListIndex + 1 Then
|
||||
unlockableremoved = 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 "UNLOCKABLE " & lstUnlockables.ListIndex + 1
|
||||
txtName.Text = TrimComplete(txtName.Text)
|
||||
txtObjective.Text = TrimComplete(txtObjective.Text)
|
||||
txtNeededEmblems.Text = TrimComplete(txtNeededEmblems.Text)
|
||||
txtNeededTime.Text = TrimComplete(txtNeededTime.Text)
|
||||
txtVar.Text = TrimComplete(txtVar.Text)
|
||||
|
||||
If txtName.Text <> "" Then tsTarget.WriteLine "NAME = " & txtName.Text
|
||||
If txtObjective.Text <> "" Then tsTarget.WriteLine "OBJECTIVE = " & txtObjective.Text
|
||||
If txtNeededEmblems.Text <> "" Then tsTarget.WriteLine "NEEDEDEMBLEMS = " & txtNeededEmblems.Text
|
||||
If txtNeededTime.Text <> "" Then tsTarget.WriteLine "NEEDEDTIME = " & txtNeededTime.Text
|
||||
If cmbType.ListIndex <> -1 Then tsTarget.WriteLine "TYPE = " & cmbType.ListIndex
|
||||
If txtVar.Text <> "" Then tsTarget.WriteLine "VAR = " & txtVar.Text
|
||||
|
||||
Dim writegrade As Long
|
||||
Dim i As Integer
|
||||
writegrade = 0
|
||||
|
||||
For i = 0 To chkGrade.Count - 1
|
||||
If chkGrade(i).Value = 1 Then
|
||||
writegrade = writegrade + chkGrade(i).Tag
|
||||
End If
|
||||
Next i
|
||||
|
||||
If writegrade > 0 Then tsTarget.WriteLine "NEEDEDGRADE = " & writegrade
|
||||
End If
|
||||
|
||||
tsTarget.Close
|
||||
Set myFSOTarget = Nothing
|
||||
|
||||
FileCopy SOCTemp, SOCFile
|
||||
|
||||
Kill SOCTemp
|
||||
|
||||
If Remove = True Then
|
||||
If unlockableremoved = True Then
|
||||
MsgBox "Unlockable deleted from SOC."
|
||||
Else
|
||||
MsgBox "Couldn't find Unlockable in SOC."
|
||||
End If
|
||||
Else
|
||||
MsgBox "Unlockable Saved."
|
||||
End If
|
||||
End Sub
|
||||
BIN
frmUnlockablesEdit.frx
Normal file
BIN
frmUnlockablesEdit.frx
Normal file
Binary file not shown.
BIN
icon1.ico
Normal file
BIN
icon1.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.1 KiB |
Loading…
Reference in a new issue