Алгоритм Grayscale на Delphi
Преобразовать цветное изображения в черно-белое (оттенки серого) можно очень быстро, потратив 3 такта CPU на пиксель.
В типе TColor красный цвет хранится в младшем байте, далее зеленый, за ним синий. Они могут быть извлечены при помощи следующих операторов:
Red := Color and $FF; Green := Color shr 8 and $FF; Blue := Color shr 16 and $FF;
Хорошо известна формула для вычисления яркости цветного изображения по интенсивности цветовых составляющих:
Lum := Red * 0.299 + Green * 0.587 + Blue * 0.114;
или в целочисленной арифметике:
Lum := (Red * 77 + Green * 150 + Blue * 29) shr 8; // div 256
Новое значение цвета пикселя в градациях серого получается при помощи задания одинаковой интенсивности всех цветовых составляющих:
Color := Lum * $00010101;
Казалось бы, все просто. Но если запрограммировать алгоритм в лоб, то обнаружится, что преобразование изображениия размером 800x600 с разрешением 32bpp занимает больше секунды:
procedure BitmapToGrayscale(Bitmap: TBitmap);
var
x, y, Color: integer;
begin;
with Bitmap do
for y:=0 to Height-1 do
for x:=0 to Width-1 do begin;
Color:=Canvas.Pixels[x, y];
Canvas.Pixels[x, y]:=((77 * (Color and $FF) //Red
+ 150 * (Color shr 8 and $FF) //Green
+ 29 * (Color shr 16 and $FF) //Blue
) shr 8
) * $00010101;
end;
end;Еще обиднее, что все это время потрачено отнюдь не на наше преобразование, а на вызовы функций получения и установки цвета пикселя. Давайте воспользуемся тем, что все пиксели изображения в формате pf32Bit лежат вплотную друг за другом. При этом учтем, что порядок следования цветовых составляющих не совпадает с типом TColor, а именно: синий цвет хранится в младшем байте, далее зеленый, за ним красный. Исправленная процедура работает в 1000-2000 раз быстрее:
procedure Grayscale1(pBuf: pInteger; Count: integer);
var
Color: integer;
begin;
repeat;
Color:=pBuf^;
pBuf^:=((29 * (Color and $FF) //Blue
+ 150 * (Color shr 8 and $FF) //Green
+ 77 * (Color shr 16 and $FF) //Red
) shr 8
) * $00010101;
dec(Count);
inc(pBuf);
until Count<=0;
end;
procedure ShaBitmapToGrayscale1(Bitmap: TBitmap);
var
p, q: pInteger;
begin;
with Bitmap do begin;
p:=ScanLine[Height-1];
q:=ScanLine[0];
if cardinal(p)>cardinal(q) then p:=q;
Grayscale1(p, Height * Width);
end;
end;Попробуем ускорить вычисление нового цвета пикселя. Обратим внимание на то, что фактически вычисление яркости пикселя в процедуре Grayscale1 производится в байте с номером 1, который затем сдвигается в младший байт (байт номер 0). Все это требует предварительного перемещения значений цветовых составляющих в младший байт. Если же вычисление яркости выполнять в старшем байте (байт номер 3), то можно обойтись без предварительного сдвига:
pBuf^:=(( (29 * 256 * 256) * (Color and $000000FF) //Blue
+ (150 * 256) * (Color and $0000FF00) //Green
+ 77 * (Color and $00FF0000) //Red
) shr 24
) * $00010101;Заметим также, что умножение синей и красной составляющих можно совместить. При этом в двух младших байтах будет дополнительно вычислено произведение Blue*77, которое не окажет влияния на результат из-за последующего сдвига:
pBuf^:=(( (150 * 256) * (Color and $0000FF00) //Green
+ (29 * 256 * 256 + 77) * (Color and $00FF00FF) //Red & Blue
) shr 24
) * $00010101;Кроме того, можно обойтись без выделения зеленой составляющей, и умножить на соответствующий ей весовой коэффициент все цвета, а красную и зеленую составляющие затем умножить на меньший коэффициент:
pBuf^:=(( (150 * 256) * (Color and $00FFFFFF)
+ (29 * 256 * 256 - 150 * 256 + 77) * (Color and $00FF00FF)
) shr 24
) * $00010101;И, наконец, логическое умножение на константу $00FFFFFF излишне, т.к. при умножении старшего байта Color на (150*256) все равно будет получен нуль. После очередного упрощения получаем:
pBuf^:=(( (150 * 256) * Color
+ (29 * 256 * 256 - 150 * 256 + 77) * (Color and $00FF00FF)
) shr 24
) * $00010101;В результате процедура преобразования стала в полтора-два раза быстрее. Полностью она теперь выглядит следующим образом:
procedure Grayscale2(pBuf: pInteger; Count: integer);
var
Color: integer;
begin;
repeat;
Color:=pBuf^;
pBuf^:=(( Color * (150 * 256)
+ (Color and $00FF00FF) * (29 * 256 * 256 - 150 * 256 + 77)
) shr 24
) * $00010101;
dec(Count);
inc(pBuf);
until Count<=0;
end;
procedure ShaBitmapToGrayscale2(Bitmap: TBitmap);
var
p, q: pInteger;
begin;
with Bitmap do begin;
p:=ScanLine[Height-1];
q:=ScanLine[0];
if cardinal(p)>cardinal(q) then p:=q;
Grayscale2(p, Height * Width);
end;
end;Если развернуть цикл, то можно получить ускорение еще примерно в 1.25 раза:
procedure Grayscale3(pBuf: pIntegerArray; Count: integer);
const
Coeff = 150 * 256;
Magic = 29 * 256 * 256 + 77 - Coeff;
var
c0, c1, t0, t1: integer;
begin;
while Count and 3<>0 do begin;
c0:=pBuf[0];
t0:=c0 * Coeff;
pBuf[0]:=((t0 + (c0 and $00FF00FF) * Magic) shr 24) * $00010101;
inc(integer(pBuf),SizeOf(pBuf[0]));
dec(Count);
end;
if Count>0 then begin;
c0:=pBuf[0];
dec(integer(pBuf),2*SizeOf(pBuf[0]));
while true do begin;
c1:=pBuf[3];
t1:=c1 * Coeff;
t0:=c0 * Coeff;
pBuf[2]:=((t0 + (c0 and $00FF00FF) * Magic) shr 24) * $00010101;
c0:=pBuf[4];
pBuf[3]:=((t1 + (c1 and $00FF00FF) * Magic) shr 24) * $00010101;
dec(Count,4);
inc(integer(pBuf),4*SizeOf(pBuf[0]));
if count=0 then break;
c1:=pBuf[1];
t1:=c1 * Coeff;
t0:=c0 * Coeff;
pBuf[0]:=((t0 + (c0 and $00FF00FF) * Magic) shr 24) * $00010101;
c0:=pBuf[2];
pBuf[1]:=((t1 + (c1 and $00FF00FF) * Magic) shr 24) * $00010101;
end;
c1:=pBuf[1];
t1:=c1 * Coeff;
t0:=c0 * Coeff;
pBuf[0]:=((t0 + (c0 and $00FF00FF) * Magic) shr 24) * $00010101;
pBuf[1]:=((t1 + (c1 and $00FF00FF) * Magic) shr 24) * $00010101;
end;
end;
procedure ShaBitmapToGrayscale3(Bitmap: TBitmap);
var
p, q: pIntegerArray;
begin;
with Bitmap do begin;
p:=ScanLine[Height-1];
q:=ScanLine[0];
if cardinal(p)>cardinal(q) then p:=q;
Grayscale3(p, Height * Width);
end;
end;Ниже результаты экспериментов сведены в таблицу. Для измерении производительности использовался фоновый рисунок 'Безмятежность.bmp' размером 800x600 из Windows XP. Все процедуры, за исключением первой, вызывались в цикле 4000 раз.
Время и относительная скорость работы алгоритмов
====================================================================
Test Pentium D/2.8GHz E6850/3GHz i5-2300/2.8GHz
Bitmap 800x600x32 Time(ms) Speed Time(ms) Speed Time(ms) Speed
--------------------------------------------------------------------
BitmapToGrayscale 5078 1 1985 1 1468 1
4000 * Grayscale1 10937 1857 5093 1559 4453 1319
4000 * Grayscale2 7829 2584 2563 3098 2204 2664
4000 * Grayscale3 5781 3514 1953 4066 1921 3057Скорость работы первоначальной реализации превышена в 3000-4000 раз. При этом процессорам E6850 и i5-2300 потребовалось всего 3 такта на обработку одного пикселя.