Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Скелитолизация изображения используя алгоритм Зонг, Скелитолизация изображения используя алг 
:(
    Опции темы
Terikon
Дата 19.1.2013, 14:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 58
Регистрация: 1.4.2009

Репутация: нет
Всего: нет



Ни как не могу привести к работоспособному виду (на выходе получается чёрное изображение) 

Код Зонга-Суня который нашел в интернете и картинку на которой тренируюсь прикрепил ниже

Немного изменил под себя код

Код
function t1a(i, j: integer; var a: array of integer; var b: integer): integer;
var
  n, m: integer;
begin
  { Return the number of 01 patterns in the sequence of pixels
    P2 p3 p4 p5 p6 p7 p8 p9. }

  // int n,m;

  for n := 0 to 8 - 1 do
    a[n] := 0;

  if (i - 1 >= 0) then
  begin
    a[0] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i - 1, j]);
    if (j + 1 < Form1.Image1.Picture.Bitmap.Height) then
      a[1] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i - 1, j + 1]);
    if (j - 1 >= 0) then
      a[7] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i - 1, j - 1]);
  end;

  if (i + 1 < Form1.Image1.Picture.Bitmap.Width) then
  begin
    a[4] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i + 1, j]);
    if (j + 1 < Form1.Image1.Picture.Bitmap.Height) then
      a[3] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i + 1, j + 1]);
    if (j - 1 >= 0) then
      a[5] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i + 1, j - 1]);
  end;

  if (j + 1 < Form1.Image1.Picture.Bitmap.Height) then
    a[2] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i, j + 1]);
  if (j - 1 >= 0) then
    a[6] := integer(Form1.img1.Picture.Bitmap.Canvas.Pixels[i, j - 1]);

  m := 0;
  b := 0;
  for n := 0 to 6 do
  begin
    if ((a[n] = 0) and (a[n + 1] = 1)) then
      m := m + 1;
    b := b + a[n];
  end;

  if ((a[7] = 0) and (a[0] = 1)) then
    m := m + 1;
  b := b + a[7];
  result := m;
end;

procedure subtr;
var
  i, j: integer;

begin

  for i := 0 to Form1.Image1.Picture.Bitmap.Width do
    for j := 0 to Form1.Image1.Picture.Bitmap.Height do
      if Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] = clWhite then
      begin
        Form1.img1.Picture.Bitmap.Canvas.Pixels[i, j] := 0;
        pixeldeleted := true;
      end;
end;

Procedure SkeletizeZS2;
var
  i, j, n, m, k, cont, br, ar, p1, p2: integer;
  a: array [0 .. 8] of integer;
begin
  pixeldeleted := false;
  { Sub-iteration 1: }
  for i := 0 to Form1.Image1.Picture.Bitmap.Width do
    for j := 0 to Form1.Image1.Picture.Bitmap.Height do
    begin
      { Scan the entire image }
      if (Form1.img1.Picture.Bitmap.Canvas.Pixels[i, j] = 0) then
      begin
        Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] := 0;
        continue;
      end;
      ar := t1a(i, j, a, br); { Function A }
      p1 := a[0] * a[2] * a[4];
      p2 := a[2] * a[4] * a[6];
      if ((ar = 1) and ((br >= 2) and (br <= 6)) and (p1 = 0) and (p2 = 0)) then
      begin
        Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] := clWhite;
      end
      else
        Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] := 0;
    end;
  subtr;

  { Sub iteration 2: }
  for i := 0 to Form1.Image1.Picture.Bitmap.Width do
    for j := 0 to Form1.Image1.Picture.Bitmap.Height do
    begin { Scan the entire image }
      if (Form1.img1.Picture.Bitmap.Canvas.Pixels[i, j] = 0) then
      begin
        Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] := 0;
        continue;
      end;
      ar := t1a(i, j, a, br); { Function A }
      p1 := a[0] * a[2] * a[6];
      p2 := a[0] * a[4] * a[6];
      if ((ar = 1) and ((br >= 2) and (br <= 6)) and (p1 = 0) and (p2 = 0)) then
      begin
        Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] := clWhite;

      end
      else
        Form1.img2.Picture.Bitmap.Canvas.Pixels[i, j] := 0;
    end;
  subtr;
end;


картинка http://c6b3tlxv.byethost4.com/image34.bmp
PAS файл http://c6b3tlxv.byethost4.com/ZS.pas
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!


Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »


 




[ Время генерации скрипта: 0.0509 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.