Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2006.03.26;
Скачать: [xml.tar.bz2];

Вниз

Kak zgladit BitMap   Найти похожие ветки 

 
yura32 ©   (2005-10-19 23:07) [0]

vapros lamerskiy no vsyodki nujen otvet .
zaranie spasibo.


 
yura32 ©   (2005-10-20 03:51) [1]

4o ni kto ne znaet?


 
ЮЮ ©   (2005-10-20 04:06) [2]

TBitMap по определению прямоуголный, так что никак, даже напильник не поможет.

З.Ы. Заранее извини. Каков вопрос, таков ответ


 
PZ   (2005-10-20 11:14) [3]

У меня есть исходник. Если хотите, перешлю почтой.


 
yura32 ©   (2005-10-20 16:16) [4]

PZ
otprav pls


 
yura32 ©   (2005-10-20 16:17) [5]

outwar@mail.ru


 
PZ   (2005-10-20 16:35) [6]

Исходник отправил.
С уважением. PZ


 
yura32 ©   (2005-10-20 19:49) [7]

PZ

spasibo imeno to shto mne nado bilo :)


 
Expl   (2005-10-21 23:58) [8]

PZ. Помоги мне тоже с этим вопросом, если не затруднит. Заранее спасибо.


 
Fenik ©   (2005-10-22 01:04) [9]

procedure AntiAlias(Bitmap: TBitmap);
var x, y: Integer;
   p0, p1, p2: pByteArray;
begin
 Bitmap.PixelFormat := pf24Bit;
 for y := 1 to Bitmap.Height - 2 do begin
   p1 := Bitmap.ScanLine[y];
   p0 := Bitmap.ScanLine[y - 1];
   p2 := Bitmap.ScanLine[y + 1];
   for x := 0 to Bitmap.Width - 2 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;


 
Ricks ©   (2005-10-22 02:11) [10]


> Fenik


Твой пример равносилен этому (если bitmap задан как массив [в моем случае черно-белый]):


// считать что GetBMVal возвращает цвет в заданной точке.
procedure BlurMap( var HM : TByteMatrix; w, l : integer );
var x, z : Cardinal;
   v    : single;
begin
for z:=0 to pred(l) do
 for x:=0 to pred(w) do begin
  v:=0;
  v:=v + GetBMVal( HM, w, l, x + 1, z - 1);
  v:=v + GetBMVal( HM, w, l,     x, z - 1);
  v:=v + GetBMVal( HM, w, l, x - 1, z - 1);

  v:=v + GetBMVal( HM, w, l, x - 1,     z);
  v:=v + GetBMVal( HM, w, l,     x,     z);
  v:=v + GetBMVal( HM, w, l, x + 1,     z);

  v:=v + GetBMVal( HM, w, l, x + 1, z + 1);
  v:=v + GetBMVal( HM, w, l,     x, z + 1);
  v:=v + GetBMVal( HM, w, l, x - 1, z + 1);
  if v <> 0 then v:=v / 9;
  HM[z, x]:=Round(v);
 end;
end;


Теперь такой вопрос:
Приведенные выше процедуры сглаживают изображение довольно сильно, а нельзя ли как-нибудь уменьшить степень сглаживания?


 
Expl   (2005-10-22 10:54) [11]

А можно как-то сгладить изображение, состоящее только из черных точек ( в моем случае рисованная стрелка), т.к. эти алгоритмы делают из нее одно большое черное пятно?


 
Fenik ©   (2005-10-22 14:50) [12]

> Ricks ©  (22.10.05 02:11) [10]
> а нельзя ли как-нибудь уменьшить степень сглаживания?


Побольше веса центральному пикселю, поменьше - окружающим.
Вот например:

procedure BlurBmp(Bmp: TBitmap; Value: Byte);
var x, y, x1, x2, x3, n, i: Integer;
   p1, p2, p3: pByteArray;
begin
 Bmp.PixelFormat := pf24Bit;
 n := Value + 8;
 for y := 0 to Bmp.Height - 1 do begin
   p1 := Bmp.ScanLine[Max(y - 1, 0)];
   p2 := Bmp.ScanLine[y];
   p3 := Bmp.ScanLine[Min(y + 1, Bmp.Height - 1)];
   for x := 0 to Bmp.Width - 1 do begin
     x1 := Max(x - 1, 0) * 3;
     x2 := x * 3;
     x3 := Min(x + 1, Bmp.Width - 1) * 3;
     for i := 0 to 2 do begin
       p2[x2+i] := Trunc((p1[x1+i] + p1[x2+i]       + p3[x3+i] +
                          p2[x1+i] + p2[x2+i]*Value + p2[x3+i] +
                          p3[x1+i] + p3[x2+i]       + p3[x3+i]) / (Value + 8));
     end;
   end;
 end;
end;


Чем больше Value, тем слабее смазывание. При 150 уже почти незаметно. При 0 - максимум.
Можно, кстати, угловые пиксели не учитывать. тогда будет так:

       p2[x2+i] := Trunc((           p1[x2+i] +
                          p2[x1+i] + p2[x2+i]*Value + p2[x3+i] +
                                     p3[x2+i]) / (Value + 4));


Короче говоря, вся суть в весовых коэффициентах при усреднении с соседними пикселами. Можно, допустим, угловым ставить меньше, чем боковым. Можно брать радиус больше. Это обычный матричный фильтр. В редакторах он значится как пользовательский или заказной - User Defined Filter.

> Expl  (22.10.05 10:54) [11]
> А можно как-то сгладить изображение, состоящее только из черных точек ( в моем случае рисованная стрелка), т.к. эти алгоритмы делают из нее одно большое черное пятно?


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


 
Fenik ©   (2005-10-22 15:21) [13]

Виноват, правильнее иметь один исходный растр и один изменяемый такого же размера, дабы не накапливать смазывание. Т.е. надо переделать так:

procedure BlurBmp(Src, Dest: TBitmap; Value: Byte);
var x, y, x1, x2, x3, i: Integer;
  p, p1, p2, p3: pByteArray;
begin
 for y := 0 to Src.Height - 1 do begin
   p := Dest.ScanLine[y];
   p1 := Src.ScanLine[Max(y - 1, 0)];
   p2 := Src.ScanLine[y];
   p3 := Src.ScanLine[Min(y + 1, Src.Height - 1)];
   for x := 0 to Src.Width - 1 do begin
     x1 := Max(x - 1, 0) * 3;
     x2 := x * 3;
     x3 := Min(x + 1, Src.Width - 1) * 3;
     for i := 0 to 2 do begin
        p[x2+i] := Trunc((p1[x1+i] + p1[x2+i]    + p3[x3+i] +
                p2[x1+i] + p2[x2+i]*Value + p2[x3+i] +
                p3[x1+i] + p3[x2+i]    + p3[x3+i]) / (Value + 8));
     end;
   end;
 end;
end;



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

Форум: "Media";
Текущий архив: 2006.03.26;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.045 c
2-1142101123
jenya_rus
2006-03-11 21:18
2006.03.26
Извлечь имена файлов из папки??? :0


15-1141061124
grisme
2006-02-27 20:25
2006.03.26
Старая, избитая тема


15-1141510989
Bogdan1024
2006-03-05 01:23
2006.03.26
Explicit и Implicit


2-1141714480
R.O.O.T
2006-03-07 09:54
2006.03.26
Как сравнить две таблицы


2-1141754192
sicilla
2006-03-07 20:56
2006.03.26
PopupMenu





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский