Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
 
Купить недорогую недвижимость в крыму presidentrealty.ru/sea-house/krym/.

Поставить точку... Быстрый доступ к пикселам 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 г.
   Внимание! Запрещается перепечатка данной статьи или ее части без согласования с автором. Если вы хотите разместить эту статью на своем сайте или издать в печатном виде, свяжитесь с автором.
Автор статьи:  Борис Новгородов, Алексей Радионов.
  

Другие статьи Наверх


  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо