Author |
Topic ![Next Topic Next Topic](images/icon_go_right.svg) |
|
Fellafoo
![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif)
USA
49 Posts |
Posted - Jul 21 2024 : 13:53:33
|
I've been working on a Delphi routine for processing images using a CLAHE method. The results I'm getting in greyscale, or merged back into the color original are on track with what I would expect. However, I'm sure the approach I'm taking could be improved (or corrected) so I'm looking for feedback from anyone who might be familiar with this. Here's my current code:
procedure ApplyCLAHE(var ieBmp: TIEBitmap; ClipLimit: Integer; TileGridSize: Integer);
var
tileWidth, tileHeight, xTiles, yTiles: Integer;
x, y, i, j: Integer;
histogram: array[0..255] of Integer;
lut: array[0..255] of Byte;
cdfMin, cdf: Integer;
clipThreshold, excessPixels, redistribute: Integer;
tileBmp: TIEBitmap;
Line: string;
w, h, CurrRow, Offset: Integer;
ptrRed, ptrGreen, ptrBlue: PByte;
begin
ieBmp.PixelFormat := ie24RGB;
tileWidth := ieBmp.Width div TileGridSize;
tileHeight := ieBmp.Height div TileGridSize;
xTiles := TileGridSize;
yTiles := TileGridSize;
ieBmp.ConvertToGray;
tileBmp := TIEBitmap.Create(tileWidth, tileHeight, ie24RGB);
try
for y := 0 to yTiles - 1 do begin
for x := 0 to xTiles - 1 do begin
ieBmp.CopyRectTo(tileBmp, x * tileWidth, y * tileHeight, 0, 0, tileWidth, tileHeight, False);
{ Calculate histogram }
FillChar(histogram, SizeOf(histogram), 0);
for j := 0 to tileHeight - 1 do begin
for i := 0 to tileWidth - 1 do begin
Inc(histogram[tileBmp.Pixels[i, j].R]); { Only considering red channel as image is grayscale }
end;
end;
(*
{ Debug: Output histogram }
Line := '';
Write2StartupLog('Histogram for tile [' + IntToStr(y) + '][' + IntToStr(x) + ']:');
for i := 0 to 255 do begin
Line := Line + IntToStr(histogram[i]) + ' ';
end;
Write2StartupLog(Line);
*)
{ Clip histogram }
clipThreshold := (tileWidth * tileHeight * ClipLimit) div 100;
excessPixels := 0;
for i := 0 to 255 do begin
if histogram[i] > clipThreshold then begin
excessPixels := excessPixels + histogram[i] - clipThreshold;
histogram[i] := clipThreshold;
end;
end;
redistribute := excessPixels div 256;
for i := 0 to 255 do begin
histogram[i] := histogram[i] + redistribute;
end;
{ Calculate CDF }
cdf := 0;
cdfMin := 0;
for i := 0 to 255 do begin
cdf := cdf + histogram[i];
if cdfMin = 0 then
cdfMin := cdf;
lut[i] := ((cdf - cdfMin) * 255) div ((tileWidth * tileHeight) - cdfMin);
end;
(*
{ Debug: Output LUT }
Line := '';
Write2StartupLog('LUT for tile [' + IntToStr(y) + '][' + IntToStr(x) + ']:');
for i := 0 to 255 do begin
Line := Line + IntToStr(lut[i]) + ' ';
end;
Write2StartupLog(Line);
*)
{ Apply LUT }
CurrRow := Integer(tileBmp.Scanline[0]);
Offset := Integer(tileBmp.Scanline[1]) - CurrRow;
for h := 0 to tileBmp.Height - 1 do begin
for w := 0 to tileBmp.Width - 1 do begin
ptrBlue := PByte(CurrRow + w * 3);
ptrGreen := PByte(CurrRow + w * 3 + 1);
ptrRed := PByte(CurrRow + w * 3 + 2);
ptrRed^ := lut[Byte(ptrRed^)];
ptrGreen^ := lut[Byte(ptrGreen^)];
ptrBlue^ := lut[Byte(ptrBlue^)];
end;
Inc(CurrRow, Offset);
end;
{ Copy the processed tile back to the original image }
tileBmp.CopyRectTo(ieBmp, 0, 0, x * tileWidth, y * tileHeight, tileWidth, tileHeight, False);
{ Write the processed tile to disk for debugging }
// tileBmp.Write(CfgGetPath(Path_Temp) + 'Tile[' + IntToStr(y) + '][' + IntToStr(x) + '].bmp');
end;
end;
finally
tileBmp.Free;
end;
end;
procedure ApplyCLAHE_LAB(var ieBmp: TIEBitmap; ClipLimit: Integer; TileGridSize: Integer; doColor: Boolean = True);
var
ieVisionImage, LABImage, LChannel, AChannel, BChannel, ClaheLChannel: TIEVisionImage;
ClaheLChannelTemp: TIEBitmap;
begin
try
{ Convert TIEBitmap to TIEVisionImage }
ieVisionImage := ieBmp.GetIEVisionImage();
{ Convert from RGB to LAB }
ieVisionImage.ConvertColor(ievRGB2Lab);
{ Split into LAB channels }
LChannel := IEVisionLib.createImage(ieBmp.Width, ieBmp.Height, ievUINT8, 1);
AChannel := IEVisionLib.createImage(ieBmp.Width, ieBmp.Height, ievUINT8, 1);
BChannel := IEVisionLib.createImage(ieBmp.Width, ieBmp.Height, ievUINT8, 1);
ieVisionImage.splitPlanes(LChannel, AChannel, BChannel);
{ Save channels to disk for debugging purposes }
//LChannel.save(PChar(CfgGetPath(Path_Temp) + 'LChannel_' + ExtractFileName(ieBmp.Filename)));
//AChannel.save(PChar(CfgGetPath(Path_Temp) + 'AChannel_' + ExtractFileName(ieBmp.Filename)));
//BChannel.save(PChar(CfgGetPath(Path_Temp) + 'BChannel_' + ExtractFileName(ieBmp.Filename)));
{ Apply CLAHE to L channel }
ClaheLChannelTemp := TIEBitmap.Create;
try
{ Convert TIEVisionImage to TIEBitmap }
ClaheLChannelTemp.AssignIEVisionImage(LChannel);
{ Apply Filter }
ApplyCLAHE(ClaheLChannelTemp, ClipLimit, TileGridSize);
{ Save to disk for debugging purposes }
//ClaheLChannelTemp.Write(CfgGetPath(Path_Temp) + 'ClaheLChannelTemp_' + ExtractFileName(ieBmp.Filename));
{ Convert to 8 bit greyscale before merging channels }
ClaheLChannelTemp.PixelFormat := ie8g;
{ Convert TIEBitmap to TIEVisionImage }
ClaheLChannel := ClaheLChannelTemp.GetIEVisionImage();
{ Merge modified L channel back with original A and B channels }
LABImage := IEVisionLib.createImage(ieBmp.Width, ieBmp.Height, ievUINT8, 3);
LABImage.merge(ClaheLChannel, AChannel, BChannel);
{ Convert from LAB back to RGB }
LABImage.ConvertColor(ievLab2RGB);
{ Save to disk for debugging purposes }
//LABImage.save(PChar(CfgGetPath(Path_Temp) + 'LABImage_' + ExtractFileName(ieBmp.Filename)));
{ Update the original IEBitmap with the processed image }
if doColor then
ieBmp.AssignIEVisionImage(LABImage)
else
ieBmp.AssignIEVisionImage(ClaheLChannel);
finally
ClaheLChannelTemp.Free;
end;
except
on E: Exception do
Write2StartupLog('Error: ' + E.Message);
end;
end;
No matter how I adjust the tile size, the divisions are readily apparent in the result. Of, course I'd like to avoid this checkerboard effect.
Thank You,
MFM |
|
xequte
![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif)
38418 Posts |
Posted - Jul 21 2024 : 16:27:31
|
Hi
I'm not sure how you world normalize the histogram shifting across all the tiles. I see CLAHE is available in OpenCV, so we will look at adding it to IEVision.
Nigel Xequte Software www.imageen.com
|
![Go to Top of Page Go to Top of Page](images/icon_go_up.svg) |
|
Fellafoo
![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif)
USA
49 Posts |
Posted - Jul 21 2024 : 16:36:30
|
Hi Nigel,
I was just looking at OpenCV. Thank you for considering this addition.
MFM |
![Go to Top of Page Go to Top of Page](images/icon_go_up.svg) |
|
Fellafoo
![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif)
USA
49 Posts |
Posted - Jul 22 2024 : 11:19:50
|
I've got this working with the OpenCV libraries.
Here's my test source if anyone is interested. I did have to make some changes to uclahe.pas to address an integer overflow issue I ran into.
unit Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
{ OpenCV }
ocv.core_c, ocv.highgui_c, ocv.imgproc_c, ocv.utils, ocv.core.types_c, ocv.imgproc.types_c, uclahe;
type
TForm4 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure ApplyCLAHE_OpenCV(const InputImagePath, OutputColorImagePath, OutputGreyscaleImagePath: string; ClipLimit: Double; TileGridSize: Integer);
var
src, lab, l, a, b, clahe_l, dst: pIplImage;
xdivs, ydivs, bins: Cardinal;
begin
// Load the input image
src := cvLoadImage(PAnsiChar(AnsiString(InputImagePath)), CV_LOAD_IMAGE_COLOR);
if src = nil then
raise Exception.Create('Error loading input image');
try
// Convert RGB to LAB
lab := cvCreateImage(cvGetSize(src), IPL_DEPTH_8U, 3);
cvCvtColor(src, lab, CV_BGR2Lab);
// Split LAB channels
l := cvCreateImage(cvGetSize(src), IPL_DEPTH_8U, 1);
a := cvCreateImage(cvGetSize(src), IPL_DEPTH_8U, 1);
b := cvCreateImage(cvGetSize(src), IPL_DEPTH_8U, 1);
cvSplit(lab, l, a, b, nil);
// Apply CLAHE on L channel
xdivs := TileGridSize;
ydivs := TileGridSize;
bins := 256;
cvCLAdaptEqualize(l, l, xdivs, ydivs, bins, ClipLimit, CV_CLAHE_RANGE_FULL);
// Save the greyscale image
if cvSaveImage(PAnsiChar(AnsiString(OutputGreyscaleImagePath)), l) = 0 then
raise Exception.Create('Error saving greyscale image');
// Merge modified L channel back with original A and B channels
cvMerge(l, a, b, nil, lab);
// Convert LAB back to RGB
dst := cvCreateImage(cvGetSize(src), IPL_DEPTH_8U, 3);
cvCvtColor(lab, dst, CV_Lab2BGR);
// Save the result
if cvSaveImage(PAnsiChar(AnsiString(OutputColorImagePath)), dst) = 0 then
raise Exception.Create('Error saving output image');
finally
cvReleaseImage(src);
cvReleaseImage(lab);
cvReleaseImage(l);
cvReleaseImage(a);
cvReleaseImage(b);
cvReleaseImage(dst);
end;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
ApplyCLAHE_OpenCV('20240615_122248.bmp', '20240615_122248_clahe_color.jpg', '20240615_122248_clahe_bw.jpg', 4.0, 16);
end;
end.
Original: attach/Fellafoo/2024722111349_20240615_122248.jpg
CLAHE greyscale: attach/Fellafoo/2024722111216_20240615_122248_clahe_bw.jpg
CLAHE 'merged' color: attach/Fellafoo/2024722111437_20240615_122248_clahe_color.jpg
|
![Go to Top of Page Go to Top of Page](images/icon_go_up.svg) |
|
xequte
![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif) ![](images/icon_star_gold.gif)
38418 Posts |
Posted - Jul 24 2024 : 05:09:46
|
Nice one ![](images/icon_smile_approve_2.gif)
Nigel Xequte Software www.imageen.com
|
![Go to Top of Page Go to Top of Page](images/icon_go_up.svg) |
|
|
Topic ![Next Topic Next Topic](images/icon_go_right.svg) |
|
|
|