Palette Snatching

akrocks
05-13-2006, 08:40 PM
Alright. In my quest to save images with better quality, I am working on a piece of code that will grab each color and add it to a new palette. But, I'm having trouble checking to see if the color already exists in the new palette and adding it if it doesnt...


'grab the colors from the image and add them to the palette.
Dim x As Long = 1 'x pos of the grabber
Dim y As Long = 1 'y pos of the grabber
Dim h As Integer = picMain.Height 'myImg.Height 'img height
Dim w As Integer = picMain.Width 'myImg.Width 'img width
Dim myPal As ColorPalette
Dim mybmp As New Bitmap(myImg)

Dim curColor As Color 'current color the grabber has found...
Dim colorExists As Boolean = False '
myPal = mybmp.Palette
'loop through all the pixels in the image....
For y = 1 To h - 1
For x = 1 To w - 1
curColor = mybmp.GetPixel(x, y)

'Loop through the colors in the palette
'and check if it exists already
For Each allColors As Color In myPal.Entries


'**************
'What is the best way to check if it exists?
'**************


Next

Next
Next



What is the best way to check if the color exists?

Rockoon
05-14-2006, 01:34 AM
compare the R, G, and B components seperately.. and you problably want to tolerate a little error in the comparison (+/- 1 for example) although that is strictly not necessary..

akrocks
05-14-2006, 02:55 PM
Mmmk. Now, when i try to add it to the palette i get an outside the bounds of the array...


'grab the colors from the image and add them to the palette.
Dim x As Long = 1 'x pos of the grabber
Dim y As Long = 1 'y pos of the grabber
Dim h As Integer = picMain.Height 'myImg.Height 'img height
Dim w As Integer = picMain.Width 'myImg.Width 'img width
Dim myPal As ColorPalette
Dim mybmp As New Bitmap(myImg)
Dim numColors As Integer = 0

Dim curColor As Color 'current color the grabber has found...
Dim colorExists As Boolean = False '
myPal = mybmp.Palette
'loop through all the pixels in the image....
For y = 1 To h - 1
For x = 1 To w - 1
curColor = mybmp.GetPixel(x, y)

'Loop through the colors in the palette
'and check if it exists already
Dim colorExist As Boolean = False


For n As Integer = 0 To myPal.Entries.Length - 1
If curColor.A = myPal.Entries(n).A And curColor.B = myPal.Entries(n).B And curColor.G = myPal.Entries(n).G _
And curColor.R = myPal.Entries(n).R Then
colorExists = True
End If

Next
If colorExists = False Then
Dim alpha As Integer = curColor.A
Dim red As Integer = curColor.R
Dim green As Integer = curColor.G
Dim blue As Integer = curColor.B

myPal.Entries(numColors) = Color.FromArgb(alpha, red, green, blue)
numColors += 1

Else
colorExists = False
End If
Next
Next



the error is on this line:
myPal.Entries(numColors) = Color.FromArgb(alpha, red, green, blue)
The little line is pointing to alpha which = 255. And that acceptible so i know its not to big of a number...

Rockoon
05-17-2006, 03:29 AM
I believe the problem value is 'numColors'

akrocks
08-11-2006, 11:03 PM
ok after a long break! i'm back to this project. now, i think i've got this part almost solved! to see if my palette is being created correctly i want to save it to a bmp with the colors...

the code seems to be working except one glitch. it's only coloring black. instead of each color.

i have an array that grabs the colors from the original image. then we come here to take the colors from that array and draw out a bitmap.

please take a look at my code and see if you can help me. thanks a lot.


Private Sub buildPalette(ByVal myImg As Image)
'grab the colors from the image and add them to the palette.
Dim x As Long = 1 'x pos of the grabber
Dim y As Long = 1 'y pos of the grabber
Dim h As Integer = picMain.Height 'myImg.Height 'img height
Dim w As Integer = picMain.Width 'myImg.Width 'img width

Dim arry As New ArrayList

Dim mybmp As New Bitmap(myImg)
Dim numColors As Integer = 1

Dim curColor As Color 'current color the grabber has found...
Dim colorExists As Boolean = False '

'loop through all the pixels in the image....
For y = 1 To h - 1
For x = 1 To w - 1
curColor = mybmp.GetPixel(x, y)

'Loop through the colors in the palette
'and check if it exists already
Dim colorExist As Boolean = False

For n As Integer = 0 To arry.Count - 1
If curColor = Color.FromArgb(arry.Item(n)) Then
colorExists = True
End If

Next
If colorExists = False Then
arry.Add(curColor.ToArgb)

numColors += 1
Debug.Print(arry.Item(arry.Count - 1).ToString)
Else
colorExists = False
End If
Next
Next


'save a palette test file for... testing ;O)
Dim g As Graphics = Me.CreateGraphics
Dim x1 As Integer = 0
Dim y1 As Integer = 0
Debug.Print("---Creating Palette---")
For p As Integer = 0 To arry.Count - 1
Dim myhappycolor As Color = Color.FromArgb(arry.Item(p))
Dim myBrush As SolidBrush = New SolidBrush(myhappycolor)

Debug.Print(myBrush.Color.ToArgb)
g.FillRectangle(myBrush, x1, y1, 15, 15)

x1 += 16

Next
Dim savebmp As Bitmap = New Bitmap(x1 + 16, y1 + 16, g)
savebmp.Save("c:\mypalette.bmp")

End Sub

OnErr0r
08-12-2006, 02:18 AM
There seem to be a couple things you aren't considering here.

1) Paletted bitmaps are limited to 256 colors. In counting/populating a bit array of colors is usually fastest, or you can use a modified radix sort for smaller images. Once you've finished counting, if there are more than 256 colors, you'll need to perform "quantization". See OCtree or Median cut algos.

2) Bitmaps default to 32bits. So, the bitmap you're creating to save it not paletted. Paletted bitmaps can have 2, 16 or 256 colors. You'll need to request the correct sort of bitmap and then set the palette before saving.

jo0ls
08-12-2006, 02:32 AM
Dim savebmp As Bitmap = New Bitmap(x1 + 16, y1 + 16, g)
savebmp.Save("c:\mypalette.bmp")

All you are saving is a new bitmap, and new bitmaps start with all the pixels set to black.
Create the bitmap before the loop that draws the rectangles. Then create the graphics object from the bitmap instead:

Dim g as Graphics = Graphics.FromImage(savebmp)

If you want to display the bitmap on the form then load it into a picturebox or something. The rectangles you currently draw is erased if you move the form off-screen and back on again as you are using me.creategraphics).

OnErr0r
08-12-2006, 02:41 AM
Dim savebmp As Bitmap = New Bitmap(x1 + 16, y1 + 16, g)
savebmp.Save("c:\mypalette.bmp")

All you are saving is a new bitmap, and new bitmaps start with all the pixels set to black.
Create the bitmap before the loop that draws the rectangles. Then create the graphics object from the bitmap instead:

Dim g as Graphics = Graphics.FromImage(savebmp)

If you want to display the bitmap on the form then load it into a picturebox or something. The rectangles you currently draw is erased if you move the form off-screen and back on again as you are using me.creategraphics).

I agree, he needs to set the pixels of the new bitmap before attempting to saving it. And set the palette, as I already mentioned. Unfortunately, you cannot create a graphics object from a paletted bitmap.

jo0ls
08-12-2006, 06:05 AM
Your post hadn't appeared when I was composing an answer.
At the moment akrocks is not saving the original image with a new palette, the image is just a representation of the colors in the palette, so it doesn't really need to use a paletted format. I figured another post asking about attaching palettes to new bitmaps would appear in a few days...

akrocks
08-12-2006, 09:46 AM
ok! now i got it working thanks guys.

akrocks
08-12-2006, 04:41 PM
I figured another post asking about attaching palettes to new bitmaps would appear in a few days...

Hehe. Yeah. That is my next question. Now that I have the individual colors extracted from the picture how can i save that information to the palette of the original image?

akrocks
08-14-2006, 04:49 PM
Ok! It looks like I got it to work! And work pretty well. Of course I'm gonna have to do some tests on it. Like what it's gonna break when there are more than 256 colors :O but other than that I think it works like a charm.
Here are the images it produced.
original low quality produced (http://img.photobucket.com/albums/v48/bwoogie/vb/finallow.gif)
High(er) quality image produced by my lil' bute (http://img.photobucket.com/albums/v48/bwoogie/vb/finalhigh.png) - some reason photobucket is converting it to png?

I wouldn't mind if you guys took a look at this code and see if every thing looks right. I don't care if anyone uses this code - credit would be appreciated - since it was a pain to figure out. It's fully commented so it should be easy to find anything I didn't need to do, or did wrong. You guys have been a big help.


Private Sub buildPalette(ByVal myImg As Image)

'grab the colors from the image and add them to the palette.
Dim x As Long = 1 'x pos of the grabber
Dim y As Long = 1 'y pos of the grabber
Dim h As Integer = picMain.Height 'img height
Dim w As Integer = picMain.Width 'img width

Dim arry As New ArrayList 'array for holding the colors

Dim myBmp As New Bitmap(myImg) 'the bitmap to grab all the pixels

Dim curColor As Color 'current color the grabber has found...
Dim colorExists As Boolean = False 'is the color in the array already?

'loop through all the pixels in the image....
For y = 1 To h - 1
For x = 1 To w - 1
curColor = mybmp.GetPixel(x, y)

'Loop through the colors in the palette
'and check if it exists already
For n As Integer = 0 To arry.Count - 1
If curColor = Color.FromArgb(arry.Item(n)) Then
colorExists = True
End If

Next n
If colorExists = False Then
'The color isnt in the array yet so lets add it.
arry.Add(curColor.ToArgb)
Else
colorExists = False
End If
Next x
Next y

'create a real palette
GCHandle2 = Runtime.InteropServices.GCHandle.Alloc(gData, Runtime.InteropServices.GCHandleType.Pinned)
gifAddress = GCHandle2.AddrOfPinnedObject()

Dim cPalette As ColorPalette 'The color palette, duh.
Dim imageGif As New Bitmap(myBmp.Width, myBmp.Height, ((myBmp.Height + 3) And Not 3), _
Imaging.PixelFormat.Format8bppIndexed, gifAddress) ' create the GIF

cPalette = imageGif.Palette 'set the palette to the new gif's

'Loop through our original array of colors and add them to the new palette
For z As Integer = 0 To arry.Count - 1
cPalette.Entries(z) = Color.FromArgb(arry.Item(z))
Next z

myImg.Palette = cPalette 'set the image's palette to our new one.

myImg.Save("c:\finalimage.gif") 'save the image (use your own method)

'save a image test file of the palette for... testing ;O)
If debugMode = True Then 'public boolean if we are "debugging"
Dim maxW As Integer = arry.Count * 8 'max width of our image (each color 8px)
Dim palTestBmp As New Bitmap(maxW, 8) 'our image

Dim g As Graphics = Graphics.FromImage(palTestBmp) 'Graphics!

Dim x1 As Integer = 0 'drawing x location
Dim y1 As Integer = 0 'drawing y location

Const boxW As Integer = 8 'width of each color to be drawn.
Const boxH As Integer = 8 'height...

'Loop through each color in the array
For p As Integer = 0 To arry.Count - 1
'dorky name, but the current color in the array to draw with
Dim myhappycolor As Color = Color.FromArgb(arry.Item(p))
Dim myBrush As SolidBrush = New SolidBrush(myhappycolor) 'create a brush with the dorky color.

g.FillRectangle(myBrush, x1, y1, boxW, boxH) 'Draw the filled rectangle.
palTestBmp.SetPixel(x1, y1, myhappycolor) 'Draw it on the bitmap
x1 += boxW 'set the location of the next box to be drawn
Next p

palTestBmp.Palette = cPalette 'set the palette
palTestBmp.Save("c:\mypalette.bmp") 'save it.. again, use your own routine

'This opens a form (frmpal) with a picbox (picPalette) to show the new image.
Dim frmpal As New frmPalette
frmpal.Show()
frmpal.picPalette.Image = palTestBmp
End If

End Sub

akrocks
08-15-2006, 05:40 PM
I dont think this is working right, after all. :(
I got to thinking it was just saving a bmp with the name of a gif. so if I save with System.Drawing.Imaging.ImageFormat.Gif I lose the quality I thought I was getting from my palette maker which now I lost faith in. Can someone confirm if giving it a gif filename vb will automatically save it with the correct format or it's just saving it as a bitmap.

OnErr0r
08-15-2006, 06:03 PM
The encoder changes the internal file format. Changing the extension of a file does nothing.

Re-read what I said in post #6 of this thread.

akrocks
08-15-2006, 08:26 PM
There seem to be a couple things you aren't considering here.

1) Paletted bitmaps are limited to 256 colors. In counting/populating a bit array of colors is usually fastest, or you can use a modified radix sort for smaller images. Once you've finished counting, if there are more than 256 colors, you'll need to perform "quantization". See OCtree or Median cut algos.

2) Bitmaps default to 32bits. So, the bitmap you're creating to save it not paletted. Paletted bitmaps can have 2, 16 or 256 colors. You'll need to request the correct sort of bitmap and then set the palette before saving.

1) Ok, I don't have more than 256 colors so I'm not going to dive in to quantization just yet if i can help that.

2) I'm getting good quality images because my palette isnt working correctly? Because I'm suposedly setting a palette to the image. What exactly does "request the correct sort of bitmap" mean? Do you mean the encoder?

I guess my main problem is just not understanding images in general.

OnErr0r
08-15-2006, 08:54 PM
Requesting the correct sort of bitmap was refering to: Imaging.PixelFormat.Format8bppIndexed. Which you are doing now. Did you specify the GIF encoder yet? If so, and image quality is poor, post the original BMP and newly created GIF.

akrocks
08-15-2006, 09:24 PM
Requesting the correct sort of bitmap was refering to: Imaging.PixelFormat.Format8bppIndexed. Which you are doing now. Did you specify the GIF encoder yet? If so, and image quality is poor, post the original BMP and newly created GIF.

I probably didnt do it correctly. What about the EncoderParameters? Does that make a differance?
myImg.Save("c:\finalimage.gif", ImageFormat.Gif)

I cant really upload the original bmp because my program generates the image, but I'll upload the so called gif file it saves.

I uploaded an image of how it should look more like. only with out "test"

OnErr0r
08-16-2006, 12:14 PM
Rather than attempt to fix your code, I wrote an example. Here is what happens in the example:

1) The 32bit bitmap is looped through in order to count the number of colors and create a palette from it's pixel data.

2) The palette is sorted for fast searching.

3) We again loop through the 32bit data to determine the pixel index into the palette. That index is then saved to the 8bit bitmap.

4) Assign the custom palette and save as GIF.

There might be an easier way to do this, but it works. :)


Option Explicit On
Option Strict On

Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim pad As Integer
Dim pixels8() As Byte
Dim pixels() As Integer
Dim bd As Drawing.Imaging.BitmapData
Dim pal As Drawing.Imaging.ColorPalette
Dim bmp As New Drawing.Bitmap("c:\test.bmp") ' Some BMP with <= 256 colors

' Buffer to hold 32bit data
pixels = New Integer((bmp.Height * bmp.Width) - 1) {}

' Buffer to hold 8bit data
pixels8 = New Byte((((bmp.Width + 3) And Not 3) * bmp.Height) - 1) {}

' First let's get the 32bit data
bd = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format32bppArgb)
Runtime.InteropServices.Marshal.Copy(bd.Scan0, pixels, 0, bmp.Height * bmp.Width)
bmp.UnlockBits(bd)

Dim bmp8 As New Drawing.Bitmap(bmp.Width, bmp.Height, (bmp.Width + 3) And Not 3, Imaging.PixelFormat.Format8bppIndexed, IntPtr.Zero)

pal = bmp8.Palette ' Init the new palette from the default halftone palette

' Now count the number of unique colors and populate the palette
If CountUniqueArray(pixels, pal.Entries) <= 256 Then
' Sort the palette entries in order to Binary Search later
Array.Sort(pal.Entries, New CompareColors)

' Loop through and create 8bit palette pointers from 32bit data
For y = 0 To bmp.Height - 1
For x = 0 To bmp.Width - 1
i = Array.BinarySearch(pal.Entries, pixels((y * bmp.Width) + x), New CompareColorToInteger)
If i >= 0 Then pixels8((y * bmp.Width) + x + pad) = Convert.ToByte(i)
Next x
pad += -bmp.Width And 3 ' 8 bit padding, if any
Next y

' Write out the 8bit data to the bitmap
bd = bmp8.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), Imaging.ImageLockMode.WriteOnly, Imaging.PixelFormat.Format8bppIndexed)
Runtime.InteropServices.Marshal.Copy(pixels8, 0, bd.Scan0, bmp.Height * ((bmp.Width + 3) And Not 3))
bmp8.UnlockBits(bd)

bmp8.Palette = pal ' Assign our new custom palette
bmp8.Save("c:\test.gif", Drawing.Imaging.ImageFormat.Gif)
bmp.Dispose()
bmp8.Dispose()
Else
' Handle > 256 colors here
End If
End Sub

' Based on VB6 code by DaftAsBrush
' Uses a bit array for color counting
Public Function CountUniqueArray(ByRef iPixels() As Integer, ByVal entries() As Drawing.Color) As Integer
Dim i As Integer
Dim color As Integer
Dim iNumColors As Integer
Dim colors(524287) As UInteger

For i = 0 To iPixels.Length - 1
color = (iPixels(i) And &HFFFFFF) ' Remove Alpha channel

' Have we seen this color before?
If (colors(color \ 32) And CType(1& << (color And 31), UInteger)) = 0 Then

' If not, mark it as "seen" and count it.
colors(color \ 32) = colors(color \ 32) Or CType(1& << (color And 31), UInteger)

' Store the new color in the palette
If iNumColors < 256 Then
entries(iNumColors) = Drawing.Color.FromArgb(color Or &HFF000000)
End If

iNumColors += 1
End If
Next i

Return iNumColors
End Function

Public Class CompareColorToInteger
Implements IComparer

Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
Dim c As Integer = DirectCast(x, Drawing.Color).ToArgb
Dim i As Integer = DirectCast(y, Integer)

Return Convert.ToInt32(c > i) - Convert.ToInt32(c < i)
End Function
End Class

Public Class CompareColors
Implements IComparer(Of Drawing.Color)

Function Compare(ByVal x As Drawing.Color, ByVal y As Drawing.Color) As Integer _
Implements System.Collections.Generic.IComparer(Of System.Drawing.Color).Compare
Return Convert.ToInt32(x.ToArgb > y.ToArgb) - Convert.ToInt32(x.ToArgb < y.ToArgb)
End Function
End Class
End Class

akrocks
08-16-2006, 04:12 PM
Hmm.. I'm getting an error.

Arithmetic operation resulted in an overflow.

' Have we seen this color before?
If (colors(color \ 32) And CType(1 << (color And 31), UInteger)) = 0 Then

OnErr0r
08-16-2006, 10:19 PM
See the requirement in the comments at the top of the function.

akrocks
08-17-2006, 04:37 PM
Ok thanks. I'm using 2005 express, though. so they didnt include that option. is there any make shift ways of getting around this?

OnErr0r
08-17-2006, 05:39 PM
I altered the function to work without ignoring overflows and removed the requirement from the comments.

akrocks
08-17-2006, 06:03 PM
Works like a charm! Thanks alot! You have been a great help!

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum