Changeset 501 for trunk/Packages

Timestamp:

Dec 23, 2023, 11:11:19 AM (11 months ago)

Author:

chronos

Message:

• Fixed: TPixelPointer range check.

Location:

trunk/Packages

Files:

• CevoComponents/ScreenTools.pas (modified) (11 diffs)
• DpiControls/Dpi.PixelPointer.pas (modified) (3 diffs)

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -40 +40 @@
 procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer);
 procedure MakeRed(Dst: TBitmap; X, Y, Width, Height: Integer);
-procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
+procedure ImageOp_B(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
 procedure ImageOp_BCC(Dst, Src: TBitmap;
   xDst, yDst, xSrc, ySrc, Width, Height, Color1, Color2: Integer); overload;
@@ -47 +47 @@
 procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
   Color0, Color2: Integer);
-procedure ImageOp_CCC(bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer);
+procedure ImageOp_CCC(Bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer);
 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer;
   SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
@@ -627 +627 @@
 end;
 
-procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
+procedure ImageOp_B(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
 // Src is template
 // X channel = background amp (old Dst content), 128=original brightness
@@ -643 +643 @@
   Height := ScaleToNative(Height);
   //Assert(Src.PixelFormat = pf8bit);
-  Assert(dst.PixelFormat = TPixelFormat.pf24bit);
+  Assert(Dst.PixelFormat = TPixelFormat.pf24bit);
   if xDst < 0 then begin
     Width := Width + xDst;
@@ -654 +654 @@
     yDst := 0;
   end;
-  if xDst + Width > ScaleToNative(dst.Width) then
-    Width := ScaleToNative(dst.Width) - xDst;
-  if yDst + Height > ScaleToNative(dst.Height) then
-    Height := ScaleToNative(dst.Height) - yDst;
+  if xDst + Width > ScaleToNative(Dst.Width) then
+    Width := ScaleToNative(Dst.Width) - xDst;
+  if yDst + Height > ScaleToNative(Dst.Height) then
+    Height := ScaleToNative(Dst.Height) - yDst;
   if (Width < 0) or (Height < 0) then
     Exit;
 
-  dst.BeginUpdate;
+  Dst.BeginUpdate;
   Src.BeginUpdate;
   PixelDst := TPixelPointer.Create(Dst, xDst, yDst);
@@ -690 +690 @@
   end;
   src.EndUpdate;
-  dst.EndUpdate;
-end;
-
-procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
+  Dst.EndUpdate;
+end;
+
+procedure ImageOp_BCC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
   Color1, Color2: Integer);
 // Src is template
@@ -720 +720 @@
     yDst := 0;
   end;
-  if xDst + Width > ScaleToNative(dst.Width) then
-    Width := ScaleToNative(dst.Width) - xDst;
-  if yDst + Height > ScaleToNative(dst.Height) then
-    Height := ScaleToNative(dst.Height) - yDst;
+  if xDst + Width > ScaleToNative(Dst.Width) then
+    Width := ScaleToNative(Dst.Width) - xDst;
+  if yDst + Height > ScaleToNative(Dst.Height) then
+    Height := ScaleToNative(Dst.Height) - yDst;
   if (Width < 0) or (Height < 0) then
     Exit;
 
   Src.BeginUpdate;
-  dst.BeginUpdate;
+  Dst.BeginUpdate;
   SrcPixel := TPixelPointer.Create(Src, xSrc, ySrc);
   DstPixel := TPixelPointer.Create(Dst, xDst, yDst);
@@ -757 +757 @@
   end;
   Src.EndUpdate;
-  dst.EndUpdate;
+  Dst.EndUpdate;
 end;
 
@@ -816 +816 @@
 end;
 
-procedure ImageOp_CCC(bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer);
+procedure ImageOp_CCC(Bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer);
 // Bmp is template
 // B channel = Color0 amp, 128=original brightness
@@ -822 +822 @@
 // R channel = Color2 amp, 128=original brightness
 var
-  I, Red, Green: Integer;
+  XX, YY: Integer;
+  Red, Green: Integer;
   PixelPtr: TPixelPointer;
 begin
   X := ScaleToNative(X);
   Y := ScaleToNative(Y);
-  Width := ScaleToNative(Width);
-  Height := ScaleToNative(Height);
-  bmp.BeginUpdate;
-  Assert(bmp.PixelFormat = TPixelFormat.pf24bit);
-  Height := Y + Height;
+  Width := ScaleToNativeDist(X, Width);
+  Height := ScaleToNativeDist(Y, Height);
+
+  if X + Width > ScaleToNative(Bmp.Width) then
+    Width := ScaleToNative(Bmp.Width) - X;
+  if Y + Height > ScaleToNative(Bmp.Height) then
+    Height := ScaleToNative(Bmp.Height) - Y;
+  if (Width < 0) or (Height < 0) then
+    Exit;
+
+  Bmp.BeginUpdate;
+  Assert(Bmp.PixelFormat = TPixelFormat.pf24bit);
   PixelPtr := TPixelPointer.Create(Bmp, X, Y);
-  while Y < Height do begin
-    for I := 0 to Width - 1 do begin
+  for YY := 0 to Height - 1 do begin
+    for XX := 0 to Width - 1 do begin
       Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
         (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
@@ -847 +855 @@
       PixelPtr.NextPixel;
     end;
-    Inc(Y);
     PixelPtr.NextLine;
   end;
-  bmp.EndUpdate;
+  Bmp.EndUpdate;
 end;
 

trunk/Packages/DpiControls/Dpi.PixelPointer.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Dpi.Graphics, Dpi.Common;
+  Math, Classes, SysUtils, Dpi.Graphics, Dpi.Common;
 
 type
@@ -68 +68 @@
 
 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]';
 
@@ -126 +126 @@
 
 procedure TPixelPointer.CheckRange;
+var
+  X: Integer;
+  Y: Integer;
 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 + 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;