Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.02.2010, 20:16   #11
koshel
Пользователь
 
Аватар для koshel
 
Регистрация: 03.02.2010
Сообщений: 38
По умолчанию

почему, если шум убрать вполне ничего!!! код можно????

Код:
procedure TForm1.Button2Click(Sender: TObject);
var X,Y:integer;

begin

for X:=1 to image1.Picture.Width do
for Y:=1 to image1.Picture.Height do


if (Image1.canvas.Pixels[X, Y]>90000) and (Image1.canvas.Pixels[X, Y]<4000000)
then
Image1.Canvas.Pixels[X,Y] := clwhite
else
Image1.canvas.Pixels[X, Y]:=Image1.canvas.Pixels[X, Y]
end;
как убрать шум пока не могу понять, работаю над этим, если есть идеи буду очень рад услышать))

Последний раз редактировалось Stilet; 22.02.2010 в 13:21.
koshel вне форума Ответить с цитированием
Старый 18.02.2010, 18:36   #12
mihali4
*
Старожил
 
Регистрация: 22.11.2006
Сообщений: 9,201
По умолчанию

"Похожие темы" внизу:
http://www.programmersforum.ru/showthread.php?t=39140
mihali4 вне форума Ответить с цитированием
Старый 18.02.2010, 18:40   #13
koshel
Пользователь
 
Аватар для koshel
 
Регистрация: 03.02.2010
Сообщений: 38
По умолчанию

Цитата:
"Похожие темы" внизу:
http://www.programmersforum.ru/showthread.php?t=39140
да я смотрел на похожую тему но она не решена и закрыта.
koshel вне форума Ответить с цитированием
Старый 18.02.2010, 18:42   #14
Arigato
Высокая репутация
СуперМодератор
 
Аватар для Arigato
 
Регистрация: 27.07.2008
Сообщений: 16,218
По умолчанию

koshel
Очень медленный способ.
Во-первых, дважды обращаться к цвету пикселя вообще не рационально.
Во-вторых, лучше использовать не TImage, а TBitMap, а для доступа к цвету воспользоваться ScanLine.
Arigato вне форума Ответить с цитированием
Старый 18.02.2010, 18:45   #15
koshel
Пользователь
 
Аватар для koshel
 
Регистрация: 03.02.2010
Сообщений: 38
По умолчанию

Возможно, но в графике я новичок, и не знаю многого, можно сказать знаю мизер как с ней работать в delphi.
Буду рад увидеть ваш вариант оптимизации моего кода)
koshel вне форума Ответить с цитированием
Старый 18.02.2010, 19:08   #16
Arigato
Высокая репутация
СуперМодератор
 
Аватар для Arigato
 
Регистрация: 27.07.2008
Сообщений: 16,218
По умолчанию

koshel
Прочитайте про TBitMap и ScanLine, самому нет времени решать Вам задачу.
Arigato вне форума Ответить с цитированием
Старый 18.02.2010, 22:02   #17
JTG
я получил эту роль
Старожил
 
Аватар для JTG
 
Регистрация: 25.05.2007
Сообщений: 3,694
По умолчанию

Сравнивать каждую компоненту RGB нужно отдельно (R + deltaR, G + deltaG, B + deltaB) и, как минимум, для 2 диапазонов цвета (тень/свет). Для одного диапазона получится что-то вроде


(В аттаче сорс, очень медленный )

После можно применить X раз фотошоповский фильтр "медиана", затем "изогелия", на делфи это выглядит примерно так:

Код:
procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;

  function ColorToRGB(Color: TColor): TRGB;
  begin
    with Result do
    begin
      R := Lo(Color);
      G := Lo(Color shr 8);
      B := Lo((Color shr 8) shr 8);
    end;
  end;

var
  x, y: Word;
  C1, C2: TRGB;
  Dest: pRGB;
begin
  Bitmap.PixelFormat := pf24Bit;
  C1 := ColorToRGB(Color1);
  C2 := ColorToRGB(Color2);
  for y := 0 to Bitmap.Height - 1 do
  begin
    Dest := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value then
        Dest^ := C1
      else
        Dest^ := C2;
      Inc(Dest);
    end;
  end;
end;

procedure Median(Bitmap: tbitmap; XOrigin, YOrigin,  XFinal, YFinal: Integer);
var Memo,x,y: Integer;
    p0,p1,p2:pbytearray;
begin
   if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end;
   if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end;
   XOrigin:=max(1,XOrigin);
   YOrigin:=max(1,YOrigin);
   XFinal:=min(Bitmap.width-2,XFinal);
   YFinal:=min(Bitmap.height-2,YFinal);
   Bitmap.PixelFormat :=pf24bit;
   for y:=YOrigin to YFinal do begin
    p0:=Bitmap.ScanLine [y-1];
    p1:=Bitmap.scanline [y];
    p2:=Bitmap.ScanLine [y+1];
    for x:=XOrigin to XFinal do begin
      p1[x*3]:=(p0[x*3]+p2[x*3]+p1[(x-1)*3]+p1[(x+1)*3])div 4;
      p1[x*3+1]:=(p0[x*3+1]+p2[x*3+1]+p1[(x-1)*3+1]+p1[(x+1)*3+1])div 4;
      p1[x*3+2]:=(p0[x*3+2]+p2[x*3+2]+p1[(x-1)*3+2]+p1[(x+1)*3+2])div 4;
      end;
   end;
end;

...

for i:=1 to X do Median(Bitmap, 0, 0, Bitmap.Width, Bitmap.Height);
Threshold(Bitmap, value, clBlack, clWhite);
Первый стирает мелкие области и "закрашивает дырки" в крупных, второй даст Ч/Б изображение



По пятнам как-нибудь построить квадраты (google Smallest rectangle, convex hull), слишком мелкия рядом - объеденить, большие - отбросить, вырезать по координатам квадратов из оригинала морды. Многое зависит от исходного изображения, если на разных фото большая разница в цвете/освещённости, неконтрастный задний фон - нифига не выйдет
Вложения
Тип файла: rar TestMorda.rar (741.7 Кб, 67 просмотров)
пыщь

Последний раз редактировалось JTG; 18.02.2010 в 22:09.
JTG вне форума Ответить с цитированием
Старый 20.02.2010, 16:31   #18
koshel
Пользователь
 
Аватар для koshel
 
Регистрация: 03.02.2010
Сообщений: 38
По умолчанию

Большое спасибо!!!! Ноу меня ваш проект не запустился пишет
[Fatal Error] main.pas(181): Could not create output file 'D:\Development\DelphiOutbox\main.d cu'
не могу понять что это за файл??
koshel вне форума Ответить с цитированием
Старый 21.02.2010, 00:39   #19
JTG
я получил эту роль
Старожил
 
Аватар для JTG
 
Регистрация: 25.05.2007
Сообщений: 3,694
По умолчанию

Это из моих конфигов, укажи правильные пути в в project-options-directories
пыщь
JTG вне форума Ответить с цитированием
Старый 21.02.2010, 01:08   #20
koshel
Пользователь
 
Аватар для koshel
 
Регистрация: 03.02.2010
Сообщений: 38
По умолчанию

Все работает!) Большое спасибо)
Теперь у меня возникла идея! Как можно по этим "Эскизам" лиц востановить лица из оригинала изображения! Ну типа вписать элипс в эти эскизы и вернуть убраные пиксели во время фильтрации??? что бы все осталось фильтрованое а лица нормальные!!Завтра буду думать))) Ну уже прогресс на лицо, спаси бо вам JTG!!!

Последний раз редактировалось mihali4; 10.03.2010 в 18:42.
koshel вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Выявление повторяющихся лиц из таблицы Ferrari-51 Помощь студентам 5 26.10.2009 18:49
Распознание формул в Delphi mud girl Компоненты Delphi 5 29.05.2009 09:27
Распознавание(обнаружение) лиц на фотографии Бзик Мультимедиа в Delphi 4 18.02.2009 23:15
Распознание цифр на изображении slashy Помощь студентам 4 29.04.2008 16:14
Распознание текста DOLBY Общие вопросы Delphi 13 14.02.2008 13:31