Changeset 506 for trunk/Packages/DpiControls/NativePixelPointer.pas

Timestamp:

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

Author:

chronos

Message:

• Fixed: Better PixelPointer range checking.

File:

• trunk/Packages/DpiControls/NativePixelPointer.pas (modified) (6 diffs)

trunk/Packages/DpiControls/NativePixelPointer.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 }
 
   TPixel32 = packed record
-    procedure SetRGB(Color: TColor32);
-    function GetRGB: TColor32;
+  private
+    procedure SetRGB(AValue: Cardinal); inline;
+    function GetRGB: Cardinal; inline;
+  public
+    property RGB: Cardinal read GetRGB write SetRGB;
     case Integer of
       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;
@@ -26 +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;
@@ -43 +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;
 
+  function SwapRedBlue(Color: TColor32): TColor32;
+  procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
+  procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
+    SrcBitmap: TRasterImage; SrcRect: TRect);
+  procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
+  procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
+  procedure BitmapSwapRedBlue(Bitmap:TRasterImage);
+  procedure BitmapInvert(Bitmap: TRasterImage);
+  procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
+  function Color32(A, R, G, B: Byte): TColor32;
+  function Color32ToPixel32(Color: TColor32): TPixel32;
+  function Pixel32ToColor32(Color: TPixel32): TColor32;
   function Color32ToColor(Color: TColor32): TColor;
   function ColorToColor32(Color: TColor): TColor32;
@@ -53 +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]';
 
-  { TPixel32 }
-
-procedure TPixel32.SetRGB(Color: TColor32);
-begin
-  B := Color and $ff;
-  G := (Color shr 8) and $ff;
-  R := (Color shr 16) and $ff;
-end;
-
-function TPixel32.GetRGB: TColor32;
+{ TPixel32 }
+
+function TPixel32.GetRGB: Cardinal;
 begin
   Result := ARGB and $ffffff;
+end;
+
+procedure TPixel32.SetRGB(AValue: Cardinal);
+begin
+  R := (AValue shr 16) and $ff;
+  G := (AValue shr 8) and $ff;
+  B := (AValue shr 0) and $ff;
 end;
 
@@ -106 +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;
+
+procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
+  SrcBitmap: TRasterImage; SrcPos: TPoint);
+var
+  SrcPtr, DstPtr: TPixelPointer;
+  X, Y: Integer;
+begin
+  SrcBitmap.BeginUpdate(True);
+  DstBitmap.BeginUpdate(True);
+  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y);
+  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
+  for Y := 0 to DstRect.Height - 1 do begin
+    for X := 0 to DstRect.Width - 1 do begin
+      DstPtr.PixelARGB := SrcPtr.PixelARGB;
+      SrcPtr.NextPixel;
+      DstPtr.NextPixel;
+    end;
+    SrcPtr.NextLine;
+    DstPtr.NextLine;
+  end;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
+  SrcBitmap: TRasterImage; SrcRect: TRect);
+var
+  SrcPtr, DstPtr: TPixelPointer;
+  X, Y: Integer;
+  XX, YY: Integer;
+  R: TRect;
+  C: TColor32;
+begin
+  if (DstRect.Width = SrcRect.Width) and (DstRect.Height = SrcRect.Height) then begin
+    BitmapCopyRect(DstBitmap, DstRect, SrcBitmap, Point(SrcRect.Left, SrcRect.Top));
+    Exit;
+  end;
+  SrcBitmap.BeginUpdate(True);
+  DstBitmap.BeginUpdate(True);
+  SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top);
+  DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
+  for Y := 0 to DstRect.Height - 1 do begin
+    for X := 0 to DstRect.Width - 1 do begin
+      R := Rect(Trunc(X * SrcRect.Width / DstRect.Width),
+        Trunc(Y * SrcRect.Height / DstRect.Height),
+        Trunc((X + 1) * SrcRect.Width / DstRect.Width),
+        Trunc((Y + 1) * SrcRect.Height / DstRect.Height));
+      DstPtr.SetXY(X, Y);
+      SrcPtr.SetXY(R.Left, R.Top);
+      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.PixelARGB := C;
+          DstPtr.NextPixel;
+        end;
+        DstPtr.NextLine;
+      end;
+    end;
+  end;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := TPixelPointer.Create(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      Ptr.PixelARGB := Color;
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top);
+  for Y := 0 to Rect.Height - 1 do begin
+    for X := 0 to Rect.Width - 1 do begin
+      Ptr.PixelARGB := Color;
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+procedure BitmapSwapRedBlue(Bitmap: TRasterImage);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := TPixelPointer.Create(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+procedure BitmapInvert(Bitmap: TRasterImage);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := TPixelPointer.Create(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+  A, R, G, B: Word;
+  Pixel: TPixel32;
+begin
+  Pixel := Color32ToPixel32(Color);
+  Bitmap.BeginUpdate(True);
+  Ptr := TPixelPointer.Create(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      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;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+function Color32(A, R, G, B: Byte): TColor32;
+begin
+  Result := ((A and $ff) shl 24) or ((R and $ff) shl 16) or
+    ((G and $ff) shl 8) or ((B and $ff) shl 0);
+end;
+
+function Color32ToPixel32(Color: TColor32): TPixel32;
+begin
+  Result.ARGB := Color;
+end;
+
+function Pixel32ToColor32(Color: TPixel32): TColor32;
+begin
+  Result := Color.ARGB;
+end;
+
+function Color32ToColor(Color: TColor32): TColor;
+begin
+  Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
+    ((Color and $ff) shl 16);
+end;
+
+function ColorToColor32(Color: TColor): TColor32;
+begin
+  Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
+    ((Color and $ff) shl 16);
 end;
 
@@ -129 +452 @@
 end;
 
-function Color32ToColor(Color: TColor32): TColor;
-begin
-  Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
-    ((Color and $ff) shl 16);
-end;
-
-function ColorToColor32(Color: TColor): TColor32;
-begin
-  Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
-    ((Color and $ff) shl 16);
+function SwapRedBlue(Color: TColor32): TColor32;
+begin
+  Result := (Color and $ff00ff00) or ((Color and $ff) shl 16) or ((Color shr 16) and $ff);
 end;
 
 end.
-