Convert color image to 24-bit or 8-bit grayscale
Posted: Wed Feb 17, 2016 5:00 am
From what i've seen browsing the forums there are probably quite a few other grayscale conversion source codes already available for PB, but i wanted to write my own to help get my stupid head around it. Ive used direct buffer modification via pointers so the speed is ok (no Point()/Plot()'s), it supports 24-bit RGB and BGR, and in the name of equality has 6 different weighting algorithms to choose from (and a Prototype to directly point at the chosen algorithm procedure). Simple to add 32-bit support but i have no need at the moment, and knowing me id probably end up supporting ARGB or something instead of RGBA anyway 
should support all OS
wilbert made this excellent image to demonstrate the RGB-to-gray conversions from the different weighting algorithms, you can see that both of his two algorithms are extremely close to Photoshops output so you probably should choose one of those two as your default!:


should support all OS
Code: Select all
EnableExplicit
UsePNGImageDecoder(): UseJPEGImageDecoder(): UseJPEG2000ImageDecoder()
;--- Color-to-Gray weighting algorithms -----------------------------------------------------------------------
Prototype.l protoRGBToGray(red,green,blue)
Global RGBToGray.protoRGBToGray
;-- Average
Procedure.l RGBtoAverage(red,green,blue) ;Simplest but poorest result and slow division
ProcedureReturn (red + green + blue) / 3
EndProcedure
;-- Mean
Procedure.l RGBtoMean(red,green,blue) ;aka "Lightness method"
Protected lum,max,min
If green < red: min = green: Else: min = red: EndIf
If blue < min: min = blue: EndIf
If green > red: max = green: Else: max = red: EndIf
If blue > max: max = blue: EndIf
lum = (max + min) >> 1 ;/ 2.0
ProcedureReturn lum
EndProcedure
;-- 601 linear
Procedure.l RGBtoLuma601(red,green,blue) ;ITU-R BT.601, Matlab
ProcedureReturn (red * 0.299) + (green * 0.587) + (blue * 0.114)
EndProcedure
;-- 709 linear
Procedure.l RGBtoLuma709(red,green,blue) ;ITU-R BT.709
ProcedureReturn (red * 0.2126) + (green * 0.7152) + (blue * 0.0722)
EndProcedure
;-- 709 sRGB -- by wilbert
Procedure.d inv_gam_sRGB(ic)
Protected c.d = ic/255.0
If c <= 0.04045
ProcedureReturn c/12.92
Else
ProcedureReturn Pow((c+0.055)/1.055,2.4)
EndIf
EndProcedure
Procedure gam_sRGB(v.d)
If v <= 0.0031308
v * 12.92
Else
v = 1.055*Pow(v,1.0/2.4)-0.055
EndIf
ProcedureReturn Int(v*255+0.5)
EndProcedure
Procedure RGBto709sRGB(r, g, b)
ProcedureReturn gam_sRGB(0.2126*inv_gam_sRGB(r) + 0.7152*inv_gam_sRGB(g) + 0.0722*inv_gam_sRGB(b))
EndProcedure
;-- Square-Root sRGB -- by wilbert
;-VERSION 1 (Simplified)
; Procedure.l RGBSqrt(red, green, blue)
; ProcedureReturn Sqr(0.23*red*red + 0.70*green*green + 0.07*blue*blue)
; EndProcedure
;-VERSION 2 (Faster using lookup table and asm)
Global Dim SqrTable.a(65025)
Define i
For i = 0 To 65025
SqrTable(i) = Sqr(i)
Next
Procedure.l RGBSqrt(red, green, blue); weighted Euclidean distance
!movzx eax, byte [p.v_red]
!movzx ecx, byte [p.v_green]
!movzx edx, byte [p.v_blue]
!imul eax, eax
!imul ecx, ecx
!imul edx, edx
!imul eax, 0x3ae1
!imul ecx, 0xb333
!imul edx, 0x11ec
!add eax, ecx
!lea eax, [eax + edx + 0x8000]
!shr eax, 16
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
!mov rdx, [a_SqrTable]
!movzx eax, byte [rdx + rax]
CompilerElse
!mov edx, [a_SqrTable]
!movzx eax, byte [edx + eax]
CompilerEndIf
ProcedureReturn
EndProcedure
;---SELECT ALGORITHM---
Procedure SetWeightingAlgorithm(algo.i)
Select algo
Case 0: RGBToGray.protoRGBToGray = @RGBtoMean()
Case 1: RGBToGray.protoRGBToGray = @RGBtoAverage()
Case 2: RGBToGray.protoRGBToGray = @RGBtoLuma601()
Case 3: RGBToGray.protoRGBToGray = @RGBtoLuma709()
Case 4: RGBToGray.protoRGBToGray = @RGBto709sRGB()
Case 5: RGBToGray.protoRGBToGray = @RGBSqrt()
EndSelect
EndProcedure
SetWeightingAlgorithm(0) ;Self-initialize at start so RGBToGray() isnt null ptr
;----------------------------------------------------------------------------------------------------------
Procedure ConvertImageToGrayscale(hOrigImg)
Protected *pOrig,*pNew, *pNextNew.Ascii,*pNextOrig.Ascii, rowbytes, pixfmt, x,y, width,height, hNew, red,green,blue,gray
If StartDrawing(ImageOutput(hOrigImg)) = 0
MessageRequester("Error", "Couldnt read original image buffer"): ProcedureReturn 0
EndIf
*pOrig = DrawingBuffer()
rowbytes = DrawingBufferPitch()
pixfmt = DrawingBufferPixelFormat() ;#PB_PixelFormat_ReversedY is ignored as not required
StopDrawing()
If pixfmt & #PB_PixelFormat_24Bits_RGB
pixfmt = #PB_PixelFormat_24Bits_RGB
ElseIf pixfmt & #PB_PixelFormat_24Bits_BGR
pixfmt = #PB_PixelFormat_24Bits_BGR
Else
MessageRequester("Error", "Only 24-bit currently supported"): ProcedureReturn 0
EndIf
width = ImageWidth(hOrigImg): height = ImageHeight(hOrigImg)
hNew = CreateImage(#PB_Any, width, height, 24)
If hNew = 0 Or StartDrawing(ImageOutput(hNew)) = 0
MessageRequester("Error", "Couldnt create second image"): ProcedureReturn 0
EndIf
*pNew = DrawingBuffer()
StopDrawing()
Select pixfmt
Case #PB_PixelFormat_24Bits_RGB
For y = 0 To height-1
*pNextOrig = *pOrig + (y * rowbytes)
*pNextNew = *pNew + (y * rowbytes)
For x = 0 To width-1
red = *pNextOrig\a: *pNextOrig+1
green = *pNextOrig\a: *pNextOrig+1
blue = *pNextOrig\a: *pNextOrig+1
gray = RGBToGray(red,green,blue)
*pNextNew\a = gray: *pNextNew+1
*pNextNew\a = gray: *pNextNew+1
*pNextNew\a = gray: *pNextNew+1
Next x
Next y
Case #PB_PixelFormat_24Bits_BGR
For y = 0 To height-1
*pNextOrig = *pOrig + (y * rowbytes)
*pNextNew = *pNew + (y * rowbytes)
For x = 0 To width-1
blue = *pNextOrig\a: *pNextOrig+1
green = *pNextOrig\a: *pNextOrig+1
red = *pNextOrig\a: *pNextOrig+1
gray = RGBToGray(red,green,blue)
*pNextNew\a = gray: *pNextNew+1
*pNextNew\a = gray: *pNextNew+1
*pNextNew\a = gray: *pNextNew+1
Next x
Next y
EndSelect
ProcedureReturn hNew
EndProcedure
;--------------------------------------------------------------------
Define hImg1 = LoadImage(#PB_Any, "C:\temp\beach.png")
If hImg1 = 0: MessageRequester("Error","Couldnt load image"): End: EndIf
Define hImg2 = ConvertImageToGrayscale(hImg1)
If hImg2 = 0: MessageRequester("Error", "Couldnt convert to grayscale"): End: EndIf
If OpenWindow(0, 0, 0, ImageWidth(hImg1), ImageHeight(hImg1), "Convert image to grayscale", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ImageGadget(0, 0, 0, ImageWidth(hImg1), ImageHeight(hImg1), ImageID(hImg2))
Repeat
Define Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
FreeImage(hImg1): FreeImage(hImg2)
