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

TMyClass
  private
    fDelta; integer;
    fStart: integer;
end;

...

function TMyClass.GetPixels(X, Y: integer): integer; assembler;
asm
  imul ecx,[eax].fDelta
  add ecx,[eax].fStart
  add ecx,edx
  movzx eax,WORD PTR [ecx+2*edx]
  bswap eax
  shr eax,8
  movzx ecx, BYTE PTR [ecx+2*edx+2]
  or eax,ecx
end;


procedure TMyClass.SetPixels(X, Y: integer; {color}const Value: integer); assembler;
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;

procedure TMyClass.Mymethod;
begin
  if (bmp = nil) or bmp.Empty then Exit;
  bmp.PixelFormat := pf24bit;
  fStart := integer(bmp.Scanline[0]);
  fDelta := integer(bmp.Scanline[1]) - fStart;
  ...
end;

function TMyClass.GetPixels2(X, Y: Integer): TColor;
var
  P: PByte;
begin
  P := PByte(Integer(fStart) + Y * fDelta + X * 3);
  Result := P[0] or (P[1] shl 8) or (P[2] shl 16);
end;

procedure TMyClass.SetPixels2(X, Y: Integer; Value: TColor);
var
  P: PByte;
begin
  P := PByte(Integer(fStart) + Y * fDelta + X * 3);
  P[0] := Byte(Value);
  P[1] := Byte(Value shr 8);
  P[2] := Byte(Value shr 16);
end;

// === Оптимизация для релиза ===
{$OPTIMIZATION ON}        // Включить оптимизацию кода
{$STACKFRAMES OFF}        // Не создавать фреймы стека (критично для ASM!)
{$DEBUGINFO OFF}          // Отключить отладочную информацию
{$LOCALSYMBOLS OFF}       // Не сохранять локальные символы
{$OVERFLOWCHECKS OFF}     // Отключить проверку переполнения
{$RANGECHECKS OFF}        // Отключить проверку границ массивов
{$IOCHECKS OFF}           // Отключить проверку I/O ошибок
{$ASSERTIONS OFF}         // Отключить директивы Assert
{$A8}                     // Выравнивание данных по 8 байт (опционально)

// === Важно для ASM ===
{$STACKFRAMES OFF}        // Обязательно: не использовать EBP как frame pointer
{$HINTS OFF}              // Меньше шума при компиляции
{$WARNINGS OFF}           // Меньше шума при компиляции

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

// === Оптимизация для релиза ===
{$OPTIMIZATION ON}        // Включить оптимизацию кода
{$STACKFRAMES OFF}        // Не создавать фреймы стека (критично для ASM!)
{$DEBUGINFO OFF}          // Отключить отладочную информацию
{$LOCALSYMBOLS OFF}       // Не сохранять локальные символы
{$OVERFLOWCHECKS OFF}     // Отключить проверку переполнения
{$RANGECHECKS OFF}        // Отключить проверку границ массивов
{$IOCHECKS OFF}           // Отключить проверку I/O ошибок
{$ASSERTIONS OFF}         // Отключить директивы Assert
{$A8}                     // Выравнивание данных по 8 байт (опционально)

// === Важно для ASM ===
{$STACKFRAMES OFF}        // Обязательно: не использовать EBP как frame pointer
{$HINTS OFF}              // Меньше шума при компиляции
{$WARNINGS OFF}           // Меньше шума при компиляции

uses
  Windows,
  System.SysUtils,
  Vcl.Graphics;

type
  TMyClass = class
  private
    fDelta: Integer;
    fStart: Integer;
  public
    procedure InitBitmap(bmp: TBitmap);
    function GetPixels(X, Y: Integer): Integer;
    procedure SetPixels(X, Y: Integer; const Value: Integer);
    function GetPixels2(X, Y: Integer): TColor; inline;
    procedure SetPixels2(X, Y: Integer; Value: TColor); inline;
  end;

procedure TMyClass.InitBitmap(bmp: TBitmap);
begin
  bmp.PixelFormat := pf24bit;
  fStart := Integer(bmp.ScanLine[0]);
  fDelta := Integer(bmp.ScanLine[1]) - fStart;
end;

function TMyClass.GetPixels(X, Y: integer): integer; assembler;
asm
  imul ecx,[eax].fDelta
  add ecx,[eax].fStart
  add ecx,edx
  movzx eax,WORD PTR [ecx+2*edx]
  bswap eax
  shr eax,8
  movzx ecx, BYTE PTR [ecx+2*edx+2]
  or eax,ecx
end;

procedure TMyClass.SetPixels(X, Y: integer; {color}const Value: integer); assembler;
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;

function TMyClass.GetPixels2(X, Y: Integer): TColor;
var
  P: PByte;
begin
  P := PByte(Integer(fStart) + Y * fDelta + X * 3);
  Result := P[0] or (P[1] shl 8) or (P[2] shl 16);
end;

procedure TMyClass.SetPixels2(X, Y: Integer; Value: TColor);
var
  P: PByte;
begin
  P := PByte(Integer(fStart) + Y * fDelta + X * 3);
  P[0] := Byte(Value);
  P[1] := Byte(Value shr 8);
  P[2] := Byte(Value shr 16);
end;

function GetTicks: Int64; inline;
begin
  QueryPerformanceCounter(Result);
end;

function TicksToMs(ticks: Int64; freq: Int64): Double; inline;
begin
  Result := ticks * 1000.0 / freq;
end;

var
  bmp, bmp2: TBitmap;
  obj, obj2: TMyClass;
  x, y: Integer;
  freq, start, stop: Int64;
  elapsedMs: Double;
  dummy: integer;
  C: TColor;

begin
  QueryPerformanceFrequency(freq);

  if not FileExists('test.bmp') then begin
    WriteLn('File "test.bmp" not found');
    ReadLn;
    Exit;
  end;

  if FileExists('test2.bmp') then begin
    DeleteFile('test2.bmp');
  end;

  bmp := TBitmap.Create;
  bmp.LoadFromFile('test.bmp');

  bmp2 := TBitmap.Create;
  bmp2.Width := bmp.Width;
  bmp2.Height := bmp.Height;

  obj := TMyClass.Create;
  obj.InitBitmap(bmp);

  obj2 := TMyClass.Create;
  obj2.InitBitmap(bmp2);

  start := GetTicks;

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

      {
      // вариант на GDI
      C := bmp.Canvas.Pixels[x, y];
      bmp2.Canvas.Pixels[x, y] := C;
      {}

      // варант на ASM
      dummy := obj.GetPixels(x, y);
      obj2.SetPixels(x, y, dummy);
      {}

      // вариант без ASM
      C := obj.GetPixels2(x, y);
      obj2.SetPixels2(x, y, C);
      {}

    end;
  end;

  stop := GetTicks;

  elapsedMs := TicksToMs(stop - start, freq);
  WriteLn('  Время: ', Round(elapsedMs), ' мс | ', Round((bmp.Width * bmp.Height / 1e6) / (elapsedMs / 1000)), ' Мпикс/сек');

  bmp2.SaveToFile('test2.bmp');

  bmp.Free;
  bmp2.Free;

  readln;
end.