Уменьшение кол-ва цветов (Мозаика)

[mutabor]

Кто нибудь пробовал делать из полноцветных изображений перевод их в изображения с ограниченным кол-вом цветов, со своей палитрой. А также эффект мозаики, т.е. разбиение на мелкие части каждая - одного цвета.
Поделитесь идеями, как это реализовать более эффективно.

[TwiX]

Я инвирсию и сепию делал) Но мозайка вроде тоже не очень сложно: пробегаем по картинке квадратами, находя в каждом квадрате средний цвет (RGB) и заменяя все цвета в квадрате на средний

[Alex Cones]

Вот мой код для ограничения количества цветов в изображении, думаю разберетесь:

N:=StrToInt(Edit1.Text);

{For N:=255 downto 2 do
Begin}

 Bit:=TBitMap.Create;
 Bit.LoadFromFile('D:\A-MIND\Utils\Archiver\Resource\Main.bmp');
 Bit2:=TBitMap.Create;
 Bit2.LoadFromFile('D:\A-MIND\Utils\Archiver\Resource\Main.bmp');
 Windows.Beep(700,700);
 For Y:=0 to 8399 do
  For X:=0 to 749 do
   Begin
    C:=Bit2.Canvas.Pixels[X,Y];
    CHex:=IntToHex(C,1);
    CHex:=StringOfChar('0',6-Length(CHex))+CHex;
    SFD:=Copy(CHex,1,2);
    SSD:=Copy(CHex,3,2);
    STD:=Copy(CHex,5,2);
    CHex:='';
    FD:=StrToInt('$'+SFD);
    SD:=StrToInt('$'+SSD);
    TD:=StrToInt('$'+STD);
    If (FD mod N <> 0) Then FD:=FD-(FD mod N);
    If (SD mod N <> 0) Then SD:=SD-(SD mod N);
    If (TD mod N <> 0) Then TD:=TD-(TD mod N);
    SFD:=IntToHex(FD,2);
    SSD:=IntToHex(SD,2);
    STD:=IntToHex(TD,2);
    C:=StrToInt('$'+SFD+SSD+STD);
    Bit.Canvas.Pixels[X,Y]:=C;
    If Y mod 100 =0 Then
     Begin
      Edit1.Text:=IntToStr(Y);
      Edit1.Refresh;
     End;
   End;
   Windows.Beep(700,700);
 {Image1.Canvas.Draw(0,0,Bit2); }
 Image2.Canvas.Draw(0,0,Bit);
 Edit1.Text:=IntToStr(N);
 Edit1.Refresh;
 Image2.Refresh;
 Image2.Picture.SaveToFile('MainFC.bmp')

[TwiX]

А вот для мозайки:

procedure TForm1.Button1Click(Sender: TObject);
var
  size:integer;
  i, j, x, y: integer;
  r, g, b: extended;
begin
  size:=StrToInt(Edit1.Text);
  for x := 0 to round(Image1.Picture.Bitmap.Width / size) - 1 do
    for y := 0 to round(Image1.Picture.Bitmap.Height / size) - 1 do
    begin
      r := 0;
      g := 0;
      b := 0;
      for i := x * size to x * size + size - 1 do
        for j := y * size to y * size + size - 1 do
          with Image1.Canvas do
          begin
            r := r + GetRValue(Pixels[i, j]);
            g := g + GetGValue(Pixels[i, j]);
            b := b + GetBValue(Pixels[i, j]);
          end;
      r := r / (size * size);
      g := g / (size * size);
      b := b / (size * size);
      for i := x * size to x * size + size - 1 do
        for j := y * size to y * size + size - 1 do
          Image1.Canvas.Pixels[i, j] := rgb(round(r), round(g), round(g));
      Application.ProcessMessages;
    end;
end;

В image1 была эта картинка http://www.indinf.pub.ro/catalinp/proiect/lena512.bmp