Поставить точку... Быстрый доступ к пикселам TBitmap
Архив с исходными текстами для статьи
При работе с растровой графикой очень часто возникает задача попиксельного доступа к Bitmap. Удобно и очень просто при этом пользоваться свойством Canvas.Pixels, но работает такой метод очень медленно - прочитать, установить или поменять цвета нескольких точек или не слишком большой области можно, но вот проводить какую-либо цифровую обработку - затруднительно. Для быстрого доступа к данным у класса TBitmap имеется свойство ScanLine - скорость при этом вырастает на порядок, но возникают и существенные проблемы - обращение к пикселам будет выглядеть совершенно по-разному в зависимости от формата растра (цветовой глубины - 8, 16, 24 бит/пиксел и т.д.), т.е. страдает универсальность разрабатываемых процедур.
Причины низкой скорости доступа к Pixels вкратце таковы: при каждом таком обращении вызываются функции API SetPixel или GetPixel, которые должны заблокировать передаваемый контекст устройства (далее DC - Device Context), определить текущее преобразование координат, с его учетом проверить, попадает ли пиксел в доступный регион DC, установить или прочитать значение цвета пиксела с преобразованием к нужному цветовому формату, что осуществляется c помощью "блиттинга" - копирования прямоугольного участка DC, после чего разблокировать DC. Все это требует существенных затрат процессорного времени (в том числе и на переход в режим ядра и назад). При использовании графических примитивов GDI, например, линий, прямоугольников и кривых, накладные расходы не так существенны, поскольку вышеуказанные операции выполняются лишь единожды для целой группы пикселов. Можно, конечно, держать копию данных растра в DIB или DIB-секции, как часто и делается, но удобнее создать более или менее универсальный механизм доступа к пикселам TBitmap. Для этого нам нужно знать, как же устроен Bitmap, и как хранятся данные в различных цветовых форматах. Класс TBitmap инкапсулирует в себе объекты Windows - DDB (Device-Dependent Bitmap) или DIB-секции. Во втором случае (а объекты TBitmap практически всегда имеют HandleType=bmDib, если не задавать bmDDB самостоятельно или не присваивать TBitmap.Handle дескриптор DDB) можно получить прямой доступ к информационному заголовку - TBitmapInfo, хранящему в себе данные о размерах растра, цветовом формате, палитре (для растров с 1-8 бит/пиксел (BPP - Bits Per Pixel)), а главное - к участку памяти, содержащему непосредственно цветовые данные (для форматов с палитрой - индексы цветов в палитре).
Для обеспечения приемлемой скорости и одновременно простоты обращения и создан описанный в статье класс TQuickPixels. Возможно, в сложных случаях для обеспечения максимального быстродействия лучше будет воспользоваться какой-либо профессиональной графической библиотекой.
Класс TQuickPixels
Подробно рассмотрим ключевые методы класса и принцип их работы.
Метод Attach позволяет присоединиться к объекту TBitmap и получить внутренние параметры, используемые для работы с ним. Поскольку свойство PixelFormat не вполне однозначно определяет конкретный цветовой режим, придется завести поле BPP, характеризующее метод хранения цветовых данных:
var
DS: TDibSection;
case FBitmap.PixelFormat of
...
pf4bit: SetBPP(4);
// для подобных режимов все просто
...
pfCustom:// а здесь проведем небольшое исследование
begin
if GetObject(FBitmap.Handle, SizeOf(DS), @DS) > 0 then
// получим информационный заголовок
with DS, dsBmih do
case biBitCount of
16: case biCompression of
BI_RGB: SetBPP(15);
BI_BITFIELDS:
// анализируем стандартные маски доступа к цветовым составляющим
// маски описаны в разделе о чтении пиксела
// достаточно проверить одну маску - в данном случае - зеленой составляющей
begin
if dsBitFields[1] = $7E0 then
SetBPP(16);
if dsBitFields[1] = $3E0 then
SetBPP(15);
end;
end;
32: case biCompression of
BI_RGB: SetBPP(32);
BI_BITFIELDS: if dsBitFields[1] = $FF0000 then
SetBPP(32);
end;
end;
end;
Теперь скопируем палитру (для тех режимов, где она существует) во внутреннее поле, чтобы не обращаться каждый раз к связанному объекту TBitmap:
if FBPP <= 8 then
begin
FLogPal.palVersion := $300;
FLogPal.palNumEntries := 1 shl FBPP; //2^BPP
GetPaletteEntries(FBitmap.Palette, 0, FLogPal.palNumEntries, FLogPal.palPalEntry[0]);
FHPal := CreatePalette(PLogPalette(@FLogPal)^);
// создадим для данной логической палитры и HPalette, что нам потребуется при поиске ближайшего цвета
end;
Запомним размерность растра:
FWidth := FBitmap.Width;
FHeight := FBitmap.Height;
Получим адрес блока данных:
FStart := Integer(FBitmap.Scanline[0]);
И разность между адресами соседних строк развертки растра - обычно строки хранятся в обратном порядке, так что величина получится в этом случае отрицательной:
FDelta := Integer(FBitmap.Scanline[1]) - FStart;
Если существует вероятность, что важные для правильного обращения параметры Bitmap будут независимо изменены, можно (но необязательно, если в программе предусмотреть гарантии переинициализации QuickPixels) отслеживать эти изменения, установив свойство TrackBitmapChange, благодаря тому, что у класса TBitmap имеется событие OnChange:
if FTrackBitmapChange then
FBitmap.OnChange:=BitmapChange;
Объект TQuickPixels придется заново проинициализировать при изменении размеров или цветового формата.
procedure TQuickPixels.BitmapChange(Sender: TObject);
begin
if (FBitmap.Width<>FWidth) or (FBitmap.Height<>FHeight) or
(FBitmap.PixelFormat<>FPixelFormat) then
Attach(FBitmap);
end;
Методы доступа к значению цвета в указанной точке
В классе определено cвойство-массив по умолчанию (в использовании подобное TCanvas.Pixels):
property Pixels[X, Y: Integer]: TColor read GetPixels write SetPixels; default;
Это позволяет обращаться к точкам растра очень просто:
ColorValue:=QP[x,y];
или
QP[x,y]:=ColorValue;
Методы GetPixels и SetPixels можно было бы оформить таким образом:
case FBPP of
1: //получить или установить цвет пиксела для данного формата
4: ...
8: ...
Однако при этом существенное время занимает именно выполнение перебора вариантов оператора Case. Более быстрый доступ обеспечивается с помощью определения отдельных методов доступа для каждого цветового режима, и заданием процедурных переменных методов такого типа:
TSetPixelsMethod = procedure(X, Y: Integer; const Value: TColor) of object;
TGetPixelsMethod = function(X, Y: Integer): TColor of object;
SetPixel: TSetPixelsMethod;
GetPixel: TGetPixelsMethod;
Связывание этих полей с конкретными методами доступа происходит при задании свойства BPP в методе SetBPP:
case FBPP of
1: if FByPaletteIndex then begin
SetPixel := SetPixels1Index;
GetPixel := GetPixels1Index;
end else begin
SetPixel := SetPixels1;
GetPixel := GetPixels1;
end;
....
procedure TQuickPixels.SetPixels(X, Y: Integer; const Value: TColor);
begin
SetPixel(X, Y, Value);
end;
В методах установки и чтения свойств происходит просто переадресация. Конечно, такая цепочка вызовов приводит к некоторому снижению быстродействия, и в тех случаях, когда чтение-запись пикселов является узким местом, стоит слегка поступиться удобством записи и вызывать Set/GetPixel напрямую, т.е. вместо
QP[x, y]:=ColorValue;
писать
QP.SetPixel(x, y, ColorValue);
Наивысшей же скорости можно добиться при непосредственном вызове, что будет не так универсально, но приемлемо при постоянной работе с растрами одного цветового формата (при этом придется перенести методы Set/GetPixelsXX в public-секцию):
SetPixels32(x, y, ColorValue);
Чтение значения цвета пиксела
Рассмотрим теперь детально, как же осуществляется чтение цвета пиксела растра в указанной точке для каждого цветового формата. Сначала режимы без палитры, в которых данные растра содержат непосредственно цвет. Для лучшего понимания принципов доступа приведем и код на Паскале, послуживший логической основой, и окончательный ассемблерный вариант.
32 BPP: каждый пиксел занимает 4 байта (в одном хранится служебная информация, например, о прозрачности), адресация будет довольно простой (Адрес пиксела=Базовый адрес блока+смещение строки+X*4):
RGBValue := PInteger(FStart + FDelta * Y + (X shl 2))^;
Но значения R,G и B (красной, зеленой и синей составляющей) идут в обратном порядке, так что для преобразования в формат TColor придется их перевернуть:
function TQuickPixels.GetPixels32(X, Y: Integer): TColor;
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
mov eax,[ecx+4*edx]
bswap eax
shr eax, 8
end;
В Delphi по умолчанию используется соглашение о передаче параметров register. Для метода класса это означает, что на входе в процедуру регистр EAX содержит указатель на экземпляр класса- Self. В EDX передается первый слева параметр - в данном случае X, а в ECX - второй параметр - здесь - Y. Если параметров больше, они передаются через стек. В первой строке приведенного кода выполняется умножение с учетом знака Y на FDelta. FDelta - поле экземпляра класса, поэтому обращение к нему и выполняется таким образом: [eax].FDelta. Далее выполняется сложение с полем FStart. Функция возвращает результат в регистре EAX, поэтому получаем в этот регистр 32-битное значение, содержащееся по адресу в квадратных скобках (с одновременным добавлением смещения пиксела в строке). Затем меняем порядок следования байт и сдвигаем результат вправо, получая значение в соответствии с форматом TColor.
24 BPP: каждый пиксел занимает 3 байта. Возникает соблазн читать сразу 4 байта, что быстрее, но делать так, увы, нельзя - при определенных размерах битмапа возможны ситуации, что блок данных будет занимать точно одну полностью заполненную страницу памяти (4К) (или несколько заполненных), и чтение крайнего пиксела может привести к выходу за границы виртуального адресного пространства, отведенного процессу, что вызовет ошибку нарушения доступа (Access Violation). Так что будем честно копировать 3 байта. Как и в случае 32BPP, их придется инвертировать.
PRGBTriple(@i)^ := PRGBTriple(FStart + FDelta * Y + 3 * X)^;
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
//вычисляем адрес строки, как и ранее
add ecx,edx
//чтобы избавиться от умножения на 3, добавляем X
movzx eax,WORD PTR [ecx+2*edx]
//а теперь учитываем еще 2X при получении слова по данному адресу
//movzx - дополнение слова нулями до двойного слова c - выполняется быстрее простого mov ax, SomeWord
bswap eax
shr eax,8
//1 и 2 байты (отсчет с нуля) eax теперь заполнены
movzx ecx, BYTE PTR [ecx+2*edx+2]
or eax,ecx
//получаем в СL оставшийся байт и комбинируем его с EAX
end;
16 BPP: Цветовые данные занимают слово, т.е. 2 байта, в формате 5-6-5 (R,G,B составляющие соответственно). Маски для выделения составляющих будут такие: $F800, $7E0 и 1F. Но полученное значение содержит только 5 или 6 старших бит из 8, так что для установления соответствия минимального уровня 0(5)->0(8) и максимального 31(5)->255(8) выполняется масштабирование цветовых составляющих, затем сведение их в переменную типа TColor
w := PWord(FStart + FDelta * Y + (X shl 1))^;
Result := (((w and $1F) * 541052) and $FF0000) or
(((((w and $7E0) shr 5) * 266294) shr 8) and $FF00) or
((((w and $F800) shr 11) * 541052) shr 16);
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
movzx eax,word ptr [ecx+2*edx]
//аналог первой строки на Паскале
mov ecx,eax
and ecx,$1F
//выделение с помощью маски одной из составляющих
imul ecx,541052
and ecx,$FF0000
//масштабирование - теперь второй байт ECX содержит эту составляющую цвета
mov edx,eax
and edx,$7E0
imul edx,135263
shr edx,12
and eax,$F800
and edx,$FF00
imul eax,135263
shr eax,24
//то же самое для двух оставшихся составляющих
or eax,ecx
or eax,edx
//комбинируем байты из EAX,ECX,EDX
end;
15 BPP: Как и для 16 бит, данные занимают слово, но старший бит не используется, формат 5-5-5, а маски: $7С00, $3E0 и 1F:
// аналог((w and $1F) shl 19) or ((w and $3E0) shl 6) or ((w and $7C00) shr 7)
// с масштабированием 5 бит на 8 (31->255)
Result := (((w and $1F) * 541052) and $FF0000) or
(((((w and $3E0) shr 5) * 541052) shr 8) and $FF00) or
((((w and $7C00) shr 10) * 541052) shr 16);
Ассемблерный код почти такой же, как для 16 бит.
Теперь рассмотри режимы с глубиной цвета 1-8 бит, в которых данные содержат индекс цвета в палитре.
8 BPP: Режим с 256 цветами, индекс занимает ровно байт, получение его наиболее просто:
b := PByte(FStart + FDelta * Y + X)^;
Полученный индекс преобразуем с использованием палитры - таблицы соответствия индекса и самого цветового значения
with FLogPal.palPalEntry[b] do
Result := peRed or (peGreen shl 8) or (peBlue shl 16);
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
movzx ecx, BYTE PTR [ecx+edx]
//в ECX теперь номер цвета в палитре
mov eax, DWORD PTR [eax+ecx*4+4].FLogPal
//результат функции - цвет из палитры, т.е. значение по адресу -
//Self + смещение поля FLogPal + смещение массива цветов + номер цвета*4 (4 = SizeOf(TPaletteEntry))
end;
4 BPP: Каждый байт хранит информацию об индексе цвета двух соседних точек, так что для получения индекса точек с четным X придется сдвинуть полученный байт вправо на 4 бита, а для нечетных X просто выделить нужный полубайт наложением маски $0F
b := PByte(FStart + FDelta * Y + (X div 2))^;
if Odd(x) then
b:=b and $F
else
b:=b shr 4;
Извлечение цвета из палитры (состоящей в данном случае из 16 цветов) аналогично случаю 8 BPP
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
shr edx,1
//X div 2
movzx ecx, BYTE PTR [ecx+edx]
jnc @@IsEven
//флаг переноса CF установлен при выполнении Shr, если младший бит был единичным, т.е. X нечетно
and ecx,$0F
jmp @@GetCol
@@IsEven:
shr ecx,4
@@GetCol:
mov eax, DWORD PTR [eax+ecx*4+4].FLogPal
end;
1 BPP: Каждый байт хранит информацию об индексах 8 точек, для выделения нужного индекса либо накладывается маска, затем производится проверка на нулевое значение, либо байт сдвигается вправо на нужное расстояние и проверяется младший бит.
b := PByte(FStart + FDelta * Y + (X shr 3))^;
b := (b shr (7 - (X mod 8))) and 1;
asm
push ebx
//сохраним регистр EBX в стеке - он нам понадобится, а содержимое его после выхода из процедуры не должно пострадать
mov ebx,edx
//в EBX теперь X
imul ecx,[eax].FDelta
add ecx,[eax].FStart
shr edx,3
//X div 8
movzx edx, BYTE PTR [ecx+edx ]
//в DL теперь байт, соответствующий 8 точкам
mov ecx,ebx
and ecx,7
//X mod 8
mov ebx,edx
mov edx,$80
//1000000b
shr edx,cl
//сдвигаем единичку вправо на X mod 8
and ebx,edx
//накладываем маску
pop ebx
jz @@Zero
//если нужный бит нулевой, выставлен флаг ZF
mov eax, DWORD PTR [eax+8].FLogPal
//бит единичный, берем из палитры 1-й цвет
jmp @@Exit
@@Zero:
//берем из палитры 0-й цвет
mov eax, DWORD PTR [eax+4].FLogPal
@@Exit:
end;
Отметим, что доступ к точкам в режимах с палитрой может быть существенно медленнее (особенно при установке цвета, что будет рассмотрено ниже), поэтому реализовано и получение просто индекса в палитре без преобразования в цвет, что может быть полезно при работе с битмапами с известной палитрой, например, в градациях серого, когда индекс однозначно соответствует яркости цвета в данной точке. Для этого служит свойство ByPaletteIndex: Boolean, при установке которого в True методы доступа GetPixels* заменяются на GetPixels*Index. Вспомогательная функция PalIndex(const Color:TColor):Integer позволяет при необходимости заранее определить индекс ближайшего цвета в заданной палитре. Код этих методов приводить не будем, так как они почти аналогичны вышеописанным, исключается лишь преобразование индекса в цвет. Обратите внимание, что результат функций для унификации объявлен как TColor, но реально младший байт содержит индекс.
Установка значения цвета пиксела
Режимы без палитры:
32 BPP: Адресация аналогична методам Get. Сначала переставляем байты в нужном порядке, затем записываем значение по нужному адресу:
PInteger(FStart + FDelta * Y + (X Shl 2))^ := SwappedValue;
procedure TQuickPixels.SetPixels32(X, Y: Integer; const Value: TColor);
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
mov eax, Value
bswap eax
shr eax, 8
mov [ecx+4*edx],eax
end;
24 BPP: Инвертируем порядок байтов, пишем 3 байта:
PRGBTriple(FStart + FDelta * Y + 3 * X)^ := PRGBTriple(@i)^;
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
lea edx,[edx+edx*2]
mov eax,[ebp+8]
//по этому адресу в стеке находится Value - значение цвета
bswap eax
shr eax, 8
mov [ecx+edx],ax
shr eax, 16
mov [ecx+edx+2],al
end;
16 BPP: Формат и маски уже рассматривались выше, масштабирование не нужно, младшие биты цветовых составляющих просто игнорируются, что достигается модификацией масок и сдвигом:
w := ((Value And $F8) Shl 8) or
((Value And $FC00) Shr 5) or
((Value And $FF0000) Shr 19);
PWord(FStart + FDelta * Y + (X Shl 1))^ := w;
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
mov eax,[ebp+$08]
push esi
mov esi,[ebp+$08]
and esi, $F8
shl esi, 8
push edi
mov edi,[ebp+$08]
and edi, $FC00
shr edi, 5
or esi,edi
pop edi
and eax, $FF0000
shr eax, 19
or eax,esi
mov [ecx+edx*2],ax
pop esi
end;
15 BPP: Аналогичная ситуация, меняются маски и сдвиги:
w := ((Value And $F8) Shl 7) or
((Value And $F800) Shr 6) or
((Value And $FF0000) Shr 19);
PWord(FStart + FDelta * Y + (X Shl 1))^ := w;
Ассемблерный код почти такой же, как и для 16 бит
8 BPP: Для установки цвета нужно сначала найти индекс ближайшего цвета в палитре, что является медленной операцией (очевидно, происходит перебор 256 цветов палитры со сравнением квадрата расстояния в цветовом пространстве RGB как суммы разностей квадратов (Pal[i].Red-ColorValue.Red) и т.д. Поэтому разумно запоминать последний найденный цвет и его индекс, что существенно ускоряет работу при последовательном задании одинакового цвета для нескольких пикселов, что является достаточно распространенной ситуацией:
If Value <> FLastColor then begin
FLastIndex := GetNearestPaletteIndex(FHPal, Value);
// вот и пригодилась палитра, созданная в методе Attach
FLastColor := Value;
end;
Установка индекса очевидна:
PByte(FStart + FDelta * Y + X)^ := FLastIndex;
asm
push ebx
push esi
//сохраним в стеке регистры, которые нам потребуются для вспомогательных операций
imul ecx,[eax].FDelta
mov esi,[ebp+8]
//по этому адресу в стеке хранится третий параметр - значение цвета
add ecx,[eax].FStart
cmp esi,[eax].FLastColor
jz @@TheSame
mov [eax].FLastColor,esi
//запомним цвет
push ecx
push edx
push eax
push esi
mov eax,[eax].FHPal
push eax
//нужно найти цвет в палитре
//сохраняем регистры, нужные для вызова функции параметра укладываем в стек
//в порядке, необходимом для соглашения stdcall
call GetNearestPaletteIndex
mov ebx,eax
//результат функции - индекс цвета
pop eax
pop edx
pop ecx
//восстановим регистры
mov [eax].FLastIndex,ebx
//запомним индекс последнего цвета
jmp @@SetCol
@@TheSame:
mov ebx,[eax].FLastIndex
//цвет с прошлого вызова остался таким же, индекс его уже хранится в поле FLastIndex
@@SetCol:
pop esi
mov [ecx+edx],bl
//запишем байт индекса по вычисленному ранее адресу
pop ebx
end;
4 BPP: Индекс находим аналогично 8-битному режиму, вычисляем адрес, и взависимости от четности X-координаты применяем соответствующие маски и сдвиг, причем сначала получаем целый байт, меняя только нужную его половину.
FAddr := FStart + FDelta * Y + (X Div 2);
if Odd(x) Then
PByte(FAddr)^ := (PByte(FAddr)^ And $0F) or (FLastIndex Shl 4)
else
PByte(FAddr)^ := (PByte(FAddr)^ And $F0) or FLastIndex;
asm
push esi
mov esi,ecx
push ebx
imul esi, [eax].FDelta
mov ecx,Value
mov ebx,[eax].FLastIndex
//сохраненный индекс
add esi,[eax].FStart
cmp ecx, [eax].FLastColor
jz @@SetCol
mov [eax].FLastColor,ecx
mov ebx,eax
//сохраним Self
push edx
push ecx
push [eax].FHPal
call GetNearestPaletteIndex
xchg ebx,eax
//в EBX - найденный индекс цвета
pop edx
mov [eax].FLastIndex,ebx
@@SetCol:
shr edx, 1
//X div 2
mov ecx, $f0
lea esi,[esi+edx]
//адрес нужного байта
jc @@SetByte
//флаг переноса, свидетельствующий о нечетности, устанавливается при выполнении shr
mov ecx, $0f
shl ebx, 4
//для четных точек устанавливаем старший полубайт
@@SetByte:
mov eax,[esi]
//в AL - исходный байт, соотв. двум точкам
and eax,ecx
//обнулим устанавливаемый полубайт
or eax,ebx
//установим новое значение этого полубайта
pop ebx
mov [esi],al
//вернем измененный байт на свое место
pop esi
end;
1 BPP: Здесь ситуация почти такая же - вычисляем маску в зависимости от X, получаем байт по нужному адресу и устанавливаем или сбрасываем нужный бит:
FAddr := FStart + FDelta * Y + (X Shr 3);
b := $80 Shr (X Mod 8);
If Value <> FLastColor Then begin
FLastIndex := GetNearestPaletteIndex(FHPal, Value);
FLastColor := Value;
end;
If FLastIndex = 0 Then
PByte(FAddr)^ := PByte(FAddr)^ And (Not b)
Else
PByte(FAddr)^ := PByte(FAddr)^ Or b;
asm
push ebx
push esi
mov esi,[ebp+8]
//цвет
cmp esi,[eax].FLastColor
jz @@TheSame
mov [eax].FLastColor,esi
push ecx
push edx
push eax
push esi
mov eax,[eax].FHPal
push eax
call GetNearestPaletteIndex
mov ebx,eax
pop eax
pop edx
pop ecx
mov [eax].FLastIndex,ebx
jmp @@SetCol
@@TheSame:
mov ebx,[eax].FLastIndex
@@SetCol:
mov esi,[eax].FDelta
imul esi,ecx
add esi,[eax].FStart
mov eax,edx
shr eax, 3
//X div 8
add esi,eax
mov eax,[esi]
//получили байт с данными о 8 точках
mov ecx,edx
and ecx, 7
//X mod 8
mov edx, $80
shr edx,cl
//маска для нужного бита
or ebx,ebx
jz @@IsZero
or eax,edx
//установка бита в 1
jmp @@SetByte
@@IsZero:
not edx
and eax,edx
//сброс бита в 0
@@SetByte:
mov [esi],al
//запись байта с измененной точкой
pop esi
pop ebx
end;
Методы с заданием не цветового значения, а индекса палитры выглядят практически также, в них просто исключается нахождение индекса, например, для 8 бит:
asm
imul ecx,[eax].FDelta
add ecx,[eax].FStart
mov eax,[ebp+8]
mov [ecx+edx], al
end;
В приложенном модуле некоторая оптимизация ассемблерного кода методов Get** и Set** класса TQuickPixels позволила повысить скорость работы примерно в 2 раза по сравнению с вариантом на Паскале - от 25 до 80 миллионов пикселов в секунду (в зависимости от цветового режима) на компьютере c процессором P3-600 МГц (10-20 процессорных тактов на точку), что примерно на два порядка быстрее, чем при использовании TCanvas.Pixels. Для режимов с палитрой скорость при выводе разных цветов, естественно, сильно падает. Отметим, что для некоторых целей - например, для проведения геометрических преобразований - можно модифицировать код класса таким образом, чтобы не переводить значения в режимах 15 - 32 бит в TColor и обратно, копируя значение в формате хранения. Однако скорость доступа к пикселам настолько высока, что при выполнении любых дополнительных действий (например, аффинных преобразований) лимитировать скорость обработки, скорее всего, будут в основном именно эти дополнительные действия, а не чтение-запись пикселов.
Вот результаты теста быстродействия на указанном компьютере (режимы с палитрой - при задании одного цвета) в мегапикселах в секунду:
1 bpp Get : 39.08 MP/s
1 bpp GetIndx: 60.26 MP/s
4 bpp Get : 63.73 MP/s
4 bpp GetIndx: 82.63 MP/s
8 bpp Get : 76.07 MP/s
8 bpp GetIndx: 104.99 MP/s
15 bpp Get : 31.63 MP/s
16 bpp Get : 31.64 MP/s
24 bpp Get : 55.48 MP/s
32 bpp Get : 79.44 MP/s
1 bpp Set : 27.22 MP/s
1 bpp SetIndx: 29.54 MP/s
4 bpp Set : 28.14 MP/s
4 bpp SetIndx: 28.99 MP/s
8 bpp Set : 31.17 MP/s
8 bpp SetIndx: 36.81 MP/s
15 bpp Set : 31.58 MP/s
16 bpp Set : 33.22 MP/s
24 bpp Set : 33.90 MP/s
32 bpp Set : 41.20 MP/s
Демонстрационная программа
Программа QPixels позволяет измерить производительность в различных режимах и демонстрирует несколько несложных графических эффектов. Для измерения нужно выбрать цветовую глубину растра, метод доступа для режимов с палитрой - по непосредственному значения цвета или по его индексу в палитре, и чтение либо запись значения - Get или Set. В процедуре тестирования создается Bitmap размером 8х8 пикселов заданного цветового формата, при записи диагональным точкам устанавливается красный цвет, при чтении сначала на битмапе рисуются цветные полоски, затем читаются диагональные пикселы. В режиме 1 бит и при работе с индексом цвета будут искажены.
procedure TForm1.TestOneMode(BPP: integer; ByIndex, SetPix, DrawBmp: boolean);
...
begin
SmallBmp := TBitmap.Create;
...
case BPP of
...
32: SmallBmp.PixelFormat := pf32bit;
end;
...
QueryPerformanceCounter(Tim1);
for i := 1 to Cnt * 1000000 do
begin
j := i and 7;
end;
QueryPerformanceCounter(Tim2);
OverHead := (Tim2 - Tim1 + j - j) / Freq;
//вычисление временных затрат на пустой цикл
//+ j - j используется, чтобы оптимизатор не удалил тело цикла
...
QP.Attach(SmallBmp);
//присоединение к созданному растру
if SetPix then
begin
QueryPerformanceCounter(Tim1);
for i := 1 to Cnt * 1000000 do
begin
j := i and 7;
QP.SetPixel(j, j, clRed);
//установка цвета, можно писать и QP[j, j]:= clRed;
end;
QueryPerformanceCounter(Tim2);
if DrawBmp then
Canvas.StretchDraw(Rect(0, 0, 80, 80), SmallBmp);
Seconds := (Tim2 - Tim1) / Freq;
end
else
begin
for i := 0 to 7 do
for j := 0 to 7 do
SmallBmp.Canvas.Pixels[i, j] := SomeColors[j];
//разноцветные полоски
QueryPerformanceCounter(Tim1);
for i := 1 to Cnt * 1000000 do
begin
j := i and 7;
Col := QP.GetPixel(j, j);
//чтение пикселов
end;
QueryPerformanceCounter(Tim2);
if DrawBmp then
Canvas.StretchDraw(Rect(0, 0, 80, 80), SmallBmp);
Seconds := (Tim2 - Tim1) / Freq;
end;
Memo1.Lines.Add(Format('%2d bpp %s%4s: %5f MP/s',
[BPP, SetGet, sByIndex, Cnt / (Seconds - OverHead)]));
//вывод результата
SmallBmp.Free;
end;
Можно протестировать и все режимы сразу:
procedure TForm1.TestAllClick(Sender: TObject);
var
i: Integer;
GetSet, byIndx: Boolean;
begin
Refresh;
Effect := 0;
Memo1.Clear;
for GetSet := False to True do
begin
for i := 0 to 6 do
for byIndx := False to (i < 3) do
TestOneMode(BPPs[i], byIndx, GetSet, False);
Memo1.Lines.Add('');
end;
end;
При выборе одного из графических эффектов устанавливается глобальная переменная Effect, которая используется в обработчике события OnMouseMove, и для интерактивных режимов происходит связывание объектов QuickPixels с предварительно загруженной картинкой Bmp и контейнером для модифицированной - NewBmp:
procedure TForm1.rgEffectsClick(Sender: TObject);
begin
Refresh;
Effect := rgEffects.ItemIndex;
case Effect of
0: Blur;
1: FlyImage;
else
begin
NewBmp.Assign(Bmp);
Canvas.Draw(0, 0, NewBmp);
QP.Attach(Bmp);
QP2.Attach(NewBmp);
w := QP.Width;
h := QP.Height;
Rct := Rect(5, 5, w - 6, h - 6);
FullRct := Rect(0, 0, w - 1, h - 1);
end;
end;
end;
Blur: Демонстрация применения простого графического фильтра размытия:
procedure TForm1.Blur;
var
fl: array[-1..1, -1..1] of integer;
bm: TBitmap;
i, j, k, l: integer;
r, g, b: integer;
c: tcolor;
begin
for k := -1 to 1 do
for l := -1 to 1 do
fl[k, l] := 1;
fl[0, 0] := 4;
//заполнение матрицы фильтра
bm := TBitmap.Create;
bm.width := 200;
bm.height := 200;
bm.PixelFormat := pf32bit;
QP.Attach(bm);
for i := 0 to 9 do
begin
bm.Canvas.MoveTo(0, 10 + i * 20);
bm.Canvas.LineTo(200, 10 + i * 20);
bm.Canvas.MoveTo(10 + i * 20, 0);
bm.Canvas.LineTo(10 + i * 20, 200);
end;
//рисование сетки
canvas.Draw(0, 0, bm);
for i := 1 to 198 do
for j := 1 to 198 do
begin
r := 0;
b := 0;
g := 0;
for k := -1 to 1 do
for l := -1 to 1 do
begin
c := QP[i + k, j + l];
inc(r, fl[k, l] * GetRValue(c));
inc(g, fl[k, l] * GetGValue(c));
inc(b, fl[k, l] * GetBValue(c));
end;
//применение фильтра к каждой цветовой составляющей
QP[i, j]:=RGB(r div 12, g div 12, b div 12);
end;
canvas.Draw(0, 210, bm);
bm.free;
end;
Fly: Демонстрация использования QuickPixels для осуществления аффинных преобразований - центр картинки движется по сужающейся спирали, размеры ее увеличиваются до исходных, она поворачивается вокруг своей оси:
procedure TForm1.FlyImage;
var
k, x_new, y_new, x0, y0: integer;
fac: double;
cosphi, sinphi, x, y, dx, dy: integer;
const
BinaryFactor = 10;
function rnd(const x, y: Integer): TPoint;
begin
Result.X := x shr BinaryFactor;
Result.Y := y shr BinaryFactor;
end;
begin
NewBmp.Assign(Bmp);
QP.Attach(Bmp);
QP2.Attach(NewBmp);
w:=QP.Width;
h:=QP.Height;
x0 := w div 2;
y0 := h div 2;
for k := 1 to 1080 do
//1080=360*3 - 3 полных оборота
begin
fac := Sqr(1080 / k);
dx := round(w * 512 * cos(k * Pi / 400) * (1 - fac));
dy := round(w * 512 * sin(k * Pi / 400) * (1 - fac));
//координаты центра
cosphi := round(fac * cos(k * Pi / 180) * (2 shl (BinaryFactor - 1)));
sinphi := round(fac * sin(k * Pi / 180) * (2 shl (BinaryFactor - 1)));
for x_new := 0 to w - 1 do
begin
y := ((-x_new + x0) * sinphi - y0 * cosphi) + (y0 shl BinaryFactor) + dx;
x := ((-x0 + x_new) * cosphi - y0 * sinphi) + (x0 shl BinaryFactor) + dy;
//аффинное преобразование - для каждой точки новой картинки рассчитывается соответствующая ей точка исходной
//основные расчеты для ускорения проводятся в целых числах
for y_new := 0 to h - 1 do
begin
with rnd(x, y) do
if (x >= 0) and (x < w) and (y >= 0) and (y < h) then
QP2.SetPixel(x_new, y_new, QP.getpixel(x, y))
else
QP2.SetPixel(x_new, y_new, clSilver);
inc(y, cosphi);
inc(x, sinphi);
end;
end;
BitBlt(Canvas.Handle, 0, 0, w, h, NewBmp.canvas.handle, 0, 0, srccopy);
end;
end;
Blend: Демонстрация наложения маски с переменной при движении мыши прозрачностью:
for xi := 0 to w - 1 do
for yi := 0 to h - 1 do
begin
ifi := Trunc(2 * (Hypot(x - xi, y - yi)));
if ifi > 255 then
ifi := 255;
//прозрачность в точке 0..255
c := QP.getpixel(xi, yi);
r := getRValue(c);
g := getGValue(c);
b := getBValue(c);
r := (r * (255 - ifi) + 128 * ifi) shr 8;
g := (g * (255 - ifi) + 128 * ifi) shr 8;
b := (b * (255 - ifi) + 128 * ifi) shr 8;
c := RGB(r, g, b);
//комбинация серого цвета и цвета исходного пиксела
QP2.SetPixel(xi, yi, c);
end;
BitBlt(Canvas.Handle, 0, 0, w - 1, h - 1, NewBmp.Canvas.Handle, 0, 0,
srccopy);
Dragging: Демонстрация перетаскивания картинки с помощью мыши, причем скорость попиксельного копирования сравнима с копированием фрагментов прямоугольников с помощью BitBlt или CopyRect:
xx := x0 + w - x;
yy := y0 + h - y;
//сдвиг относительно исходного положения. w и h добавляется во избежание проблем с отриц. числами
for xi := 0 to w - 1 do
for yi := 0 to h - 1 do
QP2.SetPixel(xi, yi, QP.GetPixel((xi + xx) mod w, (yi + yy) mod h));
BitBlt(Canvas.Handle, 0, 0, w - 1, h - 1, NewBmp.Canvas.Handle, 0, 0,
srccopy);
Rubber: Демонстрация реализации неаффинного преобразования, напоминающего резиновую поверхность с закрепленными краями. Ввиду примитивности алгоритма при искажении картинки могут наблюдаться некоторые артефакты. Для каждой точки искаженной картинки производится расчет соответствующей ей точки исходного образа таким образом: для нового положения мыши X (точка, за которую "тянут") и каждой точки Xi нового растра находится краевая точка привязки Xb, лежащая на луче X-Xi и коэффициент - параметрические координаты точки Xi на отрезке X-Xb, затем по этой краевой точке и начальному положению мыши в момент нажатия ("захвата") линейной интерполяцией находим координаты точки в исходном растре:
procedure CalcXY(xi, yi, x, y, x0, y0, w1, h1: Integer; var xx, yy: Integer);
var
xb, yb, cf: double;
begin
{quasirubber surface
x0 - old mouse coord
x- current
xi - new point
xx - old point (calculated from xi)
xb - sticking border point
-----------------
| |
| x0 x |
| |
| xi |
| xx |
| |
--xb------------- }
cf := y * xi - yi * x;
if (xi < x) then
begin
xb := 0;
yb := cf / (xi - x);
if yb < 0 then
begin
xb := cf / (y - yi);
yb := 0;
end;
if yb > h1 then
begin
xb := (h1 * (xi - x) - cf) / (yi - y);
yb := h1;
end;
end
else
begin
xb := w1;
yb := (cf + w1 * (yi - y)) / (xi - x);
if yb < 0 then
begin
xb := cf / (y - yi);
yb := 0;
end;
if yb > h1 then
begin
xb := (h1 * (xi - x) - cf) / (yi - y);
yb := h1;
end;
end;
if xb <> x then
xx := trunc(xb + (x0 - xb) * (xi - xb) / (x - xb));
if yb <> y then
yy := trunc(yb + (y0 - yb) * (yi - yb) / (y - yb));
end;
...
if (ssLeft in Shift) and PtInRect(rct, point(x, y)) then
begin
for xi := 0 to w - 1 do
for yi := 0 to h - 1 do
begin
CalcXY(xi, yi, x - Ord(xi = x), y, x0, y0, w, h, xx, yy);
if (xx >= 0) and (yy >= 0) and (xx < w) and (yy < h) then
begin
c := QP.GetPixel(xx, yy);
QP2.SetPixel(xi, yi, c);
end;
end;
BitBlt(Canvas.Handle, 0, 0, w - 1, h - 1, NewBmp.Canvas.Handle, 0, 0, srccopy);
end;
Можно загрузить и свою картинку в формате JPG или BMP и немного позабавиться над фотографией своей или босса ;). При установке флажка "KeepChanges" после отпускания кнопки мыши исходная картинка заменяется искаженной. При желании можно и сохранить плоды своего творчества.
procedure TForm1.LoadPicture;
var
JP: TJpegImage;
Bm: TBitmap;
ScaleX, ScaleY: Double;
NewX, NewY: Integer;
begin
JP := TJpegImage.Create;
Bm := TBitmap.Create;
try
if UpperCase(ExtractFileExt(OpenPictureDialog1.FileName))='.BMP' then
BM.LoadFromFile(OpenPictureDialog1.FileName)
else begin
JP.LoadFromFile(OpenPictureDialog1.FileName);
Bm.Assign(JP);
end;
ScaleX := Bm.Width / 400;
ScaleY := Bm.Height / 400;
if ScaleX > ScaleY then
if ScaleX > 1 then
begin
//масштабирование
NewX := 400;
NewY := Round(Bm.Height / ScaleX);
Bmp.Width := NewX;
Bmp.Height := NewY;
SetStretchBltMode(Bmp.Canvas.Handle, HALFTONE);
//Качественное сжатие срабатывает только в ОС NT-семейства. В Win9X масштабирование может выполняться с огрехами,
//но его можно без труда сделать и с использованием TQuickPixels со сглаживанием или интерполяцией
StretchBlt(Bmp.Canvas.Handle, 0, 0, NewX, NewY,
Bm.Canvas.Handle, 0, 0, Bm.Width, Bm.Height, SrcCopy);
end
else
Bmp.Assign(Bm)
else if ScaleY > 1 then
...
finally
JP.Free;
Bm.Free;
Effect:=0;
end;
end;
© Борис Новгородов, Алексей Радионов. 2003 г.
Другие статьи