Convert image to matrix [closed] - image

Question

It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 9 years ago.
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;