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