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;

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.