Преобразовать цветное изображения в черно-белое (оттенки серого) можно очень быстро, потратив 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 такта на обработку одного пикселя.
Comments (3)
Спасибо
Стоит добавить, что оптимизированные функции используют переполнение Integer, соответственно нужно отключить проверку overflow:
{$Q-} // overflow check off
...
{$Q+} // overflow check on
Алгоритм Grayscale на Delphi
> p:=ScanLine[Height-1];
> q:=ScanLine[0];
> if cardinal(p)>cardinal(q) then p:=q;
Возвращаемое значение указателя может зависеть от внутренней реализации ScanLine. Даже если просто вызвать ScanLine[0] 2 раза подряд, может получиться 2 разных адреса (возвращается не адрес внутреннего сплошного буфера bmp, а адрес копии заказанной строки).
Remy Lebeau:
The ScanLine property itself frees and recreates the internal bitmap data everytime you access it, thus you get a different memory address each time you access the ScanLine property, even when using the same index each time. This is because TBitmap is reference-counted internally, so doing something that can potentially alter the internal bitmap data, such as altering the bitmaps of the ScanLine data, can effect multiple TBitmap instances. So, TBitmap first clones the internal data before then allowing direct access to the data.
Конечно, в вашей программе адреса получаются и сравниваются до модификации, так что вроде это работает. Но однажды это может перестать работать. Для определения расположения строк в bmp, существует BITMAPINFOHEADER и его поле biHeight (см. MSDN):
Specifies the height of the bitmap, in pixels. If biHeight is positive, the bitmap is a bottom-up DIB and its origin is the lower-left corner. If biHeight is negative, the bitmap is a top-down DIB and its origin is the upper-left corner.
Вообще, насколько я знаю, обращение к bmp как к сплошному массиву, нигде не документировано. Теоретически возможно, что данные могут быть разбросаны в памяти.
Спасибо за исследование
Круто! Добавил в избранное.
>
if cardinal(p)>cardinal(q) then p:=q;Можно брать адрес ScanLine[Height-1] за начало - он всегда указывает на первую строку.