Scanning bmp file pixel by pixel using TBmp.Scanline with Delphi

39 Views Asked by At

I am trying to scan a .bmp file pixel by pixel to find the relevant RGB value of each of them and assign the result to a TPanel.Color.

The following is the code I am working on

procedure TForm4.FormCreate(Sender: TObject);
begin
  FBmp := TBitmap.Create;
  FBmp.PixelFormat := pf24bit;
  FBmp.LoadFromFile('xxxxx\screen.bmp');
end;

function TForm4.FindPixelColour(const aX, aY: integer): PRGBTriple;
var
  aPixel: PRGBTriple;
begin
  aPixel := FBmp.ScanLine[aY];
  Inc(aPixel, aX);
  Result := aPixel;
end;
procedure TForm4.UpdatePanel(const aPixel: PRGBTriple);
var
  Conversion: integer;
begin
  PnlColour.Color := RGB(aPixel.rgbtRed, aPixel.rgbtGreen, aPixel.rgbtBlue);
  Conversion := aPixel.rgbtRed;
  label1.Caption := 'Red: ' + IntToStr(Conversion);
  Conversion := aPixel.rgbtGreen;
  label2.Caption := 'Green: ' + IntToStr(Conversion);
  Conversion := aPixel.rgbtBlue;
  label3.Caption := 'Blue: ' + IntToStr(Conversion);
end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
  fbmp.Free;
end;

When the program is in execution, the results from FindPixelColour seem to be inconsistent. Sometimes the RGB conversion shows the correct colors in PnlColour.Color but others don't.

I am sure the .bmp file is 24-bit but I also tried to change it into 36-bit and amending FBmp.PixelFormat accordingly but still no joy.

Where am I doing wrong? Is it the way I scan the .bmp or is it the way I assign the colors retrieved by TForm4.FindPixelColour to PnlColour.Color?

1

There are 1 best solutions below

1
pio pio On

I have found the solution taking inspiration from this answer

Here is the correct code with improvements

procedure TForm4.FormCreate(Sender: TObject);
begin
  FBmp := TBitmap.Create;
  img.Picture.LoadFromFile('xxxx\screen.bmp');
  FBmp.LoadFromFile('xxxx\screen.bmp');
  case FBmp.PixelFormat of
    pf24bit:
      FSize := SizeOf(TRGBTriple);
    pf32bit:
      FSize := SizeOf(TRGBQuad);
  else
    // if the image is not 24-bit or 32-bit go away
    begin
      ShowMessage('Your bitmap has unsupported color depth!');
      Exit;
    end;
  end;
end;
function TForm4.FindPixelColour(const aX, aY: integer): PByteArray;
var
  aPixel: PByteArray;
begin
  aPixel := FBmp.ScanLine[aY];
  Result := aPixel;
end;
procedure TForm4.UpdatePanel(aPixel: PByteArray; const aX: Integer);
var
  Red, Green, Blue: byte;
begin
  Red := aPixel^[(aX * FSize) + 2]; //Red
  label1.Caption := 'Red: ' + IntToStr(Red);

  Green := aPixel^[(aX * FSize) + 1]; //Green
  label2.Caption := 'Green: ' + IntToStr(Green);

  Blue := aPixel^[(aX * FSize)];
  label3.Caption := 'Blue: ' + IntToStr(Blue);
  PnlColour.Color := RGB(Red, Green, Blue);
end;

Key changes are removing Inc(aPixel, aX); from TForm4.FindPixelColour and a different way to find the color channels in TForm4.UpdatePanel