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

[raxp]

...что за ошибку выдает, и где массив <p> и <tab>

[ArtInt]

Сравни код Автор Barbichette:
http://www.delphisources.ru/pages/so...e-effects.html

[artemavd]

ArtInt, я именно оттуда и взял этот исходник). Проблема в том, что там алгоритм работает, а у меня нет

[mutabor]

Что, до сих пор не разобрался? Кинь исходник тогда, я посмотрю и попробую исправить. Недавно работал над программой где квантизацию использовал, пока не забыл вроде.

[ArtInt]

artemavd
А инициализацию Bitmap и Image делаете?
Там в "оригинальном" исходнике. Сначала, когда создается форма, то:

procedure TForm1.FormCreate(Sender: TObject);
begin
 Image1.Parent.DoubleBuffered:=true;
//загрузил заранее, поэтому коммент
// Image1.Picture.LoadFromFile('image.bmp');
 bt:=tbitmap.Create;
 bt.Assign(image1.Picture.Bitmap);
 bt.PixelFormat:=pf32bit;

end;

А уже после жмем по кнопке с кодом:

procedure TForm1.BitBtn1Click(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(bt);
 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);

 //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;

При этом bt: TBitmap - глобальная,
подключен модуль jpeg,
изображение в Image 24 бита bmp формата.

И все отлично работает.

Чтобы остальные фильтры работали, прописываем глобальные контстанты, которые регулируют "глубину".

Думаю ошибка в том, что не учитывали данные при создании формы (в оригинальном исходнике).

[ArtInt]

Можно дальше "извращаться". Например, создадим функцию

  public
    { Public declarations }
    function Floyd(MyBitmap: TBitmap): TBitmap;
  end;

на вход необработанный битмап, на выходе обработанный

function TForm1.Floyd(MyBitmap: TBitmap): TBitmap;
var
 rw,w,h,i,j,k,l:integer;
 gc,g:integer;
 p:pbytearray;
 tab:array of integer;
begin
// image1.Picture.Bitmap.Assign(bt);
 w:=MyBitmap.Width;
 h:=MyBitmap.Height;
 rw := (((w * 32) + 31) and not 31) div 8;

 p:=MyBitmap.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;

  Result:=MyBitmap;
end; {Floyd}

Далее делаем кнопку:

procedure TForm1.BtnFloydClick(Sender: TObject);
begin
 Image1.Parent.DoubleBuffered:=true;
 bt:=tbitmap.Create;
 bt.Assign(image1.Picture.Bitmap);
 bt.PixelFormat:=pf32bit;


 Image1.Picture.Bitmap.Assign(Floyd(bt));

 bt.Free;
end;

Все работает, проверял.

P.S. В целом, важными строчками являются
Image1.Parent.DoubleBuffered:=true;
и
bt.PixelFormat:=pf32bit; - перевод в 32 битный пиксельный формат

так сам алгоритм построен для обработки такого формата, насколько мне стало понятно.

rw := (((w * 32) + 31) and not 31) div 8;
k:=i*4+j*rw;

Может, кстати можно переписать для 24 битного, если поменять численные значения.

P.S. Думаю, теперь разобрались, что было не учтено (32 битный формат).

[artemavd]

Вот, все что удалось на данный момент сделать это загрузить изображение, которое мне надо и сделать из него черно-белое. Но, есть проблемы:
1. Не работает регулировка (та что в моем исходнике справа)
2. Не удается сделать так, чтобы по нажатию на остальные кнопки действия переносились на мое изображение.
Вот, все это не получается сделать. Какие мысли?

[ArtInt]

В трех соснах заблудился?

Исходник подправил, изображение другое поставил, чтобы меньше размер был.
Про ошибки:
- Инициализацию сделал, как отдельную процедуру.
- bt должен быть везде глобальный.

P.S. Кстати bt надо еще освободить, там в исходнике где-нибудь в Form1.Close можно дописать bt.Free;

[artemavd]

В трех соснах заблудился?

Аха, наверное
Ну, теперь по крайней мере цветное изображение переводится в черно-белое, но как теперь попробовать посчитать эти самые клетки? По какому принципу?)

Вопрос: А что если просто взять и "вырезать" задний фон с фотографии? То есть убрать его оставив только кружочки. Возможно ли такое сделать? Ведь кружочки практически одинакового цвета. И фон тоже. Значит может быть попытаться сделать какой-то своего рода поиск определенного цвета (!!!), например, цвета фона. И, когда данный цвет будет найден, то "залить" его например белым, тем самым убрав его! А что? По-моему идея, только вот как начать это реализовывать? Возникает снова вопрос: как найти определенный цвет??

[ArtInt]

Вот код к размышлению, "выдран" из одной моей программы:

procedure TForm1.BtMyBWClick(Sender: TObject);
var
  MyJpeg: TJPEGImage;
  Bmp: TBitmap;
  x, y, color: integer;

begin
  if OpenPictureDialog1.Execute then
  begin

    MyJpeg := TJpegImage.create;
    // MyJpeg.LoadFromFile('turning1.jpeg');
    MYJpeg.LoadFromFile(OpenPictureDialog1.FileName);

  end; //OpenDialog
  Myjpeg.DIBNeeded; {преобразуем в битмап формат}

  Bmp := Tbitmap.Create;

  Bmp.Assign(Myjpeg);

  {все что по цвету меньше черного делаем белым}
  for Y := 0 to Bmp.Height - 1 do // Iterate
    for X := 0 to Bmp.Width - 1 do // Iterate
    begin
      Color := Bmp.Canvas.Pixels[x, y];
      //    Color:=(clRed(Color)+clGreen(Color)+clBlue(Color)) div 3;

      if Color > strtoint(Edit1.Text) then {8 000 000; 8700000}
        Bmp.Canvas.Pixels[x, y] := clWhite;
//      else
 //       Bmp.Canvas.Pixels[x, y] := clBlack;

      {делаем белым края, так как они обычно черные}
      if (y = 0) or (x = 0) or (y = Bmp.Height - 1) or (x = Bmp.Width - 1) then
        Bmp.Canvas.Pixels[x, y] := clWhite;

    end; //for x

  //  showmessage(inttostr(Color));
  image1.Picture.Bitmap.Assign(bmp);
  Bmp.Free;

  showmessage('ok');
end; {BtMyBW}

{
Можно кстати по-другому вводить коды цвета RGB, набери в справке TColor,
потом коды цвета границ можешь посмотреть в Photoshop или другой программе.

}

Как видишь из кода, там сначала загружается jpeg изображение, потом переводим его в битмап, после начинаем построчно (попиксельно) в цикле проходить данный битмап, и там сравнивать цвет. По окончании результат в Image1.
Скажу честно, не совсем понял в какой кодировке он цвет в этом случае распознает (кто понял, расскажите, если не трудно). Необходимый цвет для вычленения выяснял экспериментально, записывал значение Color в мемо и там смотрел, какие цвета необходимо закрасить в черный, а все остальные в белый.
Поэтому, если точно известно будет цвет границ, то можно из забить в массив или множество и потом условие

if (Color in [KolCvet])=true then Bmp.Canvas.Pixels[x, y] := clBlack else  Bmp.Canvas.Pixels[x, y] := clWhite;

Но сначала все таки изображение надо сбалансировать по цвету, контраст, осветление и так далее. Можно для начала попробать сделать это в фотошопе, потом пробовать переводить в черно-белое. Так как из-за того что изображение не сбалансированное, при переводе в черно-белый режим некоторые области полностью заливаются черным.

Насчет распознавания молекул, может и дурацкая мне мысль пришла, но что если пройтись в цикле по каждому пикселю и считать его центром окружности (так как молекула круглая), определить минимальный радиус и максимальный радиус молекулы. Если точка имеет черный цвет на конце радиуса (сделать для начала в четырех направлениях (далее в восьми), погрешность отклонения 1-2 пикселя например, выяснить экспериментально). Если в 90% направлениях есть одинаковый радиус значит это окружность (молекула).
Вычисляться наверное будет долговато, можно оформить в поток (сделать прогресс бар).
Просто мысли по поводу реализации, сработает или нет, точно сказать не могу, это надо экспериментировать.