Convert image to matrix

Question

I am trying to convert an image (lets say black and white) to a Matrix (where 0 = black and 1 = white)

i tried with this code :

procedure TForm1.Button1Click(Sender: TObject);
type
  tab = array[1..1000,1..1000] of byte;
var i,j: integer;
    s : string;
    image : TBitmap;
    t : tab;
begin
  image := TBitmap.Create;
  image.LoadFromFile('c:\image.bmp');

  s := '';
  for i := 0 to image.Height do
  begin
     for j := 0 to image.Width do
     begin
      if image.Canvas.Pixels[i,j] = clWhite then
        t[i,j] := 0
      else
        t[i,j] := 1;

     end;
  end;
  for i := 0 to image.Height do
  begin
    for j := 0 to image.Width do
     begin
      s:=s + IntToStr(t[i,j]);
     end;
     Memo1.Lines.Add(s);
     s:='';
  end;
end;

But it gave me wrong results.

Any Idea?

Answer 1

There are five bugs and two other issues in your code!

First,

for i := 0 to image.Height do

must be replaced by

for i := 0 to image.Height - 1 do

(why?) and similarly,

for j := 0 to image.Width do

must be replaced by

for j := 0 to image.Width - 1 do

Second, the Pixels array takes arguments [x, y], not [y, x]. Hence, you need to replace

image.Canvas.Pixels[i,j]

by

image.Canvas.Pixels[j,i]

Third, you wrote "0 = black and 1 = white" but obviously you do the opposite!

Fourth, you try to access t[0, 0], even though your matrix starts indexing at 1. Use array[0..1000,0..1000] of byte; to fix that.

Fifth, you have a memory leak (image isn't freed -- use try..finally).

Also, it is better to use dynamic arrays:

type
  TByteMatrix = array of array of byte;

var
  mat: TByteMatrix;

and you begin with

SetLength(mat, image.Height - 1, image.Width - 1);

if you want it to index [y, x], and opposite otherwise.

Finally, you should not use the Pixels property at all in this case, since it is terribly slow. Instead, use the Scanline property. See this or that or something else for more information.

Also, you will gain a lot of speed simply by adding Memo1.Lines.BeginUpdate before and Memo1.Lines.EndUpdate after the update of the memo control.

Answer 2

The following procedure converts the input ABitmap bitmap to a multidimensional AMatrix array of bytes, which represents pixels and where 0 value means white pixel and 1 means any other color:

type
  TPixelMatrix = array of array of Byte;

procedure BitmapToMatrix(ABitmap: TBitmap; var AMatrix: TPixelMatrix);
type
  TRGBBytes = array[0..2] of Byte;
var
  I: Integer;
  X: Integer;
  Y: Integer;
  Size: Integer;
  Pixels: PByteArray;
  SourceColor: TRGBBytes;
const
  TripleSize = SizeOf(TRGBBytes);
begin
  case ABitmap.PixelFormat of
    pf24bit: Size := SizeOf(TRGBTriple);
    pf32bit: Size := SizeOf(TRGBQuad);
  else
    raise Exception.Create('ABitmap must be 24-bit or 32-bit format!');
  end;

  SetLength(AMatrix, ABitmap.Height, ABitmap.Width);
  for I := 0 to TripleSize - 1 do
    SourceColor[I] := Byte(clWhite shr (16 - (I * 8)));

  for Y := 0 to ABitmap.Height - 1 do
  begin
    Pixels := ABitmap.ScanLine[Y];
    for X := 0 to ABitmap.Width - 1 do
    begin
      if CompareMem(@Pixels[(X * Size)], @SourceColor, TripleSize) then
        AMatrix[Y, X] := 0
      else
        AMatrix[Y, X] := 1;
    end;
  end;
end;

This procedure prints out the multidimensional AMatrix array of bytes to the AMemo memo box:

procedure ShowPixelMatrix(AMemo: TMemo; const AMatrix: TPixelMatrix);
var
  S: string;
  X: Integer;
  Y: Integer;
begin
  AMemo.Clear;
  AMemo.Lines.BeginUpdate;
  try
    AMemo.Lines.Add('Matrix size: ' + IntToStr(Length(AMatrix[0])) + 'x' +
      IntToStr(Length(AMatrix)));
    AMemo.Lines.Add('');

    for Y := 0 to High(AMatrix) do
    begin
      S := '';
      for X := 0 to High(AMatrix[Y]) - 1 do
      begin
        S := S + IntToStr(AMatrix[Y, X]);
      end;
      AMemo.Lines.Add(S);
    end;
  finally
    AMemo.Lines.EndUpdate;
  end;
end;

And the usage of the above procedures:

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  PixelMatrix: TPixelMatrix;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.LoadFromFile('d:\Image.bmp');
    BitmapToMatrix(Bitmap, PixelMatrix);
  finally
    Bitmap.Free;
  end;
  ShowPixelMatrix(Memo1, PixelMatrix);
end;

This extension of the above BitmapToMatrix procedure allows you to specify at which luminance level given by the AMinIntensity parameter will be pixels taken as non-white.

The more the AMinIntensity value is closer to 0, the more lighter pixels are treated as non-white. This allows you to work with a color intensity tolerance (e.g. to better recognize antialiased text):

procedure BitmapToMatrixEx(ABitmap: TBitmap; var AMatrix: TPixelMatrix;
  AMinIntensity: Byte);
type
  TRGBBytes = array[0..2] of Byte;
var
  X: Integer;
  Y: Integer;
  Gray: Byte;
  Size: Integer;
  Pixels: PByteArray;
begin
  case ABitmap.PixelFormat of
    pf24bit: Size := SizeOf(TRGBTriple);
    pf32bit: Size := SizeOf(TRGBQuad);
  else
    raise Exception.Create('ABitmap must be 24-bit or 32-bit format!');
  end;

  SetLength(AMatrix, ABitmap.Height, ABitmap.Width);

  for Y := 0 to ABitmap.Height - 1 do
  begin
    Pixels := ABitmap.ScanLine[Y];
    for X := 0 to ABitmap.Width - 1 do
    begin
      Gray := 255 - Round((0.299 * Pixels[(X * Size) + 2]) +
        (0.587 * Pixels[(X * Size) + 1]) + (0.114 * Pixels[(X * Size)]));

      if Gray < AMinIntensity then
        AMatrix[Y, X] := 0
      else
        AMatrix[Y, X] := 1;
    end;
  end;
end;

Answer 3

Memo lines position is decline, but your looping image.height first its will be result reverse in memo, to that try this code

procedure TForm1.Button1Click(Sender: TObject);
var i,j: integer;
    s : string;
    image : TBitmap;
begin
  image := TBitmap.Create;
  image.LoadFromFile('c:\image.bmp');

  s := '';
  for i := 0 to image.width-1 do
  begin
     for j := 0 to image.Height-1 do
     begin
      if image.Canvas.Pixels[i,j] = clWhite then
        s := s+'0'
      else
        s := s+'1';
     end;
     memo1.Lines.Add(s);
     s:='';
  end;
end;