Image turns out all strange, and I can't find what's wrong
I'm making my own new image format where any pixel with an alpha less than a specific amount is dropped, and up to 255 colors are stored in a dictionary for additional compression. The format is like this:
Not one of the 255 colors in the dictionary: Argb representation
In dictionary: 0 for the alpha byte, number of repetitions in the R and G bytes, and index in the B byte.
Each group is stored like so:
0 x y colors.
I'm getting an IndexOutOfRangeException because the dictionary never has anything in it, and I can't figure out why. I have no idea what's going wrong! Here's my code:
vb.net Code:
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Public NotInheritable Class EACImage
Public Shared Sub FromBitmap(ByVal b As Bitmap, ByVal output As String, Optional ByVal threshold As Integer = 0)
Dim r As New Rectangle(0, 0, b.Width, b.Height)
Using fs As New FileStream(output, FileMode.Create, FileAccess.Write)
Using bw As New BinaryWriter(fs)
Dim bd As BitmapData = b.LockBits(r, ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
Dim arr(bd.Width * bd.Height - 1) As Integer
Marshal.Copy(bd.Scan0, arr, 0, arr.Length)
'Prepare information
Dim dictionary As New List(Of Integer)
Dim data As New List(Of Integer)
For i As Integer = 0 To arr.Length - 1
While GetAComp(arr(i)) <= threshold
i += 1
If i = arr.Length Then Exit For
End While
data.Add(0) 'Begin a new group
data.Add(i Mod bd.Width) 'Width
data.Add(i \ bd.Width) 'Height
While (i < arr.Length) AndAlso (GetAComp(arr(i)) > threshold)
data.Add(arr(i))
i += 1
End While
Next
'Compress the list
CompressList(data, dictionary)
'Write header information
For Each item As Integer In dictionary
bw.Write(item)
MsgBox("Wrote " & item)
Next
bw.Write(0I)
bw.Write(bd.Width)
bw.Write(bd.Height)
'Write data
For Each item As Integer In data
bw.Write(item)
Next
'Unlock the bitmap
b.UnlockBits(bd)
'Close the streams.
bw.Close()
fs.Close()
End Using
End Using
End Sub
Public Shared Function FromFile(ByVal f As String) As Bitmap
Dim r As Bitmap = Nothing
Using fs As New FileStream(f, FileMode.Open, FileAccess.Read)
Using br As New BinaryReader(fs)
Dim dict As New List(Of Integer)
Do
Dim itm As Integer = br.ReadInt32()
If itm = 0 Then Exit Do
dict.Add(itm)
Loop
r = New Bitmap(br.ReadInt32(), br.ReadInt32(), PixelFormat.Format32bppArgb)
Dim bd As BitmapData = r.LockBits(New Rectangle(0, 0, r.Width, r.Height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
Dim arr(bd.Width * bd.Height - 1) As Integer
Dim x As Integer = 0, y As Integer = 0
Do
If br.BaseStream.Position = br.BaseStream.Length Then Exit Do
Dim n_int As Integer = br.ReadInt32()
If n_int = 0 Then 'next group
x = br.ReadInt32()
y = br.ReadInt32()
End If
If GetAComp(n_int) = 0 Then 'It's compressed
For j As Integer = 1 To GetRepetition(n_int)
arr(y * bd.Width + x) = dict(GetIndex(n_int))
x += 1
If x >= bd.Width Then
y += 1
x = x Mod bd.Width
End If
Next
Else 'Not compressed
arr(y * bd.Width + x) = n_int
End If
x += 1
If x >= bd.Width Then
y += 1
x = x Mod bd.Width
End If
Loop
'Copy back and unlock
Marshal.Copy(arr, 0, bd.Scan0, arr.Length)
r.UnlockBits(bd)
'Close the streams.
br.Close()
fs.Close()
End Using
End Using
Return r
End Function
#Region "GetXXX"
Friend Shared Function GetAComp(ByVal i As Integer) As Integer
Dim sh24 As Integer = 255I << 24
Dim res As Integer = i And sh24
Return res >> 24
End Function
Friend Shared Function GetRepetition(ByVal i As Integer) As Integer
Dim sh16 As Integer = 255 << 16
Dim sh8 As Integer = 255 << 8
Dim res As Integer = i And (sh16 Or sh8)
Return res >> 8
End Function
Friend Shared Function GetIndex(ByVal i As Integer) As Integer
Return (i And 255)
End Function
Friend Shared Function GetInt(ByVal count As Integer, ByVal index As Integer) As Integer
If count > Short.MaxValue OrElse index > 255 Then Throw New ArgumentException()
Return index Or (count << 8)
End Function
#End Region
Private Shared Sub CompressList(ByRef l As List(Of Integer), ByRef dict As List(Of Integer), Optional ByVal minrep As Integer = 30)
dict.Clear()
Dim nl As New List(Of Integer)
Dim l_itm As Integer = -1
Dim count As Integer = 0
For i As Integer = 0 To l.Count - 1
Dim itm As Integer = l(i)
If itm = 0 Then
i += 2
If i >= l.Count Then Exit For
itm = l(i)
End If
If count = 0 Then
count = 1
l_itm = itm
Else
If l_itm = itm Then
count += 1
If (count < UInt16.MaxValue) AndAlso (dict.Count < 255) Then Continue For
Re: Image turns out all strange, and I can't find what's wrong
Sorry, I fixed that just now, I made a stupid mistake...
Right now, my problem is this:
Only the picture's outline shows. That's great for special effects, but not so good for what I want. Here's the code, and "before & after" pictures:
vb.net Code:
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Public NotInheritable Class EACImage
#Region "FromBitmap"
Public Shared Sub FromBitmap(ByVal b As Bitmap, ByVal output As String, Optional ByVal threshold As Integer = 0)
Dim r As New Rectangle(0, 0, b.Width, b.Height)
Using fs As New FileStream(output, FileMode.Create, FileAccess.Write)
Using bw As New BinaryWriter(fs)
Dim bd As BitmapData = b.LockBits(r, ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
Dim arr(bd.Width * bd.Height - 1) As Integer
Marshal.Copy(bd.Scan0, arr, 0, arr.Length)
'Prepare information
Dim dictionary As New List(Of Integer)
Dim data As New List(Of Integer)
For i As Integer = 0 To arr.Length - 1
data.Add(0) 'Begin a new group
Dim x As Integer = i Mod bd.Width
Dim y As Integer = i \ bd.Width
Debug.WriteLine("Adding at " & x & "," & y & "...")
data.Add(x)
data.Add(y)
While GetAComp(arr(i)) <= threshold
i += 1
If i = arr.Length Then Exit For
End While
While (i < arr.Length) AndAlso (GetAComp(arr(i)) > threshold)
data.Add(arr(i))
i += 1
End While
Next
'Compress the list
CompressList(data, dictionary)
'Write header information
For Each item As Integer In dictionary
bw.Write(item)
Next
bw.Write(0I)
bw.Write(bd.Width)
bw.Write(bd.Height)
'Write data
For Each item As Integer In data
bw.Write(item)
Next
'Unlock the bitmap
b.UnlockBits(bd)
'Close the streams.
bw.Close()
fs.Close()
End Using
End Using
End Sub
#End Region
#Region "FromFile"
Public Shared Function FromFile(ByVal f As String) As Bitmap
Dim r As Bitmap = Nothing
Using fs As New FileStream(f, FileMode.Open, FileAccess.Read)
Using br As New BinaryReader(fs)
Dim dict As New List(Of Integer)
Do
Dim itm As Integer = br.ReadInt32()
If itm = 0 Then Exit Do
dict.Add(itm)
Loop
r = New Bitmap(br.ReadInt32(), br.ReadInt32(), PixelFormat.Format32bppArgb)
Dim bd As BitmapData = r.LockBits(New Rectangle(0, 0, r.Width, r.Height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
Dim arr(bd.Width * bd.Height - 1) As Integer
Dim i As Integer = 0
Do
If br.BaseStream.Position = br.BaseStream.Length Then Exit Do
Dim n_int As Integer = br.ReadInt32()
If n_int = 0 Then 'next group
Dim x As Integer = br.ReadInt32()
Dim y As Integer = br.ReadInt32()
Debug.WriteLine("Recieved coordinates " & x & "," & y & ".")
i = (y * bd.Width) + x
Continue Do
End If
If GetAComp(n_int) = 0 Then 'It's compressed
Dim index As Integer = GetIndex(n_int)
For j As Integer = 1 To GetRepetition(n_int)
arr(i) = dict(index)
i += 1
Next
Else 'Not compressed
Debug.WriteLine("Current X is " & (i Mod bd.Width).ToString())
Debug.WriteLine("Current Y is " & (i \ bd.Width).ToString())
arr(i) = n_int
End If
i += 1
Loop
'Copy back and unlock
Marshal.Copy(arr, 0, bd.Scan0, arr.Length)
r.UnlockBits(bd)
'Close the streams.
br.Close()
fs.Close()
End Using
End Using
Return r
End Function
#End Region
#Region "GetXXX"
Friend Shared Function GetAComp(ByVal i As Integer) As Integer
Dim sh24 As Integer = 255I << 24
Dim res As Integer = i And sh24
Return res >> 24
End Function
Friend Shared Function GetRepetition(ByVal i As Integer) As Integer
'Dim sh16 As Integer = 255 << 16
'Dim sh8 As Integer = 255 << 8
'Dim res As Integer = i And (sh16 Or sh8)
'Return res >> 8
Return (i Xor 255) >> 8
End Function
Friend Shared Function GetIndex(ByVal i As Integer) As Integer
Return (i And 255)
End Function
Friend Shared Function GetInt(ByVal count As Integer, ByVal index As Integer) As Integer
If count > Short.MaxValue OrElse index > 255 Then Throw New ArgumentException()
Return index Or (count << 8)
End Function
#End Region
#Region "CompressList"
''' <summary>
''' Compresses a list of colors representing the first stage of an EAC image.
''' </summary>
''' <param name="l">The list of colors.</param>
''' <param name="dict">The dictionary.</param>
''' <param name="minrep">The minimum amount of repetitions.</param>
Private Shared Sub CompressList(ByRef l As List(Of Integer), ByRef dict As List(Of Integer), Optional ByVal minrep As Integer = 30)
dict.Clear()
Dim nl As New List(Of Integer)
Dim l_itm As Integer = -1
Dim count As Integer = 0
For i As Integer = 0 To l.Count - 1
Dim itm As Integer = l(i)
If itm = 0 Then
nl.Add(l(i))
nl.Add(l(i + 1))
nl.Add(l(i + 2))
i += 2
Continue For
End If
If count = 0 Then
count = 1
l_itm = itm
Else
If l_itm = itm Then
count += 1
If (count < UInt16.MaxValue) AndAlso (dict.Count < 255) Then Continue For
End If
If count <= minrep Then
nl.Add(itm)
Else
Dim idx As Integer = dict.IndexOf(itm)
If idx = -1 Then
dict.Add(itm)
idx = dict.Count - 1
End If
nl.Add(GetInt(count, idx))
End If
l_itm = itm
count = 1
End If
Next
l = nl
End Sub
#End Region
End Class
Last edited by minitech; Mar 8th, 2010 at 03:20 PM.
Reason: Added pictures.
Re: Image turns out all strange, and I can't find what's wrong
Yup. I think the information is being stored properly, because of the size of the EAC file. Do you know why? At first, I thought it was because of the CompressList method, so I commented the body out (if you do that, it just doesn't compress)... no change.
Re: Image turns out all strange, and I can't find what's wrong
Ok, I've added to my code, changed some things, and added debugging statements. It seems that the file isn't being written to correctly. Here's my code, and the log file is attached:
vb.net Code:
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Public NotInheritable Class EACImage
#Region "Log Debugger"
#If CONFIG = "Debug" Then
Private Shared Debug As Debugger
Private Class Debugger
Implements IDisposable
Private m_InnerStream As StreamWriter
Public Sub New()
m_InnerStream = New StreamWriter("debug_log.txt")
End Sub
Public Sub WriteLine(ByVal ln As String)
m_InnerStream.WriteLine(ln)
End Sub
Private disposedValue As Boolean = False
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
m_InnerStream.Close()
m_InnerStream.Dispose()
m_InnerStream = Nothing
End If
End If
Me.disposedValue = True
End Sub
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
Protected Overrides Sub Finalize()
Me.Dispose(False)
MyBase.Finalize()
End Sub
End Class
#End If
#End Region
#Region "FromBitmap"
Public Shared Sub FromBitmap(ByVal b As Bitmap, ByVal output As String, Optional ByVal threshold As Integer = 0)
#If CONFIG = "Debug" Then
Debug = New Debugger()
#End If
Dim r As New Rectangle(0, 0, b.Width, b.Height)
Using fs As New FileStream(output, FileMode.Create, FileAccess.Write)
Using bw As New BinaryWriter(fs)
Dim bd As BitmapData = b.LockBits(r, ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
Dim arr(bd.Width * bd.Height - 1) As Integer
Marshal.Copy(bd.Scan0, arr, 0, arr.Length)
'Unlock the bitmap
b.UnlockBits(bd)
'Prepare information
Dim dictionary As New List(Of Integer)
Dim data As New List(Of Integer)
For i As Integer = 0 To arr.Length - 1
While GetAComp(arr(i)) <= threshold
i += 1
If i = arr.Length Then Exit For
End While
'Begin a new group
data.Add(0I)
Dim x As Integer = i Mod bd.Width
Dim y As Integer = i \ bd.Width
data.Add(x)
data.Add(y)
While (i < arr.Length) AndAlso (GetAComp(arr(i)) > threshold)
data.Add(arr(i))
i += 1
End While
Next
'Compress the list
'CompressList(data, dictionary, 30)
'Write header information
For Each item As Integer In dictionary
bw.Write(item)
Next
bw.Write(0I)
bw.Write(bd.Width)
bw.Write(bd.Height)
'Write data
For Each item As Integer In data
bw.Write(item)
Next
'Close the streams.
bw.Close()
fs.Close()
End Using
End Using
#If CONFIG = "Debug" Then
Debug.Dispose()
Debug = Nothing
#End If
End Sub
#End Region
#Region "FromFile"
Public Shared Function FromFile(ByVal f As String) As Bitmap
#If CONFIG = "Debug" Then
Debug = New Debugger()
#End If
Dim r As Bitmap = Nothing
Using fs As New FileStream(f, FileMode.Open, FileAccess.Read)
Using br As New BinaryReader(fs)
Dim dict As New List(Of Integer)
Do
Dim itm As Integer = br.ReadInt32()
If itm = 0 Then Exit Do
dict.Add(itm)
Loop
r = New Bitmap(br.ReadInt32(), br.ReadInt32(), PixelFormat.Format32bppArgb)
Dim bd As BitmapData = r.LockBits(New Rectangle(0, 0, r.Width, r.Height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
Dim arr(bd.Width * bd.Height - 1) As Integer
Dim i As Integer = 0
Do
If br.BaseStream.Position = br.BaseStream.Length Then Exit Do
Dim n_int As Integer = br.ReadInt32()
If n_int = 0 Then 'next group
Dim x As Integer = br.ReadInt32()
Dim y As Integer = br.ReadInt32()
Debug.WriteLine("Recieved coordinates " & x & "," & y & ".")
i = (y * bd.Width) + x
Continue Do
End If
If GetAComp(n_int) = 0 Then 'It's compressed
Dim index As Integer = GetIndex(n_int)
For j As Integer = 1 To GetRepetition(n_int)
arr(i) = dict(index)
i += 1
Next
Else 'Not compressed
Debug.WriteLine("Current X is " & (i Mod bd.Width).ToString())
Debug.WriteLine("Current Y is " & (i \ bd.Width).ToString())
arr(i) = n_int
End If
i += 1
Loop
'Copy back and unlock
Marshal.Copy(arr, 0, bd.Scan0, arr.Length)
r.UnlockBits(bd)
'Close the streams.
br.Close()
fs.Close()
End Using
End Using
#If CONFIG = "Debug" Then
Debug.Dispose()
#End If
Return r
End Function
#End Region
#Region "GetXXX"
Friend Shared Function GetAComp(ByVal i As Integer) As Integer
Dim sh24 As Integer = 255I << 24
Dim res As Integer = i And sh24
Return res >> 24
End Function
Friend Shared Function GetRepetition(ByVal i As Integer) As Integer
'Dim sh16 As Integer = 255 << 16
'Dim sh8 As Integer = 255 << 8
'Dim res As Integer = i And (sh16 Or sh8)
'Return res >> 8
Return (i Xor 255) >> 8
End Function
Friend Shared Function GetIndex(ByVal i As Integer) As Integer
Return (i And 255)
End Function
Friend Shared Function GetInt(ByVal count As Integer, ByVal index As Integer) As Integer
If count > Short.MaxValue OrElse index > 255 Then Throw New ArgumentException()
Return index Or (count << 8)
End Function
#End Region
#Region "CompressList"
''' <summary>
''' Compresses a list of colors representing the first stage of an EAC image.
''' </summary>
''' <param name="l">The list of colors.</param>
''' <param name="dict">The dictionary.</param>
''' <param name="minrep">The minimum amount of repetitions.</param>
Private Shared Sub CompressList(ByRef l As List(Of Integer), ByRef dict As List(Of Integer), Optional ByVal minrep As Integer = 30)
dict.Clear()
Dim nl As New List(Of Integer)
Dim l_itm As Integer = -1
Dim count As Integer = 0
For i As Integer = 0 To l.Count - 1
Dim itm As Integer = l(i)
If itm = 0 Then
nl.Add(0I)
nl.Add(l(i + 1))
nl.Add(l(i + 2))
i += 2
Continue For 'Will also add 1 to i.
End If
If count = 0 Then
count = 1
l_itm = itm
Else
If l_itm = itm Then
count += 1
If (count < UInt16.MaxValue) AndAlso (dict.Count < 255) Then Continue For
Image turns out all strange, and I can't find what's wrong
Reply With Quote
