Changeset 506 for trunk/Packages/Common

Timestamp:

Dec 25, 2023, 11:35:51 AM (12 months ago)

Author:

chronos

Message:

• Fixed: Better PixelPointer range checking.

Location:

trunk/Packages/Common

Files:

• Languages/PixelPointer.pot (modified) (1 diff)
• PixelPointer.pas (modified) (14 diffs)

trunk/Packages/Common/Languages/PixelPointer.pot

@@ -3 +3 @@
 
 #: pixelpointer.soutofrange
-msgid "Pixel pointer out of range"
+#, object-pascal-format
+msgid "Pixel pointer out of range [X: %d. Y: %d]"
 msgstr ""
 

trunk/Packages/Common/PixelPointer.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Graphics;
+  Math, Classes, SysUtils, Graphics;
 
 type
   TColor32 = type Cardinal;
   TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
+  TColor32Planes = array[0..3] of Byte;
 
   { TPixel32 }
@@ -14 +15 @@
   TPixel32 = packed record
   private
-    procedure SetRGB(AValue: Cardinal);
-    function GetRGB: Cardinal;
+    procedure SetRGB(AValue: Cardinal); inline;
+    function GetRGB: Cardinal; inline;
   public
     property RGB: Cardinal read GetRGB write SetRGB;
@@ -21 +22 @@
       0: (B, G, R, A: Byte);
       1: (ARGB: TColor32);
-      2: (Planes: array[0..3] of Byte);
+      2: (Planes: TColor32Planes);
       3: (Components: array[TColor32Component] of Byte);
   end;
@@ -29 +30 @@
 
   TPixelPointer = record
+  private
+    function GetPixelARGB: TColor32; inline;
+    function GetPixelB: Byte; inline;
+    function GetPixelG: Byte; inline;
+    function GetPixelPlane(Index: Byte): Byte;
+    function GetPixelR: Byte; inline;
+    function GetPixelA: Byte; inline;
+    function GetPixelPlanes: TColor32Planes;
+    function GetPixelRGB: Cardinal;
+    procedure SetPixelARGB(Value: TColor32); inline;
+    procedure SetPixelB(Value: Byte); inline;
+    procedure SetPixelG(Value: Byte); inline;
+    procedure SetPixelPlane(Index: Byte; AValue: Byte);
+    procedure SetPixelR(Value: Byte); inline;
+    procedure SetPixelA(Value: Byte); inline;
+    procedure SetPixelRGB(Value: Cardinal);
+  public
     Base: PPixel32;
     Pixel: PPixel32;
@@ -46 +64 @@
     procedure CheckRange; inline; // Check if current pixel position is not out of range
     class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
+    property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
+    property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB;
+    property PixelB: Byte read GetPixelB write SetPixelB;
+    property PixelG: Byte read GetPixelG write SetPixelG;
+    property PixelR: Byte read GetPixelR write SetPixelR;
+    property PixelA: Byte read GetPixelA write SetPixelA;
+    property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane;
   end;
   PPixelPointer = ^TPixelPointer;
@@ -68 +93 @@
 
 resourcestring
-  SOutOfRange = 'Pixel pointer out of range';
+  SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]';
   SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
 
@@ -121 +146 @@
 
 procedure TPixelPointer.CheckRange;
+{$IFOPT R+}
+var
+  X: Integer;
+  Y: Integer;
+{$ENDIF}
 begin
   {$IFOPT R+}
   if (PByte(Pixel) < PByte(Data)) or
-    (PByte(Pixel) >= PByte(Data) + (Width + Height * BytesPerLine) * BytesPerPixel) then
-    raise Exception.Create(SOutOfRange);
+    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
+    X := PByte(Pixel) - PByte(Data);
+    Y := Floor(X / BytesPerLine);
+    X := X - Y * BytesPerLine;
+    X := Floor(X / BytesPerPixel);
+    raise Exception.Create(Format(SOutOfRange, [X, Y]));
+  end;
   {$ENDIF}
+end;
+
+function TPixelPointer.GetPixelPlanes: TColor32Planes;
+begin
+  CheckRange;
+  Result := Pixel^.Planes;
+end;
+
+function TPixelPointer.GetPixelRGB: Cardinal;
+begin
+  CheckRange;
+  Result := Pixel^.RGB;
+end;
+
+procedure TPixelPointer.SetPixelARGB(Value: TColor32);
+begin
+  CheckRange;
+  Pixel^.ARGB := Value;
+end;
+
+procedure TPixelPointer.SetPixelB(Value: Byte);
+begin
+  CheckRange;
+  Pixel^.B := Value;
+end;
+
+procedure TPixelPointer.SetPixelG(Value: Byte);
+begin
+  CheckRange;
+  Pixel^.G := Value;
+end;
+
+procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte);
+begin
+  CheckRange;
+  Pixel^.Planes[Index] := AValue;
+end;
+
+procedure TPixelPointer.SetPixelR(Value: Byte);
+begin
+  CheckRange;
+  Pixel^.R := Value;
+end;
+
+procedure TPixelPointer.SetPixelA(Value: Byte);
+begin
+  CheckRange;
+  Pixel^.A := Value;
+end;
+
+function TPixelPointer.GetPixelARGB: TColor32;
+begin
+  CheckRange;
+  Result := Pixel^.ARGB;
+end;
+
+function TPixelPointer.GetPixelB: Byte;
+begin
+  CheckRange;
+  Result := Pixel^.B;
+end;
+
+function TPixelPointer.GetPixelG: Byte;
+begin
+  CheckRange;
+  Result := Pixel^.G;
+end;
+
+function TPixelPointer.GetPixelPlane(Index: Byte): Byte;
+begin
+  CheckRange;
+  Result := Pixel^.Planes[Index];
+end;
+
+function TPixelPointer.GetPixelR: Byte;
+begin
+  CheckRange;
+  Result := Pixel^.R;
+end;
+
+function TPixelPointer.GetPixelA: Byte;
+begin
+  CheckRange;
+  Result := Pixel^.A;
+end;
+
+procedure TPixelPointer.SetPixelRGB(Value: Cardinal);
+begin
+  CheckRange;
+  Pixel^.RGB := Value;
 end;
 
@@ -141 +266 @@
   for Y := 0 to DstRect.Height - 1 do begin
     for X := 0 to DstRect.Width - 1 do begin
-      DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
+      DstPtr.PixelARGB := SrcPtr.PixelARGB;
       SrcPtr.NextPixel;
       DstPtr.NextPixel;
@@ -177 +302 @@
       DstPtr.SetXY(X, Y);
       SrcPtr.SetXY(R.Left, R.Top);
-      C := SrcPtr.Pixel^.ARGB;
-      DstPtr.Pixel^.ARGB := C;
+      C := SrcPtr.PixelARGB;
+      DstPtr.PixelARGB := C;
       for YY := 0 to R.Height - 1 do begin
         for XX := 0 to R.Width - 1 do begin
-          DstPtr.Pixel^.ARGB := C;
+          DstPtr.PixelARGB := C;
           DstPtr.NextPixel;
         end;
@@ -201 +326 @@
   for Y := 0 to Bitmap.Height - 1 do begin
     for X := 0 to Bitmap.Width - 1 do begin
-      Ptr.Pixel^.ARGB := Color;
+      Ptr.PixelARGB := Color;
       Ptr.NextPixel;
     end;
@@ -218 +343 @@
   for Y := 0 to Rect.Height - 1 do begin
     for X := 0 to Rect.Width - 1 do begin
-      Ptr.Pixel^.ARGB := Color;
+      Ptr.PixelARGB := Color;
       Ptr.NextPixel;
     end;
@@ -235 +360 @@
   for Y := 0 to Bitmap.Height - 1 do begin
     for X := 0 to Bitmap.Width - 1 do begin
-      Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
+      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
       Ptr.NextPixel;
     end;
@@ -252 +377 @@
   for Y := 0 to Bitmap.Height - 1 do begin
     for X := 0 to Bitmap.Width - 1 do begin
-      Ptr.Pixel^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;
+      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
       Ptr.NextPixel;
     end;
@@ -272 +397 @@
   for Y := 0 to Bitmap.Height - 1 do begin
     for X := 0 to Bitmap.Width - 1 do begin
-      A := Ptr.Pixel^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;
-      R := (Ptr.Pixel^.R + Pixel.R) shr 1;
-      G := (Ptr.Pixel^.G + Pixel.G) shr 1;
-      B := (Ptr.Pixel^.B + Pixel.B) shr 1;
-      Ptr.Pixel^.ARGB := Color32(A, R, G, B);
+      A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1;
+      R := (Ptr.PixelR + Pixel.R) shr 1;
+      G := (Ptr.PixelG + Pixel.G) shr 1;
+      B := (Ptr.PixelB + Pixel.B) shr 1;
+      Ptr.PixelARGB := Color32(A, R, G, B);
       Ptr.NextPixel;
     end;