Public Class FontTools Dim drawSurface As Bitmap Public Colors = New List(Of Color) Public Function GetColors() 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)) End Function Public Sub convertTo16() 'DONE Dim CurByte As Byte Dim tempByte As Byte Dim tempByte2 As Byte Dim tempByte3 As Byte Dim tempByte4 As Byte Dim vertCounter As Integer Dim newFont = New List(Of Byte) Dim fontRawData = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona 2 - Batsu (NTSC-J) [SLPS-02825]\Export/JapFont.bin") Dim ReadCounter = 64919 Dim readAddr = 1152 Do If readAddr >= ReadCounter Then Exit Do newFont.Add(ReverseBits(fontRawData(readAddr))) tempByte2 = ReverseBits(fontRawData(readAddr + 1)) newFont.Add(tempByte2 And &HF0) tempByte3 = ReverseBits(fontRawData(readAddr + 2)) Dim collby3 As Byte = (tempByte3 >> 4) newFont.Add(tempByte2 << 4 Or collby3) 'Need last 4 bits tempByte4 = tempByte3 << 4 newFont.Add(tempByte4) readAddr += 3 vertCounter += 1 If vertCounter = 6 Then vertCounter = 0 newFont.Add(0) newFont.Add(0) newFont.Add(0) newFont.Add(0) newFont.Add(0) newFont.Add(0) newFont.Add(0) newFont.Add(0) End If Loop My.Computer.FileSystem.WriteAllBytes("D:\Games\PSX\Persona 2 - Batsu (NTSC-J) [SLPS-02825]/Export/WatchMyFont.bin.bak", newFont.ToArray, False) End Sub 'DONE Public Sub ConvertTo12() Dim CurByte As Byte Dim newFont = New List(Of Byte) Dim tempByte2 As Byte Dim tempByte3 As Byte Dim tempByte4 As Byte If Not My.Computer.FileSystem.FileExists(Form1.WorkDir.Text & "/JapFont.bin") Then MsgBox(Form1.WorkDir.Text & "/JapFont.bin not found. Check Export path!") : Exit Sub Dim fontHeader As Byte() = My.Computer.FileSystem.ReadAllBytes(Form1.WorkDir.Text & "/JapFont.bin") ReDim Preserve fontHeader(1151) 'Loading font header (1152 bytes of normal first font) newFont.AddRange(fontHeader.ToList) Dim vertCounter As Integer Dim fontRawData = My.Computer.FileSystem.ReadAllBytes(Form1.WorkDir.Text & "/WatchMyFont.bin") Dim ReadCounter = 82572 Dim readAddr = 0 Do If readAddr >= ReadCounter Then Exit Do newFont.Add(ReverseBits(fontRawData(readAddr))) tempByte2 = fontRawData(readAddr + 1) And &HF0 tempByte3 = fontRawData(readAddr + 2) >> 4 newFont.Add(ReverseBits(tempByte2 Or tempByte3)) tempByte3 = fontRawData(readAddr + 2) << 4 tempByte4 = fontRawData(readAddr + 3) >> 4 newFont.Add(ReverseBits(tempByte3 Or tempByte4)) readAddr += 4 vertCounter += 1 If vertCounter = 6 Then readAddr += 8 vertCounter = 0 End If Loop 'Creating Rus 8x12 Font @ BA00 (47616) For aaa = 1 To 47616 - newFont.Count newFont.Add(0) Next readAddr = 32 * 32 ' Starting with CHR32 (space) Do For a = 0 To 11 '12 rows loop newFont.Add(ReverseBits(fontRawData(readAddr))) readAddr += 2 'skip 2 bytes Next readAddr += 8 'skip empty 12*4 bytes Loop While readAddr < 256 * 32 'All symbols readed - exit For aaa = 1 To 65520 - newFont.Count newFont.Add(0) Next My.Computer.FileSystem.WriteAllBytes(Form1.WorkDir.Text & "/0013_00_0_0_U", newFont.ToArray, False) MsgBox("OK to /Export/0013_00_0_0_U", MsgBoxStyle.Information) End Sub Public Function ReverseBits(x As Byte) As Byte x = (((x And &HAA) >> 1) Or ((x And &H55) << 1)) x = (((x And &HCC) >> 2) Or ((x And &H33) << 2)) x = (((x And &HF0) >> 4) Or ((x And &HF) << 4)) Return ((x)) End Function Public Sub DrawChars(ByRef byt As List(Of Byte), ByRef df As Bitmap, ByVal y As Integer, ByRef CurColor As Integer) Dim curX = 10 Dim curY = 10 + y 'Load Font Here Dim font = New List(Of List(Of Byte)) Dim fil = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona 2 - Batsu (NTSC-J) [SLPS-02825]\Export\WatchMyFont.bin.bak").ToList Dim charCount As Integer = fil.Count / 32 For x = 0 To fil.Count - 32 Step 32 Dim curChar = New List(Of Byte) curChar.AddRange(fil.GetRange(x, 32)) font.Add(curChar) Next For a = 0 To byt.Count - 2 Step 2 Dim c = byt(a) + byt(a + 1) * 256 If c = &H1120 Or c = &H1131 Then curX = curX + 12 Continue For End If If c = &H122E Then CurColor = byt(a + 2) a = a + 2 Continue For End If If c = &H1103 Then y = y + 12 Continue For End If 'DrawChar(font(c), curX, curY, df, CurColor) DrawChar(font(c), curX, curY, df, 0) curX = curX + 12 notDraw: Next End Sub Public Sub DrawChar(ByRef ch As List(Of Byte), ByVal tx As Integer, ByVal ty As Integer, ByRef df As Bitmap, ByRef CurColor As Integer) Dim ch2 = New List(Of Byte) For Each C In ch ch2.Add(ReverseBits(C)) Next Dim curSize = Form1.PictureBox1.Size Dim bits = New BitArray(ch2.ToArray) For x = 0 To 15 For y = 0 To 15 If x + tx >= curSize.Width Or y + ty >= curSize.Height Then Continue For If Not bits(x + 16 * y) Then Continue For DrawX2(x + tx, y + ty, df, Colors(CurColor)) Next Next Form1.PictureBox1.Invalidate() End Sub Public Sub DrawX2(ByRef x As Integer, ByRef y As Integer, ByRef df As Bitmap, ByVal col As Color) df.SetPixel(x * 2, y * 2, col) df.SetPixel(x * 2 + 1, y * 2, col) df.SetPixel(x * 2, y * 2 + 1, col) df.SetPixel(x * 2 + 1, y * 2 + 1, col) End Sub End Class