Issue converting an image to gray scale in Lazarus

Question

I've written a procedure called gray_scale that is suppose to have an input TImage component, turn the image that it contains into gray scale and then print it in the same TImage component. The issue with it is that it prints an black image. My code is below, please note that I've created a local variable called img2: TPicture which purpose is to be like a middle stage between the input and the output of the procedure.

procedure gray(var img1: TImage);
var
  i,j: Integer;
  y: integer;
  color: TColor;
  img2: TPicture;
begin
  i := 0; j := 0;
  img2 := TPicture.create;
  img2.Bitmap.Width:= img1.width;
  img2.Bitmap.Height:= img1.height;
  for i := 0 to img1.width  do begin
    for j := 0 to img1.height do begin
      y:= trunc((255 * luminance(img1,i,j)));
      color := RGBToColor(byte(y), byte(y), byte(y));
      img2.Bitmap.Canvas.DrawPixel(i,j, TColorToFPColor(color));
    end;
    img1.Picture.Assign(img2);
  end;
end;

Using the debugger, have you checked that Color is not always 0 for each pixel ? — fpiette, Mar 20 '21 at 15:25
Your output is exactly what you would expect if you were using a bitmap format that supported AlphaChannel but had not set the AlphaChannel. I'm not familiar with the Lazarus defaults, but if your TPicture is using an AlphaChannel supported format you will need to set the AlphaChannel on each pixel. — Rob Lambden, Mar 20 '21 at 15:41
@MiqueasGamero - have you checked for AlphaChannel - for any RGB values, having an AlphaChannel of 0 means nothing is drawn ... which looks to me like what you are seeing here. — Rob Lambden, Mar 20 '21 at 16:50
Uhm, I'm gonna check AlphaChannel ASAP, I'm gonna update here. Thank you! — neil_huygens, Mar 20 '21 at 20:48
Rob: I've already check AlphaChannel and as far as I can tell it is supposed to print as expected, for example, the first pixel in position (0,0) returns the color #2C2C2C. The issue with my code should be on the last line in which I assign the bitmap of img2 to img1. — neil_huygens, Mar 20 '21 at 21:24
@MiqueasGamero Should it not be `img1.Assign(img2)` or `img1.Picture.Assign(img2.Picture)`? Now you’re mixing them... — R. Hoek, Mar 21 '21 at 10:20

score 2 · Accepted Answer · answered Mar 21 '21 at 16:48

Look at this piece of code where you have two nested loops.

  for i := 0 to img1.width  do begin
    for j := 0 to img1.height do begin
      y:= trunc((255 * luminance(img1,i,j)));
      color := RGBToColor(byte(y), byte(y), byte(y));
      img2.Bitmap.Canvas.DrawPixel(i,j, TColorToFPColor(color));
    end;
    img1.Picture.Assign(img2);
  end;

After the inner loop you assign img2 to img1.Picture which you will continue to read after a visit to the outer loop. As a result, img1 becomes empty (except for the leftmost pixel column) at the time the outer loop enters the second iteration.

Change the code as follows:

  for i := 0 to img1.width  do begin
    for j := 0 to img1.height do begin
      y:= trunc((255 * luminance(img1,i,j)));
      color := RGBToColor(byte(y), byte(y), byte(y));
      img2.Bitmap.Canvas.DrawPixel(i,j, TColorToFPColor(color));
    end;
  end;
  img1.Picture.Assign(img2);

It is also misleading to name a TPicture to img2, especially when img1 refers to a TImage.

Further, there are a few points you should consider in order to make your code more efficient. The most important is to scan a bitmap image one row at a time with the help of scanlines.

Look at this SO post

You're right! I had to rewrite my code but I did not realized what you've pointed out. Thank you! — neil_huygens, Mar 23 '21 at 15:54
@DelphiCoder You claim: *AFAIK, there is no ScanLine in Lazarus/FreePascal* You could have easily looked yourself to verify. `TBitmap` inherits (via other classes) from `TRasterImage` which declares `property ScanLine[Row: Integer]: Pointer read GetScanLine; platform;` — Tom Brunberg, Apr 07 '21 at 08:17
Interesting, thanks! Couldn't find that a few years ago when I was trying to make some code compatible to Delphi and Lazarus. — Delphi Coder, Apr 07 '21 at 08:31
@DelphiCoder As the `Graphics` unit is included in most progs, with a declared variable: `bmp: TBitmap` you only need to type `bmp.Sc ` to already get a suggestion of `Scanline`. Not really much to find, but never mind. Cheers ;) — Tom Brunberg, Apr 07 '21 at 09:20

score 0 · Answer 2 · edited Sep 28 '21 at 10:20

unit rhsBitmapGrayscale;

interface

uses
  SysUtils, Classes, Graphics, IntfGraphics, FPImage;

  procedure BitmapGrayscale(BM: TCustomBitmap; R, G, B: Single);

implementation

// BitmapGrayscale(Bitmap, 0.30, 0.59, 0.11);  // ISO-Neutral-Gray

procedure BitmapGrayscale(BM: TCustomBitmap; R, G, B: Single);
var
  IntfImg: TLazIntfImage = nil;
  x, y, w, h: Integer;
  TempColor: TFPColor;
  Gray: Word;
begin
  try
    IntfImg := BM.CreateIntfImage;

    w := IntfImg.Width - 1;
    h := IntfImg.Height - 1;

    IntfImg.BeginUpdate;
    for y := 0 to h do
      for x := 0 to w do
      begin
        TempColor := IntfImg.Colors[x, y];
        Gray := Round(TempColor.Red * R + TempColor.Green * G + TempColor.Blue * B);
        TempColor.Red := Gray;
        TempColor.Green := Gray;
        TempColor.Blue := Gray;
        IntfImg.Colors[x, y] := TempColor;
      end;
    IntfImg.EndUpdate;

    BM.LoadFromIntfImage(IntfImg);
  finally
    IntfImg.Free;
  end;
end;

end.

Using TLazIntfImage results in improved processing speed. With the parameters for red, green and blue, the result can be influenced individually.

Here are some examples:

BitmapGrayscale(Image1.Picture.Bitmap, 0.30, 0.59, 0.11);  // Neutral filter
BitmapGrayscale(Image1.Picture.Bitmap, 1.00, 0.00, 0.00);  // Red filter
BitmapGrayscale(Image1.Picture.Bitmap, 0.00, 1.00, 0.00);  // Green filter
BitmapGrayscale(Image1.Picture.Bitmap, 0.00, 0.00, 1.00);  // Blue filter
BitmapGrayscale(Image1.Picture.Bitmap, 0.00, 0.50, 0.50);  // Cyan filter
BitmapGrayscale(Image1.Picture.Bitmap, 0.50, 0.00, 0.50);  // Magenta filter
BitmapGrayscale(Image1.Picture.Bitmap, 0.50, 0.50, 0.00);  // Yellow filter

Please provide additional details in your answer. As it's currently written, it's hard to understand your solution. — Community, Sep 08 '21 at 11:36
Thank you for this code snippet, which might provide some limited, immediate help. A [proper explanation](https://meta.stackexchange.com/q/114762/349538) would greatly improve its long-term value by showing why this is a good solution to the problem and would make it more useful to future readers with other, similar questions. Please [edit] your answer to add some explanation, including the assumptions you’ve made. — helvete, Sep 09 '21 at 13:05

Issue converting an image to gray scale in Lazarus

2 Answers2