Количество клеток мембраны

[raxp]

из серии "cемен-семеныч"...

procedure TForm1.Button2Click(Sender: TObject);
var bt: TBitmap;
begin
 Image2.Picture.Bitmap.Assign(bt);
...

[artemavd]

raxp, в моем коде стоит то, что вы выделили). Но не работает.

[ArtInt]

А объект bt точно создан?

bt:=TBitmap.Create;

и после освобождаем в конце всего кода:

bt.Free;

[raxp]

...намек идет на то, что вы не создали <bt> ...мало того, ничего в нее не загрузили/

[artemavd]

Сделал как было сказано в посте №13:

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

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

 //passe l'image en niveau de gris et sauve le tout dans tab
 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;
  // 30% de rouge, 59% de vert, 11% de bleu
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 // effectue l'algo de Floyd-Steinberg dans tab
 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;

 // transfert tab dans le bitmap
 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;
  bt.Free;
end;

Теперь выдается ошибка: "Scan line index out of range"
???

[ArtInt]

А загрузить изображение (raxp уже об этом упомянул).

  bt.LoadFromFile('MyFile.bmp');

И зачем Вам здесь TBitmap? Если судя по коду обращение сразу идет к Image? А в Image, тогда изображение загружено?
Немного код, наверное надо переделать и обращаться к битмап, а потом для вывода результата в конце уже через Assign сделать отображение для Image. И после этого освободить битмап (Free).

[artemavd]

А в Image, тогда изображение загружено?

Да, загружено.

Немного код, наверное надо переделать и обращаться к битмап,

Каким это образом?

[ArtInt]

Вот что примерно имел ввиду, если через Image:

procedure TForm1.Button2Click(Sender: TObject);
var
 rw,w,h,i,j,k,l:integer;
 gc,g:integer;
 p:pbytearray;
 tab:array of integer;
 bt: TBitmap;
begin
// Image2.Picture.Bitmap.Assign(bt);
  Image2.Picture.LoadFromFile('1obr.bmp');

 w:=Image2.Picture.Bitmap.Width;
 h:=Image2.Picture.Bitmap.Height;
 rw := (((w * 32) + 31) and not 31) div 8;

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

 //passe l'image en niveau de gris et sauve le tout dans tab
 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;
  // 30% de rouge, 59% de vert, 11% de bleu
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 // effectue l'algo de Floyd-Steinberg dans tab
 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;

 // transfert tab dans le bitmap
 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;

если через Bitmap:

procedure TForm1.BitBtn2Click(Sender: TObject);
var
 rw,w,h,i,j,k,l:integer;
 gc,g:integer;
 p:pbytearray;
 tab:array of integer;
 bt: TBitmap;
begin
 bt:=TBitmap.Create;
 Bt.PixelFormat:=pf8bit;
 Bt.LoadFromFile('1obr.bmp');

 
//  Image2.Picture.LoadFromFile('1obr.bmp');

 w:=bt.Width;
 h:=bt.Height;
 rw := (((w * 32) + 31) and not 31) div 8;

 p:=bt.ScanLine[h-1];
 w:=w+1;
 h:=h+1;
 SetLength(tab,w*h);

 //passe l'image en niveau de gris et sauve le tout dans tab
 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;
  // 30% de rouge, 59% de vert, 11% de bleu
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 // effectue l'algo de Floyd-Steinberg dans tab
 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;

 // transfert tab dans le bitmap
 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;

 Image2.Picture.Bitmap:=bt;
 Bt.Free;

end;

Но не могу сказать правильно ли сам алгоритм работает, надо посмотреть его повнимательней.

[mutabor]

Флойд-Стенберг это ты в нужную сторону копаешь. Если результат будет не совсем хороший, еще можно квантизацию (перевод в BW по сути тоже квантизация) применить после блера или антиалиаса, тоже хорошо контуры навести можно.

Image2.Picture.Bitmap:=bt;
Bt.Free;

По-моему так нельзя делать, ты присвоил ссылку на битмап в Picture.Bitmap и тут же его удаляешь, ошибка будет. Assign используй в данном случае.

[artemavd]

Ок, для начала пробую сделать через Image:

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

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

 //passe l'image en niveau de gris et sauve le tout dans tab
 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;
  // 30% de rouge, 59% de vert, 11% de bleu
  l:=(76*p[k+2]+151*p[k+1]+29*p[k+0]) div 256;
  tab[i+w*j] :=l;
 end;

 // effectue l'algo de Floyd-Steinberg dans tab
 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;

 // transfert tab dans le bitmap
 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;

Сначала я через OpenPictureDialog1 загружаю .bmp изображение в Image, потом нажимаю на кнопку. Но сейчас выдается уже другая ошибка. Каждый раз ошибка новая. Это хорошо, это значит, что прогресс наблюдается . В этот раз появляется Access Violation и выделяется строка, которую я выделил в коде. Может кто-то сможет подробно пояснить по-русски) этот код, а то по-немецки как-то я не очень?)