321 lines
10 KiB
Plaintext
321 lines
10 KiB
Plaintext
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
|
|
|