535 lines
16 KiB
VB.net
535 lines
16 KiB
VB.net
Imports Ionic
|
|
Imports Free.Ports.libpng
|
|
Imports System.IO
|
|
Imports System.IO.Compression
|
|
Imports Microsoft.VisualBasic.VBMath
|
|
|
|
Public Class pngImage
|
|
Public MagicWord = {137, 80, 78, 71, 13, 10, 26, 10}
|
|
Public Width As Integer
|
|
Public Heigth As Integer
|
|
Public bit As Byte
|
|
Public colors As Integer
|
|
Public Palette = New List(Of Byte)
|
|
Public Transp = New List(Of Byte)
|
|
Public imageDATA = New List(Of Byte)
|
|
Public Chunks As List(Of Chunk)
|
|
Public IMG As Bitmap
|
|
|
|
Public Sub New()
|
|
Chunks = New List(Of Chunk)
|
|
End Sub
|
|
|
|
Public Sub InitBitMap(ByVal path As String)
|
|
|
|
|
|
|
|
IMG = Image.FromFile(path)
|
|
|
|
|
|
End Sub
|
|
|
|
Public Function makeBigTexturePng(ByRef cluts As List(Of List(Of Byte)), ByRef pics As List(Of List(Of Byte)))
|
|
|
|
Dim bigWidth = 64 * pics.Count
|
|
|
|
Dim ch = New Chunk With {.Type = "IHDR", .Size = 13}
|
|
'Making header
|
|
ch.Data.AddRange(BitConverter.GetBytes(bigWidth).Reverse)
|
|
ch.Data.AddRange(BitConverter.GetBytes(256).Reverse)
|
|
ch.Data.Add(8) '8 Bit bits per channel
|
|
ch.Data.Add(2) 'Or 6 with alpha 'Color Type - RGB Mode (24bit) if 16bit
|
|
ch.Data.Add(0) 'Compression (zlib)
|
|
ch.Data.Add(0) 'Filter?
|
|
ch.Data.Add(0) 'Interlace?
|
|
Chunks.Add(ch)
|
|
ch = New Chunk With {.Type = "tRNS"} : ch.Data.Add(0) : Chunks.Add(ch) 'First Color is transparent
|
|
|
|
|
|
ch = New Chunk With {.Type = "IDAT"}
|
|
'Adding Image data
|
|
|
|
''Image loop here
|
|
Dim img = New List(Of Byte)
|
|
|
|
|
|
|
|
For x = 0 To 255
|
|
img.Add(0)
|
|
For y = 0 To pics.Count - 1
|
|
For z = 0 To 63
|
|
Dim curPicIndex = x * 64 + z + 8 'PIC LINE * WIDTH + CURRENT PIX IN LINE + 8(INIT BYTES)
|
|
Dim curCol = GetColFrom1555List(cluts(y), pics(y)(curPicIndex))
|
|
img.AddRange({curCol(0), curCol(1), curCol(2)})
|
|
Next
|
|
Next
|
|
Next
|
|
|
|
|
|
Dim dstream = Zlib.ZlibStream.CompressBuffer(img.ToArray)
|
|
ch.Data = dstream.ToList
|
|
Chunks.Add(ch)
|
|
ch = New Chunk With {.Type = "IEND", .Size = 0}
|
|
Chunks.Add(ch)
|
|
|
|
|
|
Return (GenerateFile()) 'Return file to mainWindow
|
|
End Function
|
|
|
|
Public Function GetColFrom1555List(ByRef bytes As List(Of Byte), ByVal ind As Integer)
|
|
ind = ind * 2 + 8
|
|
If ind > bytes.Count - 1 Then Return {0, 0, 0}
|
|
|
|
Dim col As Integer = (bytes(ind)) + CInt(bytes(ind + 1)) * 256
|
|
Dim a = col And &H8000 >> 15, b = ((col And &H7C00) >> 10) * 8, g = ((col And &H3E0) >> 5) * 8, r = (col And &H1F) * 8
|
|
Return {r, g, b}
|
|
End Function
|
|
|
|
Public Function NewPng(ByRef pic As rleFile, ByRef clut As rleFile)
|
|
|
|
'Need to deconctruct and construct palettes and imagedata here
|
|
|
|
'need to set correct x&y
|
|
If Form1.CurrentImgMode = 16 Then
|
|
Width = pic.w
|
|
|
|
ElseIf clut.w = 16 Or Form1.Force4bit.Checked Then
|
|
Width = pic.w * 4
|
|
Else
|
|
If clut.w = 256 Then Width = pic.w * 2 Else Width = pic.w
|
|
End If
|
|
|
|
Heigth = pic.h
|
|
|
|
|
|
GeneratePngChunks(pic, clut)
|
|
Return (GenerateFile()) 'Return file to mainWindow
|
|
End Function
|
|
|
|
|
|
Public Sub GeneratePngChunks(ByRef pic As rleFile, ByRef clut As rleFile)
|
|
|
|
|
|
|
|
|
|
Dim ch = New Chunk With {.Type = "IHDR", .Size = 13}
|
|
'Making header
|
|
ch.Data.AddRange(BitConverter.GetBytes(Width).Reverse)
|
|
ch.Data.AddRange(BitConverter.GetBytes(Heigth).Reverse)
|
|
If Form1.CurrentImgMode <> 16 Then
|
|
ch.Data.Add(8) '8 Bit Depth in palette
|
|
ch.Data.Add(3) 'Color Type - Indexed Colors 'If CLUT exists first!
|
|
Else
|
|
ch.Data.Add(8) '8 Bit bits per channel
|
|
ch.Data.Add(2) 'Or 6 with alpha 'Color Type - RGB Mode (24bit) if 16bit
|
|
End If
|
|
|
|
ch.Data.Add(0) 'Compression (zlib)
|
|
ch.Data.Add(0) 'Filter?
|
|
ch.Data.Add(0) 'Interlace?
|
|
|
|
|
|
'not 16bit
|
|
If Form1.CurrentImgMode <> 16 Then
|
|
Chunks.Add(ch)
|
|
ch = New Chunk With {.Type = "PLTE"}
|
|
'Making Palette
|
|
ch.Data.AddRange(MakeCLUTList(clut))
|
|
|
|
|
|
Chunks.Add(ch)
|
|
ch = New Chunk With {.Type = "tRNS"}
|
|
'Making Trans
|
|
If Form1.alpha0.Checked Then ch.Data.Add(0) 'First Color is transparent
|
|
End If
|
|
|
|
|
|
Chunks.Add(ch)
|
|
ch = New Chunk With {.Type = "IDAT"}
|
|
'Adding Image data
|
|
|
|
|
|
|
|
Dim rle = New rleTools
|
|
Dim picdata As Byte()
|
|
If pic.Compr > 0 Then
|
|
picdata = rle.Unrle2(pic.Bytes).ToArray
|
|
Else
|
|
Dim piclist = pic.Bytes.ToList
|
|
piclist.RemoveRange(0, 16)
|
|
picdata = piclist.ToArray
|
|
End If
|
|
|
|
|
|
|
|
Dim img = New List(Of Byte)
|
|
|
|
If Form1.Force4bit.Checked Then GoTo force4bit 'force 4 bit
|
|
|
|
If Form1.CurrentImgMode = 16 Then 'True color
|
|
Dim piccc() = picdata.ToArray
|
|
Dim reader = 0, x = 0
|
|
img.Add(0) 'Fucking filter byte
|
|
|
|
'16bit_PNG_export
|
|
Do
|
|
If x = Width Then x = 0 : img.Add(0) 'Fucking filter byte
|
|
Dim curCol = GetColFrom1555(piccc, reader)
|
|
img.AddRange({curCol(0), curCol(1), curCol(2)})
|
|
reader += 2
|
|
x += 1
|
|
If reader >= picdata.Count Then Exit Do
|
|
|
|
Loop
|
|
|
|
|
|
|
|
Else
|
|
'other export
|
|
|
|
|
|
Select Case clut.w
|
|
Case 16
|
|
'4bit mode
|
|
force4bit:
|
|
|
|
For y = 0 To Heigth - 1
|
|
img.Add(0) 'Fucking filter byte
|
|
For x = 0 To Width / 2 - 1
|
|
Dim fs = picdata(y * Width / 2 + x) 'Width/2 = Bytes in pic line
|
|
Dim lp = fs And &HF 'get left byte
|
|
Dim rp = (fs And &HF0) >> 4 'get right byte
|
|
img.Add(lp)
|
|
img.Add(rp)
|
|
Next
|
|
Next
|
|
|
|
Case 256
|
|
'8bit mode
|
|
For y = 0 To Heigth - 1
|
|
img.Add(0) 'Fucking filter byte
|
|
For x = 0 To Width - 1
|
|
Dim fs = picdata(y * Width + x)
|
|
img.Add(fs)
|
|
Next
|
|
Next
|
|
End Select
|
|
|
|
|
|
End If
|
|
|
|
|
|
Dim dstream = Zlib.ZlibStream.CompressBuffer(img.ToArray)
|
|
|
|
ch.Data = dstream.ToList
|
|
|
|
|
|
|
|
Chunks.Add(ch)
|
|
ch = New Chunk With {.Type = "IEND", .Size = 0}
|
|
Chunks.Add(ch)
|
|
|
|
|
|
End Sub
|
|
|
|
Public Function GenerateFile()
|
|
|
|
Dim file = New List(Of Byte)
|
|
For Each a In MagicWord
|
|
file.Add(a)
|
|
Next
|
|
|
|
|
|
|
|
For Each ch As Chunk In Chunks
|
|
Dim tempChunk = New List(Of Byte)
|
|
ch.Size = ch.Data.Count
|
|
file.AddRange(BitConverter.GetBytes(ch.Size).Reverse) 'Size of chunk Not Included in CRC
|
|
|
|
For chChar = 0 To 3 : tempChunk.Add(Asc(ch.Type(chChar))) : Next 'AddingChunkName
|
|
tempChunk.AddRange(ch.Data)
|
|
|
|
Dim CRC = New Ionic.Crc.CRC32()
|
|
CRC.SlurpBlock(tempChunk.ToArray, 0, tempChunk.Count) 'CRC CALCULATES HERE!
|
|
file.AddRange(tempChunk)
|
|
file.AddRange(BitConverter.GetBytes(CRC.Crc32Result).Reverse)
|
|
|
|
Next
|
|
|
|
|
|
Return file
|
|
End Function
|
|
|
|
Public Function MakeCLUTList(ByRef nx As rleFile)
|
|
|
|
Dim a = New List(Of Byte)
|
|
Dim rle As New rleTools
|
|
Dim unrl() As Byte
|
|
|
|
Select Case nx.Compr
|
|
Case 0
|
|
unrl = rle.UnrleNocompr(nx.Bytes).ToArray
|
|
Case 1
|
|
unrl = rle.Unrle2(nx.Bytes).ToArray 'Image
|
|
Case Else
|
|
unrl = rle.Unrle(nx.Bytes).ToArray 'data
|
|
End Select
|
|
|
|
|
|
|
|
'4bit mode
|
|
If nx.w = 16 Or Form1.Force4bit.Checked Then
|
|
For x = 0 To 15
|
|
Dim b As Integer() = GetColFrom1555(unrl, Form1.CLUTid.Value * 32 + x * 2)
|
|
a.Add(b(0)) : a.Add(b(1)) : a.Add(b(2))
|
|
Next
|
|
Return a
|
|
End If
|
|
|
|
|
|
If nx.w = 256 Then
|
|
For x = 0 To 255
|
|
'a.Add(GetColFrom1555(nx.Bytes, 16 + CLUTid.Value * 256 + x * 2))
|
|
Dim b As Integer() = GetColFrom1555(unrl, x * 2)
|
|
a.Add(b(0)) : a.Add(b(1)) : a.Add(b(2))
|
|
Next
|
|
End If
|
|
|
|
Return a
|
|
End Function
|
|
|
|
Public Function GetColFrom1555(ByRef bytes As Byte(), ByVal ind As Integer)
|
|
If ind > UBound(bytes) - 1 Then Return {0, 0, 0}
|
|
Dim col As Int16 = BitConverter.ToInt16(bytes, ind)
|
|
Dim a = col And &H8000 >> 15, b = ((col And &H7C00) >> 10) * 8, g = ((col And &H3E0) >> 5) * 8, r = (col And &H1F) * 8
|
|
Return {r, g, b}
|
|
End Function
|
|
|
|
|
|
|
|
|
|
Public Function Convert888To565(ByRef col As Color)
|
|
Dim r = col.R : Dim g = col.G : Dim b = col.B
|
|
|
|
Dim res As Int32
|
|
|
|
res = ((b And &HF8) << 7) Or ((g And &HF8) << 2) Or ((r And &HF8) >> 3)
|
|
'Dim x1 = (b And &HF8) Or (g >> 5)
|
|
'Dim x2 = ((g And &H1C) << 3) Or (r >> 3)
|
|
|
|
'res = x2 Or (x1 << 8)
|
|
|
|
Return res
|
|
End Function
|
|
|
|
Public Function ParsePNGgetData(ByRef src As List(Of Byte), ByRef rle As rleFile)
|
|
Dim file = New List(Of Byte)
|
|
|
|
|
|
If src(0) <> 137 And src(1) <> 80 And src(2) <> 78 Then MsgBox("Это не PNG!!!", MsgBoxStyle.Critical) : Return file
|
|
|
|
|
|
'Loading Chunks
|
|
Dim Reader As Integer = 8
|
|
Do
|
|
GenerateChunk(src, Reader)
|
|
Loop Until Reader >= src.Count
|
|
|
|
Dim header As List(Of Byte) = GetChunk("IHDR").Data
|
|
Width = Read32bitNumBE(header, 0)
|
|
Heigth = Read32bitNumBE(header, 4)
|
|
|
|
|
|
Dim plte As Chunk = GetChunk("PLTE")
|
|
If Form1.imp4bit.Checked Then
|
|
bit = 4
|
|
Else
|
|
If Form1.Imp8bit.Checked Then
|
|
bit = 8
|
|
Else
|
|
bit = 16
|
|
End If
|
|
End If
|
|
|
|
|
|
Dim imgData = New List(Of Byte)
|
|
'LoadingChunks
|
|
|
|
Dim chunks = GetChunks("IDAT") 'CONCAT ALL IDATS....
|
|
Dim buff = New List(Of Byte)
|
|
For Each ch In chunks
|
|
buff.AddRange(ch.Data)
|
|
Next
|
|
|
|
Dim dstream = Zlib.ZlibStream.UncompressBuffer(buff.ToArray()) '....AND DECOMPRESS
|
|
|
|
imgData.AddRange(dstream.ToList)
|
|
Dim filter As Integer
|
|
|
|
Reader = 1
|
|
|
|
|
|
Dim x, y As Integer
|
|
|
|
If bit = 4 Or bit = 8 Then UnfilterNew(imgData, Width, Heigth) 'unfilter ALL scanlines
|
|
|
|
|
|
Do
|
|
Select Case bit
|
|
Case 4
|
|
Dim lp = imgData(Reader)
|
|
Dim rp = imgData(Reader + 1) : Reader += 1
|
|
file.Add(((rp And &HF) << 4) Or (lp And &HF))
|
|
x += 2
|
|
Case 8
|
|
If y = Heigth Then Exit Do
|
|
file.Add(imgData(Reader))
|
|
x += 1
|
|
Case 16
|
|
|
|
Dim col As Color = IMG.GetPixel(x, y)
|
|
|
|
|
|
|
|
Dim res As Int32 = Convert888To565(col)
|
|
file.AddRange({BitConverter.GetBytes(res)(0), BitConverter.GetBytes(res)(1)})
|
|
|
|
x += 1
|
|
'Reader += 2
|
|
End Select
|
|
|
|
If x >= Width Then
|
|
If Reader >= imgData.Count - 1 Then Exit Do
|
|
x = 0
|
|
y += 1
|
|
|
|
Reader += 1
|
|
|
|
End If
|
|
|
|
If y >= Heigth Then Exit Do
|
|
|
|
|
|
Reader += 1
|
|
|
|
|
|
Loop
|
|
|
|
|
|
|
|
Return file
|
|
End Function
|
|
|
|
Public Sub UnfilterNew(ByRef imgData As List(Of Byte), ByVal Width As Integer, ByVal Heigth As Integer)
|
|
''''''NEW UNFILTER FROM PNGLIB OFFICIAL LIBRARY (3rd version)
|
|
|
|
Dim x = 0, y = 0, filter, reader As Integer
|
|
filter = imgData(reader) ': Debug.WriteLine("Y=" & y & "FLT=" & filter) 'INIT
|
|
reader += 1
|
|
|
|
Do
|
|
Select Case filter
|
|
Case 0 'none filter
|
|
|
|
Case 1 'sub filter
|
|
For a = 1 To Width - 1
|
|
Dim rp As Integer = imgData(reader + a)
|
|
Dim rpp As Integer = imgData(reader + a - 1)
|
|
imgData(reader + a) = (rp + rpp) And &HFF
|
|
Next
|
|
Case 2 'up filter
|
|
For a = 0 To Width - 1
|
|
Dim rp As Integer = imgData(reader + a)
|
|
Dim pp As Integer = imgData(reader + a - Width - 1)
|
|
imgData(reader + a) = (rp + pp) And &HFF
|
|
Next
|
|
Case 3 'average filter
|
|
|
|
Dim rp As Integer = imgData(reader)
|
|
Dim pp As Integer = imgData(reader - Width - 1) 'first pixel
|
|
imgData(reader) = (rp + (pp / 2)) And &HFF
|
|
|
|
For a = 1 To Width - 1
|
|
rp = imgData(reader + a)
|
|
pp = imgData(reader + a - Width - 1)
|
|
Dim rpp As Integer = imgData(reader + a - 1)
|
|
imgData(reader + a) = (rp + Math.Floor((pp + rpp) / 2)) And &HFF 'Other pixels
|
|
Next
|
|
|
|
Case 4 'paeth 1-byte filter
|
|
|
|
Dim rp_end As Integer = reader + Width
|
|
Dim a, c As Integer
|
|
x = 0
|
|
c = imgData(reader - Width - 1) 'first pixel
|
|
a = imgData(reader) + c
|
|
imgData(reader) = a And &HFF : reader += 1
|
|
|
|
While (reader < rp_end)
|
|
Dim b, pa, pb, pc, p As Integer
|
|
x = x + 1
|
|
a = a And &HFF 'cleaning byte
|
|
b = imgData(reader - Width - 1)
|
|
|
|
p = b - c
|
|
pc = a - c
|
|
|
|
pa = Math.Abs(p)
|
|
pb = Math.Abs(pc)
|
|
pc = Math.Abs(p + pc)
|
|
|
|
If pb < pa Then pa = pb : a = b
|
|
If pc < pa Then a = c
|
|
|
|
c = b
|
|
a += imgData(reader)
|
|
imgData(reader) = a And &HFF : reader += 1
|
|
End While
|
|
End Select
|
|
If filter <> 4 Then reader += Width
|
|
|
|
y = y + 1
|
|
If reader >= imgData.Count - 1 Or y = Heigth Then Exit Do
|
|
|
|
filter = imgData(reader)
|
|
reader += 1
|
|
'Debug.WriteLine("Y=" & y & "FLT=" & filter)
|
|
|
|
Loop
|
|
|
|
End Sub
|
|
|
|
|
|
Public Sub GenerateChunk(ByRef src As List(Of Byte), ByRef reader As Integer)
|
|
Dim cc = New Chunk
|
|
cc.Size = Read32bitNumBE(src, reader) : reader += 4
|
|
For x = 0 To 3 : cc.Type &= Chr(src(x + reader)) : Next : reader += 4
|
|
For x = 0 To cc.Size - 1 : cc.Data.Add(src(x + reader)) : Next : reader += cc.Size
|
|
reader += 4 'Nahuy CRC-check!
|
|
Chunks.add(cc)
|
|
End Sub
|
|
Public Function GetChunk(ByVal Tp As String)
|
|
For Each cc In Chunks
|
|
If cc.Type = Tp Then Return cc
|
|
Next
|
|
Return Nothing
|
|
End Function
|
|
|
|
Public Function GetChunks(ByVal Tp As String)
|
|
|
|
Dim a = New List(Of Chunk)
|
|
a = Chunks.FindAll(Function(x) x.Type = Tp)
|
|
|
|
Return a
|
|
End Function
|
|
|
|
Public Function Read32bitNumBE(ByRef f As List(Of Byte), ByVal bytenum As Integer)
|
|
Return f(bytenum + 3) + f(bytenum + 2) * 256 + f(bytenum + 1) * 65536 + f(bytenum) * 16777216
|
|
End Function
|
|
End Class
|
|
|
|
Public Class Chunk
|
|
Public Size As Integer
|
|
Public Type As String
|
|
Public Data = New List(Of Byte)
|
|
End Class |