Быстрый доступ к пикселям Bitmap

Снова тема из разряда вечных. Быстрый доступ к пикселям необходим в первую очередь при работе с графикой, видео, и людям, которые стремятся делать конечный продукт хорошо и красиво.

Содержание скрыть

Подготовка экспериментальной площадки

Свойство Canvas.Pixels

Пиксель GDI+

Кнопка «IPBitmap»

ScanLine

Улучшенный метод ScanLine

Класс TxIPBitmapScan

Оптимизация

Большая картинка. Большой тест.

Выводы

Тема не закрыта

Скачать

Для подобных задач есть целая обойма технологий — DircetX, OpenGL, OpenCV и тому подобное. Позднее доберемся и до них. Но что делать, если в рамках локальной задачи необходимо поменять цветность картинки. Допустим, привлечь внимание к подозрительному «зависанию» процесса путем плавного наращивания красного.

Рис.1. Круговой прогресс бар с индикацией «зависания».

Либо определить оставшиеся кегли после броска в боулинге. Или посчитать количество головок сыра прошедших по конвейеру в реальном времени. Не стану же я тащить всю эту мощь в скромный проект.

Рис.2. Определение устоявших кегель и подсчет голов сыра

Для начала сформулируем требования, которые желательно соблюсти в поиске решения. Помимо скорости, хотелось бы видеть некое стандартное решение без установки дополнительных библиотек. Чтобы не таскать потом вместе с проектом кучу мусора, в виде необходимых, но неиспользуемых dll. Чтобы конечный продукт не требовал установки чего-либо дополнительного на машине пользователя.

Также, попытаемся обойтись без ассемблера. В свое время увлечение скоростью обработки (но правда, строк) вылилось в муки перевода ассемблерного кода на 64-битные рельсы. Главная задача — найти простое, понятное и легко переносимое решение, которое всегда под рукой.

Подготовка экспериментальной площадки

Работа с битовой матрицей почти всегда строится по принципу — идем по всей матрице W x H и что-то делаем с каждым пикселем. В 99.9% случаев упрощенно это выглядит так:

function DoSomething(const ABitmap: TBitmap): TBitmap;
var 
  x,y: Integer;
  w,h: Integer;
  clr: TColor;
begin
  w := ABitmap.Width;
  h := ABitmap.Height;
  Result := CreateBitmap(w, h);

  for y := 0 to h-1 do begin
    for x := 0 to w-1 do begin
      clr := ABitmap.Pixel[x,y];
      clr := Something(clr,x,y,...);
      Result.pixel[x,y] := clr;
    end;
  end;
end;

function DoSomething(const ABitmap: TBitmap): TBitmap;

var

x,y: Integer;

w,h: Integer;

clr: TColor;

begin

w := ABitmap.Width;

h := ABitmap.Height;

Result := CreateBitmap(w, h);

for y := 0 to h-1 do begin

for x := 0 to w-1 do begin

clr := ABitmap.Pixel[x,y];

clr := Something(clr,x,y,...);

Result.pixel[x,y] := clr;

end;

Пока сделаем простую операцию с пикселем — инвертирование:

function InvertColor(clr: TColor): TColor;
begin
  Result := RGB(
    255-GetRValue(clr),
    255-GetGValue(clr),
    255-GetBValue(clr));
end;

function InvertColor(clr: TColor): TColor;

begin

Result := RGB(

255-GetRValue(clr),

255-GetGValue(clr),

255-GetBValue(clr));

end;

Все методы обработки имеют одинаковую «сигнатуру»:

function InvertMethodName(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;

function InvertMethodName(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

ABitmap — искомая битовая матрица, которую надо инвертировать.
AEvent — событие TNotifyEvent, в котором Sender на самом деле целочисленный процент выполнения.

Генерация события происходит следующей процедурой:

function DoEvent(AOld: Integer; APrc: Single; 
  AEvent: TNotifyEvent): Integer;
begin
  Result := Round(APrc*100);
  if (AOld <> Result) and (Assigned(AEvent)) then
    AEvent(TObject(Result));
end;

function DoEvent(AOld: Integer; APrc: Single;

AEvent: TNotifyEvent): Integer;

begin

Result := Round(APrc*100);

if (AOld <> Result) and (Assigned(AEvent)) then

AEvent(TObject(Result));

end;

Вызов из каждого метода таков:

if Assigned (AEvent) then 
  old := DoEvent(old, y/h, AEvent);

1 2	if Assigned (AEvent) then old := DoEvent(old, y/h, AEvent);

Сделано так с целью минимизировать время на вызов события и «рисование» прогресс бара в главном окне. Потому что ну как же без прогресса.

Обработчик события в форме очень прост:

procedure TFmPixMain.ProcessEvent(Sender: TObject);
begin
  FCurrPercent := Integer(Sender);
  sbr.Invalidate;
  Application.ProcessMessages;
end;

procedure TFmPixMain.ProcessEvent(Sender: TObject);

begin

FCurrPercent := Integer(Sender);

sbr.Invalidate;

Application.ProcessMessages;

end;

Вызовы методов доступа к пикселям реализованы как кнопки в интерфейсе (фрагмент метода btnStandartClick):

  // стартуем процесс
  FProcessMode := True;
  FCurrPercent := 0;
  UpdateMenu;
  // инициализация
  BmpMethod := xbmStandart;
  tmp := GetTickCount;

  try
    // Будет произведена легкая оптимизация выполнения
    GPixOptimization := chbOptimization.Checked;
    // Работать с 32 или 24 битной матрицей
    G32BitsBitmap := chb32bits.Checked;

    if Sender = btnStandart then BmpMethod := xbmStandart;
    if Sender = btnGDIP then BmpMethod := xbmGDIPStandart;
    if Sender = btnGDIPCanvas then BmpMethod := xbmGDIPCanvas;
    if Sender = btnScanLine then BmpMethod := xbmScanLine;
    if Sender = btnScanLineXY then BmpMethod := xbmScanLineXY;
    if Sender = btnScanLineXYTwo then 
      BmpMethod := xbmScanLineXYTwo;
    if Sender = btnBitmapScan then BmpMethod := xbmBitmapScanXY;

    // Генерация события отбирает время, поэтому при большой
    // картинке - событие нежелательно
    if cbhEvent.Checked then
      PixEvent := ProcessEvent
    else
      PixEvent := nil;

    FBitmap := InvertColors(FSource, BmpMethod, PixEvent);

  finally
    tmp := GetTickCount - tmp;
    sbr.Panels[2].Text := 'Time: ' + IntToStr(tmp);
    SetLabelText(BmpMethod, Sender, IntToStr(tmp));
    imgRes.Picture.Assign(FBitmap);
    FProcessMode := False;
    UpdateMenu;
  end;
end;

// стартуем процесс

FProcessMode := True;

FCurrPercent := 0;

UpdateMenu;

// инициализация

BmpMethod := xbmStandart;

tmp := GetTickCount;

try

// Будет произведена легкая оптимизация выполнения

GPixOptimization := chbOptimization.Checked;

// Работать с 32 или 24 битной матрицей

G32BitsBitmap := chb32bits.Checked;

if Sender = btnStandart then BmpMethod := xbmStandart;

if Sender = btnGDIP then BmpMethod := xbmGDIPStandart;

if Sender = btnGDIPCanvas then BmpMethod := xbmGDIPCanvas;

if Sender = btnScanLine then BmpMethod := xbmScanLine;

if Sender = btnScanLineXY then BmpMethod := xbmScanLineXY;

if Sender = btnScanLineXYTwo then

BmpMethod := xbmScanLineXYTwo;

if Sender = btnBitmapScan then BmpMethod := xbmBitmapScanXY;

// Генерация события отбирает время, поэтому при большой

// картинке - событие нежелательно

if cbhEvent.Checked then

PixEvent := ProcessEvent

else

PixEvent := nil;

FBitmap := InvertColors(FSource, BmpMethod, PixEvent);

finally

tmp := GetTickCount - tmp;

sbr.Panels[2].Text := 'Time: ' + IntToStr(tmp);

SetLabelText(BmpMethod, Sender, IntToStr(tmp));

imgRes.Picture.Assign(FBitmap);

FProcessMode := False;

UpdateMenu;

end;

Из кода можно сделать вывод, что есть некий режим оптимизации (в самом конце статьи) и есть возможность не генерировать событие выполнения (для получения «чистых» оценок времени).

Также видим, что на все обработки вызывается одна функция. Она выполняет роль диспетчера:

function InvertColors(const ABitmap: TBitmap; 
  const AOper: TxBitmapMethod;
  const AEvent: TNotifyEvent = nil): TBitmap;
begin
  Result := nil;
  if (not Assigned(ABitmap)) then
    Exit;

  case AOper of
    xbmStandart: 
      Result := InvertStandart(ABitmap, AEvent);
    xbmGDIPStandart: 
      Result := InvertGDIP(ABitmap, AEvent);
    xbmGDIPCanvas: 
      Result := InvertGDIPCanvas(ABitmap, AEvent);
    xbmScanLine: 
      Result := InvertScanLine(ABitmap, AEvent);
    xbmScanLineXY: 
      Result := InvertScanLineXY(ABitmap, AEvent);
    xbmScanLineXYTwo: 
      Result := InvertScanLineXYTwo(ABitmap, AEvent);
    xbmBitmapScanXY: 
      Result := InvertIPBitmapScanLine(ABitmap, AEvent);
  end;
end;

function InvertColors(const ABitmap: TBitmap;

const AOper: TxBitmapMethod;

const AEvent: TNotifyEvent = nil): TBitmap;

begin

Result := nil;

if (not Assigned(ABitmap)) then

Exit;

case AOper of

xbmStandart:

Result := InvertStandart(ABitmap, AEvent);

xbmGDIPStandart:

Result := InvertGDIP(ABitmap, AEvent);

xbmGDIPCanvas:

Result := InvertGDIPCanvas(ABitmap, AEvent);

xbmScanLine:

Result := InvertScanLine(ABitmap, AEvent);

xbmScanLineXY:

Result := InvertScanLineXY(ABitmap, AEvent);

xbmScanLineXYTwo:

Result := InvertScanLineXYTwo(ABitmap, AEvent);

xbmBitmapScanXY:

Result := InvertIPBitmapScanLine(ABitmap, AEvent);

end;

Описывать весь проект смысла не вижу, легче скачать и посмотреть.

Интерфейс прост. Имеем 4 кнопки под рисунком, это выбор предопределенного изображения. Можем вставить из буфера обмена кнопкой «Paste» или загрузить из файла кнопкой «Load». Остальные кнопки — выбор метода. В строке статуса видим размерность изображения и примерное время выполнения. Сейчас на рисунке очень долгое время выполнения самого первого метода — Standart. Этот метод использует самое простое — свойство Pixels Canvas’а битовой матрицы.

Свойство Canvas.Pixels

Рано или поздно всем приходилось сталкиваться со стандартным свойством TCanvas.Pixels[x,y]. Ничего кроме расстройства это свойство не принесло. Останавливаться долго не будем и возвращаться к нему тоже. Но для полноты картины должен был о нем упомянуть.

Использование Canvas.Pixels

//**********************************************************************
//  Стнадартный доступ к пикселям через св-во Pixels[x,y]
//**********************************************************************
function InvertStandart(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    clr: TColor;
    old: Integer;
begin
  old := 0;
  h := ABitmap.Height;
  w := ABitmap.Width;
  Result := CreateBitmap(w,h);

  // Так будет быстрее, что погоды в этом случае не сделает
  ABitmap.PixelFormat := pf24bit;
  Result.PixelFormat := pf24bit;

  for y := 0 to h-1 do begin
    for x := 0 to w-1 do begin
      clr := ABitmap.Canvas.Pixels[x,y];
      clr := InvertColor(clr);
      Result.Canvas.Pixels[x,y] := clr;
    end;
    if Assigned (AEvent) then
      old := DoEvent(old, y/h, AEvent);
  end;
end;

//**********************************************************************

// Стнадартный доступ к пикселям через св-во Pixels[x,y]

//**********************************************************************

function InvertStandart(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

clr: TColor;

old: Integer;

begin

old := 0;

h := ABitmap.Height;

w := ABitmap.Width;

Result := CreateBitmap(w,h);

// Так будет быстрее, что погоды в этом случае не сделает

ABitmap.PixelFormat := pf24bit;

Result.PixelFormat := pf24bit;

for y := 0 to h-1 do begin

for x := 0 to w-1 do begin

clr := ABitmap.Canvas.Pixels[x,y];

clr := InvertColor(clr);

Result.Canvas.Pixels[x,y] := clr;

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

[свернуть]

На рис.3 видно, что время выполнения 3578 миллисекунд для картинки размером 900 x 900 пикселей. Если мы хотим обрабатывать видео «на лету» со скоростью 25 кадров/сек, можно навсегда забыть об этом методе.

А что скажет GDI+ по этому поводу?

Пиксель GDI+

В GDI+ тоже есть GetPixel(x,y) и SetPixel(x,y). Чтобы не тратить много времени на описание принципов работы с ним, перейдем сразу к листингу.

Пиксели в GDI+

//**********************************************************************
//  Доступ к пикселям в GDI+ стандартно
//**********************************************************************
function InvertGDIP(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    clr: Cardinal;
    old: Integer;
    src: TGPBitmap;
    dst: TGPBitmap;
    MemSrc : TMemoryStream;
begin
  // MemSrc должен существовать до окончания всех
  // манипуляций с bitmap, иначе изображение может
  // оказаться "неполным" или "обрезанным"
  MemSrc := nil;

  // Создание экземпляра TGPBitmap из TBitmap.
  // Функции, используемые в этом листинге, находятся
  // в модуле PixelsGDIPBitmap.
  src := LoadGPBitmapFromGraphic(ABitmap, MemSrc);

  old := 0;
  h := src.GetHeight;
  w := src.GetWidth;
  dst := TGPBitmap.Create(w,h);

  try
    // Почти один-в-один с предыдущим методом
    for y := 0 to h-1 do  begin
      for x := 0 to w-1 do begin
        src.GetPixel(x,y,clr);
        clr := InvertColor(clr);
        dst.SetPixel(x,y,clr);
      end;
      if Assigned (AEvent) then
        old := DoEvent(old, y/h, AEvent);
    end;
    // детали реализации в PixelsGDIPBitmap
    Result := SaveGPBitmapToBitmap(dst);

  finally
    FreeAndNil(MemSrc);
    FreeAndNil(Src);
    FreeAndNil(Dst);
  end;
end;

//**********************************************************************

// Доступ к пикселям в GDI+ стандартно

//**********************************************************************

function InvertGDIP(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

clr: Cardinal;

old: Integer;

src: TGPBitmap;

dst: TGPBitmap;

MemSrc : TMemoryStream;

begin

// MemSrc должен существовать до окончания всех

// манипуляций с bitmap, иначе изображение может

// оказаться "неполным" или "обрезанным"

MemSrc := nil;

// Создание экземпляра TGPBitmap из TBitmap.

// Функции, используемые в этом листинге, находятся

// в модуле PixelsGDIPBitmap.

src := LoadGPBitmapFromGraphic(ABitmap, MemSrc);

old := 0;

h := src.GetHeight;

w := src.GetWidth;

dst := TGPBitmap.Create(w,h);

try

// Почти один-в-один с предыдущим методом

for y := 0 to h-1 do begin

for x := 0 to w-1 do begin

src.GetPixel(x,y,clr);

clr := InvertColor(clr);

dst.SetPixel(x,y,clr);

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

// детали реализации в PixelsGDIPBitmap

Result := SaveGPBitmapToBitmap(dst);

finally

FreeAndNil(MemSrc);

FreeAndNil(Src);

FreeAndNil(Dst);

end;

[свернуть]

Казалось бы, все очень просто. Действительно просто, если не глянуть в PixelsGDIPBitmap, который был написан специально для этой функции.

Модуль PixelsGDIPBitmap. Работа с bitmap GDI+

unit PixelsGDIPBitmap;
//***********************************************************************
//    Вспомогательный модуль для работы с bitmap GDI+
//***********************************************************************
//       Author: ©Roman Romanov boss@small-pro.com
//      Project: IP76.RU' 2020
//  Description: Преобразование TBitmap в TGPBitmap и обратно
//***********************************************************************

interface
uses
  Windows, Classes, SysUtils, Graphics
  //-- GDI+ ------------------------------------------------
  , GDIPAPI, GDIPOBJ
  ;

//***********************************************************************
//  Преобразовать TGraphic в TGPBitmap
//***********************************************************************
function LoadGPBitmapFromGraphic(const AGraphic : TGraphic;
  var AMemStream: TMemoryStream) : TGPBitmap;

//***********************************************************************
//  Преобразовать TGPBitmap в TBitmap
//***********************************************************************
function SaveGPBitmapToBitmap(const AImage: TGPImage): TBitmap;

implementation

uses
  ActiveX;

type
  TMyStreamAdapter = class(TStreamAdapter)
  public
    function Stat(out statstg: TStatStg;
        grfStatFlag: {$IF CompilerVersion >= 30}
        DWORD {$ELSE} Longint {$ENDIF}
        ): HResult; override; stdcall;
  end;

//***********************************************************************
//  Решение проблемы с несовместимым форматом для PNG
//***********************************************************************
function TMyStreamAdapter.Stat(out statstg: TStatStg;
        grfStatFlag: {$IF CompilerVersion >= 30}
        DWORD {$ELSE} Longint {$ENDIF}
       ): HResult;
//-----------------------------------------------------------
 function DateTimeToFileTime(DateTime: TDateTime): TFileTime;
  const FileTimeBase = - 109205.0;
        // 10 наносекунд в день
        FileTimeStep: extended = 24.0 * 60.0 * 60.0 *
          1000.0 * 1000.0 * 10.0;
  var E: extended;
      F64: int64;
 begin
   E := (DateTime - FileTimeBase) * FileTimeStep;
   F64 := Round(E);
   Result := TFileTime(F64);
 end;
//-----------------------------------------------------------
begin
  Result := S_OK;
  try
   if (@statstg <> nil) then
    with statstg do
     begin
       FillChar(statstg, sizeof(statstg), 0);
       dwType := STGTY_STREAM;
       cbSize := Stream.Size;
       mTime := DateTimeToFileTime(now);
       cTime := DateTimeToFileTime(now);
       aTime := DateTimeToFileTime(now);
       grfLocksSupported := LOCK_WRITE;
     end;
  except
   Result := E_UNEXPECTED;
  end;
end;

//***********************************************************************
//  Найти GUID encoder'а или decoder'а (AEncode = False)
//  для запрошенного графического формата (AGUID: TGUID).
//  Тут используется только для Bitmap (ImageFormatBMP)
//***********************************************************************
function FindCodec(const AGUID: TGUID;
  const AEncode: boolean = True): TGUID;
var
  Nums: Cardinal;
  Size: Cardinal;
  Codecs: Array of TImageCodecInfo;
  I: Integer;
begin
  Result := TGUID.Empty;

  if (AEncode and (GetImageEncodersSize(Nums, Size) <> ok)) then
    Exit;
  if ((not AEncode) and (GetImageDecodersSize(Nums, Size) <> ok)) then
    Exit;
  if ((Nums <= 0) or (Size < SizeOf(TImageCodecInfo))) then
    Exit;

  SetLength(Codecs, Size div SizeOf(TImageCodecInfo));

  try
    if (AEncode and
       (GetImageEncoders(Nums, Size, PImageCodecInfo(@Codecs[0])) <> ok))
    then
      Abort;
    if ((not AEncode) and
       (GetImageDecoders(Nums, Size, PImageCodecInfo(@Codecs[0])) <> ok))
    then
      Abort;

    for i := 0 to Nums - 1 do
      if IsEqualGUID(Codecs[i].FormatID, AGUID) then
      begin
        Result := Codecs[i].Clsid;
        Break;
      end;

  finally
    SetLength(Codecs,0);
  end;
end;


const
  EmptyGuid: TGUID = '{00000000-0000-0000-0000-000000000000}';

var
  BMPEncode: TGUID = '{00000000-0000-0000-0000-000000000000}';

function GetBMPFormatEncoder: TGUID;
begin
  if IsEqualGUID (BMPEncode, EmptyGuid) then
    BMPEncode := FindCodec(ImageFormatBMP, True);
  Result := BMPEncode;
end;

//***********************************************************************
//  Преобразовать TGraphic в TGPBitmap
//***********************************************************************
function LoadGPBitmapFromGraphic (const AGraphic : TGraphic;
  var AMemStream: TMemoryStream): TGPBitmap;
var
  TmpBitmap: TGPBitmap;
  ImgStream: IStream;
begin
  AMemStream := TMemoryStream.Create;
  AMemStream.Position := 0;

  AGraphic.SaveToStream(AMemStream);
  AMemStream.Position := 0;

  TmpBitmap := TGPBitmap.Create;
  try
    ImgStream := TMyStreamAdapter.Create(AMemStream, soReference) as IStream;
    Result := TmpBitmap.FromStream(ImgStream);

  finally
    FreeAndNil(TmpBitmap);
  end;
end;

//***********************************************************************
//  Сохранить TGPImage в поток AStream
//***********************************************************************
function SaveToStream(const AImage: TGPImage;
  const AStream: TStream): Boolean;
var
  ImgStream: IStream;
  Encoder: TGUID;
begin
  Result := (Assigned(AImage) and Assigned(AStream));

  if Result then
  begin
    Encoder := GetBMPFormatEncoder;
    Result := (not IsEqualGUID(Encoder, EmptyGuid));
  end;

  if Result then
  begin
    ImgStream := TMyStreamAdapter.Create(AStream, soReference) as IStream;
    Result := (AImage.Save(ImgStream, Encoder) = Ok);
  end;
end;

//***********************************************************************
//  Преобразовать TGPBitmap в TBitmap
//***********************************************************************
function SaveGPBitmapToBitmap(const AImage: TGPImage): TBitmap;
var
  mem: TMemoryStream;
begin
  Result := nil;
  mem := TMemoryStream.Create;

  try
    mem.Position := 0;
    if SaveToStream(AImage, mem) then
    begin
      mem.Position := 0;
      Result := TBitmap.Create;
      Result.LoadFromStream(mem);
    end;

  except
    FreeAndNil(Result);
  end;

  FreeAndNil(mem);
end;
end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

unit PixelsGDIPBitmap;

//***********************************************************************

// Вспомогательный модуль для работы с bitmap GDI+

//***********************************************************************

// Author: ©Roman Romanov boss@small-pro.com

// Project: IP76.RU' 2020

// Description: Преобразование TBitmap в TGPBitmap и обратно

//***********************************************************************

interface

uses

Windows, Classes, SysUtils, Graphics

//-- GDI+ ------------------------------------------------

, GDIPAPI, GDIPOBJ

;

//***********************************************************************

// Преобразовать TGraphic в TGPBitmap

//***********************************************************************

function LoadGPBitmapFromGraphic(const AGraphic : TGraphic;

var AMemStream: TMemoryStream) : TGPBitmap;

//***********************************************************************

// Преобразовать TGPBitmap в TBitmap

//***********************************************************************

function SaveGPBitmapToBitmap(const AImage: TGPImage): TBitmap;

implementation

uses

ActiveX;

type

TMyStreamAdapter = class(TStreamAdapter)

public

function Stat(out statstg: TStatStg;

grfStatFlag: {$IF CompilerVersion >= 30}

DWORD {$ELSE} Longint {$ENDIF}

): HResult; override; stdcall;

end;

//***********************************************************************

// Решение проблемы с несовместимым форматом для PNG

//***********************************************************************

function TMyStreamAdapter.Stat(out statstg: TStatStg;

grfStatFlag: {$IF CompilerVersion >= 30}

DWORD {$ELSE} Longint {$ENDIF}

): HResult;

//-----------------------------------------------------------

function DateTimeToFileTime(DateTime: TDateTime): TFileTime;

const FileTimeBase = - 109205.0;

// 10 наносекунд в день

FileTimeStep: extended = 24.0 * 60.0 * 60.0 *

1000.0 * 1000.0 * 10.0;

var E: extended;

F64: int64;

begin

E := (DateTime - FileTimeBase) * FileTimeStep;

F64 := Round(E);

Result := TFileTime(F64);

end;

//-----------------------------------------------------------

begin

Result := S_OK;

try

if (@statstg <> nil) then

with statstg do

begin

FillChar(statstg, sizeof(statstg), 0);

dwType := STGTY_STREAM;

cbSize := Stream.Size;

mTime := DateTimeToFileTime(now);

cTime := DateTimeToFileTime(now);

aTime := DateTimeToFileTime(now);

grfLocksSupported := LOCK_WRITE;

end;

except

Result := E_UNEXPECTED;

end;

//***********************************************************************

// Найти GUID encoder'а или decoder'а (AEncode = False)

// для запрошенного графического формата (AGUID: TGUID).

// Тут используется только для Bitmap (ImageFormatBMP)

//***********************************************************************

function FindCodec(const AGUID: TGUID;

const AEncode: boolean = True): TGUID;

var

Nums: Cardinal;

Size: Cardinal;

Codecs: Array of TImageCodecInfo;

I: Integer;

begin

Result := TGUID.Empty;

if (AEncode and (GetImageEncodersSize(Nums, Size) <> ok)) then

Exit;

if ((not AEncode) and (GetImageDecodersSize(Nums, Size) <> ok)) then

Exit;

if ((Nums <= 0) or (Size < SizeOf(TImageCodecInfo))) then

Exit;

SetLength(Codecs, Size div SizeOf(TImageCodecInfo));

try

if (AEncode and

(GetImageEncoders(Nums, Size, PImageCodecInfo(@Codecs[0])) <> ok))

then

Abort;

if ((not AEncode) and

(GetImageDecoders(Nums, Size, PImageCodecInfo(@Codecs[0])) <> ok))

then

Abort;

for i := 0 to Nums - 1 do

if IsEqualGUID(Codecs[i].FormatID, AGUID) then

begin

Result := Codecs[i].Clsid;

Break;

end;

finally

SetLength(Codecs,0);

end;

const

EmptyGuid: TGUID = '{00000000-0000-0000-0000-000000000000}';

var

BMPEncode: TGUID = '{00000000-0000-0000-0000-000000000000}';

function GetBMPFormatEncoder: TGUID;

begin

if IsEqualGUID (BMPEncode, EmptyGuid) then

BMPEncode := FindCodec(ImageFormatBMP, True);

Result := BMPEncode;

end;

//***********************************************************************

// Преобразовать TGraphic в TGPBitmap

//***********************************************************************

function LoadGPBitmapFromGraphic (const AGraphic : TGraphic;

var AMemStream: TMemoryStream): TGPBitmap;

var

TmpBitmap: TGPBitmap;

ImgStream: IStream;

begin

AMemStream := TMemoryStream.Create;

AMemStream.Position := 0;

AGraphic.SaveToStream(AMemStream);

AMemStream.Position := 0;

TmpBitmap := TGPBitmap.Create;

try

ImgStream := TMyStreamAdapter.Create(AMemStream, soReference) as IStream;

Result := TmpBitmap.FromStream(ImgStream);

finally

FreeAndNil(TmpBitmap);

end;

//***********************************************************************

// Сохранить TGPImage в поток AStream

//***********************************************************************

function SaveToStream(const AImage: TGPImage;

const AStream: TStream): Boolean;

var

ImgStream: IStream;

Encoder: TGUID;

begin

Result := (Assigned(AImage) and Assigned(AStream));

if Result then

begin

Encoder := GetBMPFormatEncoder;

Result := (not IsEqualGUID(Encoder, EmptyGuid));

end;

if Result then

begin

ImgStream := TMyStreamAdapter.Create(AStream, soReference) as IStream;

Result := (AImage.Save(ImgStream, Encoder) = Ok);

end;

//***********************************************************************

// Преобразовать TGPBitmap в TBitmap

//***********************************************************************

function SaveGPBitmapToBitmap(const AImage: TGPImage): TBitmap;

var

mem: TMemoryStream;

begin

Result := nil;

mem := TMemoryStream.Create;

try

mem.Position := 0;

if SaveToStream(AImage, mem) then

begin

mem.Position := 0;

Result := TBitmap.Create;

Result.LoadFromStream(mem);

end;

except

FreeAndNil(Result);

end;

FreeAndNil(mem);

end;

end.

[свернуть]

К сожалению, GDIP не поддерживает стандартные для Delphi типы TGraphic. Поэтому работа с GDI+ осложняется необходимостью писать много кода. Этот модуль написан всего лишь для того, чтобы получить TGPBitmap из TBitmap, и наоборот, из получившегося TGPBitmap забрать TBitmap.

Для себя эту проблему решил в свое время. Написал наследника TCanvas, который реализует в себе как стандартные вызовы, так и вызовы GDI+. А также ряд классов-оберток над TGPPen, TGPBrush и TGPImage. Все рутинные вещи спрятаны «под капот». Ниже иллюстрация как тоже самое выглядело бы с использованием TxGDIPBitmap.

Кнопка «IPBitmap»

Код, в принципе, не сильно отличается от предыдущего. Отличие в том, что вся рутина, частично представленная в PixelsGDIPBitmap убрана.

пример использования TxGDIPBitmap

//**********************************************************************
//  Доступ к пикселям в GDI+ стандартным образом, но через TxGDIPBitmap
//**********************************************************************
function InvertGDIPCanvas (const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    clr: Cardinal;
    old: Integer;
    src: TxGDIPBitmap;
    dst: TxGDIPBitmap;
begin
  src := TxGDIPBitmap.Create(ABitmap);
  old := 0;
  h := src.Height;
  w := src.Width;
  dst := TxGDIPBitmap.Create(w,h);

  try
    for y := 0 to h-1 do begin
      for x := 0 to w-1 do begin
        src.GPBitmap.GetPixel(x,y,clr);
        clr := InvertColor(clr);
        dst.GPBitmap.SetPixel(x,y,clr);
      end;
      if Assigned (AEvent) then
        old := DoEvent(old, y/h, AEvent);
    end;
    Result := dst.SaveToGraphic(xifBMP) as TBitmap;

  finally
    FreeAndNil(Src);
    FreeAndNil(Dst);
  end;
end;

//**********************************************************************

// Доступ к пикселям в GDI+ стандартным образом, но через TxGDIPBitmap

//**********************************************************************

function InvertGDIPCanvas (const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

clr: Cardinal;

old: Integer;

src: TxGDIPBitmap;

dst: TxGDIPBitmap;

begin

src := TxGDIPBitmap.Create(ABitmap);

old := 0;

h := src.Height;

w := src.Width;

dst := TxGDIPBitmap.Create(w,h);

try

for y := 0 to h-1 do begin

for x := 0 to w-1 do begin

src.GPBitmap.GetPixel(x,y,clr);

clr := InvertColor(clr);

dst.GPBitmap.SetPixel(x,y,clr);

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

Result := dst.SaveToGraphic(xifBMP) as TBitmap;

finally

FreeAndNil(Src);

FreeAndNil(Dst);

end;

[свернуть]

Итак, что имеем. Тот же рисунок, но время 265 мсек. Ура! О нет, еще не ура, это слишком долго.

Пожалуй, не все возможности стандартного TBitmap исчерпаны. Знающие люди понимают, что переходим к замечательному свойству ScanLine.

ScanLine

Как любой продвинутый инструмент обязательно имеет скрытые нюансы эксплуатации, так и ScanLine не всегда столь хорош, как может показаться с первого взгляда.

Небольшое отступление. Бытует мнение, что для ScanLine оптимальным является формат pf24bit. Чтобы проверить это утверждение, добавим checkbox «32 bits». Если на нем будет галка, работаем с 32-битной матрицей, иначе — с 24-битной.

Инициализация матриц перед использованием такова:

//***************************************************************
//  Вспомогательная инициализация
//***************************************************************
function InitBitmaps(const ASrc, ADst: TBitmap): Integer;
var
  PixelFmt: Graphics.TPixelFormat;
begin
  if G32BitsBitmap then begin
    PixelFmt := pf32bit;
    Result := 4;
  end else begin
    PixelFmt := pf24bit;
    Result := 3;
  end;
  ASrc.PixelFormat := PixelFmt;
  ADst.PixelFormat := PixelFmt;
end;

//***************************************************************

// Вспомогательная инициализация

//***************************************************************

function InitBitmaps(const ASrc, ADst: TBitmap): Integer;

var

PixelFmt: Graphics.TPixelFormat;

begin

if G32BitsBitmap then begin

PixelFmt := pf32bit;

Result := 4;

end else begin

PixelFmt := pf24bit;

Result := 3;

end;

ASrc.PixelFormat := PixelFmt;

ADst.PixelFormat := PixelFmt;

end;

И сам метод:

Использование TBitmap.ScanLine

//**********************************************************************
//  Доступ к пикселям через св-во ScanLine[y]
//**********************************************************************
function InvertScanLine(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    old: Integer;
    clr: TColor;
    src: PByte;
    dst: PByte;
    Size: Integer;
begin
  old := 0;
  h := ABitmap.Height;
  w := ABitmap.Width;
  Result := CreateBitmap(w, h);
  Size := InitBitmaps(ABitmap, Result);

  for y := 0 to h - 1 do
  begin
    src := ABitmap.ScanLine[y];
    dst := Result.ScanLine[y];

    for x := 0 to w - 1 do
    begin
      clr := InvertColor(RGB(PRGBQuad(src)^.rgbRed,
          PRGBQuad(src)^.rgbGreen, PRGBQuad(src)^.rgbBlue));
      PRGBQuad(dst)^.rgbRed   := GetRValue(clr);
      PRGBQuad(dst)^.rgbGreen := GetGValue(clr);
      PRGBQuad(dst)^.rgbBlue  := GetBValue(clr);
      inc(src, Size);
      inc(dst, Size);
    end;
    if Assigned (AEvent) then 
      old := DoEvent(old, y/h, AEvent);
  end;
end;

//**********************************************************************

// Доступ к пикселям через св-во ScanLine[y]

//**********************************************************************

function InvertScanLine(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

old: Integer;

clr: TColor;

src: PByte;

dst: PByte;

Size: Integer;

begin

old := 0;

h := ABitmap.Height;

w := ABitmap.Width;

Result := CreateBitmap(w, h);

Size := InitBitmaps(ABitmap, Result);

for y := 0 to h - 1 do

begin

src := ABitmap.ScanLine[y];

dst := Result.ScanLine[y];

for x := 0 to w - 1 do

begin

clr := InvertColor(RGB(PRGBQuad(src)^.rgbRed,

PRGBQuad(src)^.rgbGreen, PRGBQuad(src)^.rgbBlue));

PRGBQuad(dst)^.rgbRed := GetRValue(clr);

PRGBQuad(dst)^.rgbGreen := GetGValue(clr);

PRGBQuad(dst)^.rgbBlue := GetBValue(clr);

inc(src, Size);

inc(dst, Size);

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

[свернуть]

Время 62 мсек. Скорость просто сказочная. Также выяснили, что от формата матрицы, 24 или 32 бита, скорость никак не зависит. Но, к сожалению, есть нюанс.

Сейчас алгоритм таков. Мы знаем, что scan-линии идут горизонтально. Поэтому первый цикл у нас по Y. Мы получаем в цикле указатель на начало очередной линии и во вложенном цикле по X смещаем указатель. Таким образом, выходим на следующий пиксель. Это идеальный вариант.

Но в жизни нам чаще всего приходится считать конечную точку (пиксель) на основании значений, расположенных и выше, и ниже, и по бокам заданной координаты. Также, эксперимент не совсем «чистый». В предыдущих методах мы обращаемся к пикселю по координатам, а тут «хитрим».

Напишем «честный» вариант:

Подсчет смещений для X и Y в вызовах TBitmap.ScanLine

//**********************************************************************
//  Доступ к пикселям через св-во ScanLine[y], но с расчетом X Y
//**********************************************************************
function InvertScanLineXY(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    old: Integer;
    clr: TColor;
    src: PRGBTriple;
    dst: PRGBTriple;
    Size: Integer;
begin
  old := 0;
  h := ABitmap.Height;
  w := ABitmap.Width;
  Result := CreateBitmap(w, h);
  Size := InitBitmaps(ABitmap, Result);

  for y := 0 to h-1 do begin
    for x := 0 to w-1 do begin
      src := PRGBTriple(Integer(ABitmap.ScanLine[y]) + x*Size);
      dst := PRGBTriple(Integer(Result.ScanLine[y])  + x*Size);
      clr := InvertColor(RGB(src^.rgbtRed, src^.rgbtGreen, src^.rgbtBlue));
      dst^.rgbtRed   := GetRValue(clr);
      dst^.rgbtGreen := GetGValue(clr);
      dst^.rgbtBlue  := GetBValue(clr);
    end;
    if Assigned (AEvent) then
      old := DoEvent(old, y/h, AEvent);
  end;
end;

//**********************************************************************

// Доступ к пикселям через св-во ScanLine[y], но с расчетом X Y

//**********************************************************************

function InvertScanLineXY(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

old: Integer;

clr: TColor;

src: PRGBTriple;

dst: PRGBTriple;

Size: Integer;

begin

old := 0;

h := ABitmap.Height;

w := ABitmap.Width;

Result := CreateBitmap(w, h);

Size := InitBitmaps(ABitmap, Result);

for y := 0 to h-1 do begin

for x := 0 to w-1 do begin

src := PRGBTriple(Integer(ABitmap.ScanLine[y]) + x*Size);

dst := PRGBTriple(Integer(Result.ScanLine[y]) + x*Size);

clr := InvertColor(RGB(src^.rgbtRed, src^.rgbtGreen, src^.rgbtBlue));

dst^.rgbtRed := GetRValue(clr);

dst^.rgbtGreen := GetGValue(clr);

dst^.rgbtBlue := GetBValue(clr);

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

[свернуть]

Время стало 3688 мсек. Хуже, чем Canvas.Pixels. То есть, хуже и быть не может…. Не рановато ли метод отправлен на свалку истории?

Проблема конечно не в «честности», а в том, чтобы брать пиксель от произвольной координаты. Поэтому снова модифицируем код.

Улучшенный метод ScanLine

Идея в следующем. ScanLine берет свое значение как смещение от поля bmBits внутренней структуры типа tagBITMAP, которая содержится внутри класса TBitmap, и наружу не торчит ни единым методом или свойством. Инициализация структуры происходит в том числе и в момент запроса ScanLine, если ранее не была создана.

Таким образом, если перед нашими циклами запросить нулевые ScanLine, тем самым получив указатель на bmBits (массив битов растрового изображения), и потом, в цикле, правильно находить нужное смещение, можно предположить выигрыш в скорости.

Произвольный X,У при использовании TBitmap.ScanLine

//**********************************************************************
//  Доступ к пикселям через св-во ScanLine[y] с "умным" расчетом X, Y,
//**********************************************************************
function InvertScanLineXYTwo(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    old: Integer;
    clr: TColor;
    src: PRGBTriple;
    dst: PRGBTriple;
    s: PByte;
    d: PByte;
    BytesPerScan: Integer;
    BytesOffset: Integer;
    Size: Integer;
begin
  old := 0;
  h := ABitmap.Height;
  w := ABitmap.Width;
  Result := CreateBitmap(w, h);

  // Инициализация для 32 или 24 бита
  Size := InitBitmaps(ABitmap, Result);
  // Начала массивов пикселей
  s := ABitmap.ScanLine[0];
  d := Result.ScanLine[0];
  // "Ширина" скан-линии в байтах
  BytesPerScan := BytesPerScanline(w, Size*8, 32);

  for y := 0 to h-1 do begin
    for x := 0 to w-1 do begin
      BytesOffset := y * BytesPerScan - x * Size;
      src := PRGBTriple(Integer(s) - BytesOffset);
      dst := PRGBTriple(Integer(d) - BytesOffset);

      clr := InvertColor(RGB(src^.rgbtRed, src^.rgbtGreen, src^.rgbtBlue));
      dst^.rgbtRed   := GetRValue(clr);
      dst^.rgbtGreen := GetGValue(clr);
      dst^.rgbtBlue  := GetBValue(clr);
    end;

    if Assigned (AEvent) then
      old := DoEvent(old, y/h, AEvent);
  end;
end;

//**********************************************************************

// Доступ к пикселям через св-во ScanLine[y] с "умным" расчетом X, Y,

//**********************************************************************

function InvertScanLineXYTwo(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

old: Integer;

clr: TColor;

src: PRGBTriple;

dst: PRGBTriple;

s: PByte;

d: PByte;

BytesPerScan: Integer;

BytesOffset: Integer;

Size: Integer;

begin

old := 0;

h := ABitmap.Height;

w := ABitmap.Width;

Result := CreateBitmap(w, h);

// Инициализация для 32 или 24 бита

Size := InitBitmaps(ABitmap, Result);

// Начала массивов пикселей

s := ABitmap.ScanLine[0];

d := Result.ScanLine[0];

// "Ширина" скан-линии в байтах

BytesPerScan := BytesPerScanline(w, Size*8, 32);

for y := 0 to h-1 do begin

for x := 0 to w-1 do begin

BytesOffset := y * BytesPerScan - x * Size;

src := PRGBTriple(Integer(s) - BytesOffset);

dst := PRGBTriple(Integer(d) - BytesOffset);

clr := InvertColor(RGB(src^.rgbtRed, src^.rgbtGreen, src^.rgbtBlue));

dst^.rgbtRed := GetRValue(clr);

dst^.rgbtGreen := GetGValue(clr);

dst^.rgbtBlue := GetBValue(clr);

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

[свернуть]

Вуаля! Снова видим 62 мсек. И давайте сменим картинку. На аналогичную 900 x 900.

Рис.4. Скорость ScanLine по произвольным X,Y

Из минусов. В этом случае нет никаких проверок на корректность и генерации правильных исключений. Вся ответственность целиком на программисте. Но ради скорости можно простить и это.

Настала пора, пожалуй, заняться написанием класса.

Класс TxIPBitmapScan

Напишем очень простой класс, реализующий доступ к пикселю bitmap по координатам (X,Y) на основе предыдущего метода.

По большому счету, нам нужно в начале работы знать сколько байт у на пиксель, начало битового массива и посчитать «ширину» линии. Реализуем это в конструкторе:

Constructor TxIPBitmapScan.Create (const ABitmap : TBitmap;
  const A32Bits: Boolean = False);
begin
  if (ABitmap = nil) then 
    raise
 Exception.Create('Error TxIPBitmapScan.Create!');

  FBitmap := ABitmap;
  if A32Bits then begin
    FBitmap.PixelFormat := pf32bit;
    FSizeOf := 4;
  end else begin
    FBitmap.PixelFormat := pf24bit;
    FSizeOf := 3;
  end;

  FWidth  := FBitmap.Width;
  FHeight := FBitmap.Height;

  FStartLine := Integer(PByte(FBitmap.ScanLine[0]));
  FBytesPerScan := BytesPerScanline(FWidth, FSizeOf*8, 32);
end;

Constructor TxIPBitmapScan.Create (const ABitmap : TBitmap;

const A32Bits: Boolean = False);

begin

if (ABitmap = nil) then

raise

Exception.Create('Error TxIPBitmapScan.Create!');

FBitmap := ABitmap;

if A32Bits then begin

FBitmap.PixelFormat := pf32bit;

FSizeOf := 4;

end else begin

FBitmap.PixelFormat := pf24bit;

FSizeOf := 3;

end;

FWidth := FBitmap.Width;

FHeight := FBitmap.Height;

FStartLine := Integer(PByte(FBitmap.ScanLine[0]));

FBytesPerScan := BytesPerScanline(FWidth, FSizeOf*8, 32);

end;

Предполагаем, что работать будем только с двумя возможными форматами — 24 и 32 бита. Мы ведь можем назначать любой формат. 32 бита нам нужно только в случае использования альфа-канала. Во всех остальных случаях пусть будет 3 байта на пиксель.

Далее будем просто получать указатель на нужное место в битовом массиве. Чтобы видеть альфа составляющую, в случае 32 бит, используем тип PRGBQuad. И в случае 24 бит, и 32 бита, нам вернется структура, где R, G, B находятся на правильных местах и содержат правильное значение.

Суммируя все это, остальные свойства и методы выглядят так:

property Items[const x,y: Integer]: PRGBQuad read GetRGBQuad;
property Pixels[const x,y: Integer]: Cardinal read GetPixel
      write SetPixel; default;
property ScanLine[const y: Integer]: Pointer read GetScanLine;

property Items[const x,y: Integer]: PRGBQuad read GetRGBQuad;

property Pixels[const x,y: Integer]: Cardinal read GetPixel

write SetPixel; default;

property ScanLine[const y: Integer]: Pointer read GetScanLine;

function TxIPBitmapScan.GetRGBQuad(const x,y: Integer): PRGBQuad;
begin
  Result := PRGBQuad(FStartLine - y*FBytesPerScan + x*FSizeOf);
end;

function TxIPBitmapScan.GetScanLine (const y: Integer): Pointer;
begin
  Result := Pointer(FStartLine - y*FBytesPerScan);
end;

function TxIPBitmapScan.GetPixel(const x,y: Integer): Cardinal;
var
  p: PRGBQuad;
begin
  p := GetRGBQuad(x,y);
  Result := (p^.rgbRed or
            (p^.rgbGreen shl 8) or
            (p^.rgbBlue shl 16));
end;

procedure TxIPBitmapScan.SetPixel(const x,y: Integer;
  const AColor: Cardinal);
var
  p: PRGBQuad;
begin
  p := GetRGBQuad(x,y);
  p^.rgbRed   := Byte(AColor);
  p^.rgbGreen := Byte(AColor shr 8);
  p^.rgbBlue  := Byte(AColor shr 16);
end;

function TxIPBitmapScan.GetRGBQuad(const x,y: Integer): PRGBQuad;

begin

Result := PRGBQuad(FStartLine - y*FBytesPerScan + x*FSizeOf);

end;

function TxIPBitmapScan.GetScanLine (const y: Integer): Pointer;

begin

Result := Pointer(FStartLine - y*FBytesPerScan);

end;

function TxIPBitmapScan.GetPixel(const x,y: Integer): Cardinal;

var

p: PRGBQuad;

begin

p := GetRGBQuad(x,y);

Result := (p^.rgbRed or

(p^.rgbGreen shl 8) or

(p^.rgbBlue shl 16));

end;

procedure TxIPBitmapScan.SetPixel(const x,y: Integer;

const AColor: Cardinal);

var

p: PRGBQuad;

begin

p := GetRGBQuad(x,y);

p^.rgbRed := Byte(AColor);

p^.rgbGreen := Byte(AColor shr 8);

p^.rgbBlue := Byte(AColor shr 16);

end;

Весь листинг модуля под спойлером.

Реализация класса TxIPBitmapScan

unit xIPBitmapScan;

interface

uses
  Winapi.Windows, System.UITypes, System.SysUtils, System.Classes,
  Vcl.Graphics;

type
//*******************************************************************
//   Быстрый доступ к пикселам битмапа, работает через ScanLine
//*******************************************************************
  TxIPBitmapScan = class
  private
    FBitmap : TBitmap;
    FWidth: Integer;
    FHeight: Integer;
    FSizeOf: Integer;
    FStartLine: Integer;
    FBytesPerScan: Integer;

    function GetRGBQuad(const x,y: Integer): PRGBQuad;
    function GetScanLine(const y: Integer): Pointer;
  protected
    function GetPixel(const x,y: Integer): Cardinal;
    procedure SetPixel(const x,y: Integer; const AColor: Cardinal);
  public
    Constructor Create(const ABitmap : TBitmap;
      const A32Bits: Boolean = False); virtual;
    Destructor Destroy; override;
    property Bitmap: TBitmap read FBitmap;
    property Items[const x,y: Integer]: PRGBQuad read GetRGBQuad;
    property Pixels[const x,y: Integer]: Cardinal read GetPixel
      write SetPixel; default;
    property ScanLine[const y: Integer]: Pointer read GetScanLine;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
  end;

implementation


//*******************************************************************
//   Быстрый доступ к пикселам битмапа, работает через ScanLine
//   TxIPBitmapScan = class
//*******************************************************************
Constructor TxIPBitmapScan.Create (const ABitmap : TBitmap;
  const A32Bits: Boolean = False);
begin
  if (ABitmap = nil) then raise
    Exception.Create('Error TxIPBitmapScan.Create!');

  FBitmap := ABitmap;
  if A32Bits then begin
    FBitmap.PixelFormat := pf32bit;
    FSizeOf := 4;
  end else begin
    FBitmap.PixelFormat := pf24bit;
    FSizeOf := 3;
  end;

  FWidth  := FBitmap.Width;
  FHeight := FBitmap.Height;

  FStartLine := Integer(PByte(FBitmap.ScanLine[0]));
  FBytesPerScan := BytesPerScanline(FWidth, FSizeOf*8, 32);
end;

Destructor TxIPBitmapScan.Destroy;
begin
  inherited Destroy;
end;

function TxIPBitmapScan.GetRGBQuad(const x,y: Integer): PRGBQuad;
begin
  Result := PRGBQuad(FStartLine - y*FBytesPerScan + x*FSizeOf);
end;

function TxIPBitmapScan.GetScanLine (const y: Integer): Pointer;
begin
  Result := Pointer(FStartLine - y*FBytesPerScan);
end;

function TxIPBitmapScan.GetPixel(const x,y: Integer): Cardinal;
var
  p: PRGBQuad;
begin
  p := GetRGBQuad(x,y);
  Result := (p^.rgbRed or
            (p^.rgbGreen shl 8) or
            (p^.rgbBlue shl 16));
end;

procedure TxIPBitmapScan.SetPixel(const x,y: Integer;
  const AColor: Cardinal);
var
  p: PRGBQuad;
begin
  p := GetRGBQuad(x,y);
  p^.rgbRed   := Byte(AColor);
  p^.rgbGreen := Byte(AColor shr 8);
  p^.rgbBlue  := Byte(AColor shr 16);
end;

end.

100

101

102

103

104

105

unit xIPBitmapScan;

interface

uses

Winapi.Windows, System.UITypes, System.SysUtils, System.Classes,

Vcl.Graphics;

type

//*******************************************************************

// Быстрый доступ к пикселам битмапа, работает через ScanLine

//*******************************************************************

TxIPBitmapScan = class

private

FBitmap : TBitmap;

FWidth: Integer;

FHeight: Integer;

FSizeOf: Integer;

FStartLine: Integer;

FBytesPerScan: Integer;

function GetRGBQuad(const x,y: Integer): PRGBQuad;

function GetScanLine(const y: Integer): Pointer;

protected

function GetPixel(const x,y: Integer): Cardinal;

procedure SetPixel(const x,y: Integer; const AColor: Cardinal);

public

Constructor Create(const ABitmap : TBitmap;

const A32Bits: Boolean = False); virtual;

Destructor Destroy; override;

property Bitmap: TBitmap read FBitmap;

property Items[const x,y: Integer]: PRGBQuad read GetRGBQuad;

property Pixels[const x,y: Integer]: Cardinal read GetPixel

write SetPixel; default;

property ScanLine[const y: Integer]: Pointer read GetScanLine;

property Width: Integer read FWidth;

property Height: Integer read FHeight;

end;

implementation

//*******************************************************************

// Быстрый доступ к пикселам битмапа, работает через ScanLine

// TxIPBitmapScan = class

//*******************************************************************

Constructor TxIPBitmapScan.Create (const ABitmap : TBitmap;

const A32Bits: Boolean = False);

begin

if (ABitmap = nil) then raise

Exception.Create('Error TxIPBitmapScan.Create!');

FBitmap := ABitmap;

if A32Bits then begin

FBitmap.PixelFormat := pf32bit;

FSizeOf := 4;

end else begin

FBitmap.PixelFormat := pf24bit;

FSizeOf := 3;

end;

FWidth := FBitmap.Width;

FHeight := FBitmap.Height;

FStartLine := Integer(PByte(FBitmap.ScanLine[0]));

FBytesPerScan := BytesPerScanline(FWidth, FSizeOf*8, 32);

end;

Destructor TxIPBitmapScan.Destroy;

begin

inherited Destroy;

end;

function TxIPBitmapScan.GetRGBQuad(const x,y: Integer): PRGBQuad;

begin

Result := PRGBQuad(FStartLine - y*FBytesPerScan + x*FSizeOf);

end;

function TxIPBitmapScan.GetScanLine (const y: Integer): Pointer;

begin

Result := Pointer(FStartLine - y*FBytesPerScan);

end;

function TxIPBitmapScan.GetPixel(const x,y: Integer): Cardinal;

var

p: PRGBQuad;

begin

p := GetRGBQuad(x,y);

Result := (p^.rgbRed or

(p^.rgbGreen shl 8) or

(p^.rgbBlue shl 16));

end;

procedure TxIPBitmapScan.SetPixel(const x,y: Integer;

const AColor: Cardinal);

var

p: PRGBQuad;

begin

p := GetRGBQuad(x,y);

p^.rgbRed := Byte(AColor);

p^.rgbGreen := Byte(AColor shr 8);

p^.rgbBlue := Byte(AColor shr 16);

end;

end.

[свернуть]

Тест класса показывает время, аналогичное «быстрым» ScanLine методам. Таблица победителей распределилась таким образом:

Оптимизация

Если внимательно посмотреть на код, увидим, что массу лишнего времени тратим на получение цветовых составляющих R, G, B и обратное преобразование. Хотя эти параметры у нас уже есть изначально.

Например:

clr := InvertColor(RGB(src^.rgbtRed, 
         src^.rgbtGreen, src^.rgbtBlue));
dst^.rgbtRed   := GetRValue(clr);
dst^.rgbtGreen := GetGValue(clr);
dst^.rgbtBlue  := GetBValue(clr);

clr := InvertColor(RGB(src^.rgbtRed,

src^.rgbtGreen, src^.rgbtBlue));

dst^.rgbtRed := GetRValue(clr);

dst^.rgbtGreen := GetGValue(clr);

dst^.rgbtBlue := GetBValue(clr);

Можно записать как:

dst^.rgbtRed   := 255 - src^.rgbtRed;
dst^.rgbtGreen := 255 - src^.rgbtGreen;
dst^.rgbtBlue  := 255 - src^.rgbtBlue;

dst^.rgbtRed := 255 - src^.rgbtRed;

dst^.rgbtGreen := 255 - src^.rgbtGreen;

dst^.rgbtBlue := 255 - src^.rgbtBlue;

Немного модифицируем методы, связанные со ScanLine. Добавим глобальную переменную GPixOptimization: Boolean. За ее инициализацию отвечает соответствующая галочка в интерфейсе. И внутри каждого цикла произведем вот такое усложнение:

      if GPixOptimization then begin
        dst^.rgbtRed   := 255 - src^.rgbtRed;
        ...
      end else begin
        clr := InvertColor(RGB(src^.rgbtRed, 
                 src^.rgbtGreen, src^.rgbtBlue));
        dst^.rgbtRed   := GetRValue(clr);
        ...  
      end;

if GPixOptimization then begin

dst^.rgbtRed := 255 - src^.rgbtRed;

...

end else begin

clr := InvertColor(RGB(src^.rgbtRed,

src^.rgbtGreen, src^.rgbtBlue));

dst^.rgbtRed := GetRValue(clr);

...

end;

Конечно, для каждого метода есть свои нюансы. Это можно посмотреть непосредственно в коде.

Правда, на картинке 900 x 900, выигрыш почти не ощутим. Что если взять побольше полотно?

Большая картинка. Большой тест.

В завершение проведем тест на большой картинке. Разрешение 900 x 900 это немало. Но у нас есть 6080 x 3413. Номер четыре. Это, прямо скажем, вызов.

Для чистоты эксперимента отключим генерацию события. И пусть все работают на 24 бита. Вначале без оптимизации, потом с оптимизацией.

Рис.6. Большая картинка. Без оптимизации.

Победитель явно первый ScanLine, который использует все преимущества идеального варианта и не использует координаты. А наш класс на 3-м месте. Однако, картина меняется, если включить оптимизацию.

Сейчас оптимизация вполне себе ощутима. Выигрыш в 1.5-2 раза.

Теперь наш класс на первом месте. На самом деле все три победителя равнозначны. Просто с классом работать удобней, когда дело дойдет до фильтров и сверток. А время сильно зависит, от того, как карта у ОС ляжет. При всех прочих одинаковых условиях один и тот же метод может дать и 400 миллисекунд.

Выводы

Таким образом, для быстрой работы с пикселями, без привлечения сторонних библиотек, мало одной технологии, не помешает и методология. Допустим, если мы в большинстве случаев идем по исходной матрице, рассчитываем каждый пиксель на основании соседних, имеет смысл использовать класс. А при сохранении можно использовать тот самый идеальный вариант первого ScanLine. В этом случае никаких расчетов ведь не происходит. Надо просто присвоить получившийся цвет в конкретную точку bitmap.

//***************************************************************
//  Обрабатываем пиксели комбинированным способом.
//  Обращение к исходной матрице без оптимизации
//  Моделируем ситуацию доступа именно по координатам к исходнику
//****************************************************************
function InvertScanLineCombo(const ABitmap: TBitmap;
  const AEvent: TNotifyEvent): TBitmap;
var x,y: Integer;
    w,h: Integer;
    clr: TColor;
    old: Integer;
    src: TxIPBitmapScan;
    s: PByte;
    d: PByte;
    v: TRGBTriple;
    Size: Integer;
begin
  old := 0;
  src := TxIPBitmapScan.Create(ABitmap, G32BitsBitmap);
  h := src.Height;
  w := src.Width;
  Result := CreateBitmap(w, h);
  if G32BitsBitmap then begin
    Size := 4;
    Result.PixelFormat := pf32bit;
  end else
    Size := 3;

  try
    for y := 0 to h-1 do begin
      d := result.ScanLine[y];

      for x := 0 to w-1 do  begin
        // Берем строго по координатам, без оптимизаций
        s := PByte(src.Items[x,y]);
        // Какие-то вычисления
        // v := src.Items[x+1,y] * mx[1,0] + ... etc
        v := PRGBTriple(s)^;
        // Присваиваем уже без координат
        PRGBTriple(d)^.rgbtRed   := 255 - v.rgbtRed;
        PRGBTriple(d)^.rgbtGreen := 255 - v.rgbtGreen;
        PRGBTriple(d)^.rgbtBlue  := 255 - v.rgbtBlue;
        // Смещаем указатель в линии на следующий пиксель
        inc(d,Size);
      end;

      if Assigned (AEvent) then
        old := DoEvent(old, y/h, AEvent);
    end;

  finally
    FreeAndNil(Src);
  end;
end;

//***************************************************************

// Обрабатываем пиксели комбинированным способом.

// Обращение к исходной матрице без оптимизации

// Моделируем ситуацию доступа именно по координатам к исходнику

//****************************************************************

function InvertScanLineCombo(const ABitmap: TBitmap;

const AEvent: TNotifyEvent): TBitmap;

var x,y: Integer;

w,h: Integer;

clr: TColor;

old: Integer;

src: TxIPBitmapScan;

s: PByte;

d: PByte;

v: TRGBTriple;

Size: Integer;

begin

old := 0;

src := TxIPBitmapScan.Create(ABitmap, G32BitsBitmap);

h := src.Height;

w := src.Width;

Result := CreateBitmap(w, h);

if G32BitsBitmap then begin

Size := 4;

Result.PixelFormat := pf32bit;

end else

Size := 3;

try

for y := 0 to h-1 do begin

d := result.ScanLine[y];

for x := 0 to w-1 do begin

// Берем строго по координатам, без оптимизаций

s := PByte(src.Items[x,y]);

// Какие-то вычисления

// v := src.Items[x+1,y] * mx[1,0] + ... etc

v := PRGBTriple(s)^;

// Присваиваем уже без координат

PRGBTriple(d)^.rgbtRed := 255 - v.rgbtRed;

PRGBTriple(d)^.rgbtGreen := 255 - v.rgbtGreen;

PRGBTriple(d)^.rgbtBlue := 255 - v.rgbtBlue;

// Смещаем указатель в линии на следующий пиксель

inc(d,Size);

end;

if Assigned (AEvent) then

old := DoEvent(old, y/h, AEvent);

end;

finally

FreeAndNil(Src);

end;

Тема не закрыта

Изначально хотел рассказать больше. Но статья и без того получилась весьма объемна. Поэтому, тема еще не закрыта. В следующий раз планирую рассказать, как на самом деле обстоят дела с по-пиксельным доступом в GDI+ и показать, как это сделано в Graphics32.

Ах, да! Глобальные переменные — это нехорошо. Присутствуют в коде по причине того, что это пример и иллюстрация. В реальной жизни их надо избегать )))

Информация о новых статьях есть в моем телеграм-канале. На сайте не будет e-mail и прочих рассылок, потому что не люблю. ТГ-канал мне кажется самым демократичным — доставка мгновенная, в любое время можно отписаться без всяких заморочек и вопросов: типа, что не понравилось.

Надеюсь, информация была полезной.

Друзья, спасибо за внимание!

Не забываем комментировать )))

Скачать

Исходники 2.96 Мб (Delphi XE 7-10)

Исполняемый файл 3.54 Мб

В версии для Delphi 7 убрана работа с GDI+. В D7 GDI+ из коробки нет, дополнительно ставить не стал.

Исполняемый файл + Исходник 5.57 Мб (Delphi 7)

Появилась возможность «безболезненно» использовать GDI+ для Delphi 7. Узнать как это сделать и скачать исходник для этой статьи можно по ссылке «Как подключить GDI+ для Delphi 7 и не иметь проблем в XE»

5 11 голоса

Рейтинг статьи

11 комментариев

Старые

Новые Популярные

Межтекстовые Отзывы

Посмотреть все комментарии

Aleks

3 лет назад

Просто супер! Нагрузка на ЦП минимальная или недолгая. Как изменить xIPBitmapScan чтобы быстро использовать в своей программе, нужно попроще код. Мне нужно искать пикселы нужного цвета , только и всего.

Ответить

Александр

3 лет назад

Я разобрался как использовать в своём проекте ваш класс. Спасибо, очень удобно. Я увижу разницу в нагрузке на ЦП если будут использовать GetPixel из класса, в цикле?

 while y < bmp.Height do
 begin
		y:=y+5;
 end;

while y < bmp.Height do

begin

y:=y+5;

end;

Ответить

Roman

Автор

Ответить на Александр

3 лет назад

Здравствуйте, Александр! Рад, что материал нужен.
Если с использованием класса TxIPBitmapScan, то следующий код будет очень быстрым и не напрягающим:

 procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TBitmap;
  src: TxIPBitmapScan;
  x,y: Integer;
  clr: TColor;
  d: DWORD;
begin
  bmp := TBitmap.Create;
  bmp.Assign(Image4.Picture.Graphic);

  d := GetTickCount;
  src := TxIPBitmapScan.Create(bmp,True);
  try
    for y := 0 to src.Height-1 do
      for x := 0 to src.Width-1 do
      begin
        clr := src.Pixels[x,y];
        if GetRValue(clr) > 100 then
        begin
          clr := RGB(100, GetGValue(clr), GetBValue(clr));
          src.Pixels[x,y] := clr;
        end;
      end;
  finally
    d := GetTickCount - d;
    Caption := IntToStr(d) + ' ' +
      IntToStr(src.Width) + ' x ' + IntToStr(src.Height);

    FreeAndNil(src);
    Image1.Picture.Assign(bmp);
    FreeAndNil(bmp);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);

var

bmp: TBitmap;

src: TxIPBitmapScan;

x,y: Integer;

clr: TColor;

d: DWORD;

begin

bmp := TBitmap.Create;

bmp.Assign(Image4.Picture.Graphic);

d := GetTickCount;

src := TxIPBitmapScan.Create(bmp,True);

try

for y := 0 to src.Height-1 do

for x := 0 to src.Width-1 do

begin

clr := src.Pixels[x,y];

if GetRValue(clr) > 100 then

begin

clr := RGB(100, GetGValue(clr), GetBValue(clr));

src.Pixels[x,y] := clr;

end;

finally

d := GetTickCount - d;

Caption := IntToStr(d) + ' ' +

IntToStr(src.Width) + ' x ' + IntToStr(src.Height);

FreeAndNil(src);

Image1.Picture.Assign(bmp);

FreeAndNil(bmp);

end;

Однако, если нужен очень быстрый доступ, то следующий код раз в 10 быстрее:

procedure TForm1.Button2Click(Sender: TObject);
var
  bmp: TBitmap;
  x,y: Integer;
  p: PRGBQuad;
  d: DWORD;
begin
  bmp := TBitmap.Create;
  bmp.Assign(Image4.Picture.Graphic);
  bmp.PixelFormat := pf32bit;

  d := GetTickCount;
  p := bmp.ScanLine[bmp.Height-1];

  try
    for y := 0 to bmp.Height-1 do
      for x := 0 to bmp.Width-1 do
      begin
        if p^.rgbRed > 100 then
           p^.rgbRed := 100;
        inc(p);
      end;
  finally
    d := GetTickCount - d;
    Caption := IntToStr(d) + ' ' +
      IntToStr(bmp.Width) + ' x ' +
      IntToStr(bmp.Height);

    Image1.Picture.Assign(bmp);
    FreeAndNil(bmp);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);

var

bmp: TBitmap;

x,y: Integer;

p: PRGBQuad;

d: DWORD;

begin

bmp := TBitmap.Create;

bmp.Assign(Image4.Picture.Graphic);

bmp.PixelFormat := pf32bit;

d := GetTickCount;

p := bmp.ScanLine[bmp.Height-1];

try

for y := 0 to bmp.Height-1 do

for x := 0 to bmp.Width-1 do

begin

if p^.rgbRed > 100 then

p^.rgbRed := 100;

inc(p);

end;

finally

d := GetTickCount - d;

Caption := IntToStr(d) + ' ' +

IntToStr(bmp.Width) + ' x ' +

IntToStr(bmp.Height);

Image1.Picture.Assign(bmp);

FreeAndNil(bmp);

end;

Почему так происходит рассказал тут
На рисунке в заголовке скорость выполнения первого и второго.
Исходник и исполняемый файл от вышеприведенного тут.
Взят из головы выдуманный случай, дескать, надо обработать битмап и если канал красного больше 100 сделать его равным 100. В качестве изображения — большой тест из статьи.
Удачи! Спрашивайте, если что ))) Не мгновенно, но отвечу обязательно.
Второй фрагмент кода можно сделать еще быстрее. Оставил двойной цикл для наглядности.

Ответить

Александр

Ответить на Roman

3 лет назад

Спасибо! Это потрясающе! Я сделал тест на время и результат такой (конкретно в моём случае изображение 500x на 700y).
Canvas = 10 — 12ms
TxIPBitmapScan = 0 — 1 ms.

Теперь можно работать с видеопотоком. Пишу проект детектирования предметов для робота. Ваш чудесный код очень выручил.

Ответить

Александр

Ответить на Roman

3 лет назад

Забыл добавить, что при использовании в фоновом потоке Canvas работает не точно, например перекрашивает только часть изображения. TxIPBitmapScan в фоновом потоке работет без проблем.

Ответить

Roman

Автор

Ответить на Александр

3 лет назад

Спасибо за теплые слова!
Все же, думаю, стоит обратить внимание на procedure TForm1.Button2Click(Sender: TObject) в моем последнем комментарии.
Посмотреть статью о прямом доступе к пикселям.
Если дело касается обработки видеопотока и детектировании предметов, можно рассмотреть вариант с OpenCV. Лично я бы постарался обойтись без него. Но, возможно, там все уже есть.
.

Ответить

Владислав

3 лет назад

Как будет выглядеть все это в Borland delphi 7? Не получается написать все то же самое, что и у вас.

Ответить

Roman

Автор

Ответить на Владислав

3 лет назад

Весь проект из статьи не получится быстро переделать для D7, т.к. в ней нет работы с GDI+. Возможно, GDI+ надо вообще выкинуть из примера.
Однако, основное из статьи — быстрый доступ к пикселям и работу класса TxIPBitmapScan — можно посмотреть тут.
Это адаптированный под D7 ответ https://ip76.ru/fast-pixel-post/#comment-120 на вопрос Александра.

Ответить

Roman

Автор

Ответить на Владислав

3 лет назад

Сделал вариант для D7. Ссылку разместил в статье в разделе скачать.

Ответить

Sturman

Участник

3 лет назад

Всё очень интересно.
А вот получение TBitmap из TGPImage я делаю так:
GPImage.GetHBITMAP(aclTransparent, h);
Bitmap.Handle := h;
вроде бы работает.. (но для фоток ещё нужна проверка на поворот)

Ответить

Roman

Автор

Ответить на Sturman

3 лет назад

Согласен. Завтра даже будет новая статья, где это упоминается.
Также и TGPBitmap получить из TBitmap проще некуда:

gbmp := TGPBitmap.Create(tmp.Handle, tmp.Palette);

1	gbmp := TGPBitmap.Create(tmp.Handle, tmp.Palette);

Но представленные LoadGPBitmapFromGraphic и SaveGPBitmapToBitmap работают с любым TGraphic и любым TGPImage.
А в TGPImage нет ни

constructor Create(hbm: HBITMAP; hpal: HPALETTE);

1	constructor Create(hbm: HBITMAP; hpal: HPALETTE);

ни

function GetHBITMAP(colorBackground: TGPColor; out hbmReturn: HBITMAP): TStatus;

1	function GetHBITMAP(colorBackground: TGPColor; out hbmReturn: HBITMAP): TStatus;

Ответить