413 lines
12 KiB
VB.net
413 lines
12 KiB
VB.net
Imports IO
|
||
Imports IO.Directory
|
||
|
||
Public Class ScriptCheck
|
||
|
||
Public files As New List(Of String)
|
||
Public CurFilenum As Integer
|
||
Public RRes As ScriptFile
|
||
Public OverallDial As Integer
|
||
Public CurDial As Integer
|
||
|
||
Public CurX, CurY
|
||
Public CurColor As Color
|
||
Public CurShadColor As Color
|
||
Public IsNewWin As Boolean
|
||
Public FontData As List(Of Byte)
|
||
|
||
Public Colors = New List(Of Color)
|
||
|
||
'Public CurEow As Integer
|
||
Public NextEowPointer As Integer
|
||
|
||
Public SelectionCount As Integer
|
||
Public Cursel As Integer
|
||
|
||
|
||
Dim drawSurface As Bitmap
|
||
|
||
|
||
Private Sub ScriptCheck_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
||
FontData = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona.2.Innocent.Sin\Export\0059_00_0_0_U").ToList
|
||
Colors.Add(Color.Black)
|
||
Colors.Add(Color.FromArgb(238, 238, 238))
|
||
Colors.Add(Color.FromArgb(24, 24, 24))
|
||
Colors.Add(Color.FromArgb(156, 156, 156))
|
||
Colors.Add(Color.FromArgb(49, 49, 49))
|
||
Colors.Add(Color.FromArgb(246, 82, 131))
|
||
Colors.Add(Color.FromArgb(24, 24, 24))
|
||
Colors.Add(Color.FromArgb(148, 213, 255)) 'Persona2 TEXT PALETTE
|
||
Colors.Add(Color.FromArgb(24, 24, 49))
|
||
Colors.Add(Color.FromArgb(131, 230, 131))
|
||
Colors.Add(Color.FromArgb(24, 24, 24))
|
||
Colors.Add(Color.FromArgb(230, 230, 74))
|
||
Colors.Add(Color.FromArgb(49, 49, 24))
|
||
Colors.Add(Color.FromArgb(255, 131, 49))
|
||
Colors.Add(Color.FromArgb(49, 24, 24))
|
||
|
||
drawSurface = New Bitmap(PictureBox1.ClientSize.Width * 5, PictureBox1.ClientSize.Height * 5)
|
||
PictureBox1.Image = drawSurface
|
||
|
||
|
||
FilesLoad.PerformClick()
|
||
|
||
End Sub
|
||
'Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
|
||
' e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
|
||
' e.Graphics.ScaleTransform(3, 3)
|
||
' e.Graphics.DrawImage(drawSurface, 0, 0)
|
||
'End Sub
|
||
|
||
|
||
Private Sub FilesLoad_Click(sender As Object, e As EventArgs) Handles FilesLoad.Click
|
||
|
||
files = IO.Directory.GetFiles(Dir.Text, "*.TRNSL").ToList
|
||
|
||
CurFilenum = 0
|
||
CurDial = 0
|
||
If files.Count = 0 Then MsgBox("No TRNSL files in init directory!") : Exit Sub
|
||
InitFile(0)
|
||
|
||
|
||
End Sub
|
||
|
||
Public Sub InitFile(ByVal id As Integer)
|
||
|
||
Dim a = New ScriptTools
|
||
|
||
RRes = New ScriptFile
|
||
a.ParseResource(My.Computer.FileSystem.ReadAllBytes(files(id)), RRes)
|
||
' PictureBox2.Parent = PictureBox1
|
||
|
||
NextEowPointer = 0
|
||
OverallDial = RRes.textPointers.Count
|
||
CurDial = 0
|
||
|
||
PrintText()
|
||
|
||
|
||
|
||
|
||
End Sub
|
||
|
||
Public Sub PrintText()
|
||
|
||
If IsNewWin Then ClearWinAndReset()
|
||
|
||
UpdateCurFileDial()
|
||
|
||
ShowDialodID(CurDial)
|
||
|
||
|
||
End Sub
|
||
|
||
Public Sub ClearWinAndReset()
|
||
|
||
PictureBox1.BackColor = Color.Transparent
|
||
PictureBox1.Invalidate()
|
||
drawSurface = New Bitmap(PictureBox1.ClientSize.Width * 5, PictureBox1.ClientSize.Height * 5)
|
||
PictureBox1.Image = drawSurface
|
||
|
||
CurX = 4
|
||
CurY = 4
|
||
|
||
IsNewWin = False
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
Public Sub UpdateCurFileDial()
|
||
|
||
CurFileText.Text = "f: " & CurFilenum + 1 & " / " & files.Count
|
||
CurFileName.Text = Split(files(CurFilenum), "\").ToList.Last
|
||
CurrentDial.Text = "w: " & CurDial + 1 & " / " & OverallDial
|
||
|
||
ProgressBar1.Value = CurDial / OverallDial * 100
|
||
|
||
End Sub
|
||
|
||
|
||
Public Sub ShowDialodID(ByVal id As Integer)
|
||
|
||
Dim m As List(Of Byte) = RRes.Text
|
||
|
||
|
||
Dim a = RRes.textPointers(id) 'counter
|
||
DemoText.Text = ""
|
||
|
||
If NextEowPointer <> 0 Then a = NextEowPointer
|
||
|
||
Do
|
||
Dim c = get2(m, a)
|
||
If c = &H122E Then 'Парсим код цвета текста
|
||
CurColor = Colors(get2(m, a + 2))
|
||
CurShadColor = Colors(get2(m, a + 2) + 1)
|
||
a += 4
|
||
GoTo endlineTest
|
||
End If
|
||
|
||
|
||
If c = &H1101 Then DemoText.Text &= vbCrLf : CurX = 3 : CurY += 14 : a += 2 : GoTo endlineTest ' Перенос строки
|
||
If c = &H1131 Then DemoText.Text &= " " : CurX += 4 : a += 2 : GoTo endlineTest ' Табуляция (+12 пикс)
|
||
|
||
If c = &H1208 Then DemoText.Text &= "[SelectionMenu][" & get2(m, a + 2) & "]" : SelectionCount = get2(m, a + 2) : Cursel = 0 : a += 4 : GoTo endlineTest ' Пауза 1с при воспроизведении диалога
|
||
|
||
If c = &H1121 Then
|
||
For vv = 0 To 3 : DrawChar(Asc("Суоу"(vv))) : Next
|
||
a += 2 : GoTo endlineTest
|
||
End If
|
||
'Имя игрока
|
||
If c = &H1120 Then
|
||
For vv = 0 To 4 : DrawChar(Asc("Тацуя"(vv))) : Next
|
||
a += 2
|
||
GoTo endlineTest 'Фамилия игрока
|
||
End If
|
||
|
||
'Кликуха
|
||
If c = 4372 Then
|
||
For vv = 0 To 3 : DrawChar(Asc("Тацу"(vv))) : Next
|
||
a += 2
|
||
GoTo endlineTest 'Кликуха
|
||
End If
|
||
|
||
If c = &H1106 Then
|
||
If get2(m, a + 2) = &H1102 Then
|
||
If get2(m, a + 4) = &H1103 Then 'Закрыть окна диалога!
|
||
IsNewWin = True
|
||
NextEowPointer = 0
|
||
Exit Do
|
||
Else
|
||
NextEowPointer = a + 4 'След диалог без закрытия окна
|
||
Exit Do
|
||
End If
|
||
End If
|
||
End If
|
||
If c = &H1109 Then
|
||
If get2(m, a + 2) = &H1102 Then
|
||
If get2(m, a + 4) = &H1103 Then 'Выбор варианта ответа!
|
||
IsNewWin = True
|
||
SelectionCount = 0 : Cursel = 0
|
||
a += 6 : GoTo endlineTest
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
|
||
|
||
If c = &H1103 Then Exit Do
|
||
|
||
If c And &H1000 Then 'COMMAND PARSE
|
||
|
||
Dim comLen = c >> 8
|
||
comLen = comLen And &HF 'command length check
|
||
'Dim comCode = c And &HFF
|
||
|
||
a += comLen * 2 'Jump command
|
||
GoTo endlineTest
|
||
|
||
|
||
|
||
ElseIf c And &H2000 Then 'Если строка в моём однобайтном формате
|
||
|
||
Dim charNum = c And &HFF
|
||
a += 2
|
||
For x = 1 To charNum
|
||
DemoText.Text &= Chr(m(a))
|
||
DrawChar(m(a))
|
||
a += 1
|
||
Next
|
||
If charNum And 1 Then a += 1 'if AND1 - +1
|
||
GoTo endlineTest
|
||
|
||
End If
|
||
|
||
'draw any char from font!
|
||
DrawChar(c)
|
||
a += 2
|
||
|
||
|
||
endlineTest:
|
||
|
||
'Читаем до следующего текст-поинтера или конца массива
|
||
If id < RRes.textPointers.Count - 1 Then
|
||
If a >= RRes.textPointers(id + 1) Then Exit Do
|
||
Else
|
||
If a >= m.Count - 1 Then Exit Do
|
||
|
||
End If
|
||
|
||
|
||
|
||
Loop
|
||
|
||
|
||
|
||
End Sub
|
||
|
||
Public Sub DrawChar(ByVal chr As Integer)
|
||
|
||
Dim f = New FontTools
|
||
Dim readAddr = 1152 + 18 * chr '18 bytes per char
|
||
|
||
'making shadow
|
||
|
||
For a = 0 To 5
|
||
Dim b1 As Byte = FontData(readAddr + (a * 3))
|
||
Dim b2 As Byte = FontData(readAddr + (a * 3) + 1)
|
||
Dim b3 As Byte = FontData(readAddr + (a * 3) + 2)
|
||
Dim b1bits = New BitArray(BitConverter.GetBytes(b1))
|
||
Dim b2bits = New BitArray(BitConverter.GetBytes(b2))
|
||
Dim b3bits = New BitArray(BitConverter.GetBytes(b3))
|
||
For x = 0 To 7
|
||
If b1bits(x) Then drawpixel(x + CurX + 1, CurY + 1, True)
|
||
Next
|
||
|
||
Dim addX = CurX + 9
|
||
For x = 0 To 7
|
||
If b2bits(x) Then drawpixel(x + addX, CurY + 1, True)
|
||
If x = 3 Then addX -= 12 : CurY += 1
|
||
Next
|
||
|
||
For x = 0 To 7
|
||
If b3bits(x) Then drawpixel(x + CurX + 5, CurY + 1, True)
|
||
Next
|
||
CurY += 1
|
||
Next
|
||
|
||
CurY -= 12
|
||
|
||
'making char
|
||
|
||
For a = 0 To 5
|
||
Dim b1 As Byte = FontData(readAddr + (a * 3))
|
||
Dim b2 As Byte = FontData(readAddr + (a * 3) + 1)
|
||
Dim b3 As Byte = FontData(readAddr + (a * 3) + 2)
|
||
Dim b1bits = New BitArray(BitConverter.GetBytes(b1))
|
||
Dim b2bits = New BitArray(BitConverter.GetBytes(b2))
|
||
Dim b3bits = New BitArray(BitConverter.GetBytes(b3))
|
||
For x = 0 To 7
|
||
If b1bits(x) Then drawpixel(x + CurX, CurY, False)
|
||
Next
|
||
|
||
Dim addX = CurX + 8
|
||
For x = 0 To 7
|
||
If b2bits(x) Then drawpixel(x + addX, CurY, False)
|
||
If x = 3 Then addX -= 12 : CurY += 1
|
||
Next
|
||
|
||
For x = 0 To 7
|
||
If b3bits(x) Then drawpixel(x + CurX + 4, CurY, False)
|
||
Next
|
||
CurY += 1
|
||
Next
|
||
|
||
|
||
|
||
PictureBox1.Invalidate()
|
||
CurY -= 12
|
||
CurX += 6
|
||
End Sub
|
||
|
||
|
||
|
||
Public Sub drawpixel(ByVal x As Integer, ByVal y As Integer, ByVal isShadow As Boolean)
|
||
|
||
For a = 0 To 2
|
||
For b = 0 To 2
|
||
If isShadow Then
|
||
drawSurface.SetPixel(x * 3 + a, y * 3 + b, CurShadColor)
|
||
Else
|
||
drawSurface.SetPixel(x * 3 + a, y * 3 + b, CurColor)
|
||
End If
|
||
Next
|
||
Next
|
||
|
||
|
||
End Sub
|
||
|
||
Public Function get2(ByRef f As List(Of Byte), ByVal Index As Integer)
|
||
Return f(Index) + f(Index + 1) * 256
|
||
End Function
|
||
|
||
Private Sub NxFile_Click(sender As Object, e As EventArgs) Handles NxFile.Click
|
||
If CurFilenum = files.Count - 1 Then
|
||
|
||
CurFilenum = 0
|
||
Else
|
||
CurFilenum += 1
|
||
End If
|
||
|
||
|
||
|
||
InitFile(CurFilenum)
|
||
UpdateCurFileDial()
|
||
|
||
|
||
End Sub
|
||
|
||
Private Sub PrevFile_Click(sender As Object, e As EventArgs) Handles PrevFile.Click
|
||
If CurFilenum = 0 Then CurFilenum = files.Count
|
||
|
||
|
||
CurFilenum -= 1
|
||
|
||
InitFile(CurFilenum)
|
||
UpdateCurFileDial()
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
Private Sub NxDial_Click(sender As Object, e As EventArgs) Handles NxDial.Click
|
||
If NextEowPointer <> 0 Then PrintText() : Exit Sub
|
||
|
||
If CurDial = OverallDial - 1 Then
|
||
CurDial = 0
|
||
If CurFilenum <> files.Count - 1 Then
|
||
CurFilenum += 1
|
||
InitFile(CurFilenum)
|
||
UpdateCurFileDial()
|
||
End If
|
||
Else
|
||
CurDial += 1
|
||
End If
|
||
|
||
|
||
|
||
PrintText()
|
||
|
||
End Sub
|
||
|
||
Private Sub srch_Click(sender As Object, e As EventArgs) Handles srch.Click
|
||
Dim a = files.FindIndex(Function(x) x.Contains(IDsrch.Text))
|
||
|
||
If a = -1 Then
|
||
MsgBox("File not found :(")
|
||
Exit Sub
|
||
Else
|
||
InitFile(a)
|
||
CurFilenum = a
|
||
UpdateCurFileDial()
|
||
End If
|
||
|
||
|
||
End Sub
|
||
|
||
Private Sub prevDial_Click(sender As Object, e As EventArgs) Handles prevDial.Click
|
||
If CurDial = 0 Then CurDial = OverallDial
|
||
NextEowPointer = 0
|
||
CurDial -= 1
|
||
PrintText()
|
||
End Sub
|
||
|
||
Private Sub Editor_Click(sender As Object, e As EventArgs) Handles Editor.Click
|
||
Dim fil = Replace("""C:\Program Files (x86)\Notepad++\Notepad++.exe"" """ & files(CurFilenum) & """", ".TRNSL", "")
|
||
|
||
Shell(fil)
|
||
End Sub
|
||
|
||
Private Sub ScriptCheck_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
|
||
If e.KeyCode = Keys.Add Then NxDial.PerformClick()
|
||
End Sub
|
||
End Class |