mirror of
https://git.do.srb2.org/STJr/SOCEdit.git
synced 2024-11-14 00:10:54 +00:00
315 lines
8.3 KiB
Text
315 lines
8.3 KiB
Text
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
|