Calculate Bitmap to Matrix

uses jpeg

var
  bmp : TBitmap;

const
 seuil22:array[0..3] of integer = (32,160,222,96);
 seuil33:array[0..8] of integer = (198,255,141,56,28,113,170,85,226);
 seuil44:array[0..15] of integer = (15,143,47,175,207,79,239,111,63,191,31,159,255,127,223,95);

Beispiele :

procedure TForm1.FormCreate(Sender: TObject);
begin
 Image1.Parent.DoubleBuffered:=true;
 Image1.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Image.bmp');
 bmp := TBitmap.Create;
 bmp.Assign(image1.Picture.Bitmap);
 bmp.PixelFormat := pf32bit;
end;

// Original Image Button
procedure TForm1.Button1Click(Sender: TObject);
begin
 image1.Picture.Bitmap.Assign(bmp);
end;

  // Floyd_Steinberg Button
procedure TForm1.Button2Click(Sender: TObject);
var
 rw,w,h,i,j,k,l:integer;
 gc,g:integer;
 p:pbytearray;
 tab:array of integer;
begin
 image1.Picture.Bitmap.Assign(bmp);
 w:=image1.Picture.Bitmap.Width;
 h:=image1.Picture.Bitmap.Height;
 rw := (((w * 32) + 31) and not 31) div 8;

 p:=image1.Picture.Bitmap.ScanLine[h-1];
 w:=w+1; h:=h+1; setlength(tab,w*h);

 for j:=0 to h-1 do
 for i:=0 to w-1 do
 if (i=w-1) or (j=h-1) then tab[i+w*j]:=0
 else
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 for j:=0 to h-2 do
 for i:=0 to w-2 do
  begin
   k:=i+j*w;
   gc:=tab[k];
   if gc<128 then g:=0 else g:=255;
   gc:=gc-g;
   tab[k]:=g;
   tab[k+1]:=tab[k+1]+gc*7 div 16;
   tab[k-1+w]:=tab[k-1+w]+gc*3 div 16;
   tab[k+0+w]:=tab[k+0+w]+gc*5 div 16;
   tab[k+1+w]:=tab[k+1+w]+gc*1 div 16;
  end;

 for j:=0 to h-2 do
 for i:=0 to w-2 do
  begin
   k:=i*4+j*rw;
   p[k+2]:=tab[i+w*j];
   p[k+1]:=tab[i+w*j];
   p[k+0]:=tab[i+w*j];
  end;
end;

  // Random Button
procedure TForm1.Button3Click(Sender: TObject);
var
 rw,i,j,k,l:integer;
 p:pbytearray;
begin
 image1.Picture.Bitmap.Assign(bmp);
 rw := (((bmp.Width * 32) + 31) and not 31) div 8;
 p:=image1.Picture.Bitmap.ScanLine[bmp.Height-1];
 for j:=0 to bmp.Height-1 do
 for i:=0 to bmp.Width-1 do
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+150*p[k+1]+30*p[k+0]) div 256;
  if l<random(256) then l:=0 else l:=255;
  p[k+2]:=l;
  p[k+1]:=l;
  p[k+0]:=l;
 end;
end;

  // Matrix 2x2 Button
procedure TForm1.Button4Click(Sender: TObject);
var
 rw,i,j,k,l,m:integer;
 p:pbytearray;
begin
 image1.Picture.Bitmap.Assign(bmp);
 rw := (((bmp.Width * 32) + 31) and not 31) div 8;
 p:=image1.Picture.Bitmap.ScanLine[bmp.Height-1];
 for j:=0 to bmp.Height-1 do
 for i:=0 to bmp.Width-1 do
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+150*p[k+1]+30*p[k+0]) div 256;
  m:=(i mod 2)+(j mod 2)*2;
  if l<seuil22[m] then l:=0 else l:=255;
  p[k+2]:=l;
  p[k+1]:=l;
  p[k+0]:=l;
 end;
end;
  // Matrix 3x3 Button
procedure TForm1.Button5Click(Sender: TObject);
var
 rw,i,j,k,l,m:integer;
 p:pbytearray;
begin
 image1.Picture.Bitmap.Assign(bmp);
 rw := (((bmp.Width * 32) + 31) and not 31) div 8;
 p:=image1.Picture.Bitmap.ScanLine[bmp.Height-1];
 for j:=0 to bmp.Height-1 do
 for i:=0 to bmp.Width-1 do
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+150*p[k+1]+30*p[k+0]) div 256;
  m:=(i mod 3)+(j mod 3)*3;
  if l<seuil33[m] then l:=0 else l:=255;
  p[k+2]:=l;
  p[k+1]:=l;
  p[k+0]:=l;
 end;
end;

  // Matrix 4x4 Button
procedure TForm1.Button6Click(Sender: TObject);
var
 rw,i,j,k,l,m:integer;
 p:pbytearray;
begin
image1.Picture.Bitmap.Assign(bmp);
 rw := (((bmp.Width * 32) + 31) and not 31) div 8;
 p:=image1.Picture.Bitmap.ScanLine[bmp.Height-1];
 for j:=0 to bmp.Height-1 do
 for i:=0 to bmp.Width-1 do
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+150*p[k+1]+30*p[k+0]) div 256;
  m:=(i mod 4)+(j mod 4)*4;
  if l<seuil44[m] then l:=0 else l:=255;
  p[k+2]:=l;
  p[k+1]:=l;
  p[k+0]:=l;
 end;
end;
  // Threshold
procedure TForm1.Button7Click(Sender: TObject);
var
 rw,i,j,k,l:integer;
 seuil:integer;
 p:pbytearray;
begin
 seuil := TrackBar1.Position;
 image1.Picture.Bitmap.Assign(bmp);
 rw := (((bmp.Width * 32) + 31) and not 31) div 8;
 p:=image1.Picture.Bitmap.ScanLine[bmp.Height-1];
 for j:=0 to bmp.Height-1 do
 for i:=0 to bmp.Width-1 do
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+150*p[k+1]+30*p[k+0]) div 256;
  if l<seuil then l:=0 else l:=255;
  p[k+2]:=l;
  p[k+1]:=l;
  p[k+0]:=l;
 end;
end;

  // Floyd-Steinberg + Matrix 4x4
procedure TForm1.Button8Click(Sender: TObject);
var
 rw,w,h,i,j,k,l,m:integer;
 gc,g:integer;
 p:pbytearray;
 tab:array of integer;
begin
 image1.Picture.Bitmap.Assign(bmp);
 w:=image1.Picture.Bitmap.Width;
 h:=image1.Picture.Bitmap.Height;
 rw := (((w * 32) + 31) and not 31) div 8;

 p:=image1.Picture.Bitmap.ScanLine[h-1];
 w:=w+1; h:=h+1; setlength(tab,w*h);

 for j:=0 to h-1 do
 for i:=0 to w-1 do
 if (i=w-1) or (j=h-1) then tab[i+w*j]:=0
 else
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 for j:=0 to h-2 do
 for i:=0 to w-2 do
  begin
   k:=i+j*w;
   gc:=tab[k];
   m:=(i mod 4)+(j mod 4)*4;
   if gc<seuil44[m] then g:=0 else g:=255;
   gc:=gc-g;
   tab[k]:=g;
   tab[k+1]:=tab[k+1]+gc*7 div 16;
   tab[k-1+w]:=tab[k-1+w]+gc*3 div 16;
   tab[k+0+w]:=tab[k+0+w]+gc*5 div 16;
   tab[k+1+w]:=tab[k+1+w]+gc*1 div 16;
  end;

 for j:=0 to h-2 do
 for i:=0 to w-2 do
  begin
   k:=i*4+j*rw;
   p[k+2]:=tab[i+w*j];
   p[k+1]:=tab[i+w*j];
   p[k+0]:=tab[i+w*j];
  end;
end;

  // Floyd-Steinberg + Random
procedure TForm1.Button9Click(Sender: TObject);
var
 rw,w,h,i,j,k,l:integer;
 gc,g:integer;
 p:pbytearray;
 tab:array of integer;
begin
 image1.Picture.Bitmap.Assign(bmp);
 w:=image1.Picture.Bitmap.Width;
 h:=image1.Picture.Bitmap.Height;
 rw := (((w * 32) + 31) and not 31) div 8;

 p:=image1.Picture.Bitmap.ScanLine[h-1];
 w:=w+1; h:=h+1; setlength(tab,w*h);

 for j:=0 to h-1 do
 for i:=0 to w-1 do
 if (i=w-1) or (j=h-1) then tab[i+w*j]:=0
 else
 begin
  k:=i*4+j*rw;
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 for j:=0 to h-2 do
 for i:=0 to w-2 do
  begin
   k:=i+j*w;
   gc:=tab[k];
   if gc<random(256) then g:=0 else g:=255;
   gc:=gc-g;
   tab[k]:=g;
   tab[k+1]:=tab[k+1]+gc*7 div 16;
   tab[k-1+w]:=tab[k-1+w]+gc*3 div 16;
   tab[k+0+w]:=tab[k+0+w]+gc*5 div 16;
   tab[k+1+w]:=tab[k+1+w]+gc*1 div 16;
  end;

 for j:=0 to h-2 do
 for i:=0 to w-2 do
  begin
   k:=i*4+j*rw;
   p[k+2]:=tab[i+w*j];
   p[k+1]:=tab[i+w*j];
   p[k+0]:=tab[i+w*j];
  end;
end;

  // Threshold Setting
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 Label1.Caption := 'Threshold: '+inttostr(TrackBar1.Position*100 div 256)+'%';
 Button7Click(nil);
end;