ImageEn for Delphi and C++ Builder ImageEn for Delphi and C++ Builder

 

ImageEn Forum
Profile    Join    Active Topics    Forum FAQ    Search this forumSearch
Forum membership is Free!  Click Join to sign-up
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 ImageEn Library for Delphi, C++ and .Net
 ImageEn and IEvolution Support Forum
 CLAHE (Contrast Limited Adaptive Histogram Equalization)
 New Topic  Reply to Topic
Author Previous Topic Topic Next Topic  

Fellafoo

USA
52 Posts

Posted - Jul 21 2024 :  13:53:33  Show Profile  Reply
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

38650 Posts

Posted - Jul 21 2024 :  16:27:31  Show Profile  Reply
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

Fellafoo

USA
52 Posts

Posted - Jul 21 2024 :  16:36:30  Show Profile  Reply
Hi Nigel,

I was just looking at OpenCV. Thank you for considering this addition.

MFM
Go to Top of Page

Fellafoo

USA
52 Posts

Posted - Jul 22 2024 :  11:19:50  Show Profile  Reply
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

xequte

38650 Posts

Posted - Jul 24 2024 :  05:09:46  Show Profile  Reply
Nice one

Nigel
Xequte Software
www.imageen.com
Go to Top of Page

Fellafoo

USA
52 Posts

Posted - Nov 14 2024 :  10:36:01  Show Profile  Reply
Nigel,

Did the OpenCV / CLAHE get exposed in IEVision v8.1.4?

MFM
Go to Top of Page

xequte

38650 Posts

Posted - Nov 14 2024 :  13:12:01  Show Profile  Reply
Sorry, we have not had time to implement this one yet. It is on our to-do list, but there are a number of higher priority items. I will email you when it is implemented.

Nigel
Xequte Software
www.imageen.com
Go to Top of Page
  Previous Topic Topic Next Topic  
 New Topic  Reply to Topic
Jump To: