See, below, this Delphi project (console applicati...

See, below, this Delphi project (console application) that aims to build a basic path to access pixels ("read" and "write" pixels) through ScanLine.

1. FIRST PROJECT

The first project is a bit more primitive, but it works well/perfectly.

ImageAccessors.pas:

text
unit ImageAccessors;

interface

uses
  Winapi.Windows,  // Added for Windows API functions
  Vcl.Graphics,    // Added for TBitmap and color functions
  System.SysUtils,
  System.Types,
  ImageCore;

type
  TScanlineReader = class
  private
    FBitmap: Vcl.Graphics.TBitmap;  // Fully qualified TBitmap
    FScanlines: array of PRGB32Array;
    function GetHeight: Integer;
    function GetWidth: Integer;
    function GetScanline(Y: Integer): PRGB32Array;
  public
    constructor Create(ABitmap: Vcl.Graphics.TBitmap);
    function GetPixel(X, Y: Integer): TRGB32;
    property Scanline[Y: Integer]: PRGB32Array read GetScanline;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
  end;

  TScanlineWriter = class
  private
    FBitmap: Vcl.Graphics.TBitmap;  // Fully qualified TBitmap
    FScanlines: array of PRGB32Array;
    FPendingWrites: array of TPendingPixel;
    FPendingWriteCount: Integer;
    procedure FlushPendingWrites;
  public
    constructor Create(ABitmap: Vcl.Graphics.TBitmap);
    destructor Destroy; override;
    procedure AddScanline(APixel: TPendingPixel);
    procedure SetPixel(X, Y: Integer; Color: TRGB32); overload;
    procedure SetPixel(X, Y: Integer; Color: TColor); overload;
    procedure CommitChanges;
  end;

implementation

{ TScanlineReader }

constructor TScanlineReader.Create(ABitmap: Vcl.Graphics.TBitmap);
var
  Y: Integer;
begin
  if ABitmap.PixelFormat <> pf32bit then
    raise Exception.Create('Bitmap must be 32-bit format');

  FBitmap := ABitmap;
  SetLength(FScanlines, FBitmap.Height);
  for Y := 0 to FBitmap.Height - 1 do
    FScanlines[Y] := FBitmap.ScanLine[Y];
end;

function TScanlineReader.GetScanline(Y: Integer): PRGB32Array;
begin
  if (Y < 0) or (Y >= FBitmap.Height) then
    raise Exception.Create(Format('Scanline Y=%d out of bounds (0..%d)', [Y, FBitmap.Height-1]));
  Result := FScanlines[Y];
end;

function TScanlineReader.GetPixel(X, Y: Integer): TRGB32;
begin
  if (X < 0) or (X >= Width) then
    raise Exception.Create(Format('X=%d out of bounds', [X]));
  if (Y < 0) or (Y >= Height) then
    raise Exception.Create(Format('Y=%d out of bounds', [Y]));

  Result := FScanlines[Y]^[X];
end;

function TScanlineReader.GetHeight: Integer;
begin
  Result := FBitmap.Height;
end;

function TScanlineReader.GetWidth: Integer;
begin
  Result := FBitmap.Width;
end;

{ TScanlineWriter }

constructor TScanlineWriter.Create(ABitmap: Vcl.Graphics.TBitmap);
var
  Y: Integer;
begin
  if ABitmap.PixelFormat <> pf32bit then
    raise Exception.Create('Bitmap must be 32-bit format');

  FBitmap := ABitmap;
  SetLength(FScanlines, FBitmap.Height);
  for Y := 0 to FBitmap.Height - 1 do
    FScanlines[Y] := FBitmap.ScanLine[Y];
end;

procedure TScanlineWriter.SetPixel(X, Y: Integer; Color: TRGB32);
begin
  if (X < 0) or (X >= FBitmap.Width) or (Y < 0) or (Y >= FBitmap.Height) then
    Exit;

  SetLength(FPendingWrites, Length(FPendingWrites)+1);
  FPendingWrites[High(FPendingWrites)].XPos := X;
  FPendingWrites[High(FPendingWrites)].YPos := Y;
  FPendingWrites[High(FPendingWrites)].Color := Color;

  if Length(FPendingWrites) > 1024 then
    FlushPendingWrites;
end;

procedure TScanlineWriter.SetPixel(X, Y: Integer; Color: TColor);
var
  RGB: TRGB32;
begin
  RGB.R := GetRValue(Color);
  RGB.G := GetGValue(Color);
  RGB.B := GetBValue(Color);
  RGB.A := 255;
  SetPixel(X, Y, RGB);
end;

procedure TScanlineWriter.AddScanline(APixel: TPendingPixel);
begin
  if FPendingWriteCount = Length(FPendingWrites) then
    SetLength(FPendingWrites, FPendingWriteCount + 16);
  FPendingWrites[FPendingWriteCount] := APixel;
  Inc(FPendingWriteCount);
end;


procedure TScanlineWriter.FlushPendingWrites;
var
  i: Integer;
begin
  // Only process valid entries up to FPendingWriteCount
  for i := 0 to FPendingWriteCount - 1 do
  begin
    // Here you would do the actual processing for each scanline.
    // For example: WriteScanlineToDestination(FPendingWrites[i]);
  end;
  // Reset count after processing
  FPendingWriteCount := 0;
end;

destructor TScanlineWriter.Destroy;
begin
  // If there are any pending scanlines, flush them before destroying the object.
  if FPendingWriteCount > 0 then
    FlushPendingWrites;
  inherited;
end;

procedure TScanlineWriter.CommitChanges;
begin
  FlushPendingWrites;
  if FBitmap.HandleAllocated then
    FBitmap.Modified := True;
end;

end.

ImageCore.pas:

text
unit ImageCore;

interface

uses
  Winapi.Windows, Vcl.Graphics;

type
  TRGB32 = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    A: Byte;
  end;
  PRGB32 = ^TRGB32;
  PRGB32Array = ^TRGB32Array;
  TRGB32Array = array[0..0] of TRGB32;

  TPendingPixel = record
    XPos: Integer;
    YPos: Integer;
    Color: TRGB32;
  end;

implementation

end.

ScanlineConsoleDemo.dpr:

text
program ScanlineConsoleDemo;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Classes,
  Vcl.Graphics,       // For TBitmap
  System.Diagnostics; // For TStopwatch

type
  // A simple type to represent a 32-bit RGB color.
  TRGB32 = Cardinal;

  // Minimal image processor for testing.
  TImageProcessor = class
  private
    FWidth: Integer;
    FHeight: Integer;
    // The image is stored as a one-dimensional array of pixels.
    FData: array of TRGB32;
  public
    constructor Create(AWidth, AHeight: Integer);
    destructor Destroy; override;
    // Sets a pixel at (X, Y) to the specified Color.
    procedure SetPixel(X, Y: Integer; Color: TRGB32);
    // Saves the image to disk as a BMP file.
    procedure SaveToFile(const FileName: string);
    // Counts the number of black pixels (Color = $000000).
    function CountBlackPixels: Integer;
  end;

{ TImageProcessor }

constructor TImageProcessor.Create(AWidth, AHeight: Integer);
var
  I: Integer;
begin
  inherited Create;
  FWidth := AWidth;
  FHeight := AHeight;
  SetLength(FData, AWidth * AHeight);
  // Initialize the image to white ($FFFFFF).
  for I := 0 to High(FData) do
    FData[I] := $FFFFFF;
end;

destructor TImageProcessor.Destroy;
begin
  inherited;
end;

procedure TImageProcessor.SetPixel(X, Y: Integer; Color: TRGB32);
var
  Index: Integer;
begin
  // Ensure the pixel is within the image bounds.
  if (X < 0) or (X >= FWidth) or (Y < 0) or (Y >= FHeight) then
    Exit;
  Index := Y * FWidth + X;
  FData[Index] := Color;
end;

procedure TImageProcessor.SaveToFile(const FileName: string);
var
  Bitmap: TBitmap;
  x, y, Index: Integer;
  pLine: PByteArray;
  Color: TRGB32;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.Width := FWidth;
    Bitmap.Height := FHeight;
    // Write pixels into the bitmap.
    // Note: In a 32-bit TBitmap the pixel order is Blue, Green, Red, Alpha.
    for y := 0 to FHeight - 1 do
    begin
      pLine := Bitmap.ScanLine[y];
      for x := 0 to FWidth - 1 do
      begin
        Index := y * FWidth + x;
        Color := FData[Index];
        pLine[x * 4 + 0] := Byte(Color and $FF);             // Blue
        pLine[x * 4 + 1] := Byte((Color shr 8) and $FF);       // Green
        pLine[x * 4 + 2] := Byte((Color shr 16) and $FF);      // Red
        pLine[x * 4 + 3] := $FF;                               // Alpha
      end;
    end;
    Bitmap.SaveToFile(FileName);
  finally
    Bitmap.Free;
  end;
end;

function TImageProcessor.CountBlackPixels: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to High(FData) do
    if FData[i] = $000000 then
      Inc(Result);
end;

var
  ImgProcessor: TImageProcessor;
  sw: TStopwatch;
  writeTime, readTime: Int64;
  writeFPS, readFPS: Double;
  x, y: Integer;
  BlackCount: Integer;
  Width, Height: Integer;
begin
  try
    // Define 8K image dimensions (7680 x 4320).
    Width := 7680;
    Height := 4320;

    // Create the image.
    ImgProcessor := TImageProcessor.Create(Width, Height);
    try
      WriteLn(Format('Using resolution: %d x %d', [Width, Height]));

      // Benchmark writing: fill the entire image with black pixels.
      sw := TStopwatch.StartNew;
      for y := 0 to Height - 1 do
        for x := 0 to Width - 1 do
          ImgProcessor.SetPixel(x, y, $000000);
      sw.Stop;
      writeTime := sw.ElapsedMilliseconds;
      if writeTime > 0 then
        writeFPS := 1000 / writeTime
      else
        writeFPS := 0;

      // Save the resulting image to disk.
      ImgProcessor.SaveToFile('StressTestImage_8K.bmp');
      WriteLn('Image saved to StressTestImage_8K.bmp');

      // Benchmark reading: count the black pixels.
      sw := TStopwatch.StartNew;
      BlackCount := ImgProcessor.CountBlackPixels;
      sw.Stop;
      readTime := sw.ElapsedMilliseconds;
      if readTime > 0 then
        readFPS := 1000 / readTime
      else
        readFPS := 0;

      WriteLn(Format('Writing (setting pixels) took: %d ms (FPS: %.2f)', [writeTime, writeFPS]));
      WriteLn(Format('Reading (scanning pixels) took: %d ms (FPS: %.2f)', [readTime, readFPS]));
      WriteLn(Format('Total black pixels counted: %d', [BlackCount]));
    finally
      ImgProcessor.Free;
    end;
  except
    on E: Exception do
      WriteLn(Format('Error: %s', [E.Message]));
  end;

  // Wait for user confirmation before closing the terminal.
  WriteLn;
  Write('Press Enter to exit...');
  ReadLn;
end.





2. SECOND PROJECT

The second project is more sophisticated and refactored, notice that it has more units than the first, it is a little more elaborate and complex. However, the second project faces errors at runtime.


pScanlineConsoleDemo.dpr:

program pScanlineConsoleDemo;

{$APPTYPE CONSOLE}

{$ALIGN 4}

uses
System.SysUtils,
System.Classes,
Vcl.Graphics,
System.Diagnostics,
uImageTypes,
uImageCore,
uImageReader,
uImageWriter;

var
Bitmap: TBitmap;
Writer: TBitmapWriter;
Reader: TScanlineReader;
ImgRect: TImageRect;
BlackColor: TRGB32;
sw: TStopwatch;
writeTime, readTime: Int64;
totalPixels: Int64;
writeRate, readRate: Double;
x, y: Integer;
BlackCount: Integer;
begin
try
// Create an 8K bitmap (7680 x 4320) with 32-bit pixel format.
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit;
Bitmap.Width := 7680;
Bitmap.Height := 4320;
totalPixels := Bitmap.Width * Bitmap.Height;

text
  // Prepare the full image rectangle CORRECTLY
  ImgRect := TImageRect.Create(0, 0, Bitmap.Width, Bitmap.Height);

  // Define black color (R=0, G=0, B=0, A=255).
  BlackColor.R := 0;
  BlackColor.G := 0;
  BlackColor.B := 0;
  BlackColor.A := 255;

  // Use TBitmapWriter for fast batch pixel writes.
  Writer := TBitmapWriter.Create(Bitmap, True);
  try
    sw := TStopwatch.StartNew;
    // Fill the entire image with black pixels using an optimized fill.
    Writer.FillRect(ImgRect, BlackColor);
    Writer.CommitChanges;
    sw.Stop;
    writeTime := sw.ElapsedMilliseconds;
    if writeTime > 0 then
      writeRate := totalPixels / (writeTime / 1000)
    else
      writeRate := 0;

    WriteLn(Format('Writing (filling) took: %d ms', [writeTime]));
    WriteLn(Format('Pixel write rate: %.0f pixels per second', [writeRate]));

    // Save the resulting bitmap.
    Bitmap.SaveToFile('StressTestImage_8K.bmp');
    WriteLn('Image saved to StressTestImage_8K.bmp');
  finally
    Writer.Free;
  end;

  // Now use TScanlineReader to benchmark reading the pixels.
  Reader := TScanlineReader.Create(Bitmap);
  try
    BlackCount := 0;
    sw := TStopwatch.StartNew;
    for y := 0 to Bitmap.Height - 1 do
      for x := 0 to Bitmap.Width - 1 do
      begin
        // Use GetPixelRGB to retrieve the pixel's TRGB32 value.
        with Reader.GetPixelRGB(x, y) do
          if (R = 0) and (G = 0) and (B = 0) then
            Inc(BlackCount);
      end;
    sw.Stop;
    readTime := sw.ElapsedMilliseconds;
    if readTime > 0 then
      readRate := totalPixels / (readTime / 1000)
    else
      readRate := 0;

    WriteLn(Format('Reading (scanning) took: %d ms', [readTime]));
    WriteLn(Format('Pixel read rate: %.0f pixels per second', [readRate]));
    WriteLn(Format('Total black pixels counted: %d', [BlackCount]));
  finally
    Reader.Free;
  end;

finally
  Bitmap.Free;
end;

except
on E: Exception do
WriteLn('Error: ' + E.Message);
end;

WriteLn;
Write('Press Enter to exit...');
ReadLn;
end.

text

uImageAccessors.pas:

unit ImageAccessors;

interface

uses
Winapi.Windows, // Added for Windows API functions
Vcl.Graphics, // Added for TBitmap and color functions
System.SysUtils,
System.Types,
ImageCore;

type
TScanlineReader = class
private
FBitmap: Vcl.Graphics.TBitmap; // Fully qualified TBitmap
FScanlines: array of PRGB32Array;
function GetHeight: Integer;
function GetWidth: Integer;
function GetScanline(Y: Integer): PRGB32Array;
public
constructor Create(ABitmap: Vcl.Graphics.TBitmap);
function GetPixel(X, Y: Integer): TRGB32;
property Scanline[Y: Integer]: PRGB32Array read GetScanline;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
end;

TScanlineWriter = class
private
FBitmap: Vcl.Graphics.TBitmap; // Fully qualified TBitmap
FScanlines: array of PRGB32Array;
FPendingWrites: array of TPendingPixel;
FPendingWriteCount: Integer;
procedure FlushPendingWrites;
public
constructor Create(ABitmap: Vcl.Graphics.TBitmap);
destructor Destroy; override;
procedure AddScanline(APixel: TPendingPixel);
procedure SetPixel(X, Y: Integer; Color: TRGB32); overload;
procedure SetPixel(X, Y: Integer; Color: TColor); overload;
procedure CommitChanges;
end;

implementation

{ TScanlineReader }

constructor TScanlineReader.Create(ABitmap: Vcl.Graphics.TBitmap);
var
Y: Integer;
begin
if ABitmap.PixelFormat <> pf32bit then
raise Exception.Create('Bitmap must be 32-bit format');

FBitmap := ABitmap;
SetLength(FScanlines, FBitmap.Height);
for Y := 0 to FBitmap.Height - 1 do
FScanlines[Y] := FBitmap.ScanLine[Y];
end;

function TScanlineReader.GetScanline(Y: Integer): PRGB32Array;
begin
if (Y < 0) or (Y >= FBitmap.Height) then
raise Exception.Create(Format('Scanline Y=%d out of bounds (0..%d)', [Y, FBitmap.Height-1]));
Result := FScanlines[Y];
end;

function TScanlineReader.GetPixel(X, Y: Integer): TRGB32;
begin
if (X < 0) or (X >= Width) then
raise Exception.Create(Format('X=%d out of bounds', [X]));
if (Y < 0) or (Y >= Height) then
raise Exception.Create(Format('Y=%d out of bounds', [Y]));

Result := FScanlines[Y]^[X];
end;

function TScanlineReader.GetHeight: Integer;
begin
Result := FBitmap.Height;
end;

function TScanlineReader.GetWidth: Integer;
begin
Result := FBitmap.Width;
end;

{ TScanlineWriter }

constructor TScanlineWriter.Create(ABitmap: Vcl.Graphics.TBitmap);
var
Y: Integer;
begin
if ABitmap.PixelFormat <> pf32bit then
raise Exception.Create('Bitmap must be 32-bit format');

FBitmap := ABitmap;
SetLength(FScanlines, FBitmap.Height);
for Y := 0 to FBitmap.Height - 1 do
FScanlines[Y] := FBitmap.ScanLine[Y];
end;

procedure TScanlineWriter.SetPixel(X, Y: Integer; Color: TRGB32);
begin
if (X < 0) or (X >= FBitmap.Width) or (Y < 0) or (Y >= FBitmap.Height) then
Exit;

SetLength(FPendingWrites, Length(FPendingWrites)+1);
FPendingWrites[High(FPendingWrites)].XPos := X;
FPendingWrites[High(FPendingWrites)].YPos := Y;
FPendingWrites[High(FPendingWrites)].Color := Color;

if Length(FPendingWrites) > 1024 then
FlushPendingWrites;
end;

procedure TScanlineWriter.SetPixel(X, Y: Integer; Color: TColor);
var
RGB: TRGB32;
begin
RGB.R := GetRValue(Color);
RGB.G := GetGValue(Color);
RGB.B := GetBValue(Color);
RGB.A := 255;
SetPixel(X, Y, RGB);
end;

procedure TScanlineWriter.AddScanline(APixel: TPendingPixel);
begin
if FPendingWriteCount = Length(FPendingWrites) then
SetLength(FPendingWrites, FPendingWriteCount + 16);
FPendingWrites[FPendingWriteCount] := APixel;
Inc(FPendingWriteCount);
end;

procedure TScanlineWriter.FlushPendingWrites;
var
i: Integer;
begin
// Only process valid entries up to FPendingWriteCount
for i := 0 to FPendingWriteCount - 1 do
begin
// Here you would do the actual processing for each scanline.
// For example: WriteScanlineToDestination(FPendingWrites[i]);
end;
// Reset count after processing
FPendingWriteCount := 0;
end;

destructor TScanlineWriter.Destroy;
begin
// If there are any pending scanlines, flush them before destroying the object.
if FPendingWriteCount > 0 then
FlushPendingWrites;
inherited;
end;

procedure TScanlineWriter.CommitChanges;
begin
FlushPendingWrites;
if FBitmap.HandleAllocated then
FBitmap.Modified := True;
end;

end.

text

uImageCore.pas:

unit uImageCore;

interface

uses
Winapi.Windows, Vcl.Graphics, SysUtils, uImageTypes; // Adiciona SysUtils para Exception

type
// Se TImageRect não existir em outra unit, definimos como um alias de TRect.
//TImgRect = TRect;

// Pixel Read/Write Separation for Safety & Optimization
IImageReader = interface
['{6B33E9C1-1A4D-4F87-B6DE-2D4E5A7B8D9F}']
function GetPixel(X, Y: Integer): TColor;
function GetPixelUnsafe(X, Y: Integer): TColor; // Sem verificação de limites
function GetImageRect: TImageRect;
function SupportsSIMD: Boolean;
end;

IImageWriter = interface
['{1D45F7A2-3E8E-4D12-9C7C-8C1F2D6E5B3A}']
procedure SetPixel(X, Y: Integer; Color: TColor);
procedure SetPixelUnsafe(X, Y: Integer; Color: TColor);
procedure ApplyPreview; // Para atualizações em buffer (ex.: double buffering)
end;

EImageFrameworkError = class(Exception); // Agora Exception é conhecido

TRGBA32 = packed record
B: Byte;
G: Byte;
R: Byte;
A: Byte;
end;
PRGB32 = ^TRGBA32;
PRGB32Array = ^TRGB32Array;
TRGB32Array = array[0..0] of TRGBA32;

TPendingPixel = record
XPos: Integer;
YPos: Integer;
Color: TRGBA32;
end;

implementation

end.

text

uImageReader.pas:

unit uImageReader;

interface

uses
Winapi.Windows,
System.SysUtils,
System.Types,
System.Math,
Vcl.Graphics,
uImageCore,
uImageTypes;

type
TScanlineReader = class(TInterfacedObject, IImageReader)
protected
FBitmap: TBitmap;
FRowCache: array of Pointer; // Pre-cached Scanline pointers
FPixelFormat: TPixelFormat;
FBytesPerPixel: Integer;
FWidth, FHeight: Integer;
FSIMDSupported: Boolean;

text
function GetScanline(Y: Integer): PRGB32Array;
procedure InitializeCache;

public
constructor Create(ABitmap: TBitmap);
destructor Destroy; override;

text
// IImageReader implementation
function GetPixel(X, Y: Integer): TColor;
function GetPixelRGB(X, Y: Integer): TRGB32;
function GetPixelUnsafe(X, Y: Integer): TColor;
function GetPixelRGBUnsafe(X, Y: Integer): TRGB32;
function GetWidth: Integer;
function GetHeight: Integer;
function GetImageRect: TImageRect;
function SupportsSIMD: Boolean;

// Bulk operations for performance
procedure GetPixelLine(Y: Integer; var Buffer: array of TRGB32);
procedure GetPixelRect(const Rect: TImageRect; var Buffer: array of TRGB32);

end;

// Specialized reader for TBitmap with additional optimizations
TBitmapReader = class(TScanlineReader)
private
FUseDirectAccess: Boolean;
public
constructor Create(ABitmap: TBitmap; UseDirectAccess: Boolean = True);

text
// Optional SIMD optimized methods
procedure GetPixelLineOptimized(Y: Integer; var Buffer: array of TRGB32);

end;

implementation

{ TScanlineReader }

function IsSIMDSupported: Boolean;
{IF Defined(CPUX64)} begin // Processadores x64 sempre suportam SSE2, logo retornamos True. Result := True; end; {ELSEIF Defined(CPUX86)}
asm
// Nesta implementação para x86:
// 1. Colocamos 1 em EAX para solicitar as informações básicas do processador.
// 2. Executamos CPUID.
// 3. Testamos o bit 26 de EDX (SSE2).
// 4. Usamos SETC para colocar em AL 1 se o bit estiver setado, ou 0 caso contrário.
MOV EAX, 1 // Função CPUID 1: informações do processador
CPUID // Executa CPUID; os flags vão para EDX
BT EDX, 26 // Testa o bit 26 de EDX (SSE2)
SETC AL // Se o carry estiver setado, AL recebe 1; caso contrário, 0
// O resultado final é retornado em AL
{ELSE} begin // Para outras arquiteturas, retornamos False (ou você pode ajustar conforme a necessidade) Result := False; end; {ENDIF}

constructor TScanlineReader.Create(ABitmap: TBitmap);
begin
inherited Create;

if not Assigned(ABitmap) then
raise EImageFrameworkError.Create('Bitmap is nil');

if ABitmap.PixelFormat <> pf32bit then
raise EImageFrameworkError.Create('Bitmap must be 32-bit format');

FBitmap := ABitmap;
FWidth := FBitmap.Width;
FHeight := FBitmap.Height;
FPixelFormat := FBitmap.PixelFormat;

case FPixelFormat of
pf24bit: FBytesPerPixel := 3;
pf32bit: FBytesPerPixel := 4;
else
raise EImageFrameworkError.Create('Unsupported pixel format');
end;

FSIMDSupported := IsSIMDSupported;

InitializeCache;
end;

destructor TScanlineReader.Destroy;
begin
SetLength(FRowCache, 0);
inherited;
end;

procedure TScanlineReader.InitializeCache;
var
Y: Integer;
begin
// Pre-cache scanline pointers for faster access
SetLength(FRowCache, FHeight);
for Y := 0 to FHeight - 1 do
FRowCache[Y] := FBitmap.ScanLine[Y];
end;

function TScanlineReader.GetScanline(Y: Integer): PRGB32Array;
begin
if (Y < 0) or (Y >= FHeight) then
raise EImageFrameworkError.Create(Format('Scanline Y=%d out of bounds (0..%d)', [Y, FHeight-1]));

Result := FRowCache[Y];
end;

function TScanlineReader.GetPixel(X, Y: Integer): TColor;
var
Pixel: TRGB32;
begin
if (X < 0) or (X >= FWidth) or (Y < 0) or (Y >= FHeight) then
raise EImageFrameworkError.Create(Format('Pixel coordinates (%d,%d) out of bounds', [X, Y]));

Pixel := PRGB32Array(FRowCache[Y])^[X];
Result := RGB(Pixel.R, Pixel.G, Pixel.B);
end;

function TScanlineReader.GetPixelRGB(X, Y: Integer): TRGB32;
begin
if (X < 0) or (X >= FWidth) or (Y < 0) or (Y >= FHeight) then
raise EImageFrameworkError.Create(Format('Pixel coordinates (%d,%d) out of bounds', [X, Y]));

Result := PRGB32Array(FRowCache[Y])^[X];
end;

function TScanlineReader.GetPixelUnsafe(X, Y: Integer): TColor;
var
Pixel: TRGB32;
begin
Pixel := PRGB32Array(FRowCache[Y])^[X];
Result := RGB(Pixel.R, Pixel.G, Pixel.B);
end;

function TScanlineReader.GetPixelRGBUnsafe(X, Y: Integer): TRGB32;
begin
Result := PRGB32Array(FRowCache[Y])^[X];
end;

function TScanlineReader.GetWidth: Integer;
begin
Result := FWidth;
end;

function TScanlineReader.GetHeight: Integer;
begin
Result := FHeight;
end;

function TScanlineReader.GetImageRect: TImageRect;
begin
Result := TImageRect.CreateSize(0, 0, FWidth, FHeight);
end;

function TScanlineReader.SupportsSIMD: Boolean;
begin
Result := FSIMDSupported;
end;

procedure TScanlineReader.GetPixelLine(Y: Integer; var Buffer: array of TRGB32);
var
X, MaxX: Integer;
Scanline: PRGB32Array;
begin
if (Y < 0) or (Y >= FHeight) then
raise EImageFrameworkError.Create(Format('Line Y=%d out of bounds (0..%d)', [Y, FHeight-1]));

Scanline := PRGB32Array(FRowCache[Y]);
MaxX := Min(FWidth, Length(Buffer));

for X := 0 to MaxX - 1 do
Buffer[X] := Scanline^[X];
end;

procedure TScanlineReader.GetPixelRect(const Rect: TImageRect; var Buffer: array of TRGB32);
var
X, Y, DestIdx, Width, Height: Integer;
Scanline: PRGB32Array;
begin
Width := Rect.Width;
Height := Rect.Height;

if (Width * Height > Length(Buffer)) then
raise EImageFrameworkError.Create('Buffer too small for requested rectangle');

DestIdx := 0;
for Y := Rect.Top to Rect.Bottom - 1 do
begin
if (Y < 0) or (Y >= FHeight) then
Continue;

text
Scanline := PRGB32Array(FRowCache[Y]);

for X := Rect.Left to Rect.Right - 1 do
begin
  if (X < 0) or (X >= FWidth) then
    Continue;

  Buffer[DestIdx] := Scanline^[X];
  Inc(DestIdx);
end;

end;
end;

{ TBitmapReader }

constructor TBitmapReader.Create(ABitmap: TBitmap; UseDirectAccess: Boolean);
begin
inherited Create(ABitmap);
FUseDirectAccess := UseDirectAccess;
end;

procedure TBitmapReader.GetPixelLineOptimized(Y: Integer; var Buffer: array of TRGB32);
var
SrcLine: PRGB32Array;
BytesToCopy: Integer;
begin
if (Y < 0) or (Y >= GetHeight) then
Exit;

SrcLine := PRGB32Array(FRowCache[Y]);
BytesToCopy := Min(GetWidth, Length(Buffer)) * SizeOf(TRGB32);

// Fast memory copy
Move(SrcLine^[0], Buffer[0], BytesToCopy);

// Note: In a real implementation, SIMD operations like
// SSE2/AVX would be used here for even faster copying
end;

end.

text

uImageTypes.pas:

unit uImageTypes;

interface

uses
Winapi.Windows, Vcl.Graphics, System.Types;

type
TRGB24 = packed record
B: Byte;
G: Byte;
R: Byte;
end;
PRGB24 = ^TRGB24;
PRGB24Array = ^TRGB24Array;
TRGB24Array = array[0..0] of TRGB24;

TRGB32 = packed record
B: Byte;
G: Byte;
R: Byte;
A: Byte;
end;
PRGB32 = ^TRGB32;
PRGB32Array = ^TRGB32Array;
TRGB32Array = array[0..0] of TRGB32;

TPendingPixel = record
XPos: Integer;
YPos: Integer;
Color: TRGB32;
end;

TImageRect = packed record
Left: Integer;
Top: Integer;
Right: Integer;
Bottom: Integer;
function Width: Integer;
function Height: Integer;
function IsEmpty: Boolean;
function Contains(X, Y: Integer): Boolean;
class function Create(ALeft, ATop, ARight, ABottom: Integer): TImageRect; static;
class function CreateSize(ALeft, ATop, AWidth, AHeight: Integer): TImageRect; static;
end;

implementation

{ TImageRect }

function TImageRect.Width: Integer;
begin
Result := Right - Left;
end;

function TImageRect.Height: Integer;
begin
Result := Bottom - Top;
end;

function TImageRect.IsEmpty: Boolean;
begin
Result := (Width <= 0) or (Height <= 0);
end;

function TImageRect.Contains(X, Y: Integer): Boolean;
begin
Result := (X >= Left) and (X < Right) and (Y >= Top) and (Y < Bottom);
end;

class function TImageRect.Create(ALeft, ATop, ARight, ABottom: Integer): TImageRect;
begin
Result.Left := ALeft;
Result.Top := ATop;
Result.Right := ARight;
Result.Bottom := ABottom;
end;

class function TImageRect.CreateSize(ALeft, ATop, AWidth, AHeight: Integer): TImageRect;
begin
Result.Left := ALeft;
Result.Top := ATop;
Result.Right := ALeft + AWidth;
Result.Bottom := ATop + AHeight;
end;

end.

text

uImageWriter.pas:

unit uImageWriter;

interface

uses
Winapi.Windows,
System.SysUtils,
System.Types,
System.Math,
Vcl.Graphics,
uImageCore,
uImageTypes;

type
TScanlineWriter = class(TInterfacedObject, IImageWriter)
protected
FBitmap: TBitmap;
FRowCache: array of Pointer; // Pre-cached scanline pointers
FPendingWrites: array of TPendingPixel;
FPendingWriteCount: Integer;
FMaxBatchSize: Integer;
FAutoFlush: Boolean;

procedure FlushPendingWrites;

public
constructor Create(ABitmap: TBitmap; MaxBatchSize: Integer = 1024);
destructor Destroy; override;

text
// IImageWriter implementation
procedure SetPixel(X, Y: Integer; Color: TColor);
procedure SetPixelRGB(X, Y: Integer; Color: TRGB32);
procedure SetPixelUnsafe(X, Y: Integer; Color: TColor);
procedure SetPixelRGBUnsafe(X, Y: Integer; Color: TRGB32);
procedure CommitChanges;
procedure ApplyPreview;

// Batch operations
procedure AddPendingPixel(APixel: TPendingPixel);
procedure SetPixelLine(Y: Integer; const Buffer: array of TRGB32);
procedure SetPixelRect(const Rect: TImageRect; const Buffer: array of TRGB32);

// Properties
property AutoFlush: Boolean read FAutoFlush write FAutoFlush;

end;

// Specialized writer for TBitmap with additional optimizations
TBitmapWriter = class(TScanlineWriter)
private
FUseDirectAccess: Boolean;
FWriteBuffer: array of TRGB32; // Double-buffer for optimized updates
public
constructor Create(ABitmap: TBitmap; UseDirectAccess: Boolean = True);
destructor Destroy; override;

text
// Optimized methods
procedure SetPixelLineOptimized(Y: Integer; const Buffer: array of TRGB32);
procedure FillRect(const Rect: TImageRect; Color: TRGB32);

end;

implementation

{ TScanlineWriter }

constructor TScanlineWriter.Create(ABitmap: TBitmap; MaxBatchSize: Integer);
var
Y: Integer;
begin
if not Assigned(ABitmap) then
raise EImageFrameworkError.Create('Bitmap is nil');

if ABitmap.PixelFormat <> pf32bit then
raise EImageFrameworkError.Create('Bitmap must be 32-bit format');

FBitmap := ABitmap;
FMaxBatchSize := MaxBatchSize;
FAutoFlush := True;

// Pre-cache scanline pointers
SetLength(FRowCache, FBitmap.Height);
for Y := 0 to FBitmap.Height - 1 do
FRowCache[Y] := FBitmap.ScanLine[Y];

// Initialize pending writes buffer
SetLength(FPendingWrites, FMaxBatchSize);
FPendingWriteCount := 0;
end;

destructor TScanlineWriter.Destroy;
begin
// Flush any pending writes
if FPendingWriteCount > 0 then
FlushPendingWrites;

SetLength(FRowCache, 0);
SetLength(FPendingWrites, 0);

inherited;
end;

procedure TScanlineWriter.SetPixel(X, Y: Integer; Color: TColor);
var
RGB: TRGB32;
begin
if (X < 0) or (X >= FBitmap.Width) or (Y < 0) or (Y >= FBitmap.Height) then
Exit; // Silently ignore out-of-bounds

RGB.R := GetRValue(Color);
RGB.G := GetGValue(Color);
RGB.B := GetBValue(Color);
RGB.A := 255;

SetPixelRGB(X, Y, RGB);
end;

procedure TScanlineWriter.SetPixelRGB(X, Y: Integer; Color: TRGB32);
begin
if (X < 0) or (X >= FBitmap.Width) or (Y < 0) or (Y >= FBitmap.Height) then
Exit; // Silently ignore out-of-bounds

// Add to pending writes buffer
if FPendingWriteCount >= Length(FPendingWrites) then
SetLength(FPendingWrites, FPendingWriteCount + FMaxBatchSize);

FPendingWrites[FPendingWriteCount].XPos := X;
FPendingWrites[FPendingWriteCount].YPos := Y;
FPendingWrites[FPendingWriteCount].Color := Color;
Inc(FPendingWriteCount);

// Auto-flush if batch size exceeded
if FAutoFlush and (FPendingWriteCount >= FMaxBatchSize) then
FlushPendingWrites;
end;

procedure TScanlineWriter.SetPixelUnsafe(X, Y: Integer; Color: TColor);
var
RGB: TRGB32;
begin
RGB.R := GetRValue(Color);
RGB.G := GetGValue(Color);
RGB.B := GetBValue(Color);
RGB.A := 255;

SetPixelRGBUnsafe(X, Y, RGB);
end;

procedure TScanlineWriter.SetPixelRGBUnsafe(X, Y: Integer; Color: TRGB32);
begin
// Directly set pixel - no bounds checking, no batching
PRGB32Array(FRowCache[Y])^[X] := Color;
end;

procedure TScanlineWriter.AddPendingPixel(APixel: TPendingPixel);
begin
if FPendingWriteCount >= Length(FPendingWrites) then
SetLength(FPendingWrites, FPendingWriteCount + FMaxBatchSize);

FPendingWrites[FPendingWriteCount] := APixel;
Inc(FPendingWriteCount);

if FAutoFlush and (FPendingWriteCount >= FMaxBatchSize) then
FlushPendingWrites;
end;

procedure TScanlineWriter.FlushPendingWrites;
var
i: Integer;
X, Y: Integer;
ScanLine: PRGB32Array;
LastY: Integer;
begin
if FPendingWriteCount = 0 then
Exit;

// Sort by Y for better cache locality
// In a real implementation, you would use a more efficient
// sorting algorithm than this bubble sort
for i := 0 to FPendingWriteCount - 2 do
for X := 0 to FPendingWriteCount - i - 2 do
if FPendingWrites[X].YPos > FPendingWrites[X + 1].YPos then
begin
// Swap
FPendingWrites[X].YPos := FPendingWrites[X].YPos xor FPendingWrites[X + 1].YPos;
FPendingWrites[X + 1].YPos := FPendingWrites[X].YPos xor FPendingWrites[X + 1].YPos;
FPendingWrites[X].YPos := FPendingWrites[X].YPos xor FPendingWrites[X + 1].YPos;

text
    FPendingWrites[X].XPos := FPendingWrites[X].XPos xor FPendingWrites[X + 1].XPos;
    FPendingWrites[X + 1].XPos := FPendingWrites[X].XPos xor FPendingWrites[X + 1].XPos;
    FPendingWrites[X].XPos := FPendingWrites[X].XPos xor FPendingWrites[X + 1].XPos;

    // Swap color (would need a more complex approach for a real implementation)
  end;

// Apply all pending writes
ScanLine := nil;
LastY := -1;
for i := 0 to FPendingWriteCount - 1 do
begin
X := FPendingWrites[i].XPos;
Y := FPendingWrites[i].YPos;

text
// Skip out-of-bounds pixels
if (X < 0) or (X >= FBitmap.Width) or (Y < 0) or (Y >= FBitmap.Height) then
  Continue;

// Get scanline only when Y changes (performance optimization)
if Y <> LastY then
begin
  ScanLine := PRGB32Array(FRowCache[Y]);
  LastY := Y;
end;

// Set the pixel
ScanLine^[X] := FPendingWrites[i].Color;

end;

// Reset counter
FPendingWriteCount := 0;
end;

procedure TScanlineWriter.SetPixelLine(Y: Integer; const Buffer: array of TRGB32);
var
X, MaxX: Integer;
ScanLine: PRGB32Array;
begin
if (Y < 0) or (Y >= FBitmap.Height) then
Exit;

ScanLine := PRGB32Array(FRowCache[Y]);
MaxX := Min(FBitmap.Width, Length(Buffer));

for X := 0 to MaxX - 1 do
ScanLine^[X] := Buffer[X];
end;

procedure TScanlineWriter.SetPixelRect(const Rect: TImageRect; const Buffer: array of TRGB32);
var
X, Y, SrcIdx, Width, Height: Integer;
ScanLine: PRGB32Array;
begin
Width := Rect.Width;
Height := Rect.Height;

if (Width * Height > Length(Buffer)) then
raise EImageFrameworkError.Create('Buffer too small for requested rectangle');

SrcIdx := 0;
for Y := Rect.Top to Rect.Bottom - 1 do
begin
if (Y < 0) or (Y >= FBitmap.Height) then
begin
Inc(SrcIdx, Width);
Continue;
end;

text
ScanLine := PRGB32Array(FRowCache[Y]);

for X := Rect.Left to Rect.Right - 1 do
begin
  if (X >= 0) and (X < FBitmap.Width) then
    ScanLine^[X] := Buffer[SrcIdx];

  Inc(SrcIdx);
end;

end;
end;

procedure TScanlineWriter.CommitChanges;
begin
// First flush any pending writes
FlushPendingWrites;

// Mark bitmap as modified
if FBitmap.HandleAllocated then
FBitmap.Modified := True;
end;

procedure TScanlineWriter.ApplyPreview;

begin
// If using double buffering, but in this case, direct writes are done
end;

{ TBitmapWriter }

constructor TBitmapWriter.Create(ABitmap: TBitmap; UseDirectAccess: Boolean = True);
begin
inherited Create(ABitmap);
FUseDirectAccess := UseDirectAccess;
end;

destructor TBitmapWriter.Destroy;
begin
inherited;
end;

procedure TBitmapWriter.SetPixelLineOptimized(Y: Integer; const Buffer: array of TRGB32);
var
DestLine: PRGB32Array;
BytesToCopy: Integer;
begin
if (Y < 0) or (Y >= FBitmap.Height) then
Exit;

DestLine := PRGB32Array(FRowCache[Y]);
BytesToCopy := Min(FBitmap.Width, Length(Buffer)) * SizeOf(TRGB32);

// Fast memory copy
Move(Buffer[0], DestLine^[0], BytesToCopy);

// Note: In a real implementation, SIMD operations would be used here
// for even faster copying (SSE2, AVX, etc.)
end;

procedure TBitmapWriter.FillRect(const Rect: TImageRect; Color: TRGB32);
var
X, Y: Integer;
ScanLine: PRGB32Array;
begin
//{$R-}
for Y := Rect.Top to Rect.Bottom - 1 do
begin
if (Y < 0) or (Y >= FBitmap.Height) then
Continue;

text
ScanLine := PRGB32Array(FRowCache[Y]);

for X := Rect.Left to Rect.Right - 1 do
begin
  if (X < 0) or (X >= FBitmap.Width) then
    Continue;

  ScanLine^[X] := Color;
end;

end;
//{$R+}
end;

end.

text



See how our project's terminal output looked in its current state:

Error: Range check error

Press Enter to exit...

text

I am facing the following runtime errors:

Project pScanlineConsoleDemo.exe raised exception class ERangeError with message 'Range check error'.

text

See the Delphi Call Stack:

:00007FF868EEB699 ; C:\Windows\System32\KERNELBASE.dll
System._RaiseAtExcept(???,???)
System.SysUtils.ErrorHandler(???,$813B93) System.ErrorAt(4,$813B93)
System._BoundErr
uImageWriter.TBitmapWriter.FillRect((8714248, 0, -16777216, 464),(0, 0, 0, 255))
pScanlineConsoleDemo.pScanlineConsoleDemo
:00007FF86ADC7374 ; C:\Windows\System32\KERNEL32.DLL
:00007FF86B6BCC91 ; <UNKNOWN>

text

The **Call Stack** indicates that when calling
```delphi
Writer.FillRect(ImgRect, BlackColor);

the FillRect method is receiving a rectangle with absurd values:

(8714248, 0, -16777216, 464)

— clearly different from what we would expect from

delphi
ImgRect := TImageRect.CreateSize(0, 0, Bitmap.Width, Bitmap.Height);

(i.e. it should be something like (0, 0, 7680, 4320)).

This causes the inner loop to:

delphi
for X := Rect.Left to Rect.Right - 1 do
  if (X < 0) or (X >= FBitmap.Width) then
    Continue
  else
    ScanLine^[X] := Color;

interpret an out-of-range X value and throw an ERangeError when access to ScanLine^[X] is attempted.

So the main problem seems to stem from an excessively large memory allocation in the TBitmapWriter constructor, which can lead to memory corruption.

I even thought for a moment about putting {$R-} // Disable range checking at the beginning of the TBitmapWriter.FillRect() procedure and {$R+} // Re-enable range checking at the end of the TBitmapWriter.FillRect() procedure, but despite actually making the app reach the end of its work without crashing or closing abruptly, I consider it to be a palliative solution, without really correcting the problem and producing work with dubious and erratic results.

See also that:
The runtime error we're experiencing is likely caused by an invalid TImageRect being passed to the FillRect method. Let's analyze the code and propose a solution.
The error suggests that the TImageRect values are not correctly set up. In the original code (pScanlineConsoleDemo.dpr), the rect is created using TImageRect.CreateSize(0, 0, Bitmap.Width, Bitmap.Height). However, something seems to have gone wrong with the rect creation.

The causes I mentioned above were just guesses that I think are happening with the second project, to try to help you, but you should go beyond what I said. You should investigate both projects, the first, simpler one that is working perfectly and compare it with the second project that is not working, and find what causes in the second project are causing these errors at runtime.

I added the first project as a correctly functioning model, to help you find what is wrong with the second project. You should diagnose line by line from the sources of problems identified in the second project.

You should write solutions correcting the true causes of these problems (of second project). You should ensure compatibility with Delphi 10.4+ (modern Delphi). You should ensure that the code will be corrected and with this correction our project will work perfectly.

Write the corrected unit completely and perfectly functional (of project 2), to avoid implementation errors of the corrections (such as copy and paste errors of the corrected codes).

Note that in the first project I think it does not use its units, but only the dpr project. In the second project, when you are going to fix bugs in it, you should ensure that you use the uImageCore.pas, uImageReader.pas, uImageTypes.pas, and uImageWriter.pas units.

Design a corrected Delphi unit for a console application project that manipulates bitmap pixel data via a ScanLine mechanism. The objective is to eliminate the runtime ERangeError caused by an invalid TImageRect passed to the FillRect method. The solution must compare the functioning first project with the failing second project, pinpoint the root cause of the invalid rectangle (e.g., memory corruption or erroneous range values due to faulty memory allocation in the TBitmapWriter constructor), and provide a fully functional, robust fix that is compatible with Delphi 10.4+.

Provide the complete, fully corrected source code for the unit containing the revised TBitmapWriter class and the FillRect method (for second project). The code must be complete and formatted for easy copy-paste integration, with detailed inline comments explaining the corrections. Use tables or ASCII diagrams if necessary to illustrate complex logic. If any changes in other units or integration notes are required, include those details as well.

• Ensure the solution addresses the inherent range checking and memory allocation issues to prevent any out-of-bound access.
• Avoid using compiler directives like {$R-} as a palliative measure; implement a genuine fix.
• Confirm that the solution prevents memory corruption in all realistic usage scenarios.
• Verify that the corrected code integrates seamlessly into the existing project structure, with proper unit references and adherence to modern Delphi best practices.
• The answer should be scholarly and detailed, ensuring that every change is justified and explained.
• Do not assume extraneous context; rely solely on the details provided herein and the known differences between the first and second projects.

The project consists of two Delphi console applications that implement pixel manipulation through ScanLine access. The first project, though basic, functions perfectly, while the second, more modularized and refactored project experiences runtime errors. The runtime error is an "ERangeError" with the specific message "Range check error" when calling:

Writer.FillRect(ImgRect, BlackColor);

The call stack indicates that the TImageRect instance passed to FillRect has wildly incorrect values, for example, (8714248, 0, -16777216, 464) instead of expected values like (0, 0, Bitmap.Width, Bitmap.Height). The error arises during an inner loop where an iteration variable exceeds FBitmap.Width. Preliminary analysis suggests an erroneous memory allocation in the TBitmapWriter constructor may be corrupting the rectangle data. The solution should involve a detailed line-by-line diagnosis comparing the flawless implementation in the first project to the erroneous second project, correcting memory allocation and construction of TImageRect and any associated structures. Emphasize clear, maintainable, and robust corrections addressing both range checking and memory safety without resorting to disabling compiler safeguards.

Please generate a comprehensive solution that leverages a deep Chain-of-Thought approach to diagnose, explain, and rectify these issues, and then output the complete, corrected code of second project.