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)