SOCEdit/frmHUDEdit.frm

316 lines
8.3 KiB
Text
Raw Normal View History

2015-02-23 06:08:55 +00:00
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