Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.04.30;
Скачать: CL | DM;

Вниз

Чистка изображения   Найти похожие ветки 

 
hgd   (2005-11-29 19:18) [0]

Какие есть алгоритмы чистки изображения, смазывания?


 
PAVIA ©   (2005-11-29 20:05) [1]

Разные.
1 Медиана. Пороговый.
2 Размытие.
А уж сами алгоритмы ищи на яндоксе.


 
programania ©   (2005-11-30 22:07) [2]

Для удаления шумов лучше медианный фильтр
Для него надо сортировать пикселы вокруг и брать
средний по номеру, вот кусочек программы:

PROCEDURE noise;
var x,y,xx,yy,d,j,i,n,q,z:integer; m:array[1..81] of byte;
begin
d:=4; //1..4 радиус
q:=d*2+1; q:=q*q-1; q:=q div 2;
for y:=1 to h do for x:=1 to w do begin
n:=0;
for yy:=y-d to y+d do for xx:=x-d to x+d do
if (yy<>y)or(xx<>x) then begin
  if (yy<1)or(xx<1)or(yy>h)or(xx>w) then z:=bi[y,x] else
// сортировка вставкой
  z:=bi[yy,xx];
  i:=1; while (i<=n)and(z>m[i]) do inc(i);
  for j:=n downTo i do m[j+1]:=m[j];
  inc(n);
  m[i]:=z;
end;
bb[y,x]:=m[q];
end;
end;


 
PAVIA ©   (2005-11-30 23:28) [3]

Посмотрел я твой код. Делать сортировку вставкой, а приимущество вставки не используешь. Ведь код можно сделать линейным правдо для этого потребуються расходы на память.

Чуть не забыл программа расчитана только на alert=3(радиус 1). Не сложно переписать.
a,b,c,t,e:array of AUnit;
a1,b1,c1:TUnit;
Заменить массивами
Также для оптимизации заменить динамическии массивы на статическии. И передовать их через указатель.


type
TRGB=array [0..2] of byte;
ArRGB=array [0..2] of TRGB;
PArRGB=^ArRGB;
TImag=array [0..2] of ArRGB;
PImag=^TImag;

TUnit=record
 y:Single;
 p:TRGB;
 end;
PUnit=^TUnit;
AUnit=array of TUnit;
const
RY=0.2989;
GY=0.5866;
BY=0.1144;

procedure insert(var a:AUnit; const b:Array of TUnit);
var d:byte;
i:integer;
c:AUnit;
begin
SetLength(c,Length(a)+length(b));
d:=0;
i:=0;
repeat
 if (i>=length(a)) then
  begin
  c[i+d]:=b[d];
  inc(d);
  end
 else if (d>=length(b)) then
  begin
  c[i+d]:=a[i];
  inc(i);
  end
 else if (b[d].y<=a[i].y) then
 begin
  c[i+d]:=b[d];
  inc(d);
 end else
 begin
  c[i+d]:=a[i];
  inc(i);
 end;
until (d=length(b))and(i=length(a));
SetLength(a,0);
a:=c;
end;

procedure delete(var a:AUnit; const b:Array of TUnit);
var d:byte;
i:integer;
c:AUnit;
begin
SetLength(c,Length(a)-length(b));
d:=0;
i:=0;
repeat
 if (d>=length(b)) then
  begin
  c[i-d]:=a[i];
  inc(i);
  end
 else if (i>=length(a)) then
 begin
  inc(d);
  inc(i);
 end
 else if (b[d].y=a[i].y) then
 begin
  inc(d);
  inc(i);
 end else
 begin
  c[i-d]:=a[i];
  inc(i);
 end;
until (d>=length(b))and(i>=length(a));
SetLength(a,0);
a:=c;
end;
procedure Scan(var bp:Tbitmap);
const
alert=3;
var
i,j,k:integer;
nbp:TBitmap;
lin,lin1:PArRGB;
a,b,c,t,e:array of AUnit;
a1,b1,c1:TUnit;
d:TUnit;
mas:array of AUnit;
begin
nbp:=TBitmap.Create;
nbp.PixelFormat:=pf24bit;
nbp.Width:=bp.Width;
nbp.Height:=bp.Height;
nbp.Assign(bp);
SetLength(a,bp.Width);
SetLength(b,bp.Width);
SetLength(c,bp.Width);
SetLength(t,bp.Width);
SetLength(mas,bp.Width);
for j:=0 to 2 do //Y
begin
e:=c;
c:=b;
b:=a;
a:=e;
SetLength(a[0],0);
lin:=nbp.ScanLine[j];
for i:=0 to 2 do //X
 begin
  c1:=b1;
  b1:=a1;
  a1.p:=Lin[i];
  a1.y:=RY*a1.p[2]+GY*a1.p[1]+BY*a1.p[0];
  insert(a[0],a1);
 end;
insert(mas[0],a[0]);

for i:=1 to bp.Width-1 do //X
 begin
  SetLength(a[i],0);
  insert(a[i],a[i-1]);
  delete(a[i],c1);
  c1:=b1;
  b1:=a1;
  a1.p:=Lin[i];
  a1.y:=RY*a1.p[2]+GY*a1.p[1]+BY*a1.p[0];
  insert(a[i],a1);
  insert(mas[i],a[i]);
 end;
end;
for j:=3 to bp.Height-1 do //Y
begin
lin:=nbp.ScanLine[j];
lin1:=bp.ScanLine[j-3];
lin1[0]:=mas[0][alert*alert div 2 ].p;
 e:=t;
 t:=c;
 c:=b;
 b:=a;
 a:=e;
delete(mas[0],t[0]);
SetLength(a[0],0);
for i:=0 to 2 do //X
 begin
  c1:=b1;
  b1:=a1;
  a1.p:=Lin[i];
  a1.y:=RY*a1.p[2]+GY*a1.p[1]+BY*a1.p[0];
  insert(a[0],a1);
 end;
insert(mas[0],a[0]);

for i:=1 to bp.Width-1 do //X
 begin
 SetLength(a[i],0);
  lin1[i]:=mas[i][alert*alert div 2 ].p;
  delete(mas[i],t[i]);
  insert(a[i],a[i-1]);
  delete(a[i],c1);
  c1:=b1;
  b1:=a1;
  a1.p:=Lin[i];
  a1.y:=RY*a1.p[2]+GY*a1.p[1]+BY*a1.p[0];
  insert(a[i],a1);
  insert(mas[i],a[i]);
 end;
end;

nbp.Destroy;

end;



Страницы: 1 вся ветка

Текущий архив: 2006.04.30;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.039 c
2-1144764242
Иван2006
2006-04-11 18:04
2006.04.30
как отловить нажатие Insert


3-1141401246
_RusLAN
2006-03-03 18:54
2006.04.30
TIBScript. Отобразить процесс выполнения скрипта.


2-1144834941
Acidlex
2006-04-12 13:42
2006.04.30
dbf


15-1143965825
Aust
2006-04-02 12:17
2006.04.30
Мобилизация


2-1145013235
Дарья
2006-04-14 15:13
2006.04.30
stringlist