[kiman.ru]

Задача сделать из цветной картинки черно-белую, но без серого цвета — то есть можно использовать только 2 цвета: белый и черный.

Пример выполнения кода можно увидеть в прикрепленном изображении.

Код:

procedure TForm1.ButtonClick(Sender: TObject);
var
x, y, kontrast : Integer;
begin
kontrast := 100;
image2.Width := image1.Width;
image2.Height := image1.Height;
for y := 0 to image1.Height-1 do
begin

  for x := 0 to image1.Width-1 do
    begin
      if (GetRValue(Image1.Canvas.Pixels[x, y]) < kontrast) or (GetGValue(Image1.Canvas.Pixels[x, y]) < kontrast) or (GetBValue(Image1.Canvas.Pixels[x, y]) < kontrast) then
      Image2.Canvas.Pixels[x, y] := clBlack;
    end;
x := 0;
end;
end;

Проблема в том, что картинка у меня размером 2048х1536 пикселей, то есть цикл выполняется 3 145 728 раз и это занимает примерно 20 секунд. Нужно сделать так, чтобы происходило то же самое, но значительно быстрее. Подскажите пожалуйста как это сделать? Если можно — конкретно кусок кода.

Спасибо!

[Asinkrit]

Метод Canvas.Pixels[x, y] очень медленный, покопай в сторону BitMap.ScanLine, скорость повысишь в большое кол-во раз., а данный алгоритм будет отрабатываться мгновенно.

[x128]

как-то так:

Код:

procedure TForm1.ButtonClick(Sender: TObject);
var
  x,y,t: integer;
  c: byte;
  img: pByteArray;
begin
  t:=128; //порог
  for y:=0 to image1.Picture.Height-1 do begin
    img:=image1.Picture.Bitmap.ScanLine[y];
    for x:=0 to image1.Picture.Width-1 do begin
      c:=(img[x*3+0]+img[x*3+1]+img[x*3+2]) div 3; //(r+g+b)/3
      if c<t then c:=0 else c:=255;
      img[x*3+0]:=c;
      img[x*3+1]:=c;
      img[x*3+2]:=c;
    end;
  end;
end;

Писал прямо тут, на работоспособность естественно не проверял, но вроде не ошибся. Возможно в конце понадобится image1.Repaint;

[movnet]

http://www.delphisources.ru/pages/so...e-effects.html

[kiman.ru]

X128, спасибо! Код полностью рабочий, вы не ошиблись.