home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_Transforms.pas < prev    next >
Pascal/Delphi Source File  |  2004-12-25  |  66KB  |  2,121 lines
  1. unit GR32_Transforms;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *   Andre Beckedorf <Andre@metaException.de>
  26.  *   Mattias Andersson <Mattias@Centaurix.com>
  27.  *   J. Tulach <tulach@position.cz>
  28.  *   Michael Hansen <dyster_tid@hotmail.com>
  29.  *   Peter Larson
  30.  *
  31.  * ***** END LICENSE BLOCK ***** *)
  32.  
  33. interface
  34.  
  35. {$I GR32.inc}
  36.  
  37. uses
  38.   {$IFDEF CLX}
  39.   Qt, Types, {$IFDEF LINUX}Libc, {$ENDIF}
  40.   {$ELSE}
  41.   Windows,
  42.   {$ENDIF}
  43.   SysUtils, Classes, GR32, GR32_Blend;
  44.  
  45. type
  46.   ETransformError = class(Exception);
  47.  
  48. procedure BlockTransfer(
  49.   Dst: TBitmap32; DstX: Integer; DstY: Integer; DstClip: TRect;
  50.   Src: TBitmap32; SrcRect: TRect;
  51.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent = nil);
  52.  
  53.  
  54. procedure StretchTransfer(
  55.   Dst: TBitmap32; DstRect: TRect; DstClip: TRect;
  56.   Src: TBitmap32; SrcRect: TRect;
  57.   StretchFilter: TStretchFilter;
  58.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent = nil);
  59.  
  60. type
  61.   TFloatMatrix = array[0..2, 0..2] of Single;     // 3x3 single precision
  62.   TIntegerMatrix = array[0..2, 0..2] of Integer;  // 3x3 whatever
  63.  
  64. const
  65.   IdentityMatrix: TFloatMatrix = (
  66.     (1, 0, 0),
  67.     (0, 1, 0),
  68.     (0, 0, 1));
  69.  
  70. type
  71.   TVector3f = array[0..2] of Single;
  72.   TVector3i = array[0..2] of Integer;
  73.  
  74. procedure Adjoint(var M: TFloatMatrix);
  75. function Determinant(const M: TFloatMatrix): Single;
  76. procedure Scale(var M: TFloatMatrix; Factor: Single);
  77. procedure Invert(var M: TFloatMatrix);
  78. function Mult(const M1, M2: TFloatMatrix): TFloatMatrix;
  79. function VectorTransform(const M: TFloatMatrix; const V: TVector3f): TVector3f;
  80.  
  81. type
  82.   TTransformation = class(TObject)
  83.   private
  84.     FSrcRect: TFloatRect;
  85.     procedure SetSrcRect(const Value: TFloatRect);
  86.  
  87.     procedure ReverseTransform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); virtual; abstract; // only used in transform (draw) of bitmaps
  88.  
  89.     procedure ReverseTransformInt(DstX, DstY: Integer; out SrcX, SrcY: Integer); virtual; abstract;
  90.     procedure ReverseTransformFloat(DstX, DstY: Single; out SrcX, SrcY: Single); virtual; abstract;
  91.     procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); virtual; abstract;
  92.  
  93.     procedure TransformInt(SrcX, SrcY: Integer; out DstX, DstY: Integer); virtual; abstract;
  94.     procedure TransformFloat(SrcX, SrcY: Single; out DstX, DstY: Single); virtual; abstract;
  95.     procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); virtual; abstract;
  96.   protected
  97.     TransformValid: Boolean;
  98.     procedure PrepareTransform; virtual; abstract;
  99.   public
  100.     function  GetTransformedBounds: TRect; virtual; abstract;
  101.  
  102.     function ReverseTransform(const P: TPoint): TPoint; overload; virtual;
  103.     function ReverseTransform(const P: TFixedPoint): TFixedPoint; overload; virtual;
  104.     function ReverseTransform(const P: TFloatPoint): TFloatPoint; overload; virtual;
  105.  
  106.     function Transform(const P: TPoint): TPoint; overload; virtual;
  107.     function Transform(const P: TFixedPoint): TFixedPoint; overload; virtual;
  108.     function Transform(const P: TFloatPoint): TFloatPoint; overload; virtual;
  109.  
  110.     property SrcRect: TFloatRect read FSrcRect write SetSrcRect;
  111.   end;
  112.  
  113.   TAffineTransformation = class(TTransformation)
  114.   protected
  115.     FInverseMatrix: TFloatMatrix;
  116.     FIntMatrix, FInverseIntMatrix: TIntegerMatrix;
  117.     FFixedMatrix, FInverseFixedMatrix: TIntegerMatrix;
  118.  
  119.     procedure PrepareTransform; override;
  120.  
  121.     procedure ReverseTransform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); override;
  122.  
  123.     procedure ReverseTransformInt(DstX, DstY: Integer; out SrcX, SrcY: Integer); override;
  124.     procedure ReverseTransformFloat(DstX, DstY: Single; out SrcX, SrcY: Single); override;
  125.     procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
  126.  
  127.     procedure TransformInt(SrcX, SrcY: Integer; out DstX, DstY: Integer); override;
  128.     procedure TransformFloat(SrcX, SrcY: Single; out DstX, DstY: Single); override;
  129.     procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
  130.   public
  131.     Matrix: TFloatMatrix;
  132.     constructor Create; virtual;
  133.     function  GetTransformedBounds: TRect; override;
  134.     procedure Clear;
  135.     procedure Rotate(Cx, Cy, Alpha: Single); // degrees
  136.     procedure Skew(Fx, Fy: Single);
  137.     procedure Scale(Sx, Sy: Single);
  138.     procedure Translate(Dx, Dy: Single);
  139.   end;
  140.  
  141.   TProjectiveTransformation = class(TTransformation)
  142.   private
  143.     Wx0, Wx1, Wx2, Wx3: Single;
  144.     Wy0, Wy1, Wy2, Wy3: Single;
  145.     procedure SetX0(Value: Single);
  146.     procedure SetX1(Value: Single);
  147.     procedure SetX2(Value: Single);
  148.     procedure SetX3(Value: Single);
  149.     procedure SetY0(Value: Single);
  150.     procedure SetY1(Value: Single);
  151.     procedure SetY2(Value: Single);
  152.     procedure SetY3(Value: Single);
  153.   protected
  154.     FMatrix, FInverseMatrix: TFloatMatrix;
  155.     FIntMatrix, FInverseIntMatrix: TIntegerMatrix;
  156.     FFixedMatrix, FInverseFixedMatrix: TIntegerMatrix;
  157.  
  158.     procedure PrepareTransform; override;
  159.  
  160.     procedure ReverseTransform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); override;
  161.  
  162.     procedure ReverseTransformInt(DstX, DstY: Integer; out SrcX, SrcY: Integer); override;
  163.     procedure ReverseTransformFloat(DstX, DstY: Single; out SrcX, SrcY: Single); override;
  164.     procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
  165.  
  166.     procedure TransformInt(SrcX, SrcY: Integer; out DstX, DstY: Integer); override;
  167.     procedure TransformFloat(SrcX, SrcY: Single; out DstX, DstY: Single); override;
  168.     procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
  169.   public
  170.     function  GetTransformedBounds: TRect; override;
  171.     property X0: Single read Wx0 write SetX0;
  172.     property X1: Single read Wx1 write SetX1;
  173.     property X2: Single read Wx2 write SetX2;
  174.     property X3: Single read Wx3 write SetX3;
  175.     property Y0: Single read Wy0 write SetY0;
  176.     property Y1: Single read Wy1 write SetY1;
  177.     property Y2: Single read Wy2 write SetY2;
  178.     property Y3: Single read Wy3 write SetY3;
  179.   end;
  180.  
  181. function TransformPoints(Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
  182.  
  183. procedure Transform(Dst, Src: TBitmap32; Transformation: TTransformation);
  184. procedure SetBorderTransparent(ABitmap: TBitmap32; ARect: TRect);
  185.  
  186. { FullEdge controls how the bitmap is resampled }
  187. var
  188.   FullEdge: Boolean = True;
  189.  
  190. implementation
  191.  
  192. {$R-}{$Q-}  // switch off overflow and range checking
  193.  
  194. uses GR32_LowLevel, GR32_System, Math;
  195.  
  196. type
  197.   {provides access to proctected members of TBitmap32 by typecasting}
  198.   TBitmap32Access = class(TBitmap32);
  199.  
  200. const
  201.   SDstEmpty = 'Destination bitmap is nil or empty';
  202.   SSrcEmpty = 'Source bitmap is nil or empty';
  203.   SSrcInvalid = 'Source rectangle is invalid';
  204.  
  205. var
  206.  BlockAverage : function (Dlx, Dly, RowSrc, OffSrc: Cardinal): TColor32;
  207.  LinearInterpolator: function(PWX_256, PWY_256: Cardinal; C11, C21: PColor32): TColor32;
  208.  
  209.  
  210. procedure CheckBitmaps(Dst, Src: TBitmap32);
  211. begin
  212.   if not Assigned(Dst) or Dst.Empty then raise ETransformError.Create(SDstEmpty);
  213.   if not Assigned(Src) or Src.Empty then raise ETransformError.Create(SSrcEmpty);
  214. end;
  215.  
  216. function CheckSrcRect(Src: TBitmap32; const SrcRect: TRect): Boolean;
  217. begin
  218.   Result := False;
  219.   if IsRectEmpty(SrcRect) then Exit;
  220.   if (SrcRect.Left < 0) or (SrcRect.Right > Src.Width) or
  221.     (SrcRect.Top < 0) or (SrcRect.Bottom > Src.Height) then
  222.     raise ETransformError.Create(SSrcInvalid);
  223.   Result := True;
  224. end;
  225.  
  226. procedure BlendBlock(
  227.   Dst: TBitmap32; DstRect: TRect;
  228.   Src: TBitmap32; SrcX, SrcY: Integer;
  229.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  230. var
  231.   SrcP, DstP: PColor32;
  232.   SP, DP: PColor32;
  233.   W, I, DstY: Integer;
  234.   BlendLine: TBlendLine;
  235.   BlendLineEx: TBlendLineEx;
  236. begin
  237.   { Internal routine }
  238.   W := DstRect.Right - DstRect.Left;
  239.   SrcP := Src.PixelPtr[SrcX, SrcY];
  240.   DstP := Dst.PixelPtr[DstRect.Left, DstRect.Top];
  241.  
  242.   case CombineOp of
  243.     dmOpaque:
  244.       begin
  245.         for DstY := DstRect.Top to DstRect.Bottom - 1 do
  246.         begin
  247.           //Move(SrcP^, DstP^, W*4); // for FastCode
  248.           MoveLongWord(SrcP^, DstP^, W);
  249.           Inc(SrcP, Src.Width);
  250.           Inc(DstP, Dst.Width);
  251.         end;
  252.       end;
  253.     dmBlend:
  254.       if Src.MasterAlpha >= 255 then
  255.       begin
  256.         BlendLine := BLEND_LINE[Src.CombineMode];
  257.         for DstY := DstRect.Top to DstRect.Bottom - 1 do
  258.         begin
  259.           BlendLine(SrcP, DstP, W);
  260.           Inc(SrcP, Src.Width);
  261.           Inc(DstP, Dst.Width);
  262.         end
  263.       end
  264.       else
  265.       begin
  266.         BlendLineEx := BLEND_LINE_EX[Src.CombineMode];
  267.         for DstY := DstRect.Top to DstRect.Bottom - 1 do
  268.         begin
  269.           BlendLineEx(SrcP, DstP, W, Src.MasterAlpha);
  270.           Inc(SrcP, Src.Width);
  271.           Inc(DstP, Dst.Width);
  272.         end
  273.       end
  274.     else //  dmCustom:
  275.       begin
  276.         for DstY := DstRect.Top to DstRect.Bottom - 1 do
  277.         begin
  278.           SP := SrcP;
  279.           DP := DstP;
  280.           for I := 0 to W - 1 do
  281.           begin
  282.             CombineCallBack(SP^, DP^, Src.MasterAlpha);
  283.             Inc(SP); Inc(DP);
  284.           end;
  285.           Inc(SrcP, Src.Width);
  286.           Inc(DstP, Dst.Width);
  287.         end;
  288.       end;
  289.     end;
  290. end;
  291.  
  292. procedure BlockTransfer(
  293.   Dst: TBitmap32; DstX: Integer; DstY: Integer; DstClip: TRect;
  294.   Src: TBitmap32; SrcRect: TRect;
  295.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  296. var
  297.   SrcX, SrcY: Integer;
  298. begin
  299.   if Src.Empty then Exit;
  300.   CheckBitmaps(Src, Dst);
  301.  
  302.   if (CombineOp = dmCustom) and not Assigned(CombineCallBack) then
  303.     CombineOp := dmOpaque;
  304.  
  305.   if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then Exit;
  306.  
  307.   SrcX := SrcRect.Left;
  308.   SrcY := SrcRect.Top;
  309.  
  310.   IntersectRect(DstClip, DstClip, Dst.BoundsRect);
  311.   IntersectRect(SrcRect, SrcRect, Src.BoundsRect);
  312.   OffsetRect(SrcRect, DstX - SrcX, DstY - SrcY);
  313.   IntersectRect(SrcRect, DstClip, SrcRect);
  314.   DstClip := SrcRect;
  315.   OffsetRect(SrcRect, SrcX - DstX, SrcY - DstY);
  316.  
  317.   if not IsRectEmpty(SrcRect) then 
  318.   try
  319.     BlendBlock(Dst, DstClip, Src, SrcRect.Left, SrcRect.Top, CombineOp, CombineCallBack);
  320.   finally
  321.     EMMS;
  322.   end;
  323. end;
  324.  
  325.  
  326. procedure StretchNearest(
  327.   Dst: TBitmap32; DstRect, DstClip: TRect;
  328.   Src: TBitmap32; SrcRect: TRect;
  329.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  330. var
  331.   R: TRect;
  332.   SrcW, SrcH, DstW, DstH, DstClipW, DstClipH: Integer;
  333.   SrcY, OldSrcY: Integer;
  334.   I, J: Integer;
  335.   MapHorz: array of Integer;
  336.   SrcLine, DstLine: PColor32Array;
  337.   Buffer: TArrayOfColor32;
  338.   Scale: Single;
  339.   BlendLine: TBlendLine;
  340.   BlendLineEx: TBlendLineEx;
  341. begin
  342.   IntersectRect(DstClip, DstClip, MakeRect(0, 0, Dst.Width, Dst.Height));
  343.   IntersectRect(DstClip, DstClip, DstRect);
  344.   if IsRectEmpty(DstClip) then Exit;
  345.   IntersectRect(R, DstClip, DstRect);
  346.   if IsRectEmpty(R) then Exit;
  347.   if (SrcRect.Left < 0) or (SrcRect.Top < 0) or (SrcRect.Right > Src.Width) or
  348.     (SrcRect.Bottom > Src.Height) then raise Exception.Create('Invalid SrcRect');
  349.  
  350.   SrcW := SrcRect.Right - SrcRect.Left;
  351.   SrcH := SrcRect.Bottom - SrcRect.Top;
  352.   DstW := DstRect.Right - DstRect.Left;
  353.   DstH := DstRect.Bottom - DstRect.Top;
  354.   DstClipW := DstClip.Right - DstClip.Left;
  355.   DstClipH := DstClip.Bottom - DstClip.Top;
  356.   try
  357.     if (SrcW = DstW) and (SrcH = DstH) then
  358.     begin
  359.       { Copy without resampling }
  360.       BlendBlock(Dst, DstClip, Src, SrcRect.Left + DstClip.Left - DstRect.Left,
  361.         SrcRect.Top + DstClip.Top - DstRect.Top, CombineOp, CombineCallBack);
  362.     end
  363.     else
  364.     begin
  365.       SetLength(MapHorz, DstClipW);
  366.  
  367.       if DstW > 1 then
  368.       begin
  369.         if FullEdge then
  370.         begin
  371.           Scale := SrcW / DstW;
  372.           for I := 0 to DstClipW - 1 do
  373.             MapHorz[I] := Trunc(SrcRect.Left + (I + DstClip.Left - DstRect.Left) * Scale);
  374.         end
  375.         else
  376.         begin
  377.           Scale := (SrcW - 1) / (DstW - 1);
  378.           for I := 0 to DstClipW - 1 do
  379.             MapHorz[I] := Round(SrcRect.Left + (I + DstClip.Left - DstRect.Left) * Scale);
  380.         end;
  381.         Assert(MapHorz[0] >= SrcRect.Left);
  382.         Assert(MapHorz[DstClipW - 1] < SrcRect.Right);
  383.       end
  384.       else
  385.         MapHorz[0] := (SrcRect.Left + SrcRect.Right - 1) div 2;
  386.  
  387.       if DstH <= 1 then Scale := 0
  388.       else if FullEdge then Scale := SrcH / DstH
  389.       else Scale := (SrcH - 1) / (DstH - 1);
  390.  
  391.       if CombineOp = dmOpaque then
  392.       begin
  393.         DstLine := PColor32Array(Dst.PixelPtr[DstClip.Left, DstClip.Top]);
  394.         OldSrcY := -1;
  395.         for J := 0 to DstClipH - 1 do
  396.         begin
  397.           if DstH <= 1 then
  398.             SrcY := (SrcRect.Top + SrcRect.Bottom - 1) div 2
  399.           else if FullEdge then
  400.             SrcY := Trunc(SrcRect.Top + (J + DstClip.Top - DstRect.Top) * Scale)
  401.           else
  402.             SrcY := Round(SrcRect.Top + (J + DstClip.Top - DstRect.Top) * Scale);
  403.           if SrcY <> OldSrcY then
  404.           begin
  405.             SrcLine := Src.ScanLine[SrcY];
  406.             for I := 0 to DstClipW - 1 do DstLine[I] := SrcLine[MapHorz[I]];
  407.             OldSrcY := SrcY;
  408.           end
  409.           else
  410.             MoveLongWord(DstLine[-Dst.Width], DstLine[0], DstClipW);
  411.           Inc(DstLine, Dst.Width);
  412.         end;
  413.       end
  414.       else
  415.       begin
  416.         SetLength(Buffer, DstClipW);
  417.         DstLine := PColor32Array(Dst.PixelPtr[DstClip.Left, DstClip.Top]);
  418.         OldSrcY := -1;
  419.  
  420.         if Src.MasterAlpha >= 255 then
  421.         begin
  422.           BlendLine := BLEND_LINE[Src.CombineMode];
  423.           BlendLineEx := nil; // stop compiler warnings...
  424.         end
  425.         else
  426.         begin
  427.           BlendLineEx := BLEND_LINE_EX[Src.CombineMode];
  428.           BlendLine := nil; // stop compiler warnings...
  429.         end;
  430.  
  431.         for J := 0 to DstClipH - 1 do
  432.         begin
  433.           if DstH > 1 then
  434.           begin
  435.             EMMS;
  436.             if FullEdge then
  437.               SrcY := Trunc(SrcRect.Top + (J + DstClip.Top - DstRect.Top) * Scale)
  438.             else
  439.               SrcY := Round(SrcRect.Top + (J + DstClip.Top - DstRect.Top) * Scale);
  440.           end
  441.           else
  442.             SrcY := (SrcRect.Top + SrcRect.Bottom - 1) div 2;
  443.           if SrcY <> OldSrcY then
  444.           begin
  445.             SrcLine := Src.ScanLine[SrcY];
  446.             for I := 0 to DstClipW - 1 do Buffer[I] := SrcLine[MapHorz[I]];
  447.             OldSrcY := SrcY;
  448.           end;
  449.  
  450.           if CombineOp = dmBlend then
  451.           begin
  452.             if Src.MasterAlpha >= 255 then
  453.               BlendLine(@Buffer[0], @DstLine[0], DstClipW)
  454.             else
  455.               BlendLineEx(@Buffer[0], @DstLine[0], DstClipW, Src.MasterAlpha);
  456.           end
  457.           else
  458.             for I := 0 to DstClipW - 1 do
  459.               CombineCallBack(Buffer[I], DstLine[I], Src.MasterAlpha);
  460.  
  461.           Inc(DstLine, Dst.Width);
  462.         end;
  463.       end;
  464.     end;
  465.   finally
  466.     EMMS;
  467.   end;
  468. end;
  469.  
  470. type
  471.   TPointRec = record
  472.     Pos: Integer;
  473.     Weight: Cardinal;
  474.   end;
  475.  
  476. procedure StretchHorzStretchVertLinear(
  477.   Dst: TBitmap32; DstRect, DstClip: TRect;
  478.   Src: TBitmap32; SrcRect: TRect;
  479.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  480. //Assure DstRect is >= SrcRect, otherwise quality loss will occur
  481. var
  482.   SrcW, SrcH, DstW, DstH, DstClipW, DstClipH: Integer;
  483.   MapHorz, MapVert: array of TPointRec;
  484.   t2, Scale: Single;
  485.   SrcLine, DstLine: PColor32Array;
  486.   SrcIndex: Integer;
  487.   I, J: Integer;
  488.   WY: Cardinal;
  489.   C: TColor32;
  490.   BlendMemEx: TBlendMemEx;
  491. begin
  492.   SrcW := SrcRect.Right - SrcRect.Left;
  493.   SrcH := SrcRect.Bottom - SrcRect.Top;
  494.   DstW := DstRect.Right - DstRect.Left;
  495.   DstH := DstRect.Bottom - DstRect.Top;
  496.   DstClipW := DstClip.Right - DstClip.Left;
  497.   DstClipH := DstClip.Bottom - DstClip.Top;
  498.  
  499.   SetLength(MapHorz, DstClipW);
  500.   if FullEdge then Scale := SrcW / DstW
  501.   else Scale := (SrcW - 1) / (DstW - 1);
  502.   for I := 0 to DstClipW - 1 do
  503.   begin
  504.     if FullEdge then t2 := SrcRect.Left - 0.5 + (I + DstClip.Left - DstRect.Left + 0.5) * Scale
  505.     else t2 := SrcRect.Left + (I + DstClip.Left - DstRect.Left) * Scale;
  506.     if t2 < 0 then t2 := 0
  507.     else if t2 > Src.Width - 1 then t2 := Src.Width - 1;
  508.     MapHorz[I].Pos := Floor(t2);
  509.     MapHorz[I].Weight := 256 - Round(Frac(t2) * 256);
  510.     //Pre-pack weights to reduce MMX Reg. setups per pixel:
  511.     MapHorz[I].Weight:= MapHorz[I].Weight shl 16 + MapHorz[I].Weight;
  512.   end;
  513.   I := DstClipW - 1;
  514.   while MapHorz[I].Pos = SrcRect.Right - 1 do
  515.   begin
  516.     Dec(MapHorz[I].Pos);
  517.     MapHorz[I].Weight := 0;
  518.     Dec(I);
  519.   end;
  520.  
  521.   SetLength(MapVert, DstClipH);
  522.   if FullEdge then Scale := SrcH / DstH
  523.   else Scale := (SrcH - 1) / (DstH - 1);
  524.   for I := 0 to DstClipH - 1 do
  525.   begin
  526.     if FullEdge then t2 := SrcRect.Top - 0.5 + (I + DstClip.Top - DstRect.Top + 0.5) * Scale
  527.     else t2 := SrcRect.Top + (I + DstClip.Top - DstRect.Top) * Scale;
  528.     if t2 < 0 then t2 := 0
  529.     else if t2 > Src.Height - 1 then t2 := Src.Height - 1;
  530.     MapVert[I].Pos := Floor(t2);
  531.     MapVert[I].Weight := 256 - Round(Frac(t2) * 256);
  532.     //Pre-pack weights to reduce MMX Reg. setups per pixel:
  533.     MapVert[I].Weight := MapVert[I].Weight shl 16 + MapVert[I].Weight;
  534.   end;
  535.   I := DstClipH - 1;
  536.   while MapVert[I].Pos = SrcRect.Bottom - 1 do
  537.   begin
  538.     Dec(MapVert[I].Pos);
  539.     MapVert[I].Weight := 0;
  540.     Dec(I);
  541.   end;
  542.  
  543.   DstLine := PColor32Array(Dst.PixelPtr[DstClip.Left, DstClip.Top]);
  544.   case CombineOp of
  545.     dmOpaque:
  546.       for J := 0 to DstClipH - 1 do
  547.       begin
  548.         SrcLine := Src.ScanLine[MapVert[J].Pos];
  549.         WY := MapVert[J].Weight;
  550.         for I := 0 to DstClipW - 1 do
  551.         begin
  552.           SrcIndex := MapHorz[I].Pos;
  553.           DstLine[I] := LinearInterpolator( MapHorz[I].Weight, WY, @SrcLine[SrcIndex],
  554.                                             @SrcLine[SrcIndex + Src.Width]);
  555.         end;
  556.         Inc(DstLine, Dst.Width);
  557.       end;
  558.     dmBlend:
  559.       begin
  560.         BlendMemEx := BLEND_MEM_EX[Src.CombineMode];
  561.         for J := 0 to DstClipH - 1 do
  562.         begin
  563.           SrcLine := Src.ScanLine[MapVert[J].Pos];
  564.           WY := MapVert[J].Weight;
  565.           for I := 0 to DstClipW - 1 do
  566.           begin
  567.             SrcIndex := MapHorz[I].Pos;
  568.             C := LinearInterpolator( MapHorz[I].Weight, WY, @SrcLine[SrcIndex],
  569.                                      @SrcLine[SrcIndex + Src.Width]);
  570.             BlendMemEx(C, DstLine[I], Src.MasterAlpha)
  571.           end;
  572.           Inc(DstLine, Dst.Width);
  573.         end
  574.       end
  575.   else // cmCustom
  576.     for J := 0 to DstClipH - 1 do
  577.     begin
  578.       SrcLine := Src.ScanLine[MapVert[J].Pos];
  579.       WY := MapVert[J].Weight;
  580.       for I := 0 to DstClipW - 1 do
  581.       begin
  582.         SrcIndex := MapHorz[I].Pos;
  583.         C := LinearInterpolator( MapHorz[I].Weight, WY, @SrcLine[SrcIndex],
  584.                                  @SrcLine[SrcIndex + Src.Width]);
  585.         CombineCallBack(C, DstLine[I], Src.MasterAlpha);
  586.       end;
  587.       Inc(DstLine, Dst.Width);
  588.     end;
  589.   end;
  590.   EMMS;
  591. end;
  592.  
  593. { StretchFlt }
  594.  
  595. type
  596.   TCluster = array of TPointRec;
  597.   TMappingTable = array of TCluster;
  598.   TFilterFunc = function(Value: Single): Single;
  599.  
  600. function NearestFilter(Value: Single): Single;
  601. begin
  602.   if (Value > -0.5) and (Value <= 0.5) then Result := 1
  603.   else Result := 0;
  604. end;
  605.  
  606. function LinearFilter(Value: Single): Single;
  607. begin
  608.   if Value < -1 then Result := 0
  609.   else if Value < 0 then Result := 1 + Value
  610.   else if Value < 1 then Result := 1 - Value
  611.   else Result := 0;
  612. end;
  613.  
  614. function DraftFilter(Value: Single): Single;
  615. //This function is only present to keep compatibility
  616. //Draft resampling is handled separately, and this function will never be used.
  617. //But since draft resampling is closest to linear, this function is provided.
  618. begin
  619.   if Value < -1 then Result := 0
  620.   else if Value < 0 then Result := 1 + Value
  621.   else if Value < 1 then Result := 1 - Value
  622.   else Result := 0;
  623. end;
  624.  
  625. function CosineFilter(Value: Single): Single;
  626. begin
  627.   Result := 0;
  628.   if Abs(Value) < 1 then
  629.     Result := (Cos(Value * Pi) + 1) / 2;
  630. end;
  631.  
  632. function SplineFilter(Value: Single): Single;
  633. var
  634.   tt: Single;
  635. begin
  636.   Value := Abs(Value);
  637.   if Value < 1 then
  638.   begin
  639.     tt := Sqr(Value);
  640.     Result := 0.5 * tt * Value - tt + 2 / 3;
  641.   end
  642.   else if Value < 2 then
  643.   begin
  644.     Value := 2 - Value;
  645.     Result := 1 / 6 * Sqr(Value) * Value;
  646.   end
  647.   else Result := 0;
  648. end;
  649.  
  650. function LanczosFilter(Value: Single): Single;
  651.   function Sinc(Value: Single): Single;
  652.   begin
  653.     if Value <> 0 then
  654.     begin
  655.       Value := Value * Pi;
  656.       Result := Sin(Value) / Value;
  657.     end
  658.     else Result := 1;
  659.   end;
  660. begin
  661.   Value := Abs(Value);
  662.   if Value < 3 then Result := Sinc(Value) * Sinc(Value / 3)
  663.   else Result := 0;
  664. end;
  665.  
  666. function MitchellFilter(Value: Single): Single;
  667. var
  668.   tt, ttt: Single;
  669. begin
  670.   Value := Abs(Value);
  671.   tt := Sqr(Value);
  672.   ttt := tt * Value;
  673.   if Value < 1 then Result := (7 * ttt + -12 * tt + 16 / 3) / 6
  674.   else if Value < 2 then Result := (-7 / 3 * ttt + 12 * tt - 20 * Value + 32 / 3) / 6
  675.   else Result := 0;
  676. end;
  677.  
  678. function BuildMappingTable(
  679.   DstLo, DstHi: Integer;
  680.   ClipLo, ClipHi: Integer;
  681.   SrcLo, SrcHi: Integer;
  682.   StretchFilter: TStretchFilter): TMappingTable;
  683. const
  684.   { the first filter from these arrays is never used since the nearest and linear
  685.     filter is implemented separately. This also applies to draft-resampling }
  686.   FILTERS: array[TStretchFilter] of TFilterFunc = (NearestFilter, DraftFilter, LinearFilter,
  687.     CosineFilter, SplineFilter, LanczosFilter, MitchellFilter);
  688.   FILTERWIDTHS: array [TStretchFilter] of Single = (1, 1, 1, 1, 2, 3, 2);
  689. var
  690.   SrcW, DstW, ClipW: Integer;
  691.   Filter: TFilterFunc;
  692.   FilterWidth: Single;
  693.   Scale, OldScale: Single;
  694.   Center: Single;
  695.   Count: Integer;
  696.   Left, Right: Integer;
  697.   I, J, K: Integer;
  698.   Weight: Integer;
  699. begin
  700.   SrcW := SrcHi - SrcLo;
  701.   DstW := DstHi - DstLo;
  702.   ClipW := ClipHi - ClipLo;
  703.   if SrcW = 0 then
  704.   begin
  705.     Result := nil;
  706.     Exit;
  707.   end
  708.   else if SrcW = 1 then
  709.   begin
  710.     SetLength(Result, ClipW);
  711.     for I := 0 to ClipW - 1 do
  712.     begin
  713.       SetLength(Result[I], 1);
  714.       Result[I][0].Pos := 0;
  715.       Result[I][0].Weight := 256;
  716.     end;
  717.     Exit;
  718.   end;
  719.   SetLength(Result, ClipW);
  720.   if ClipW = 0 then Exit;
  721.  
  722.   if FullEdge then Scale := DstW / SrcW
  723.   else Scale := (DstW - 1) / (SrcW - 1);
  724.  
  725.   Filter := FILTERS[StretchFilter];
  726.   FilterWidth := FILTERWIDTHS[StretchFilter];
  727.   K := 0;
  728.  
  729.   if Scale = 0 then
  730.   begin
  731.     Assert(Length(Result) = 1);
  732.     SetLength(Result[0], 1);
  733.     Result[0][0].Pos := (SrcLo + SrcHi) div 2;
  734.     Result[0][0].Weight := 256;
  735.   end
  736.   else if Scale < 1 then
  737.   begin
  738.     OldScale := Scale;
  739.     Scale := 1 / Scale;
  740.     FilterWidth := FilterWidth * Scale;
  741.     for I := 0 to ClipW - 1 do
  742.     begin
  743.       if FullEdge then
  744.         Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
  745.       else
  746.         Center := SrcLo + (I - DstLo + ClipLo) * Scale;
  747.       Left := Floor(Center - FilterWidth);
  748.       Right := Ceil(Center + FilterWidth);
  749.       Count := -256;
  750.       for J := Left to Right do
  751.       begin
  752.         Weight := Round(256 * Filter((Center - J) * OldScale) * OldScale);
  753.         if Weight <> 0 then
  754.         begin
  755.           Inc(Count, Weight);
  756.           K := Length(Result[I]);
  757.           SetLength(Result[I], K + 1);
  758.           Result[I][K].Pos := Constrain(J, SrcLo, SrcHi - 1);
  759.           Result[I][K].Weight := Weight;
  760.         end;
  761.       end;
  762.       if Length(Result[I]) = 0 then
  763.       begin
  764.         SetLength(Result[I], 1);
  765.         Result[I][0].Pos := Floor(Center);
  766.         Result[I][0].Weight := 256;
  767.       end
  768.       else if Count <> 0 then
  769.         Dec(Result[I][K div 2].Weight, Count);
  770.     end;
  771.   end
  772.   else // scale > 1
  773.   begin
  774.     Scale := 1 / Scale;
  775.     for I := 0 to ClipW - 1 do
  776.     begin
  777.       if FullEdge then
  778.         Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
  779.       else
  780.         Center := SrcLo + (I - DstLo + ClipLo) * Scale;
  781.       Left := Floor(Center - FilterWidth);
  782.       Right := Ceil(Center + FilterWidth);
  783.       Count := -256;
  784.       for J := Left to Right do
  785.       begin
  786.         Weight := Round(256 * Filter(Center - j));
  787.         if Weight <> 0 then
  788.         begin
  789.           Inc(Count, Weight);
  790.           K := Length(Result[I]);
  791.           SetLength(Result[I], k + 1);
  792.           Result[I][K].Pos := Constrain(j, SrcLo, SrcHi - 1);
  793.           Result[I][K].Weight := Weight;
  794.         end;
  795.       end;
  796.       if Count <> 0 then
  797.         Dec(Result[I][K div 2].Weight, Count);
  798.     end;
  799.   end;
  800. end;
  801.  
  802. {$WARNINGS OFF}
  803. procedure Resample(
  804.   Dst: TBitmap32; DstRect: TRect; DstClip: TRect;
  805.   Src: TBitmap32; SrcRect: TRect;
  806.   StretchFilter: TStretchFilter;
  807.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  808. type
  809.   TBufferEntry = record
  810.     R, G, B, A: Integer;
  811.   end;
  812. var
  813.   SrcW, SrcH: Single;
  814.   DstW, DstH: Integer;
  815.   DstClipW, DstClipH: Integer;
  816.   t: Single;
  817.   MapX, MapY: TMappingTable;
  818.   I, J, X, Y, Index: Integer;
  819.   MapXLoPos, MapXHiPos: Integer;
  820.   HorzBuffer: array of TBufferEntry;
  821.   ClusterX, ClusterY: TCluster;
  822.   ClusterXSize, ClusterYSize: Integer;
  823.   C, Wt, Cr, Cg, Cb, Ca: Integer;
  824.   ClustYP, ClustYW, ClustXP, ClustXW: Integer;
  825.   SrcP: PColor32;
  826.   DstLine: PColor32Array;
  827.   RangeCheck: Boolean;
  828.   BlendMemEx: TBlendMemEx;
  829. begin
  830.   if (CombineOp = dmCustom) and not Assigned(CombineCallBack) then
  831.     CombineOp := dmOpaque;
  832.  
  833.   { check source and destination }
  834.   if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then Exit;
  835.  
  836.   BlendMemEx := BLEND_MEM_EX[Src.CombineMode]; // store in local variable
  837.  
  838.   SrcW := SrcRect.Right - SrcRect.Left;
  839.   SrcH := SrcRect.Bottom - SrcRect.Top;
  840.   DstW := DstRect.Right - DstRect.Left;
  841.   DstH := DstRect.Bottom - DstRect.Top;
  842.   DstClipW := DstClip.Right - DstClip.Left;
  843.   DstClipH := DstClip.Bottom - DstClip.Top;
  844.  
  845.   // mapping tables
  846.   MapX := BuildMappingTable(DstRect.Left, DstRect.Right, DstClip.Left, DstClip.Right, SrcRect.Left, SrcRect.Right, StretchFilter);
  847.   MapY := BuildMappingTable(DstRect.Top, DstRect.Bottom, DstClip.Top, DstClip.Bottom, SrcRect.Top, SrcRect.Bottom, StretchFilter);
  848.   ClusterX := nil;
  849.   ClusterY := nil;
  850.   try
  851.     RangeCheck := StretchFilter in [sfLanczos, sfMitchell];
  852.     if (MapX = nil) or (MapY = nil) then Exit;
  853.  
  854.     MapXLoPos := MapX[0][0].Pos;
  855.     MapXHiPos := MapX[DstClipW - 1][High(MapX[DstClipW - 1])].Pos;
  856.     SetLength(HorzBuffer, MapXHiPos - MapXLoPos + 1);
  857.  
  858.     { transfer pixels }
  859.     for J := DstClip.Top to DstClip.Bottom - 1 do
  860.     begin
  861.       ClusterY := MapY[J - DstClip.Top];
  862.       for X := MapXLoPos to MapXHiPos do
  863.       begin
  864.         Ca := 0; Cr := 0; Cg := 0; Cb := 0;
  865.         for Y := 0 to Length(ClusterY) - 1 do
  866.         begin
  867.           C := Src.Bits[X + ClusterY[Y].Pos * Src.Width];
  868.           ClustYW := ClusterY[Y].Weight;
  869.           Inc(Ca, C shr 24 * ClustYW);
  870.           Inc(Cr, (C and $00FF0000) shr 16 * ClustYW);
  871.           Inc(Cg, (C and $0000FF00) shr 8 * ClustYW);
  872.           Inc(Cb, (C and $000000FF) * ClustYW);
  873.         end;
  874.         with HorzBuffer[X - MapXLoPos] do
  875.         begin
  876.           R := Cr;
  877.           G := Cg;
  878.           B := Cb;
  879.           A := Ca;
  880.         end;
  881.       end;
  882.  
  883.       DstLine := Dst.ScanLine[J];
  884.       for I := DstClip.Left to DstClip.Right - 1 do
  885.       begin
  886.         ClusterX := MapX[I - DstClip.Left];
  887.         Ca := 0; Cr := 0; Cg := 0; Cb := 0;
  888.         for X := 0 to Length(ClusterX) - 1 do
  889.         begin
  890.           Wt := ClusterX[X].Weight;
  891.           with HorzBuffer[ClusterX[X].Pos - MapXLoPos] do
  892.           begin
  893.             Inc(Ca, A * Wt);
  894.             Inc(Cr, R * Wt);
  895.             Inc(Cg, G * Wt);
  896.             Inc(Cb, B * Wt);
  897.           end;
  898.         end;
  899.  
  900.         if RangeCheck then
  901.         begin
  902.           if Ca > $FF0000 then Ca := $FF0000
  903.           else if Ca < 0 then Ca := 0
  904.           else Ca := Ca and $00FF0000;
  905.  
  906.           if Cr > $FF0000 then Cr := $FF0000
  907.           else if Cr < 0 then Cr := 0
  908.           else Cr := Cr and $00FF0000;
  909.  
  910.           if Cg > $FF0000 then Cg := $FF0000
  911.           else if Cg < 0 then Cg := 0
  912.           else Cg := Cg and $00FF0000;
  913.  
  914.           if Cb > $FF0000 then Cb := $FF0000
  915.           else if Cb < 0 then Cb := 0
  916.           else Cb := Cb and $00FF0000;
  917.  
  918.           C := (Ca shl 8) or Cr or (Cg shr 8) or (Cb shr 16);
  919.         end
  920.         else
  921.           C := ((Ca and $00FF0000) shl 8) or (Cr and $00FF0000) or ((Cg and $00FF0000) shr 8) or ((Cb and $00FF0000) shr 16);
  922.  
  923.         // combine it with the background
  924.         case CombineOp of
  925.           dmOpaque: DstLine[I] := C;
  926.           dmBlend: BlendMemEx(C, DstLine[I], Src.MasterAlpha);
  927.           dmCustom: CombineCallBack(C, DstLine[I], Src.MasterAlpha);
  928.         end;
  929.       end;
  930.     end;
  931.   finally
  932.     EMMS;
  933.     MapX := nil;
  934.     MapY := nil;
  935.   end;
  936. end;
  937. {$WARNINGS ON}
  938.  
  939. { Draft Resample Routines }
  940.  
  941. function BlockAverage_MMX(Dlx, Dly, RowSrc, OffSrc: Cardinal): TColor32;
  942. asm
  943.    push       ebx
  944.    push       esi
  945.    push       edi
  946.  
  947.    mov        ebx, OffSrc
  948.    mov        esi, eax
  949.    mov        edi, edx
  950.    sub        ecx, $04
  951.  
  952.    db $0F,$EF,$C9           /// pxor       mm1, mm1
  953.    db $0F,$EF,$D2           /// pxor       mm2, mm2
  954.    db $0F,$EF,$FF           /// pxor       mm7, mm7
  955.  
  956.  @@LoopY:
  957.    mov        esi, eax
  958.    db $0F,$EF,$C0           /// pxor       mm0, mm0
  959.  @@LoopX:
  960.    db $0F,$6E,$34,$B1       /// movd       mm6, [ecx + esi * 4]
  961.    db $0F,$60,$F7           /// punpcklbw  mm6, mm7
  962.    db $0F,$FD,$C6           /// paddw      mm0, mm6
  963.    dec        esi
  964.    jnz        @@LoopX
  965.  
  966.    db $0F,$6F,$F0           /// movq       mm6, mm0
  967.    db $0F,$61,$F7           /// punpcklwd  mm6, mm7
  968.    db $0F,$FE,$CE           /// paddd      mm1, mm6
  969.    db $0F,$6F,$F0           /// movq       mm6, mm0
  970.    db $0F,$69,$F7           /// punpckhwd  mm6, mm7
  971.    db $0F,$FE,$D6           /// paddd      mm2, mm6
  972.    add        ecx, ebx
  973.    dec        edx
  974.    jnz        @@LoopY
  975.  
  976.    mul        edi
  977.    mov        ecx, eax
  978.    mov        eax, $01000000
  979.    div        ecx
  980.    mov        ecx, eax
  981.  
  982.    db $0F,$7E,$C8           /// movd       eax, mm1
  983.    mul        ecx
  984.    shr        eax, $18
  985.    mov        edi, eax
  986.  
  987.    db $0F,$73,$D1,$20       /// psrlq      mm1, $20
  988.    db $0F,$7E,$C8           /// movd       eax, mm1
  989.    mul        ecx
  990.    shr        eax, $10
  991.    and        eax, $0000FF00
  992.    add        edi, eax
  993.  
  994.    db $0F,$7E,$D0           /// movd       eax, mm2
  995.    mul        ecx
  996.    shr        eax, $08
  997.    and        eax, $00FF0000
  998.    add        edi, eax
  999.  
  1000.    db $0F,$73,$D2,$20       /// psrlq      mm2, $20
  1001.    db $0F,$7E,$D0           /// movd       eax, mm2
  1002.    mul        ecx
  1003.    and        eax, $FF000000
  1004.    add        eax, edi
  1005.  
  1006.    pop        edi
  1007.    pop        esi
  1008.    pop        ebx
  1009. end;
  1010.  
  1011. function BlockAverage_3dNow(Dlx, Dly, RowSrc, OffSrc: Cardinal): TColor32;
  1012. asm
  1013.    push       ebx
  1014.    push       esi
  1015.    push       edi
  1016.  
  1017.    mov        ebx, OffSrc
  1018.    mov        esi, eax
  1019.    mov        edi, edx
  1020.  
  1021.    shl        esi, $02
  1022.    sub        ebx, esi
  1023.  
  1024.    db $0F,$EF,$C9           /// pxor       mm1, mm1
  1025.    db $0F,$EF,$D2           /// pxor       mm2, mm2
  1026.    db $0F,$EF,$FF           /// pxor       mm7, mm7
  1027.  
  1028.  @@LoopY:
  1029.    mov        esi, eax
  1030.    db $0F,$EF,$C0           /// pxor       mm0, mm0
  1031.    db $0F,$0D,$34,$F1       /// prefetch   [ecx + esi * 8]
  1032.  @@LoopX:
  1033.    db $0F,$6E,$31           /// movd       mm6, [ecx]
  1034.    db $0F,$60,$F7           /// punpcklbw  mm6, mm7
  1035.    db $0F,$FD,$C6           /// paddw      mm0, mm6
  1036.    add        ecx, $04
  1037.    dec        esi
  1038.  
  1039.    jnz        @@LoopX
  1040.  
  1041.    db $0F,$6F,$F0           /// movq       mm6, mm0
  1042.    db $0F,$61,$F7           /// punpcklwd  mm6, mm7
  1043.    db $0F,$FE,$CE           /// paddd      mm1, mm6
  1044.    db $0F,$6F,$F0           /// movq       mm6, mm0
  1045.    db $0F,$69,$F7           /// punpckhwd  mm6, mm7
  1046.    db $0F,$FE,$D6           /// paddd      mm2, mm6
  1047.    add        ecx, ebx
  1048.    dec        edx
  1049.  
  1050.    jnz        @@LoopY
  1051.  
  1052.    mul        edi
  1053.    mov        ecx, eax
  1054.    mov        eax, $01000000
  1055.    div        ecx
  1056.    mov        ecx, eax
  1057.  
  1058.    db $0F,$7E,$C8           /// movd       eax, mm1
  1059.    mul        ecx
  1060.    shr        eax, $18
  1061.    mov        edi, eax
  1062.  
  1063.    db $0F,$73,$D1,$20       /// psrlq      mm1, $20
  1064.    db $0F,$7E,$C8           /// movd       eax, mm1
  1065.    mul        ecx
  1066.    shr        eax, $10
  1067.    and        eax, $0000FF00
  1068.    add        edi, eax
  1069.  
  1070.    db $0F,$7E,$D0           /// movd       eax, mm2
  1071.    mul        ecx
  1072.    shr        eax, $08
  1073.    and        eax, $00FF0000
  1074.    add        edi, eax
  1075.  
  1076.    db $0F,$73,$D2,$20       /// psrlq      mm2, $20
  1077.    db $0F,$7E,$D0           /// movd       eax, mm2
  1078.    mul        ecx
  1079.    and        eax, $FF000000
  1080.    add        eax, edi
  1081.  
  1082.    pop        edi
  1083.    pop        esi
  1084.    pop        ebx
  1085. end;
  1086.  
  1087. function BlockAverage_IA32(Dlx, Dly, RowSrc, OffSrc: Cardinal): TColor32;
  1088. type
  1089.  PCardinal = ^Cardinal;
  1090.  PRGBA = ^TRGBA;
  1091.  TRGBA = record B,G,R,A: Byte end;
  1092. var
  1093.  C: PRGBA;
  1094.  ix, iy, iA, iR, iG, iB, Area: Cardinal;
  1095. begin
  1096.   iR := 0;  iB := iR;  iG := iR;  iA := iR;
  1097.   for iy := 1 to Dly do
  1098.   begin
  1099.     C:= PRGBA(RowSrc);
  1100.     for ix := 1 to Dlx do
  1101.     begin
  1102.       inc(iB, C.B);
  1103.       inc(iG, C.G);
  1104.       inc(iR, C.R);
  1105.       inc(iA, C.A);
  1106.       inc(C);
  1107.     end;
  1108.     inc(RowSrc, OffSrc);
  1109.   end;
  1110.  
  1111.   Area := Dlx * Dly;
  1112.   Area := $1000000 div Area;
  1113.   Result := iA * Area and $FF000000 or
  1114.             iR * Area shr  8 and $FF0000 or
  1115.             iG * Area shr 16 and $FF00 or
  1116.             iB * Area shr 24 and $FF;
  1117. end;
  1118.  
  1119. procedure DraftResample(Dst: TBitmap32; DstRect: TRect; DstClip: TRect;
  1120.                         Src: TBitmap32; SrcRect: TRect;
  1121.                         CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  1122. var
  1123.   SrcW, SrcH,
  1124.   DstW, DstH,
  1125.   DstClipW, DstClipH: Cardinal;
  1126.   RowSrc, OffSrc,
  1127.   dy, dx,
  1128.   c1, c2, r1, r2,
  1129.   xs, xsrc, M: Cardinal;
  1130.   C: TColor32;
  1131.   DstLine: PColor32Array;
  1132.   ScaleFactor,lx, fe: Single;
  1133.   FSrcTop,I,J,ly,
  1134.   sc, sr, cx, cy: integer;
  1135.   Y_256: TFixed;
  1136.   BlendMemEx: TBlendMemEx;
  1137. begin
  1138.  { rangechecking and rect intersection done by caller }
  1139.  
  1140.   SrcW := SrcRect.Right  - SrcRect.Left;
  1141.   SrcH := SrcRect.Bottom - SrcRect.Top;
  1142.  
  1143.   DstW := DstRect.Right  - DstRect.Left;
  1144.   DstH := DstRect.Bottom - DstRect.Top;
  1145.  
  1146.   DstClipW := DstClip.Right - DstClip.Left;
  1147.   DstClipH := DstClip.Bottom - DstClip.Top;
  1148.  
  1149.   BlendMemEx := BLEND_MEM_EX[Src.CombineMode];
  1150.  
  1151.   if (DstW > SrcW)or(DstH > SrcH) then begin
  1152.     if (SrcW < 2) or (SrcH < 2) then
  1153.       Resample(Dst, DstRect, DstClip, Src, SrcRect, sfLinear, CombineOp,
  1154.         CombineCallBack)
  1155.     else
  1156.       StretchHorzStretchVertLinear(Dst, DstRect, DstClip, Src, SrcRect, CombineOp,
  1157.         CombineCallBack);
  1158.     end
  1159.   else
  1160.     begin //Full Scaledown, ignores Fulledge - cannot be integrated into this resampling method
  1161.       OffSrc := Src.Width * 4;
  1162.  
  1163.       ScaleFactor:= SrcW / DstW;
  1164.       cx := Trunc( (DstClip.Left - DstRect.Left) * ScaleFactor);
  1165.       r2 := Trunc(ScaleFactor);
  1166.       sr := Trunc( $10000 * ScaleFactor );
  1167.  
  1168.       ScaleFactor:= SrcH / DstH;
  1169.       cy := Trunc( (DstClip.Top - DstRect.Top) * ScaleFactor);
  1170.       c2 := Trunc(ScaleFactor);
  1171.       sc := Trunc( $10000 * ScaleFactor );
  1172.  
  1173.       DstLine := PColor32Array(Dst.PixelPtr[0, DstClip.Top]);
  1174.       RowSrc := Cardinal(Src.PixelPtr[ SrcRect.Left +  cx, SrcRect.Top + cy ]);
  1175.  
  1176.       xs := r2;
  1177.       c1 := 0;
  1178.       Dec(DstClip.Left, 2);
  1179.       Inc(DstClipW);
  1180.       Inc(DstClipH);
  1181.  
  1182.       for J := 2  to DstClipH do
  1183.       begin
  1184.         dy := c2 - c1;
  1185.         c1 := c2;
  1186.         c2 := J * sc shr 16;
  1187.         r1 := 0;
  1188.         r2 := xs;
  1189.         xsrc := RowSrc;
  1190.  
  1191.         case CombineOp of
  1192.           dmOpaque:
  1193.             for I := 2  to DstClipW do
  1194.             begin
  1195.               dx := r2 - r1;  r1 := r2;
  1196.               r2 := I * sr shr 16;
  1197.               DstLine[DstClip.Left + I]:= BlockAverage(dx, dy, xsrc, OffSrc);
  1198.               xsrc := xsrc + dx shl 2;
  1199.             end;
  1200.           dmBlend:
  1201.             for I := 2  to DstClipW do
  1202.             begin
  1203.               dx := r2 - r1;  r1 := r2;
  1204.               r2 := I * sr shr 16;
  1205.               BlendMemEx(BlockAverage(dx, dy, xsrc, OffSrc), DstLine[DstClip.Left + I], Src.MasterAlpha);
  1206.               xsrc := xsrc + dx shl 2;
  1207.             end;
  1208.           dmCustom:
  1209.             for I := 2  to DstClipW do
  1210.             begin
  1211.               dx := r2 - r1;  r1 := r2;
  1212.               r2 := I * sr shr 16;
  1213.               CombineCallBack(BlockAverage(dx, dy, xsrc, OffSrc), DstLine[DstClip.Left + I], Src.MasterAlpha);
  1214.               xsrc := xsrc + dx shl 2;
  1215.             end;
  1216.         end;
  1217.  
  1218.         Inc(DstLine, Dst.Width);
  1219.         Inc(RowSrc, OffSrc * dy);
  1220.       end;
  1221.     end;
  1222.   EMMS;
  1223. end;
  1224.  
  1225. { Stretch Transfer }
  1226.  
  1227. {$WARNINGS OFF}
  1228. procedure StretchTransfer(
  1229.   Dst: TBitmap32; DstRect: TRect; DstClip: TRect;
  1230.   Src: TBitmap32; SrcRect: TRect;
  1231.   StretchFilter: TStretchFilter;
  1232.   CombineOp: TDrawMode; CombineCallBack: TPixelCombineEvent);
  1233. var
  1234.   SrcW, SrcH: Single;
  1235.   DstW, DstH: Integer;
  1236.   R: TRect;
  1237. begin
  1238.   if Src.Empty then Exit;
  1239.   CheckBitmaps(Dst, Src);
  1240.   if not CheckSrcRect(Src, SrcRect) then Exit;
  1241.   IntersectRect(DstClip, DstClip, MakeRect(0, 0, Dst.Width, Dst.Height));
  1242.   IntersectRect(DstClip, DstClip, DstRect);
  1243.   if IsRectEmpty(DstClip) then Exit;
  1244.   IntersectRect(R, DstClip, DstRect);
  1245.   if IsRectEmpty(R) then Exit;
  1246.  
  1247.   if (CombineOp = dmCustom) and not Assigned(CombineCallBack) then CombineOp := dmOpaque;
  1248.   if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then Exit;
  1249.  
  1250.   SrcW := SrcRect.Right - SrcRect.Left;
  1251.   SrcH := SrcRect.Bottom - SrcRect.Top;
  1252.   DstW := DstRect.Right - DstRect.Left;
  1253.   DstH := DstRect.Bottom - DstRect.Top;
  1254.  
  1255.   try
  1256.     if (SrcW = DstW) and (SrcH = DstH) then
  1257.       BlendBlock(Dst, DstClip, Src, SrcRect.Left + DstClip.Left - DstRect.Left,
  1258.         SrcRect.Top + DstClip.Top - DstRect.Top, CombineOp, CombineCallBack)
  1259.     else case StretchFilter of
  1260.       sfNearest: StretchNearest(Dst, DstRect, DstClip, Src, SrcRect, CombineOp, CombineCallBack);
  1261.       sfDraft: DraftResample(Dst, DstRect, DstClip, Src, SrcRect, CombineOp, CombineCallBack);
  1262.       sfLinear:
  1263.         if (DstW > SrcW) and (DstH > SrcH) and (SrcW > 1) and (SrcH > 1) then
  1264.           StretchHorzStretchVertLinear(Dst, DstRect, DstClip, Src, SrcRect, CombineOp, CombineCallBack)
  1265.         else
  1266.           Resample(Dst, DstRect, DstClip, Src, SrcRect, sfLinear, CombineOp, CombineCallBack);
  1267.     else
  1268.       Resample(Dst, DstRect, DstClip, Src, SrcRect, StretchFilter, CombineOp, CombineCallBack);
  1269.     end;
  1270.  
  1271.   finally
  1272.     EMMS;
  1273.   end;
  1274. end;
  1275. {$WARNINGS ON}
  1276.  
  1277.  
  1278. { A bit of linear algebra }
  1279.  
  1280. function _DET(a1, a2, b1, b2: Single): Single; overload;
  1281. begin
  1282.   Result := a1 * b2 - a2 * b1;
  1283. end;
  1284.  
  1285. function _DET(a1, a2, a3, b1, b2, b3, c1, c2, c3: Single): Single; overload;
  1286. begin
  1287.   Result :=
  1288.     a1 * (b2 * c3 - b3 * c2) -
  1289.     b1 * (a2 * c3 - a3 * c2) +
  1290.     c1 * (a2 * b3 - a3 * b2);
  1291. end;
  1292.  
  1293. procedure Adjoint(var M: TFloatMatrix);
  1294. var
  1295.   a1, a2, a3: Single;
  1296.   b1, b2, b3: Single;
  1297.   c1, c2, c3: Single;
  1298. begin
  1299.   a1 := M[0,0]; a2:= M[0,1]; a3 := M[0,2];
  1300.   b1 := M[1,0]; b2:= M[1,1]; b3 := M[1,2];
  1301.   c1 := M[2,0]; c2:= M[2,1]; c3 := M[2,2];
  1302.  
  1303.   M[0,0]:= _DET(b2, b3, c2, c3);
  1304.   M[0,1]:=-_DET(a2, a3, c2, c3);
  1305.   M[0,2]:= _DET(a2, a3, b2, b3);
  1306.  
  1307.   M[1,0]:=-_DET(b1, b3, c1, c3);
  1308.   M[1,1]:= _DET(a1, a3, c1, c3);
  1309.   M[1,2]:=-_DET(a1, a3, b1, b3);
  1310.  
  1311.   M[2,0]:= _DET(b1, b2, c1, c2);
  1312.   M[2,1]:=-_DET(a1, a2, c1, c2);
  1313.   M[2,2]:= _DET(a1, a2, b1, b2);
  1314. end;
  1315.  
  1316. function Determinant(const M: TFloatMatrix): Single;
  1317. begin
  1318.   Result := _DET(M[0,0], M[1,0], M[2,0],
  1319.                  M[0,1], M[1,1], M[2,1],
  1320.                  M[0,2], M[1,2], M[2,2]);
  1321. end;
  1322.  
  1323. procedure Scale(var M: TFloatMatrix; Factor: Single);
  1324. var
  1325.   i, j: Integer;
  1326. begin
  1327.   for i := 0 to 2 do
  1328.     for j := 0 to 2 do
  1329.       M[i,j] := M[i,j] * Factor;
  1330. end;
  1331.  
  1332. procedure Invert(var M: TFloatMatrix);
  1333. var
  1334.   Det: Single;
  1335. begin
  1336.   Det := Determinant(M);
  1337.   if Abs(Det) < 1E-5 then M := IdentityMatrix
  1338.   else
  1339.   begin
  1340.     Adjoint(M);
  1341.     Scale(M, 1 / Det);
  1342.   end;
  1343. end;
  1344.  
  1345. function Mult(const M1, M2: TFloatMatrix): TFloatMatrix;
  1346. var
  1347.   i, j: Integer;
  1348. begin
  1349.   for i := 0 to 2 do
  1350.     for j := 0 to 2 do
  1351.       Result[i, j] :=
  1352.         M1[0, j] * M2[i, 0] +
  1353.         M1[1, j] * M2[i, 1] +
  1354.         M1[2, j] * M2[i, 2];
  1355. end;
  1356.  
  1357. function VectorTransform(const M: TFloatMatrix; const V: TVector3f): TVector3f;
  1358. begin
  1359.   Result[0] := M[0,0] * V[0] + M[1,0] * V[1] + M[2,0] * V[2];
  1360.   Result[1] := M[0,1] * V[0] + M[1,1] * V[1] + M[2,1] * V[2];
  1361.   Result[2] := M[0,2] * V[0] + M[1,2] * V[1] + M[2,2] * V[2];
  1362. end;
  1363.  
  1364.  
  1365. { Transformation functions }
  1366.  
  1367. function TransformPoints(Points: TArrayOfArrayOfFixedPoint; Transformation: TTransformation): TArrayOfArrayOfFixedPoint;
  1368. var
  1369.   I, J: Integer;
  1370. begin
  1371.   if Points = nil then
  1372.     Result := nil
  1373.   else
  1374.   begin
  1375.     SetLength(Result, Length(Points));
  1376.     Transformation.PrepareTransform;
  1377.     
  1378.     for I := 0 to High(Result) do
  1379.     begin
  1380.       SetLength(Result[I], Length(Points[I]));
  1381.       if Length(Result[I]) > 0 then
  1382.         for J := 0 to High(Result[I]) do
  1383.           Transformation.TransformFixed(Points[I][J].X, Points[I][J].Y, Result[I][J].X, Result[I][J].Y);
  1384.     end;
  1385.   end;
  1386. end;
  1387.  
  1388. procedure Transform(Dst, Src: TBitmap32; Transformation: TTransformation);
  1389. var
  1390.   C, SrcAlpha: TColor32;
  1391.   R, SrcRectI, DstRect, SrcRect256: TRect;
  1392.   Pixels: PColor32Array;
  1393.   I, J, X, Y: Integer;
  1394.   DrawMode: TDrawMode;
  1395.   CombineCallBack: TPixelCombineEvent;
  1396.   BlendMemEx: TBlendMemEx;
  1397.  
  1398.   function GET_S256(X256, Y256: Integer; out C: TColor32): Boolean;
  1399.   var
  1400.     celx, cely: Longword;
  1401.     C1, C2, C3, C4: TColor32;
  1402.   begin
  1403.     X := SAR_8(X256);
  1404.     Y := SAR_8(Y256);
  1405.  
  1406.     if (X > SrcRectI.Left) and (X < SrcRectI.Right - 1) and
  1407.        (Y > SrcRectI.Top) and (Y < SrcRectI.Bottom - 1) then
  1408.     begin
  1409.       // everything is ok interpolate between four neighbors
  1410.       C := TBitmap32Access(Src).GET_T256(X256, Y256);
  1411.       Result := True;
  1412.     end
  1413.     else if (X < SrcRectI.Left - 1) or (Y < SrcRectI.Top - 1) or
  1414.             (X >= SrcRectI.Right) or (Y >= SrcRectI.Bottom) then
  1415.     begin
  1416.       // (X,Y) coordinate is out of the SrcRect, do not interpolate
  1417.       C := 0; // just write something to disable compiler warnings
  1418.       Result := False;
  1419.     end
  1420.     else
  1421.     begin
  1422.       // handle edge in fail-safe mode...
  1423.       C1 := Src.PixelS[X, Y];
  1424.       C2 := Src.PixelS[X + 1, Y];
  1425.       C3 := Src.PixelS[X, Y + 1];
  1426.       C4 := Src.PixelS[X + 1, Y + 1];
  1427.  
  1428.       celx := X256 and $FF xor 255;
  1429.       cely := Y256 and $FF xor 255;
  1430.  
  1431.       C := CombineReg(CombineReg(C1, C2, celx), CombineReg(C3, C4, celx), cely);
  1432.       Result := True;
  1433.     end;
  1434.   end;
  1435.  
  1436. begin
  1437.   if not Transformation.TransformValid then Transformation.PrepareTransform;
  1438.  
  1439.   CombineCallBack := Src.OnPixelCombine; // store it into a local variable
  1440.   DrawMode := Src.DrawMode;    // store it into a local variable
  1441.   BlendMemEx := BLEND_MEM_EX[Src.CombineMode]; // store it into a local variable
  1442.   SrcAlpha := Src.MasterAlpha;
  1443.   if (DrawMode = dmCustom) and not Assigned(CombineCallBack) then
  1444.     DrawMode := dmOpaque;
  1445.  
  1446.   // clip SrcRect
  1447.  
  1448.   // workaround C++ Builder throwing exceptions:
  1449.   R := MakeRect(Round(Transformation.SrcRect.Left), Round(Transformation.SrcRect.Top),
  1450.                 Round(Transformation.SrcRect.Right), Round(Transformation.SrcRect.Bottom));
  1451.  
  1452.   IntersectRect(SrcRectI, R, MakeRect(0, 0, Src.Width - 1, Src.Height - 1));
  1453.  
  1454.   with Transformation.SrcRect do
  1455.   begin
  1456.     IntersectRect(SrcRect256, MakeRect(Round(Left * 256), Round(Top * 256),
  1457.       Round(Right * 256), Round(Bottom * 256)), MakeRect(0, 0, (Src.Width - 1) * 256,
  1458.       (Src.Height - 1) * 256));
  1459.   end;
  1460.  
  1461.   // clip DstRect
  1462.   R := Transformation.GetTransformedBounds;
  1463.   IntersectRect(DstRect, R, MakeRect(Dst.ClipRect.Left, Dst.ClipRect.Top,
  1464.     Dst.ClipRect.Right - 1, Dst.ClipRect.Bottom - 1));
  1465.  
  1466.   if (DstRect.Right < DstRect.Left) or (DstRect.Bottom < DstRect.Top) then Exit;
  1467.  
  1468.   try
  1469.     if Src.StretchFilter <> sfNearest then
  1470.       for J := DstRect.Top to DstRect.Bottom do
  1471.       begin
  1472.         Pixels := Dst.ScanLine[J];
  1473.         for I := DstRect.Left to DstRect.Right do
  1474.         begin
  1475.           Transformation.ReverseTransform256(I, J, X, Y);
  1476.           if GET_S256(X, Y, C) then
  1477.             case DrawMode of
  1478.               dmOpaque: Pixels[I] := C;
  1479.               dmBlend: BlendMemEx(C, Pixels[I], SrcAlpha);
  1480.             else // dmCustom:
  1481.               CombineCallBack(C, Pixels[I], SrcAlpha);
  1482.             end;
  1483.         end;
  1484.       end
  1485.     else // nearest filter
  1486.       for J := DstRect.Top to DstRect.Bottom do
  1487.       begin
  1488.         Pixels := Dst.ScanLine[J];
  1489.         for I := DstRect.Left to DstRect.Right do
  1490.         begin
  1491.           Transformation.ReverseTransformInt(I, J, X, Y);
  1492.           if (X >= SrcRectI.Left) and (X <= SrcRectI.Right) and
  1493.             (Y >= SrcRectI.Top) and (Y <= SrcRectI.Bottom) then
  1494.           case DrawMode of
  1495.             dmOpaque: Pixels[I] := Src.Pixel[X, Y];
  1496.             dmBlend: BlendMemEx(Src.Pixel[X, Y], Pixels[I], SrcAlpha);
  1497.           else // dmCustom:
  1498.             CombineCallBack(Src.Pixel[X, Y], Pixels[I], SrcAlpha);
  1499.           end;
  1500.         end;
  1501.       end;
  1502.   finally
  1503.     EMMS;
  1504.   end;
  1505.   Dst.Changed;
  1506. end;
  1507.  
  1508. procedure SetBorderTransparent(ABitmap: TBitmap32; ARect: TRect);
  1509. var
  1510.   I: Integer;
  1511. begin
  1512.   if TestClip(ARect.Left, ARect.Right, ABitmap.Width) and
  1513.     TestClip(ARect.Top, ARect.Bottom, ABitmap.Height) then
  1514.   begin
  1515.     for I := ARect.Left to ARect.Right do
  1516.       ABitmap[I, ARect.Top] := ABitmap[I, ARect.Top] and $00FFFFFF;
  1517.  
  1518.     for I := ARect.Left to ARect.Right do
  1519.       ABitmap[I, ARect.Bottom] := ABitmap[I, ARect.Bottom] and $00FFFFFF;
  1520.  
  1521.     if ARect.Bottom > ARect.Top + 1 then
  1522.       for I := ARect.Top + 1 to ARect.Bottom - 1 do
  1523.       begin
  1524.         ABitmap[ARect.Left, I] := ABitmap[ARect.Left, I] and $00FFFFFF;
  1525.         ABitmap[ARect.Right, I] := ABitmap[ARect.Right, I] and $00FFFFFF;
  1526.       end;
  1527.  
  1528.     ABitmap.Changed;
  1529.   end;
  1530. end;
  1531.  
  1532.  
  1533. { TTransformation }
  1534.  
  1535. function TTransformation.ReverseTransform(const P: TFloatPoint): TFloatPoint;
  1536. begin
  1537.   If not TransformValid then PrepareTransform;
  1538.   ReverseTransformFloat(P.X, P.Y, Result.X, Result.Y);
  1539. end;
  1540.  
  1541. function TTransformation.ReverseTransform(const P: TFixedPoint): TFixedPoint;
  1542. begin
  1543.   If not TransformValid then PrepareTransform;
  1544.   ReverseTransformFixed(P.X, P.Y, Result.X, Result.Y);
  1545. end;
  1546.  
  1547. function TTransformation.ReverseTransform(const P: TPoint): TPoint;
  1548. begin
  1549.   If not TransformValid then PrepareTransform;
  1550.   ReverseTransformInt(P.X, P.Y, Result.X, Result.Y);
  1551. end;
  1552.  
  1553. procedure TTransformation.SetSrcRect(const Value: TFloatRect);
  1554. begin
  1555.   FSrcRect := Value;
  1556.   TransformValid := False;
  1557. end;
  1558.  
  1559.  
  1560. function TTransformation.Transform(const P: TFloatPoint): TFloatPoint;
  1561. begin
  1562.   If not TransformValid then PrepareTransform;
  1563.   TransformFloat(P.X, P.Y, Result.X, Result.Y);
  1564. end;
  1565.  
  1566. function TTransformation.Transform(const P: TFixedPoint): TFixedPoint;
  1567. begin
  1568.   If not TransformValid then PrepareTransform;
  1569.   TransformFixed(P.X, P.Y, Result.X, Result.Y);
  1570. end;
  1571.  
  1572. function TTransformation.Transform(const P: TPoint): TPoint;
  1573. begin
  1574.   If not TransformValid then PrepareTransform;
  1575.   TransformInt(P.X, P.Y, Result.X, Result.Y);
  1576. end;
  1577.  
  1578. { TAffineTransformation }
  1579.  
  1580. procedure TAffineTransformation.Clear;
  1581. begin
  1582.   Matrix := IdentityMatrix;
  1583.   TransformValid := False;
  1584. end;
  1585.  
  1586. constructor TAffineTransformation.Create;
  1587. begin
  1588.   Clear;
  1589. end;
  1590.  
  1591. function TAffineTransformation.GetTransformedBounds: TRect;
  1592. var
  1593.   V1, V2, V3, V4: TVector3f;
  1594. begin
  1595.   V1[0] := FSrcRect.Left;  V1[1] := FSrcRect.Top;    V1[2] := 1;
  1596.   V2[0] := FSrcRect.Right; V2[1] := V1[1];           V2[2] := 1;
  1597.   V3[0] := V1[0];          V3[1] := FSrcRect.Bottom; V3[2] := 1;
  1598.   V4[0] := V2[0];          V4[1] := V3[1];           V4[2] := 1;
  1599.   V1 := VectorTransform(Matrix, V1);
  1600.   V2 := VectorTransform(Matrix, V2);
  1601.   V3 := VectorTransform(Matrix, V3);
  1602.   V4 := VectorTransform(Matrix, V4);
  1603.   Result.Left   := Round(Min(Min(V1[0], V2[0]), Min(V3[0], V4[0])) - 0.5);
  1604.   Result.Right  := Round(Max(Max(V1[0], V2[0]), Max(V3[0], V4[0])) + 0.5);
  1605.   Result.Top    := Round(Min(Min(V1[1], V2[1]), Min(V3[1], V4[1])) - 0.5);
  1606.   Result.Bottom := Round(Max(Max(V1[1], V2[1]), Max(V3[1], V4[1])) + 0.5);
  1607. end;
  1608.  
  1609. procedure TAffineTransformation.PrepareTransform;
  1610. begin
  1611.   FInverseMatrix := Matrix;
  1612.   Invert(FInverseMatrix);
  1613.  
  1614.   // calculate a fixed point (4096) factors
  1615.   FInverseIntMatrix[0,0] := Round(FInverseMatrix[0,0] * 4096);
  1616.   FInverseIntMatrix[1,0] := Round(FInverseMatrix[1,0] * 4096);
  1617.   FInverseIntMatrix[2,0] := Round(FInverseMatrix[2,0] * 4096);
  1618.   FInverseIntMatrix[0,1] := Round(FInverseMatrix[0,1] * 4096);
  1619.   FInverseIntMatrix[1,1] := Round(FInverseMatrix[1,1] * 4096);
  1620.   FInverseIntMatrix[2,1] := Round(FInverseMatrix[2,1] * 4096);
  1621.  
  1622.   FIntMatrix[0,0] := Round(Matrix[0,0] * 4096);
  1623.   FIntMatrix[1,0] := Round(Matrix[1,0] * 4096);
  1624.   FIntMatrix[2,0] := Round(Matrix[2,0] * 4096);
  1625.   FIntMatrix[0,1] := Round(Matrix[0,1] * 4096);
  1626.   FIntMatrix[1,1] := Round(Matrix[1,1] * 4096);
  1627.   FIntMatrix[2,1] := Round(Matrix[2,1] * 4096);
  1628.  
  1629.   // calculate a fixed point (65536) factors
  1630.   FInverseFixedMatrix[0,0] := Round(FInverseMatrix[0,0] * 65536);
  1631.   FInverseFixedMatrix[1,0] := Round(FInverseMatrix[1,0] * 65536);
  1632.   FInverseFixedMatrix[2,0] := Round(FInverseMatrix[2,0] * 65536);
  1633.   FInverseFixedMatrix[0,1] := Round(FInverseMatrix[0,1] * 65536);
  1634.   FInverseFixedMatrix[1,1] := Round(FInverseMatrix[1,1] * 65536);
  1635.   FInverseFixedMatrix[2,1] := Round(FInverseMatrix[2,1] * 65536);
  1636.  
  1637.   FFixedMatrix[0,0] := Round(Matrix[0,0] * 65536);
  1638.   FFixedMatrix[1,0] := Round(Matrix[1,0] * 65536);
  1639.   FFixedMatrix[2,0] := Round(Matrix[2,0] * 65536);
  1640.   FFixedMatrix[0,1] := Round(Matrix[0,1] * 65536);
  1641.   FFixedMatrix[1,1] := Round(Matrix[1,1] * 65536);
  1642.   FFixedMatrix[2,1] := Round(Matrix[2,1] * 65536);
  1643.  
  1644.   TransformValid := True;
  1645. end;
  1646.  
  1647. procedure TAffineTransformation.Rotate(Cx, Cy, Alpha: Single);
  1648. var
  1649.   S, C: Single;
  1650.   M: TFloatMatrix;
  1651. begin
  1652.   TransformValid := False;
  1653.   if (Cx <> 0) or (Cy <> 0) then Translate(-Cx, -Cy);
  1654.   Alpha := DegToRad(Alpha);
  1655.   S := Sin(Alpha); C := Cos(Alpha);
  1656.   M := IdentityMatrix;
  1657.   M[0,0] := C;   M[1,0] := S;
  1658.   M[0,1] := -S;  M[1,1] := C;
  1659.   Matrix := Mult(M, Matrix);
  1660.   if (Cx <> 0) or (Cy <> 0) then Translate(Cx, Cy);
  1661. end;
  1662.  
  1663. procedure TAffineTransformation.Scale(Sx, Sy: Single);
  1664. var
  1665.   M: TFloatMatrix;
  1666. begin
  1667.   TransformValid := False;
  1668.   M := IdentityMatrix;
  1669.   M[0,0] := Sx;
  1670.   M[1,1] := Sy;
  1671.   Matrix := Mult(M, Matrix);
  1672. end;
  1673.  
  1674. procedure TAffineTransformation.Skew(Fx, Fy: Single);
  1675. var
  1676.   M: TFloatMatrix;
  1677. begin
  1678.   TransformValid := False;
  1679.   M := IdentityMatrix;
  1680.   M[1, 0] := Fx;
  1681.   M[0, 1] := Fy;
  1682.   Matrix := Mult(M, Matrix);
  1683. end;
  1684.  
  1685. procedure TAffineTransformation.ReverseTransformInt(
  1686.   DstX, DstY: Integer;
  1687.   out SrcX, SrcY: Integer);
  1688. begin
  1689.   SrcX := SAR_12(DstX * FInverseIntMatrix[0,0] + DstY * FInverseIntMatrix[1,0] + FInverseIntMatrix[2,0] + 2047);
  1690.   SrcY := SAR_12(DstX * FInverseIntMatrix[0,1] + DstY * FInverseIntMatrix[1,1] + FInverseIntMatrix[2,1] + 2047);
  1691. end;
  1692.  
  1693. procedure TAffineTransformation.ReverseTransformFloat(
  1694.   DstX, DstY: Single;
  1695.   out SrcX, SrcY: Single);
  1696. begin
  1697.   SrcX := DstX * FInverseMatrix[0,0] + DstY * FInverseMatrix[1,0] + FInverseMatrix[2,0];
  1698.   SrcY := DstX * FInverseMatrix[0,1] + DstY * FInverseMatrix[1,1] + FInverseMatrix[2,1];
  1699. end;
  1700.  
  1701. procedure TAffineTransformation.ReverseTransformFixed(
  1702.   DstX, DstY: TFixed;
  1703.   out SrcX, SrcY: TFixed);
  1704. begin
  1705.   SrcX := FixedMul(DstX, FInverseFixedMatrix[0,0]) + FixedMul(DstY, FInverseFixedMatrix[1,0]) + FInverseFixedMatrix[2,0];
  1706.   SrcY := FixedMul(DstX, FInverseFixedMatrix[0,1]) + FixedMul(DstY, FInverseFixedMatrix[1,1]) + FInverseFixedMatrix[2,1];
  1707. end;
  1708.  
  1709. procedure TAffineTransformation.ReverseTransform256(
  1710.   DstX, DstY: Integer;
  1711.   out SrcX256, SrcY256: Integer);
  1712. begin
  1713.   SrcX256 := SAR_4(DstX * FInverseIntMatrix[0,0] + DstY * FInverseIntMatrix[1,0] + FInverseIntMatrix[2,0] + 7);
  1714.   SrcY256 := SAR_4(DstX * FInverseIntMatrix[0,1] + DstY * FInverseIntMatrix[1,1] + FInverseIntMatrix[2,1] + 7);
  1715. end;
  1716.  
  1717. procedure TAffineTransformation.TransformInt(
  1718.   SrcX, SrcY: Integer;
  1719.   out DstX, DstY: Integer);
  1720. begin
  1721.   DstX := SAR_12(SrcX * FIntMatrix[0,0] + SrcY * FIntMatrix[1,0] + FIntMatrix[2,0] + 2047);
  1722.   DstY := SAR_12(SrcX * FIntMatrix[0,1] + SrcY * FIntMatrix[1,1] + FIntMatrix[2,1] + 2047);
  1723. end;
  1724.  
  1725. procedure TAffineTransformation.TransformFloat(
  1726.   SrcX, SrcY: Single;
  1727.   out DstX, DstY: Single);
  1728. begin
  1729.   DstX := SrcX * Matrix[0,0] + SrcY * Matrix[1,0] + Matrix[2,0];
  1730.   DstY := SrcY * Matrix[0,1] + SrcY * Matrix[1,1] + Matrix[2,1];
  1731. end;
  1732.  
  1733. procedure TAffineTransformation.TransformFixed(
  1734.   SrcX, SrcY: TFixed;
  1735.   out DstX, DstY: TFixed);
  1736. begin
  1737.   DstX := FixedMul(SrcX, FFixedMatrix[0,0]) + FixedMul(SrcY, FFixedMatrix[1,0]) + FFixedMatrix[2,0];
  1738.   DstY := FixedMul(SrcX, FFixedMatrix[0,1]) + FixedMul(SrcY, FFixedMatrix[1,1]) + FFixedMatrix[2,1];
  1739. end;
  1740.  
  1741. procedure TAffineTransformation.Translate(Dx, Dy: Single);
  1742. var
  1743.   M: TFloatMatrix;
  1744. begin
  1745.   TransformValid := False;
  1746.   M := IdentityMatrix;
  1747.   M[2,0] := Dx;
  1748.   M[2,1] := Dy;
  1749.   Matrix := Mult(M, Matrix);
  1750. end;
  1751.  
  1752.  
  1753. { TProjectiveTransformation }
  1754.  
  1755. function TProjectiveTransformation.GetTransformedBounds: TRect;
  1756. begin
  1757.   Result.Left   := Round(Min(Min(Wx0, Wx1), Min(Wx2, Wx3)) - 0.5);
  1758.   Result.Right  := Round(Max(Max(Wx0, Wx1), Max(Wx2, Wx3)) + 0.5);
  1759.   Result.Top    := Round(Min(Min(Wy0, Wy1), Min(Wy2, Wy3)) - 0.5);
  1760.   Result.Bottom := Round(Max(Max(Wy0, Wy1), Max(Wy2, Wy3)) + 0.5);
  1761. end;
  1762.  
  1763. procedure TProjectiveTransformation.PrepareTransform;
  1764. var
  1765.   dx1, dx2, px, dy1, dy2, py: Single;
  1766.   g, h, k: Single;
  1767.   R: TFloatMatrix;
  1768. begin
  1769.   px  := Wx0 - Wx1 + Wx2 - Wx3;
  1770.   py  := Wy0 - Wy1 + Wy2 - Wy3;
  1771.  
  1772.   if (px = 0) and (py = 0) then
  1773.   begin
  1774.     // affine mapping
  1775.     FMatrix[0,0] := Wx1 - Wx0;
  1776.     FMatrix[1,0] := Wx2 - Wx1;
  1777.     FMatrix[2,0] := Wx0;
  1778.  
  1779.     FMatrix[0,1] := Wy1 - Wy0;
  1780.     FMatrix[1,1] := Wy2 - Wy1;
  1781.     FMatrix[2,1] := Wy0;
  1782.  
  1783.     FMatrix[0,2] := 0;
  1784.     FMatrix[1,2] := 0;
  1785.     FMatrix[2,2] := 1;
  1786.   end
  1787.   else
  1788.   begin
  1789.     // projective mapping
  1790.     dx1 := Wx1 - Wx2;
  1791.     dx2 := Wx3 - Wx2;
  1792.     dy1 := Wy1 - Wy2;
  1793.     dy2 := Wy3 - Wy2;
  1794.     k := dx1 * dy2 - dx2 * dy1;
  1795.     if k <> 0 then
  1796.     begin
  1797.       g := (px * dy2 - py * dx2) / k;
  1798.       h := (dx1 * py - dy1 * px) / k;
  1799.  
  1800.       FMatrix[0,0] := Wx1 - Wx0 + g * Wx1;
  1801.       FMatrix[1,0] := Wx3 - Wx0 + h * Wx3;
  1802.       FMatrix[2,0] := Wx0;
  1803.  
  1804.       FMatrix[0,1] := Wy1 - Wy0 + g * Wy1;
  1805.       FMatrix[1,1] := Wy3 - Wy0 + h * Wy3;
  1806.       FMatrix[2,1] := Wy0;
  1807.  
  1808.       FMatrix[0,2] := g;
  1809.       FMatrix[1,2] := h;
  1810.       FMatrix[2,2] := 1;
  1811.     end
  1812.     else
  1813.     begin
  1814.       FillChar(FMatrix, SizeOf(FMatrix), 0);
  1815.     end;
  1816.   end;
  1817.  
  1818.   // denormalize texture space (u, v)
  1819.   R := IdentityMatrix;
  1820.   R[0,0] := 1 / (SrcRect.Right - SrcRect.Left);
  1821.   R[1,1] := 1 / (SrcRect.Bottom - SrcRect.Top);
  1822.   FMatrix := Mult(FMatrix, R);
  1823.  
  1824.   R := IdentityMatrix;
  1825.   R[2,0] := -SrcRect.Left;
  1826.   R[2,1] := -SrcRect.Top;
  1827.   FMatrix := Mult(FMatrix, R);
  1828.  
  1829.   FInverseMatrix := FMatrix;
  1830.   Invert(FInverseMatrix);
  1831.  
  1832.   TransformValid := True;
  1833. end;
  1834.  
  1835. procedure TProjectiveTransformation.SetX0(Value: Single);
  1836. begin
  1837.   Wx0 := Value;  TransformValid := False;
  1838. end;
  1839.  
  1840. procedure TProjectiveTransformation.SetX1(Value: Single);
  1841. begin
  1842.   Wx1 := Value;  TransformValid := False;
  1843. end;
  1844.  
  1845. procedure TProjectiveTransformation.SetX2(Value: Single);
  1846. begin
  1847.   Wx2 := Value;  TransformValid := False;
  1848. end;
  1849.  
  1850. procedure TProjectiveTransformation.SetX3(Value: Single);
  1851. begin
  1852.   Wx3 := Value;  TransformValid := False;
  1853. end;
  1854.  
  1855. procedure TProjectiveTransformation.SetY0(Value: Single);
  1856. begin
  1857.   Wy0 := Value;  TransformValid := False;
  1858. end;
  1859.  
  1860. procedure TProjectiveTransformation.SetY1(Value: Single);
  1861. begin
  1862.   Wy1 := Value;  TransformValid := False;
  1863. end;
  1864.  
  1865. procedure TProjectiveTransformation.SetY2(Value: Single);
  1866. begin
  1867.   Wy2 := Value;  TransformValid := False;
  1868. end;
  1869.  
  1870. procedure TProjectiveTransformation.SetY3(Value: Single);
  1871. begin
  1872.   Wy3 := Value;  TransformValid := False;
  1873. end;
  1874.  
  1875. procedure TProjectiveTransformation.ReverseTransformInt(
  1876.   DstX, DstY: Integer;
  1877.   out SrcX, SrcY: Integer);
  1878. var
  1879.   X, Y, Z: Single;
  1880. begin
  1881.   EMMS;
  1882.   X := DstX; Y := DstY;
  1883.   Z := FInverseMatrix[0,2] * X + FInverseMatrix[1,2] * Y + FInverseMatrix[2,2];
  1884.   if Z = 0 then Exit
  1885.   else if Z = 1 then
  1886.   begin
  1887.     SrcX := Round(FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]);
  1888.     SrcY := Round(FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]);
  1889.   end
  1890.   else
  1891.   begin
  1892.     Z := 1 / Z;
  1893.     SrcX := Round((FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * Z);
  1894.     SrcY := Round((FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * Z);
  1895.   end;
  1896. end;
  1897.  
  1898. procedure TProjectiveTransformation.ReverseTransformFloat(
  1899.   DstX, DstY: Single;
  1900.   out SrcX, SrcY: Single);
  1901. var
  1902.   X, Y, Z: Single;
  1903. begin
  1904.   EMMS;
  1905.   X := DstX; Y := DstY;
  1906.   Z := FInverseMatrix[0,2] * X + FInverseMatrix[1,2] * Y + FInverseMatrix[2,2];
  1907.   if Z = 0 then Exit
  1908.   else if Z = 1 then
  1909.   begin
  1910.     SrcX := FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0];
  1911.     SrcY := FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1];
  1912.   end
  1913.   else
  1914.   begin
  1915.     Z := 1 / Z;
  1916.     SrcX := (FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * Z;
  1917.     SrcY := (FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * Z;
  1918.   end;
  1919. end;
  1920.  
  1921. procedure TProjectiveTransformation.ReverseTransformFixed(
  1922.   DstX, DstY: TFixed;
  1923.   out SrcX, SrcY: TFixed);
  1924. var
  1925.   X, Y, Z: Single;
  1926. begin
  1927.   EMMS;
  1928.   X := DstX; Y := DstY;
  1929.   Z := FInverseMatrix[0,2] * X + FInverseMatrix[1,2] * Y + FInverseMatrix[2,2];
  1930.   if Z = 0 then Exit
  1931.   else if Z = 1 then
  1932.   begin
  1933.     SrcX := Round((FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * 65536);
  1934.     SrcY := Round((FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * 65536);
  1935.   end
  1936.   else
  1937.   begin
  1938.     Z := 1 / Z;
  1939.     SrcX := Round(((FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * Z) * 65536);
  1940.     SrcY := Round(((FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * Z) * 65536);
  1941.   end;
  1942. end;
  1943.  
  1944. procedure TProjectiveTransformation.ReverseTransform256(
  1945.   DstX, DstY: Integer;
  1946.   out SrcX256, SrcY256: Integer);
  1947. var
  1948.   X, Y, Z: Single;
  1949. begin
  1950.   EMMS;
  1951.   X := DstX; Y := DstY;
  1952.   Z := FInverseMatrix[0,2] * X + FInverseMatrix[1,2] * Y + FInverseMatrix[2,2];
  1953.   if Z = 0 then Exit
  1954.   else if Z = 1 then
  1955.   begin
  1956.     SrcX256 := Round(256 * (FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]));
  1957.     SrcY256 := Round(256 * (FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]));
  1958.   end
  1959.   else
  1960.   begin
  1961.     Z := 1 / Z;
  1962.     SrcX256 := Round(256 * (FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * Z);
  1963.     SrcY256 := Round(256 * (FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * Z);
  1964.   end;
  1965. end;
  1966.  
  1967.  
  1968. procedure TProjectiveTransformation.TransformFixed(
  1969.   SrcX, SrcY: TFixed;
  1970.   out DstX, DstY: TFixed);
  1971. var
  1972.   X, Y, Z: Single;
  1973. begin
  1974.   EMMS;
  1975.   X := DstX; Y := DstY;
  1976.   Z := FMatrix[0,2] * X + FMatrix[1,2] * Y + FMatrix[2,2];
  1977.   if Z = 0 then Exit
  1978.   else if Z = 1 then
  1979.   begin
  1980.     DstX := Round((FMatrix[0,0] * X + FMatrix[1,0] * Y + FMatrix[2,0]) * 65536);
  1981.     DstY := Round((FMatrix[0,1] * X + FMatrix[1,1] * Y + FMatrix[2,1]) * 65536);
  1982.   end
  1983.   else
  1984.   begin
  1985.     Z := 1 / Z;
  1986.     DstX := Round(((FMatrix[0,0] * X + FMatrix[1,0] * Y + FMatrix[2,0]) * Z) * 65536);
  1987.     DstY := Round(((FMatrix[0,1] * X + FMatrix[1,1] * Y + FMatrix[2,1]) * Z) * 65536);
  1988.   end;
  1989. end;
  1990.  
  1991. procedure TProjectiveTransformation.TransformFloat(
  1992.   SrcX, SrcY: Single;
  1993.   out DstX, DstY: Single);
  1994. var
  1995.   X, Y, Z: Single;
  1996. begin
  1997.   EMMS;
  1998.   X := DstX; Y := DstY;
  1999.   Z := FMatrix[0,2] * X + FMatrix[1,2] * Y + FMatrix[2,2];
  2000.   if Z = 0 then Exit
  2001.   else if Z = 1 then
  2002.   begin
  2003.     DstX := FMatrix[0,0] * X + FMatrix[1,0] * Y + FMatrix[2,0];
  2004.     DstY := FMatrix[0,1] * X + FMatrix[1,1] * Y + FMatrix[2,1];
  2005.   end
  2006.   else
  2007.   begin
  2008.     Z := 1 / Z;
  2009.     DstX := (FMatrix[0,0] * X + FMatrix[1,0] * Y + FMatrix[2,0]) * Z;
  2010.     DstY := (FMatrix[0,1] * X + FMatrix[1,1] * Y + FMatrix[2,1]) * Z;
  2011.   end;
  2012. end;
  2013.  
  2014. procedure TProjectiveTransformation.TransformInt(
  2015.   SrcX, SrcY: Integer;
  2016.   out DstX, DstY: Integer);
  2017. var
  2018.   X, Y, Z: Single;
  2019. begin
  2020.   EMMS;
  2021.   X := DstX; Y := DstY;
  2022.   Z := FInverseMatrix[0,2] * X + FInverseMatrix[1,2] * Y + FInverseMatrix[2,2];
  2023.   if Z = 0 then Exit
  2024.   else if Z = 1 then
  2025.   begin
  2026.     DstX := Round(FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]);
  2027.     DstY := Round(FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]);
  2028.   end
  2029.   else
  2030.   begin
  2031.     Z := 1 / Z;
  2032.     DstX := Round((FInverseMatrix[0,0] * X + FInverseMatrix[1,0] * Y + FInverseMatrix[2,0]) * Z);
  2033.     DstY := Round((FInverseMatrix[0,1] * X + FInverseMatrix[1,1] * Y + FInverseMatrix[2,1]) * Z);
  2034.   end;
  2035. end;
  2036.  
  2037. { Special interpolators (for sfLinear and sfDraft) }
  2038.  
  2039. function M_LinearInterpolator(PWX_256, PWY_256: Cardinal; C11, C21: PColor32): TColor32;
  2040. asm
  2041.         db $0F,$6F,$09           /// MOVQ      MM1,[ECX]
  2042.         MOV       ECX,C21
  2043.         db $0F,$6F,$19           /// MOVQ      MM3,[ECX]
  2044.         db $0F,$6F,$D1           /// MOVQ      MM2,MM1
  2045.         db $0F,$6F,$E3           /// MOVQ      MM4,MM3
  2046.         db $0F,$73,$D1,$20       /// PSRLQ     MM1,32
  2047.         db $0F,$73,$D3,$20       /// PSRLQ     MM3,32
  2048.         db $0F,$6E,$E8           /// MOVD      MM5,EAX
  2049.         db $0F,$62,$ED           /// PUNPCKLDQ MM5,MM5
  2050.         db $0F,$EF,$C0           /// PXOR MM0, MM0
  2051.         db $0F,$60,$C8           /// PUNPCKLBW MM1,MM0
  2052.         db $0F,$60,$D0           /// PUNPCKLBW MM2,MM0
  2053.         db $0F,$F9,$D1           /// PSUBW     MM2,MM1
  2054.         db $0F,$D5,$D5           /// PMULLW    MM2,MM5
  2055.         db $0F,$71,$F1,$08       /// PSLLW     MM1,8
  2056.         db $0F,$FD,$D1           /// PADDW     MM2,MM1
  2057.         db $0F,$71,$D2,$08       /// PSRLW     MM2,8
  2058.         db $0F,$60,$D8           /// PUNPCKLBW MM3,MM0
  2059.         db $0F,$60,$E0           /// PUNPCKLBW MM4,MM0
  2060.         db $0F,$F9,$E3           /// PSUBW     MM4,MM3
  2061.         db $0F,$D5,$E5           /// PMULLW    MM4,MM5
  2062.         db $0F,$71,$F3,$08       /// PSLLW     MM3,8
  2063.         db $0F,$FD,$E3           /// PADDW     MM4,MM3
  2064.         db $0F,$71,$D4,$08       /// PSRLW     MM4,8
  2065.         db $0F,$6E,$EA           /// MOVD      MM5,EDX
  2066.         db $0F,$62,$ED           /// PUNPCKLDQ MM5,MM5
  2067.         db $0F,$F9,$D4           /// PSUBW     MM2,MM4
  2068.         db $0F,$D5,$D5           /// PMULLW    MM2,MM5
  2069.         db $0F,$71,$F4,$08       /// PSLLW     MM4,8
  2070.         db $0F,$FD,$D4           /// PADDW     MM2,MM4
  2071.         db $0F,$71,$D2,$08       /// PSRLW     MM2,8
  2072.         db $0F,$67,$D0           /// PACKUSWB  MM2,MM0
  2073.         db $0F,$7E,$D0           /// MOVD      EAX,MM2
  2074. end;
  2075.  
  2076. function _LinearInterpolator(PWX_256, PWY_256: Cardinal; C11, C21: PColor32): TColor32;
  2077. var
  2078.   C1, C3: TColor32;
  2079. begin
  2080.   PWX_256:= PWX_256 shr 16; if PWX_256 > $FF then PWX_256:= $FF;
  2081.   PWY_256:= PWY_256 shr 16; if PWY_256 > $FF then PWY_256:= $FF;
  2082.   C1 := C11^; Inc(C11);
  2083.   C3 := C21^; Inc(C21);
  2084.   Result := CombineReg(CombineReg(C1, C11^, PWX_256),
  2085.                        CombineReg(C3, C21^, PWX_256), PWY_256);
  2086. end;
  2087.  
  2088.  
  2089. procedure SetupFunctions;
  2090. var
  2091.   MMX_ACTIVE: Boolean;
  2092.   ACTIVE_3DNow: Boolean;
  2093. begin
  2094.   MMX_ACTIVE := HasMMX;
  2095.   ACTIVE_3DNow := Has3DNow;
  2096.   if ACTIVE_3DNow then
  2097.   begin
  2098.    // link 3DNow functions
  2099.    BlockAverage:= BlockAverage_3DNow;
  2100.    LinearInterpolator:= M_LinearInterpolator;
  2101.   end
  2102.   else
  2103.   if MMX_ACTIVE then
  2104.   begin
  2105.    // link MMX functions
  2106.    BlockAverage:= BlockAverage_MMX;
  2107.    LinearInterpolator:= M_LinearInterpolator;
  2108.   end
  2109.   else
  2110.   begin
  2111.    // link IA32 functions
  2112.    BlockAverage:= BlockAverage_IA32;
  2113.    LinearInterpolator:= _LinearInterpolator;
  2114.   end
  2115. end;
  2116.  
  2117. initialization
  2118.  SetupFunctions;
  2119.  
  2120. end.
  2121.