Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Public Class Form1
Inherits System.Windows.Forms.Form
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim pic As Image = Image.FromFile("C:\test.jpg")
SaveGIFWithNewColorTable(pic, "C:\test.gif", 256, True)
End Sub
Class Win32API
<DllImport("KERNEL32.DLL", EntryPoint:="RtlMoveMemory", _
SetLastError:=True, CharSet:=CharSet.Auto, _
ExactSpelling:=True, _
CallingConvention:=CallingConvention.StdCall)> _
Public Shared Sub CopyArrayTo(<[In](), MarshalAs(UnmanagedType.I4)> ByVal hpvDest As Int32, <[In](), Out()> ByVal hpvSource() As Byte, ByVal cbCopy As Integer)
Leave function empty - DLLImport attribute forwards calls to CopyArrayTo to
RtlMoveMemory in KERNEL32.DLL.
End Sub
End Class
Private Function GetColorPalette(ByVal nColors As Integer) As ColorPalette
Assume monochrome image.
Dim bitscolordepth As PixelFormat = PixelFormat.Format8bppIndexed
Dim palette As ColorPalette The Palette we are stealing
Dim bitmap As Bitmap The source of the stolen palette
Make a new Bitmap object to get its Palette.
bitmap = New Bitmap(1, 1, bitscolordepth)
palette = bitmap.Palette Grab the palette
bitmap.Dispose() cleanup the source Bitmap
Return palette Send the palette back
End Function
Private Sub SaveGIFWithNewColorTable(ByVal image As Image, ByVal filename As String, ByVal nColors As Integer, ByVal fTransparent As Boolean)
Try
nColors = 256
Make a new 8-BPP indexed bitmap that is the same size as the source image.
Dim Width As Integer = 150
Dim Height As Integer = 200
Always use PixelFormat8BppIndexed because that is the color
table based interface to the GIF codec.
Dim bitmap As Bitmap = New Bitmap(Width, Height, PixelFormat.Format32bppPArgb)
Create a color palette big enough to hold the colors you want.
Dim pal As ColorPalette = GetColorPalette(nColors)
Initialize a new color table with entries that are determined
by some optimal palette-finding algorithm; for demonstration
purposes, use a grayscale.
Dim i As Integer
For i = 0 To nColors - 1
Dim Alpha As Integer = 255 Colors are opaque
Dim Intensity As Double = CDbl(i) * 255 / (nColors - 1) even distribution
The GIF encoder makes the first entry in the palette
with a ZERO alpha the transparent color in the GIF.
Pick the first one arbitrarily, for demonstration purposes.
If (i = 0 And fTransparent) Then Make this color index...
Alpha = 0 Transparent
End If
Create a gray scale for demonstration purposes.
Otherwise, use your favorite color reduction algorithm
and an optimum palette for that algorithm generated here.
For example, a color histogram, or a median cut palette.
pal.Entries(i) = Color.FromArgb(Alpha, Intensity, Intensity, Intensity)
Next i
Set the palette into the new Bitmap object.
bitmap.Palette = pal
Use GetPixel below to pull out the color data of
image because GetPixel isnt defined on an Image; make a copy
in a Bitmap instead. Next, make a new Bitmap that is the same
size as the image that you want to export. Or, try to interpret
the native pixel format of the image by using a LockBits
call. Use PixelFormat32BppARGB so you can wrap a graphics
around it.
Dim BmpCopy As Bitmap = New Bitmap(Width, Height, PixelFormat.Format32bppPArgb)
Dim g As Graphics
g = Graphics.FromImage(BmpCopy)
g.PageUnit = GraphicsUnit.Pixel
Transfer the Image to the Bitmap.
g.DrawImage(image, 0, 0, Width, Height)
Force g to release its resources, namely BmpCopy.
g.Dispose()
Lock a rectangular portion of the bitmap for writing.
Dim bitmapData As BitmapData
Dim rect As Rectangle = New Rectangle(0, 0, Width, Height)
bitmapData = bitmap.LockBits(rect, ImageLockMode.WriteOnly, PixelFormat.Format8bppIndexed)
Write to a temporary buffer, and then copy to the buffer that
LockBits provides. Copy the pixels from the source image in this
loop. Because you want an index, convert RGB to the appropriate
palette index here.
Dim pixels As IntPtr = bitmapData.Scan0
Dim bits As Byte() the working buffer
Get the pointer to the image bits.
Dim pBits As Int32
If (bitmapData.Stride > 0) Then
pBits = pixels.ToInt32()
Else
If the Stide is negative, Scan0 points to the last
scanline in the buffer. To normalize the loop, obtain
a pointer to the front of the buffer that is located
(Height-1) scanlines previous.
pBits = pixels.ToInt32() + bitmapData.Stride * (Height - 1)
End If
Dim stride As Integer = Math.Abs(bitmapData.Stride)
ReDim bits(Height * stride) Allocate the working buffer.
Dim row As Integer
Dim col As Integer
For row = 0 To Height - 1
For col = 0 To Width - 1
Map palette indices for a gray scale.
Put your favorite color reduction algorithm here.
If you use some other technique to color convert.
Dim pixel As Color The source pixel.
The destination pixel.
Dim i8BppPixel As Integer = row * stride + col
pixel = BmpCopy.GetPixel(col, row)
Use luminance/chrominance conversion to get grayscale.
Basically, turn the image into black and white TV.
Do not calculate Cr or Cb because you
discard the color anyway.
Y = Red * 0.299 + Green * 0.587 + Blue * 0.114
This expression should be integer math for performance;
however, because GetPixel above is the slowest part of
this loop, the expression is left as floating point
for clarity.
Dim luminance As Double = (pixel.R * 0.299) + _
(pixel.G * 0.587) + _
(pixel.B * 0.114)
Gray scale is an intensity map from black to white.
Compute the index to the grayscale entry that
approximates the luminance, and then round the index.
Also, constrain the index choices by the number of
colors to do, and then set that pixels index to the byte
value.
Dim colorIndex As Double = Math.Round((luminance * (nColors - 1) / 255))
bits(i8BppPixel) = CByte(colorIndex)
/* end loop for col */
Next col
/* end loop for row */
Next row
Put the image bits definition into the bitmap.
Win32API.CopyArrayTo(pBits, bits, Height * stride)
To commit the changes, unlock the portion of the bitmap.
bitmap.UnlockBits(bitmapData)
bitmap.Save(filename, ImageFormat.Gif)
Bitmap goes out of scope here and is also marked for
garbage collection.
Pal is referenced by bitmap and goes away.
BmpCopy goes out of scope here and is marked for garbage
collection. Force it, because it is probably quite large.
The same applies for bitmap.
BmpCopy.Dispose()
bitmap.Dispose()
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
End Class
