Update from DRON.

Components/Resample.pas

@@ -10,15 +10,17 @@ implementation
 
 const
   FixedBits = 16;
+  FixedOne = 1 shl FixedBits;
+  FixedOneHalf = FixedOne shr 1;
 type
   TWeight = packed record
-    Offset: Integer;//Byte offset to pixel data
+    Offset: Integer; //Byte offset to pixel data
     case Integer of
-      0: (Weight: Integer);//Pixel weight in Q16.16 fixed point format
-      1: (Temp: Single);//same thing in float format
+      0: (Weight: Integer); //Pixel weight in Q16.16 fixed point format
+      1: (Temp: Single); //same thing in float format
   end;
   TWeightArray = array [0..MaxInt div SizeOf(TWeight) - 1] of TWeight;
-  TPutPixelProc = procedure(const Weights: array of TWeight; Bits: Pointer; var Pixel);
+  TPutPixelProc = procedure(const Weights: array of TWeight; Bits, Pixel: Pointer);
 
 procedure ResampleBits(DstSize, SrcSize: Integer; SrcLine, DstLine: Pointer;
   PixelSize, LineCount, SrcLineSize, DstLineSize: Integer; PutPixelProc: TPutPixelProc);
@@ -61,16 +63,16 @@ begin
         Inc(Count);
       end;
       if Sum <> 0 then begin
-        Sum := (1 shl FixedBits) / Sum;
+        Sum := FixedOne / Sum;
         for J := 0 to Count - 1 do
           with Weights[J] do
             Weight := Round(Temp * Sum);
-      end else 
+      end else
         Count := 0;
       Src := SrcLine;
       Dst := DstLine;
       for J := 0 to LineCount - 1 do begin
-        PutPixelProc(Slice(Weights^, Count), Src, Dst^);
+        PutPixelProc(Slice(Weights^, Count), Src, Dst);
         Inc(PByte(Src), SrcLineSize);
         Inc(PByte(Dst), DstLineSize);
       end;
@@ -82,36 +84,39 @@ begin
 end;
 
 //Process pixel in BGR format
-procedure PutPixel24(const Weights: array of TWeight; Bits: Pointer; var Pixel: TRGBTriple);
+procedure PutPixel24(const Weights: array of TWeight; Bits, Pixel: Pointer);
 type
   PRGBTriple = ^TRGBTriple;
 var
   I, R, G, B: Integer;
 begin
-  R := 0;
-  G := 0;
-  B := 0;
+  R := FixedOneHalf;
+  G := FixedOneHalf;
+  B := FixedOneHalf;
   for I := 0 to High(Weights) do
     with Weights[I], PRGBTriple(PAnsiChar(Bits) + Offset)^ do begin
       Inc(R, rgbtRed * Weight);
       Inc(G, rgbtGreen * Weight);
       Inc(B, rgbtBlue * Weight);
     end;
-  //Clamps all channels to values between 0 and 255  
-  if R < 0 then Pixel.rgbtRed   := 0 else if R > 255 shl FixedBits then Pixel.rgbtRed   := 255 else Pixel.rgbtRed   := R shr FixedBits;
-  if G < 0 then Pixel.rgbtGreen := 0 else if G > 255 shl FixedBits then Pixel.rgbtGreen := 255 else Pixel.rgbtGreen := G shr FixedBits;
-  if B < 0 then Pixel.rgbtBlue  := 0 else if B > 255 shl FixedBits then Pixel.rgbtBlue  := 255 else Pixel.rgbtBlue  := B shr FixedBits;
+  with PRGBTriple(Pixel)^ do begin
+    //Clamps all channels to values between 0 and 255
+    if R > 0 then if R < 255 shl FixedBits then rgbtRed   := R shr FixedBits else rgbtRed   := 255 else rgbtRed   := 0;
+    if G > 0 then if G < 255 shl FixedBits then rgbtGreen := G shr FixedBits else rgbtGreen := 255 else rgbtGreen := 0;
+    if B > 0 then if B < 255 shl FixedBits then rgbtBlue  := B shr FixedBits else rgbtBlue  := 255 else rgbtBlue  := 0;
+  end;
 end;
 
 //Process pixel in BGRA premultiplied alpha format
-procedure PutPixel32P(const Weights: array of TWeight; Bits: Pointer; var Pixel: TRGBQuad);
+procedure PutPixel32P(const Weights: array of TWeight; Bits, Pixel: Pointer);
 var
   I, R, G, B, A: Integer;
+  AByte: Byte;
 begin
-  R := 0;
-  G := 0;
-  B := 0;
-  A := 0;
+  R := FixedOneHalf;
+  G := FixedOneHalf;
+  B := FixedOneHalf;
+  A := FixedOneHalf;
   for I := 0 to High(Weights) do
     with Weights[I], PRGBQuad(PAnsiChar(Bits) + Offset)^ do begin
       Inc(R, rgbRed * Weight);
@@ -119,13 +124,16 @@ begin
       Inc(B, rgbBlue * Weight);
       Inc(A, rgbReserved * Weight);
     end;
-  //Clamps alpha channel to values between 0 and 255  
-  if A < 0 then Pixel.rgbReserved := 0 else if A > 255 shl FixedBits then Pixel.rgbReserved := 255 else Pixel.rgbReserved := A shr FixedBits;
-  A := Pixel.rgbReserved shl FixedBits;
-  //Clamps other channels to values between 0 and Alpha
-  if R < 0 then Pixel.rgbRed   := 0 else if R > A then Pixel.rgbRed   := A shr FixedBits else Pixel.rgbRed   := R shr FixedBits;
-  if G < 0 then Pixel.rgbGreen := 0 else if G > A then Pixel.rgbGreen := A shr FixedBits else Pixel.rgbGreen := G shr FixedBits;
-  if B < 0 then Pixel.rgbBlue  := 0 else if B > A then Pixel.rgbBlue  := A shr FixedBits else Pixel.rgbBlue  := B shr FixedBits;
+  //Clamps alpha channel to values between 0 and 255
+  if A > 0 then if A < 255 shl FixedBits then AByte := A shr FixedBits else AByte := 255 else AByte := 0;
+  with PRGBQuad(Pixel)^ do begin
+    rgbReserved := AByte;
+    I := AByte shl FixedBits;
+    //Clamps other channels to values between 0 and Alpha
+    if R > 0 then if R < I then rgbRed   := R shr FixedBits else rgbRed   := AByte else rgbRed   := 0;
+    if G > 0 then if G < I then rgbGreen := G shr FixedBits else rgbGreen := AByte else rgbGreen := 0;
+    if B > 0 then if B < I then rgbBlue  := B shr FixedBits else rgbBlue  := AByte else rgbBlue  := 0;
+  end;
 end;
 
 function StretchBmp(Canvas: TCanvas; SrcBitmap, DstBitmap: TBitmap;
@@ -156,11 +164,11 @@ begin
   if Is32bit then begin
     BI.bmiHeader.biBitCount := 32;
     PixelSize := 4;
-    Proc := @PutPixel32P;
+    Proc := PutPixel32P;
   end else begin
     BI.bmiHeader.biBitCount := 24;
     PixelSize := 3;
-    Proc := @PutPixel24;
+    Proc := PutPixel24;
   end;
   DstLineSize := (DstWidth * PixelSize + 3) and not 3;
   SrcLineSize := (SrcWidth * PixelSize + 3) and not 3;
@@ -170,7 +178,7 @@ begin
     try
       if GetDIBits(Canvas.Handle, SrcBitmap.Handle,
         0, SrcHeight, SrcBits, BI, DIB_RGB_COLORS) = 0 then Exit;
-      //Stretch horizontally  
+      //Stretch horizontally
       ResampleBits(DstWidth, SrcWidth, SrcBits, tmpBits,
         PixelSize, SrcHeight, SrcLineSize, DstLineSize, Proc);
     finally
@@ -181,7 +189,7 @@ begin
     DIB := CreateDIBSection(Canvas.Handle, BI, DIB_RGB_COLORS, DstBits, NULL, 0);
     if DIB = 0 then Exit;
     try
-      //Stretch vertically  
+      //Stretch vertically
       ResampleBits(DstHeight, SrcHeight, tmpBits, DstBits,
         DstLineSize, DstWidth, PixelSize, PixelSize, Proc);
       DstBitmap.Handle := DIB;