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