PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Convert image to 8bit 256 colors (windows only)

https://www.purebasic.fr/english/viewtopic.php?t=35627

Page 1 of 5

Convert image to 8bit 256 colors (windows only)

Posted: Sat Dec 13, 2008 7:19 pm
by netmaestro
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

Posted: Sat Dec 13, 2008 9:47 pm
by srod
Very nice Netmaestro; works great here on jpgs, pngs and bmps. 8)

Posted: Sat Dec 13, 2008 10:26 pm
by netmaestro
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.

Posted: Sat Dec 13, 2008 10:59 pm
by idle
That's a pretty good pallet, thanks.

Posted: Sat Dec 13, 2008 11:43 pm
by Joakim Christiansen
Nice indeed! :D
Would be nice if we could save it as a 8bit image too...

Posted: Sat Dec 13, 2008 11:47 pm
by netmaestro
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)

Posted: Sun Dec 14, 2008 5:25 am
by netmaestro
Added Save8bitImage command.

Posted: Sun Dec 14, 2008 5:36 am
by idle
Amazing what a bit of dinner does :lol:

Posted: Sun Dec 14, 2008 6:07 am
by PB
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

Posted: Sun Dec 14, 2008 6:49 am
by netmaestro
@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.

Posted: Sun Dec 14, 2008 6:52 am
by netmaestro
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.

Posted: Sun Dec 14, 2008 2:34 pm
by Joakim Christiansen
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! :wink:
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! :D :twisted:

Posted: Mon Dec 15, 2008 6:54 am
by netmaestro
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:

Image

Adaptive, Screen8 and Grayscale:

Image

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

Posted: Mon Dec 15, 2008 7:55 am
by idle
That's pretty amazing!

Posted: Mon Dec 15, 2008 9:06 am
by eesau
Excellent work maestro!
All times are UTC+01:00
Page 1 of 5

Powered by phpBB® Forum Software © phpBB Limited