Convert image to 8bit 256 colors (windows only)

netmaestro · Post by **netmaestro** » Sat Dec 13, 2008 7:19 pm

Here is a command that will produce a 256 color or grayscale image from any image you supply to it. It will optionally free the original image. Colors are applied from the MSX2 Screen8 palette and imho they look pretty good all things considered, but you be the judge. The advantage is that the image size is much reduced based on each pixel using only one byte.

Code: Select all

; Library commands:       ImageTo8bit() and Save8bitImage() 
; Author:                 Lloyd Gallant (netmaestro) 
; Date:                   December 12, 2008 
; Target OS:              Microsoft Windows All 
; Target Compiler:        PureBasic 4.3 and later 
; License:                Free, unrestricted, no warranty 
;            
; Usage: ImageTo8bit(hImageIn, palette) 
; 
;        hImageIn: is the 16,24 or 32bit image to reduce to 8bit depth 
;        palette:  is either 0,1 or 2:  0 = grayscale 
;                                       1 = MSX2 Screen8 color palette 
;                                       2 = Adaptive color palette 
; 
; Usage: Save8bitImage(image, filename$ [,memory]) 
; 
;        image:     is an 8bit image to save to disk or memory 
;        filename$: is the name to save it to. 
;        memory:    is a boolean which if true, will cause the procedure to return 
;                   a memory block containing the complete bitmap file. You may 
;                   compress this and send it over a network or catch the image 
;                   from the returned pointer as desired. You must free the pointer 
;                   when you're finished to avoid a memory leak. 
;===================================================================================== 

Procedure GrayscaleTable() 
  
  Global Dim GrayTable.RGBQUAD(256) 
  For i = 0 To 255 
    With GrayTable(i) 
      \rgbBlue  = i 
      \rgbGreen = i 
      \rgbRed   = i 
      \rgbReserved = 255 
    EndWith        
  Next 
  
  *palette = AllocateMemory(256*SizeOf(RGBQUAD)) 
  CopyMemory(@GrayTable(),*palette, MemorySize(*palette)) 
  ReDim GrayTable(0) 
  ProcedureReturn *palette 
  
EndProcedure 

Procedure ColorTable()
   img0 = CatchImage(#PB_Any, ?ColorTable, 824)

   DataSection
      ColorTable:
      Data.b $42,$4D,$38,$03,$00,$00,$00,$00,$00,$00,$36,$00,$00,$00,$28,$00,$00,$00,$20,$00
      Data.b $00,$00,$08,$00,$00,$00,$01,$00,$18,$00,$00,$00,$00,$00,$02,$03,$00,$00,$12,$0B
      Data.b $00,$00,$12,$0B,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$FF,$00,$55,$FF,$00
      Data.b $AA,$FF,$00,$FF,$FF,$00,$00,$FF,$24,$55,$FF,$24,$AA,$FF,$24,$FF,$FF,$24,$00,$FF
      Data.b $49,$55,$FF,$49,$AA,$FF,$49,$FF,$FF,$49,$00,$FF,$6D,$55,$FF,$6D,$AA,$FF,$6D,$FF
      Data.b $FF,$6D,$00,$FF,$92,$55,$FF,$92,$AA,$FF,$92,$FF,$FF,$92,$00,$FF,$B6,$55,$FF,$B6
      Data.b $AA,$FF,$B6,$FF,$FF,$B6,$00,$FF,$DB,$55,$FF,$DB,$AA,$FF,$DB,$FF,$FF,$DB,$00,$FF
      Data.b $FF,$55,$FF,$FF,$AA,$FF,$FF,$FF,$FF,$FF,$00,$DB,$00,$55,$DB,$14,$AA,$DB,$00,$FF
      Data.b $DB,$00,$00,$DB,$24,$55,$DB,$24,$AA,$DB,$24,$FF,$DB,$24,$00,$DB,$49,$55,$DB,$49
      Data.b $AA,$DB,$49,$FF,$DB,$49,$00,$DB,$6D,$55,$DB,$6D,$AA,$DB,$6D,$FF,$DB,$6D,$00,$DB
      Data.b $92,$55,$DB,$92,$AA,$DB,$92,$FF,$DB,$92,$00,$DB,$B6,$55,$DB,$B6,$AA,$DB,$B6,$FF
      Data.b $DB,$B6,$00,$DB,$DB,$55,$DB,$DB,$AA,$DB,$DB,$FF,$DB,$DB,$00,$DB,$FF,$55,$DB,$FF
      Data.b $AA,$DB,$FF,$FF,$DB,$FF,$00,$B6,$00,$55,$B6,$00,$AA,$B6,$00,$FF,$B6,$00,$00,$B6
      Data.b $24,$55,$B6,$24,$AA,$B6,$24,$FF,$B6,$24,$00,$B6,$49,$55,$B6,$49,$AA,$B6,$49,$FF
      Data.b $B6,$49,$00,$B6,$6D,$55,$B6,$6D,$AA,$B6,$6D,$FF,$B6,$6D,$00,$B6,$92,$55,$B6,$92
      Data.b $AA,$B6,$92,$FF,$B6,$92,$00,$B6,$B6,$55,$B6,$B6,$AA,$B6,$B6,$FF,$B6,$B6,$00,$B6
      Data.b $DB,$55,$B6,$DB,$AA,$B6,$DB,$FF,$B6,$DB,$00,$B6,$FF,$55,$B6,$FF,$AA,$B6,$FF,$FF
      Data.b $B6,$FF,$00,$92,$00,$55,$92,$00,$AA,$92,$00,$FF,$92,$00,$00,$92,$24,$55,$92,$24
      Data.b $AA,$92,$24,$FF,$92,$24,$00,$92,$49,$55,$92,$49,$AA,$92,$49,$FF,$92,$49,$00,$92
      Data.b $6D,$55,$92,$6D,$AA,$92,$6D,$FF,$92,$6D,$00,$92,$92,$55,$92,$92,$AA,$92,$92,$FF
      Data.b $92,$92,$00,$92,$B6,$55,$92,$B6,$AA,$92,$B6,$FF,$92,$B6,$00,$92,$DB,$55,$92,$DB
      Data.b $AA,$92,$DB,$FF,$92,$DB,$00,$92,$FF,$55,$92,$FF,$AA,$92,$FF,$FF,$92,$FF,$00,$6D
      Data.b $00,$55,$6D,$00,$AA,$6D,$00,$FF,$6D,$00,$00,$6D,$24,$55,$6D,$24,$AA,$6D,$24,$FF
      Data.b $6D,$24,$00,$6D,$49,$55,$6D,$49,$AA,$6D,$49,$FF,$6D,$49,$00,$6D,$6D,$55,$6D,$6D
      Data.b $AA,$6D,$6D,$FF,$6D,$6D,$00,$6D,$92,$55,$6D,$92,$AA,$6D,$92,$FF,$6D,$92,$00,$6D
      Data.b $B6,$55,$6D,$B6,$AA,$6D,$B6,$FF,$6D,$B6,$00,$6D,$DB,$55,$6D,$DB,$AA,$6D,$DB,$FF
      Data.b $6D,$DB,$00,$6D,$FF,$55,$6D,$FF,$AA,$6D,$FF,$FF,$6D,$FF,$00,$49,$00,$55,$49,$00
      Data.b $AA,$49,$00,$FF,$49,$00,$00,$49,$24,$55,$49,$24,$AA,$49,$24,$FF,$49,$24,$00,$49
      Data.b $49,$55,$49,$49,$AA,$49,$49,$FF,$49,$49,$00,$49,$6D,$55,$49,$6D,$AA,$49,$6D,$FF
      Data.b $49,$6D,$00,$49,$92,$55,$49,$92,$AA,$49,$92,$FF,$49,$92,$00,$49,$B6,$55,$49,$B6
      Data.b $AA,$49,$B6,$FF,$49,$B6,$00,$49,$DB,$55,$49,$DB,$AA,$49,$DB,$FF,$49,$DB,$00,$49
      Data.b $FF,$55,$49,$FF,$AA,$49,$FF,$FF,$49,$FF,$00,$24,$00,$55,$24,$00,$AA,$24,$00,$FF
      Data.b $24,$00,$00,$24,$24,$55,$24,$24,$AA,$24,$24,$FF,$24,$24,$00,$24,$49,$55,$24,$49
      Data.b $AA,$24,$49,$FF,$24,$49,$00,$24,$6D,$55,$24,$6D,$AA,$24,$6D,$FF,$24,$6D,$00,$24
      Data.b $92,$55,$24,$92,$AA,$24,$92,$FF,$24,$92,$00,$24,$B6,$55,$24,$B6,$AA,$24,$B6,$FF
      Data.b $24,$B6,$00,$24,$DB,$55,$24,$DB,$AA,$24,$DB,$FF,$24,$DB,$00,$24,$FF,$55,$24,$FF
      Data.b $AA,$24,$FF,$FF,$24,$FF,$00,$00,$00,$55,$00,$00,$AA,$00,$00,$FF,$00,$00,$00,$00
      Data.b $24,$55,$00,$24,$AA,$00,$24,$FF,$00,$24,$00,$00,$49,$55,$00,$49,$AA,$00,$49,$FF
      Data.b $00,$49,$00,$00,$6D,$55,$00,$6D,$AA,$00,$6D,$FF,$00,$6D,$00,$00,$92,$55,$00,$92
      Data.b $AA,$00,$92,$FF,$00,$92,$00,$00,$B6,$55,$00,$B6,$AA,$00,$B6,$FF,$00,$B6,$00,$00
      Data.b $DB,$55,$00,$DB,$AA,$00,$DB,$FF,$00,$DB,$00,$00,$FF,$55,$00,$FF,$AA,$00,$FF,$FF
      Data.b $00,$FF,$00,$00
      ColorTableend:
    EndDataSection
    
  Global Dim ctable.RGBQUAD(256) 
  
  cc=0 
  StartDrawing(ImageOutput(img0)) 
  For j=0 To 7 
    For i=0 To 31 
      col = Point(i,j) 
      With ctable(cc) 
        \rgbBlue  = Blue(col) 
        \rgbGreen = Green(col) 
        \rgbRed   = Red(col) 
        \rgbReserved = 0 
      EndWith 
      cc+1 
    Next 
  Next 
  StopDrawing() 
  FreeImage(img0) 
  
  *palette = AllocateMemory(256*SizeOf(RGBQUAD)) 
  CopyMemory(@ctable(),*palette, MemorySize(*palette)) 
  ReDim ctable(0) 
  ProcedureReturn *palette 

  
EndProcedure  

ProcedureDLL Save8bitImage(image, filename$, memory=0) 
  
  If GetObject_(image, SizeOf(BITMAP), Bmp.BITMAP) 
    With BmiInfo.BITMAPINFOHEADER 
      \biSize         = SizeOf(BITMAPINFOHEADER) 
      \biWidth        = Bmp\bmWidth 
      \biHeight       = Bmp\bmHeight 
      \biPlanes       = 1 
      \biBitCount     = 8 
    EndWith 
  Else 
    ProcedureReturn 0 
  EndIf 
  
  sz_colorbits = Bmp\bmWidthBytes*Bmp\bmHeight 
  *colortable = AllocateMemory(256*SizeOf(RGBQUAD)) 
  dc = CreateDC_("DISPLAY",0,0,0)
  hdc = CreateCompatibleDC_(dc)
    SelectObject_(hdc, image)
    NumColors = GetDIBColorTable_(hdc, 0, 256, *colortable) 
  DeleteDC_(dc)
  DeleteDC_(hdc)
  sz_image = SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER) + NumColors*SizeOf(RGBQUAD) + sz_colorbits 
  *rawimage = AllocateMemory(sz_image) 
  *fileheader.BITMAPFILEHEADER = *rawimage 
  *header = *rawimage + SizeOf(BITMAPFILEHEADER) 
  With *fileheader 
    \bfType = $4D42 ; "BM" for Bit Map
    \bfSize = sz_image 
    \bfOffBits = SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER) + NumColors*SizeOf(RGBQUAD) 
  EndWith 
  CopyMemory(BmiInfo, *header, SizeOf(BITMAPINFOHEADER)) 
  CopyMemory(*colortable, *rawimage + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER), NumColors*SizeOf(RGBQUAD)) 
  CopyMemory(Bmp\bmBits, *rawimage + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER) + NumColors*SizeOf(RGBQUAD), sz_colorbits) 
  
  FreeMemory(*colortable) 
  
  If Not memory 
    file = CreateFile(#PB_Any, filename$) 
    If file 
      WriteData(file,*rawimage,MemorySize(*rawimage)) 
      CloseFile(file) 
    EndIf 
    FreeMemory(*rawimage) 
    ProcedureReturn 1 
  Else 
    ProcedureReturn *rawimage 
  EndIf 
  
EndProcedure 

Procedure Get32BitColors(pBitmap) 

  GetObject_(pBitmap, SizeOf(BITMAP), @Bmp.BITMAP) 
  
  With BmiInfo.BITMAPINFOHEADER 
    \biSize         = SizeOf(BITMAPINFOHEADER) 
    \biWidth        = Bmp\bmWidth 
    \biHeight       = -Bmp\bmHeight 
    \biPlanes       = 1 
    \biBitCount     = 32 
    \biCompression  = #BI_RGB  
  EndWith 
  
  *pPixels = AllocateMemory(4*Bmp\bmWidth*Bmp\bmHeight) 
  hDC = GetWindowDC_(#Null) 
  iRes = GetDIBits_(hDC, pBitmap, 0, Bmp\bmHeight , *pPixels, @bmiInfo, #DIB_RGB_COLORS) 
  ReleaseDC_(#Null, hDC) 
  ProcedureReturn *pPixels 
  
EndProcedure 

Procedure AdaptiveColorTable(pBitmap) 

  *pPixels = Get32BitColors(pBitmap) 
  Global Dim ColorBits.l(MemorySize(*pPixels)/4) 
  CopyMemory(*pPixels,ColorBits(),MemorySize(*pPixels)) 
  FreeMemory(*pPixels) 
  SortArray(ColorBits(),#PB_Sort_Ascending) 
  Global Dim Apalette(256) 
  x = ArraySize(colorbits())/256 
  cc=0 
  lastcolor = colorbits(0)-1 
  For i = 0 To 255 
    If colorbits(cc)<>lastcolor 
      Apalette(i) = colorbits(cc) 
      lastcolor = colorbits(cc) 
      cc+x 
    Else 
      While colorbits(cc) = lastcolor And cc < ArraySize(colorbits()) 
        cc+1 
      Wend 
      x = (ArraySize(colorbits())-cc)/(256-i) 
      cc+x-1 
      Apalette(i) = colorbits(cc) 
      lastcolor = colorbits(cc) 
    EndIf 
  Next 
  
  ReDim Colorbits.l(0) 
  
  *palette = AllocateMemory(256*SizeOf(RGBQUAD)) 
  CopyMemory(@Apalette(),*palette, MemorySize(*palette)) 
  ReDim Apalette(0) 
  ProcedureReturn *palette 

EndProcedure 

ProcedureDLL ImageTo8bit(hImageIn, palette) 

  Select palette 
    Case 0 
      *palette = GrayscaleTable() 
    Case 1 
      *palette = ColorTable() 
    Case 2 
      *palette = AdaptiveColorTable(hImageIn) 
    Default 
      *palette = ColorTable() 
  EndSelect 

  GetObject_(hImageIn,SizeOf(BITMAP),bmp.BITMAP) 
  w = bmp\bmWidth 
  h = bmp\bmHeight 
  d = bmp\bmBitsPixel 

  dc = CreateDC_("DISPLAY",0,0,0)
  hdcSrc = CreateCompatibleDC_(dc)

  With bmi.BITMAPINFO 
    \bmiHeader\biSize     = SizeOf(BITMAPINFOHEADER) 
    \bmiHeader\biWidth    = w 
    \bmiHeader\biHeight   = -h 
    \bmiHeader\biPlanes   = 1 
    \bmiHeader\biBitCount = d 
  EndWith  
  
  GetDIBits_(hdcSrc, hImageIn, 0, 0, #Null, @bmi, #DIB_RGB_COLORS) 
    
  *bits = AllocateMemory(bmi\bmiHeader\biSizeImage) 

  GetDIBits_(hdcSrc, hImageIn, 0, h, *bits, @bmi, #DIB_RGB_COLORS) 
  
  With bmi8.BITMAPINFO 
     \bmiHeader\biSize     = SizeOf(BITMAPINFOHEADER) 
     \bmiHeader\biWidth    = w 
     \bmiHeader\biHeight   = h 
     \bmiHeader\biPlanes   = 1 
     \bmiHeader\biBitCount = 8 
  EndWith
  
  hdcDest = CreateCompatibleDC_(dc)

  hImageOut = CreateDIBSection_(hdcDest, @bmi8, #DIB_PAL_COLORS, @ppvbits, 0, 0) 
   
  SelectObject_(hdcDest, hImageOut)  
  SetDIBColorTable_(hdcDest,0,256,*palette) 
  
  GdiFlush_()
  SetDIBits_(hdcSrc, hImageOut, 0, h, *bits, @bmi, #DIB_PAL_COLORS) 
  
  DeleteDC_(dc)
  DeleteDC_(hdcSrc)
  DeleteDC_(hdcDest)
  
  FreeMemory(*bits) 
  FreeMemory(*palette) 
  
  ProcedureReturn hImageOut 

EndProcedure

Here is some test code, try with palette=0, palette=1 and palette=2:

Code: Select all

IncludeFile "Make8bitImage.pbi" 

UseJPEGImageDecoder() 
If FileSize("girl.jpg")= -1 
  InitNetwork() 
  ReceiveHTTPFile("http://www.lloydsplace.com/girl.jpg", "girl.jpg") 
EndIf 

If FileSize("girl.jpg")= -1 
  Debug "Image not found. Terminating..."
  End
EndIf

hImage = LoadImage(#PB_Any, "girl.jpg") 

i = ImageTo8bit(ImageID(hImage), 2) 

; save to a bitmap file 
Save8bitImage(i, "girl_8bit.bmp") 

; save to memory 
*image = Save8bitImage(i, "", 1) 

; test memory image 
j = CatchImage(#PB_Any, *image) 

; Let's take a look at the results...

OpenWindow(0,0,0,ImageWidth(j),ImageHeight(j),"") 
ImageGadget(0,0,0,0,0,ImageID(j))
Repeat
  ev = WaitWindowEvent()

Until ev=#PB_Event_CloseWindow

Dec 14:
Added a Save8bitImage command. If you run this testcode, your working folder will have a "girl_8bit.bmp" file added to it and this is a true 8bit 256-color image, as you may verify with Photoshop or similar. You can't verify it by doing a LoadImage from PB and checking ImageDepth.

Dec 15: Added an adaptive color table. Improves quality immensely.

Aug 30/09: Updated code to be compatible with PB v4.40.

Jan 27/17: Updated code to be compatible with PB v5.50

srod · Post by **srod** » Sat Dec 13, 2008 9:47 pm

Very nice Netmaestro; works great here on jpgs, pngs and bmps.

netmaestro · Post by **netmaestro** » Sat Dec 13, 2008 10:26 pm

Thanks, it solves a question that has cropped up on the forums a number of times. I'm currently working on a version that will create a palette intelligently based on the 256 colors that occur most often in the original image. If it's successful it should produce a result that is closer yet to the original.

Post by **idle** » Sat Dec 13, 2008 10:59 pm

That's a pretty good pallet, thanks.

Joakim Christiansen · Sat Dec 13, 2008 11:43 pm

Nice indeed!

Would be nice if we could save it as a 8bit image too...

netmaestro · Post by **netmaestro** » Sat Dec 13, 2008 11:47 pm

That's actually quite easy. I'll post an example in an hour or so, I'm just at dinner right now (and getting glared at)

netmaestro · Post by **netmaestro** » Sun Dec 14, 2008 5:25 am

Added Save8bitImage command.

Post by **idle** » Sun Dec 14, 2008 5:36 am

Amazing what a bit of dinner does

PB · Post by PB » Sun Dec 14, 2008 6:07 am

Nice girl.

But there's a bug (or my PC?). If I use your Save8bitImage() procedure,
with girl saved locally and loaded with UseJPEGImageDecoder(), the return
value is 0 and she doesn't get saved back to disk in 8bit as a bitmap. Here's
all I added to your code:

Code: Select all

UseJPEGImageDecoder()
LoadImage(0,"c:\girl.jpg")
Save8bitImage(0,"c:\girl.bmp") ; Returns 0

netmaestro · Post by **netmaestro** » Sun Dec 14, 2008 6:49 am

@PB: When PureBasic loads or catches an 8bit image it converts it to 24 or 32 bits format. Same is true for SaveImage regardless of the depth of the image it's saving, hence the need for the Save8bitImage proc. Save8bitImage would have returned 0 right away using the code in your post because it won't work with depths other than 8 bits. If your code was:

Code: Select all

UseJPEGImageDecoder() 
LoadImage(0,"c:\girl.jpg") 
img = ImageTo8bit(0, 1, 1)
Save8bitImage(img,"c:\girl.bmp")

then it should work fine.

netmaestro · Post by **netmaestro** » Sun Dec 14, 2008 6:52 am

Added a memory option to Save8bitImage so that it can return a memory block containing the complete image file. You can then compress this and send it over a network for later decompressing/catching or simply do a CatchImage on the pointer.

Joakim Christiansen · Post by **Joakim Christiansen** » Sun Dec 14, 2008 2:34 pm

netmaestro wrote:That's actually quite easy. I'll post an example in an hour or so, I'm just at dinner right now (and getting glared at)

Hehe, you rock!

And now show us how to save it as a 8 bit jpg! If you can do that I'll make you a BIG dinner!

netmaestro · Post by **netmaestro** » Mon Dec 15, 2008 6:54 am

Today I wrote a routine to generate an adaptive color table based on the colors in the original image. (code updated in first post.) I got this idea when I pulled the original image into Photoshop and changed the bit depth to 8, trying a few different palettes. When I tried "adaptive" I noticed very little change in the image quality. I thought, "how are they doing that?" and after some thought I came to the idea of putting all the image colors in an array and taking the 256 most common colors. When I tried that it was a dismal failure. The blues and browns were nicely blended but everything else was black. So I gave up and went to bed but halfway up the stairs it hit me - not enough variety. Why not sort the array and take 256 colors out of it evenly along its total length? So I tried that and the result was so good I thought I'd made a mistake and displayed the original image! Anyway, here's the result, judge for yourself:

original image:

Adaptive, Screen8 and Grayscale:

Isn't the quality amazing with the adaptive color table? I surprised myself on this one.

Post by **idle** » Mon Dec 15, 2008 7:55 am

That's pretty amazing!

eesau · Post by **eesau** » Mon Dec 15, 2008 9:06 am

Excellent work maestro!