| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Алгоритм пикселизации. [D7, WinXP]

Штотоносец ©   (2005-03-21 13:21:00) 

Это опять я =) с вопросрм по эффектам. Теперь меня заинтересовал алгоритм пикселизации. Кто-нибудь сможет мне помочь?

---

Анонимщик1   (2005-03-22 15:50:00) [1]

Решальщик, блин

---

Штотоносец   (2005-03-22 15:06:00) [2]

Все, решил задачу так:

procedure PixelsEffect(Bitmap: TBitmap; Hor, Ver: Word);
 function Min(A, B: Integer): Integer;
   begin
     if A<B then Result := A
       else Result := B;
   end;

type
 TRGB=record
   B,G,R: Byte;
 end;
 pRGB=^TRGB;
var
 i,j,x,y,xd,yd,rr,gg,bb,h,hx,hy:Integer;
 Dest:pRGB;
begin
 Bitmap.PixelFormat:=pf24Bit;
 if (Hor=1) and (Ver=1) then Exit;
 xd:=(Bitmap.Width-1) div Hor;
 yd:=(Bitmap.Height-1) div Ver;
 for i:=0 to xd do
   for j:=0 to yd do begin
     h:= 0;
     rr:=0;
     gg:=0;
     bb:=0;
     hx:=Min(Hor*(i + 1),Bitmap.Width-1);
     hy:=Min(Ver*(j + 1),Bitmap.Height-1);
     for y:=j*Ver to hy do begin
       Dest:=Bitmap.ScanLine[y];
       Inc(Dest,i*Hor);
       for x:=i*Hor to hx do begin
         Inc(rr,Dest^.R);
         Inc(gg,Dest^.G);
         Inc(bb,Dest^.B);
         Inc(h);
         Inc(Dest);
       end;
     end;
     Bitmap.Canvas.Brush.Color:=RGB(rr div h, gg div h, bb div h);
     Bitmap.Canvas.FillRect(Rect(i*Hor, j*Ver, hx+1, hy+1));
   end;
end;


---

Штотоносец   (2005-03-22 13:33:00) [3]

Почему-то он у меня не работает =(
Возвращает черный экран с цветными вертикальными полосами слева.
Вызов: Pixelate(TempBMP, 2, 2);

---

Fenik   (2005-03-21 23:11:00) [4]

Вот так лучше выглядит:

procedurePixelate(Bitmap: TBitmap; W, H: Word);
varI, J, X, Y: Integer;
    Width, Height, Left, Top, Right, Bottom: Integer;
    Red, Green, Blue, Count: Cardinal;
    Pixel: pRGBTriple;
begin
  Width := Bitmap.Width - 1;
  Height := Bitmap.Height - 1;
  if((W = 1) and(H = 1)) or(W = 0) or(H = 0)
    or(Width < 1) or(Height < 1) thenExit;
  Left := 0;
  Right := W;
  forI := 0 to(Width divW) do begin
    Top := 0;
    Bottom := H;
    forJ := 0 to(Height divH) do begin
      Count := 0;
      Red := 0;
      Green := 0;
      Blue := 0;
      ifRight > Width thenRight := Width;
      ifBottom > Height thenBottom := Height;
      forY := Top toBottom do begin
        Pixel := Bitmap.ScanLine[Y];
        Inc(Pixel, Left);
        forX := Left toRight do begin
          withPixel^ do begin
            Inc(Blue,  rgbtBlue);
            Inc(Green, rgbtGreen);
            Inc(Red,   rgbtRed);
          end;
          Inc(Count);
          Inc(Pixel);
        end;
      end;
      withBitmap.Canvas do begin
        Brush.Color := RGB(Red divCount, Green divCount, Blue divCount);
        FillRect(Rect(Left, Top, Right + 1, Bottom + 1));
      end;
      Inc(Top, H);
      Inc(Bottom, H);
    end;
    Inc(Left, W);
    Inc(Right, W);
  end;
end;

---

Fenik   (2005-03-21 20:03:00) [5]

> Штотоносец  (21.03.05 13:27) [2]
> Типа, берем смежные пиксели, вычисляем средний цвет... и т.д. > Только более подробно.

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

procedurePixelate(Bitmap: TBitmap; W, H: Word);
varI, J, X, Y: Integer;
   Red, Green, Blue, hX, hY, hW, hH, Count: Cardinal;
   Pixel: pRGBTriple;
begin
 if((W = 1) and(H = 1)) or(W = 0) or(H = 0)
    or(Bitmap.Width <= 1) or(Bitmap.Height <= 1) thenExit;
  forI := 0 toPred(Bitmap.Width) divW do
   forJ := 0 toPred(Bitmap.Height) divH do begin
     Count := 0;
     Red := 0;
     Green := 0;
     Blue := 0;
     hX := Min(W * Succ(I), Pred(Bitmap.Width));
     hY := Min(H * Succ(J), Pred(Bitmap.Height));
     hW := I * W;
     hH := J * H;
      forY := hH tohY do begin
       Pixel := Bitmap.ScanLine[Y];
       Inc(Pixel, hW);
        forX := hW tohX do begin
         withPixel^ do begin
           Inc(Blue,  rgbtBlue);
           Inc(Green, rgbtGreen);
           Inc(Red,   rgbtRed);
          end;
         Inc(Count);
         Inc(Pixel);
        end;
     end;
     withBitmap.Canvas do begin
       Brush.Color := RGB(Red divCount, Green divCount, Blue divCount);
       FillRect(Rect(hW, hH, Succ(hX), Succ(hY)));
      end;
   end;
end;

Данная процедура - это решение "в лоб". Можно еще оптимизировать.

---

man1   (2005-03-21 13:56:00) [6]

не для меня это сложно

---

Штотоносец   (2005-03-21 13:27:00) [7]

Мне не надо компонент, мне надо алгоритм.
Типа, берем смежные пиксели, вычисляем средний цвет... и т.д. Только более подробно.

---

man1   (2005-03-21 13:23:00) [8]

есть компонент OrImage, там расшарте много есть

---

Наверх