[kiman.ru]

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

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

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]

как-то так:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

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, спасибо! Код полностью рабочий, вы не ошиблись.