Ignore:
Timestamp:
Feb 1, 2012, 3:02:33 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Updated BGRABitmap package to version 5.5.
  • Modified: Removed draw method ComboBox and reorganized method list to single listview with using ownerdraw facility.
  • Added: New draw method TBitmap.RawImage.Data Move which use fast Move operation. It requires same pixel format.
  • Added: New draw method Dummy for comparion of empty method and to determine possibily max frame rate limit.
Location:
GraphicTest/BGRABitmap
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/BGRABitmap

    • Property svn:ignore set to
      lib

  • GraphicTest/BGRABitmap/bgraresample.pas

    r210 r317  
    1 unit bgraresample;
     1unit BGRAResample;
    22
    33{$mode objfpc}{$H+}
    44
    5 { 6/2/2011 : fixed SimpleStretchSmaller }
    6 
    75interface
    86
     7{ This unit provides resampling functions, i.e. resizing of bitmaps with or
     8  without interpolation filters.
     9
     10  SimpleStretch does a fast stretch by splitting the image into zones defined
     11  by integers. This can be quite ugly.
     12
     13  FineResample uses floating point coordinates to get an antialiased resample.
     14  It can use minimal interpolation (4 pixels when upsizing) for simple interpolation
     15  filters (linear and cosine-like) or wide kernel resample for complex interpolation.
     16  In this cas, it calls WideKernelResample.
     17
     18  WideKernelResample can be called by custom filter kernel, derived
     19  from TWideKernelFilter. It is slower of course than simple interpolation. }
     20
    921uses
    10   Classes, SysUtils, BGRADefaultBitmap;
    11 
    12 function FineResample(bmp: TBGRADefaultBitmap;
    13   NewWidth, NewHeight: integer): TBGRADefaultBitmap;
    14 function SimpleStretch(bmp: TBGRADefaultBitmap;
    15   NewWidth, NewHeight: integer): TBGRADefaultBitmap;
     22  Classes, SysUtils, BGRABitmapTypes;
     23
     24{------------------------------- Simple stretch ------------------------------------}
     25
     26function SimpleStretch(bmp: TBGRACustomBitmap;
     27  NewWidth, NewHeight: integer): TBGRACustomBitmap;
     28
     29{---------------------------- Interpolation filters --------------------------------}
     30
     31function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single;
     32
     33type
     34  TWideKernelFilter = class
     35    function Interpolation(t: single): single; virtual; abstract;
     36    function ShouldCheckRange: boolean; virtual; abstract;
     37    function KernelWidth: single; virtual; abstract;
     38  end;
     39
     40  TMitchellKernel = class(TWideKernelFilter)
     41    function Interpolation(t: single): single; override;
     42    function ShouldCheckRange: boolean; override;
     43    function KernelWidth: single; override;
     44  end;
     45
     46  { TSplineKernel }
     47
     48  TSplineKernel = class(TWideKernelFilter)
     49  public
     50    Coeff: single;
     51    constructor Create;
     52    constructor Create(ACoeff: single);
     53    function Interpolation(t: single): single; override;
     54    function ShouldCheckRange: boolean; override;
     55    function KernelWidth: single; override;
     56  end;
     57
     58  { TCubicKernel }
     59
     60  TCubicKernel = class(TWideKernelFilter)
     61    function pow3(x: single): single; inline;
     62    function Interpolation(t: single): single; override;
     63    function ShouldCheckRange: boolean; override;
     64    function KernelWidth: single; override;
     65  end;
     66
     67function CreateInterpolator(style: TSplineStyle): TWideKernelFilter;
     68
     69{-------------------------------- Fine resample ------------------------------------}
     70
     71function FineResample(bmp: TBGRACustomBitmap;
     72  NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap;
     73
     74function WideKernelResample(bmp: TBGRACustomBitmap;
     75  NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap;
    1676
    1777implementation
    1878
    19 uses GraphType, BGRABitmapTypes, Math;
    20 
    21 function FineResampleLarger(bmp: TBGRADefaultBitmap;
    22   newWidth, newHeight: integer): TBGRADefaultBitmap;
     79uses GraphType, Math;
     80
     81{-------------------------------- Simple stretch ------------------------------------}
     82
     83function FastSimpleStretchLarger(bmp: TBGRACustomBitmap;
     84  xFactor, yFactor: integer): TBGRACustomBitmap;
    2385var
    24   yb, xb: integer;
    25   pdest:  PBGRAPixel;
    26   xsrc, ysrc, xfactor, yfactor: double;
    27   ixsrc1, ixsrc2, iysrc1, iysrc2: integer;
    28   cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel;
    29   factHoriz, factVert, factCorrX, factCorrY, Sum, fUpLeft, fUpRight,
    30   fLowLeft, fLowRight, faUpLeft, faUpRight, faLowLeft, faLowRight: single;
    31   rSum, gSum, bSum, aSum: single;
    32   temp:   TBGRADefaultBitmap;
     86  y_src, yb, y_dest: integer;
     87
     88  x_src, xb: integer;
     89  srcColor:  TBGRAPixel;
     90
     91  PSrc:  PBGRAPixel;
     92  PDest: array of PBGRAPixel;
     93  temp:  PBGRAPixel;
     94
     95begin
     96  if (xFactor < 1) or (yFactor < 1) then
     97    raise ERangeError.Create('FastSimpleStretchLarger: New dimensions must be greater or equal (*'+IntToStr(xFactor)+'x*'+IntToStr(yFactor)+')');
     98
     99  Result := bmp.NewBitmap(bmp.Width * xFactor, bmp.Height * yFactor);
     100  if (Result.Width = 0) or (Result.Height = 0) then
     101    exit;
     102
     103  bmp.LoadFromBitmapIfNeeded;
     104
     105  SetLength(PDest, yFactor);
     106  y_dest := 0;
     107  for y_src := 0 to bmp.Height - 1 do
     108  begin
     109    PSrc := bmp.Scanline[y_src];
     110    for yb := 0 to yFactor - 1 do
     111      PDest[yb] := Result.scanLine[y_dest + yb];
     112
     113    for x_src := 0 to bmp.Width - 1 do
     114    begin
     115      srcColor := PSrc^;
     116      Inc(PSrc);
     117
     118      for yb := 0 to yFactor - 1 do
     119      begin
     120        temp := PDest[yb];
     121        for xb := 0 to xFactor - 1 do
     122        begin
     123          temp^ := srcColor;
     124          Inc(temp);
     125        end;
     126        PDest[yb] := temp;
     127      end;
     128    end;
     129    Inc(y_dest, yFactor);
     130  end;
     131
     132  Result.InvalidateBitmap;
     133end;
     134
     135function SimpleStretchLarger(bmp: TBGRACustomBitmap;
     136  newWidth, newHeight: integer): TBGRACustomBitmap;
     137var
     138  x_src, y_src: integer;
     139  inc_x_dest, mod_x_dest, acc_x_dest, inc_y_dest, mod_y_dest, acc_y_dest: integer;
     140  x_dest, y_dest, prev_x_dest, prev_y_dest: integer;
     141
     142  xb, yb:      integer;
     143  srcColor:    TBGRAPixel;
     144  PDest, PSrc: PBGRAPixel;
     145  delta, lineDelta: integer;
     146
    33147begin
    34148  if (newWidth < bmp.Width) or (newHeight < bmp.Height) then
    35     raise ERangeError.Create('FineResampleLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
     149    raise ERangeError.Create('SimpleStretchLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
     150
     151  if ((newWidth div bmp.Width) * bmp.Width = newWidth) and
     152    ((newHeight div bmp.Height) * bmp.Height = newHeight) then
     153  begin
     154    Result := FastSimpleStretchLarger(bmp, newWidth div bmp.Width,
     155      newHeight div bmp.Height);
     156    exit;
     157  end;
    36158
    37159  Result := bmp.NewBitmap(NewWidth, NewHeight);
    … …  
    41163  bmp.LoadFromBitmapIfNeeded;
    42164
     165  inc_x_dest := newwidth div bmp.Width;
     166  mod_x_dest := newwidth mod bmp.Width;
     167  inc_y_dest := newheight div bmp.Height;
     168  mod_y_dest := newheight mod bmp.Height;
     169
     170  y_dest     := 0;
     171  acc_y_dest := bmp.Height div 2;
     172  if Result.LineOrder = riloTopToBottom then
     173    lineDelta := newWidth
     174  else
     175    lineDelta := -newWidth;
     176  for y_src := 0 to bmp.Height - 1 do
     177  begin
     178    prev_y_dest := y_dest;
     179    Inc(y_dest, inc_y_dest);
     180    Inc(acc_y_dest, mod_y_dest);
     181    if acc_y_dest >= bmp.Height then
     182    begin
     183      Dec(acc_y_dest, bmp.Height);
     184      Inc(y_dest);
     185    end;
     186
     187    PSrc := bmp.Scanline[y_src];
     188
     189    x_dest     := 0;
     190    acc_x_dest := bmp.Width div 2;
     191    for x_src := 0 to bmp.Width - 1 do
     192    begin
     193      prev_x_dest := x_dest;
     194      Inc(x_dest, inc_x_dest);
     195      Inc(acc_x_dest, mod_x_dest);
     196      if acc_x_dest >= bmp.Width then
     197      begin
     198        Dec(acc_x_dest, bmp.Width);
     199        Inc(x_dest);
     200      end;
     201
     202      srcColor := PSrc^;
     203      Inc(PSrc);
     204
     205      PDest := Result.scanline[prev_y_dest] + prev_x_dest;
     206      delta := lineDelta - (x_dest - prev_x_dest);
     207      for yb := prev_y_dest to y_dest - 1 do
     208      begin
     209        for xb := prev_x_dest to x_dest - 1 do
     210        begin
     211          PDest^ := srcColor;
     212          Inc(PDest);
     213        end;
     214        Inc(PDest, delta);
     215      end;
     216    end;
     217  end;
     218  Result.InvalidateBitmap;
     219end;
     220
     221function SimpleStretchSmallerFactor2(source: TBGRACustomBitmap): TBGRACustomBitmap;
     222var xb,yb: integer;
     223    pdest: PBGRAPixel;
     224    psrc1,psrc2: PBGRAPixel;
     225    asum: integer;
     226    a1,a2,a3,a4: integer;
     227    newWidth,newHeight: integer;
     228begin
     229  newWidth := source.Width div 2;
     230  newHeight := source.Height div 2;
     231  result := source.NewBitmap(newWidth,newHeight);
     232  for yb := 0 to newHeight-1 do
     233  begin
     234    pdest := result.ScanLine[yb];
     235    psrc1 := source.Scanline[yb shl 1];
     236    psrc2 := source.Scanline[yb shl 1+1];
     237    for xb := newWidth-1 downto 0 do
     238    begin
     239      asum := psrc1^.alpha + (psrc1+1)^.alpha + psrc2^.alpha + (psrc2+1)^.alpha;
     240      if asum = 0 then
     241        pdest^ := BGRAPixelTransparent
     242      else if asum = 1020 then
     243      begin
     244        pdest^.alpha := 255;
     245        pdest^.red := (psrc1^.red + (psrc1+1)^.red + psrc2^.red + (psrc2+1)^.red + 2) shr 2;
     246        pdest^.green := (psrc1^.green + (psrc1+1)^.green + psrc2^.green + (psrc2+1)^.green+ 2) shr 2;
     247        pdest^.blue := (psrc1^.blue + (psrc1+1)^.blue + psrc2^.blue + (psrc2+1)^.blue+ 2) shr 2;
     248      end else
     249      begin
     250        pdest^.alpha := asum shr 2;
     251        a1 := psrc1^.alpha;
     252        a2 := (psrc1+1)^.alpha;
     253        a3 := psrc2^.alpha;
     254        a4 := (psrc2+1)^.alpha;
     255        pdest^.red := (psrc1^.red*a1 + (psrc1+1)^.red*a2 + psrc2^.red*a3 + (psrc2+1)^.red*a4 + (asum shr 1)) div asum;
     256        pdest^.green := (psrc1^.green*a1 + (psrc1+1)^.green*a2 + psrc2^.green*a3 + (psrc2+1)^.green*a4+ (asum shr 1)) div asum;
     257        pdest^.blue := (psrc1^.blue*a1 + (psrc1+1)^.blue*a2 + psrc2^.blue*a3 + (psrc2+1)^.blue*a4+ (asum shr 1)) div asum;
     258      end;
     259      inc(psrc1,2);
     260      inc(psrc2,2);
     261      inc(pdest);
     262    end;
     263  end;
     264end;
     265
     266function SimpleStretchSmallerFactor4(source: TBGRACustomBitmap): TBGRACustomBitmap;
     267var xb,yb: integer;
     268    pdest: PBGRAPixel;
     269    psrc1,psrc2,psrc3,psrc4: PBGRAPixel;
     270    asum: integer;
     271    a1,a2,a3,a4,
     272    a5,a6,a7,a8,
     273    a9,a10,a11,a12,
     274    a13,a14,a15,a16: integer;
     275    newWidth,newHeight: integer;
     276begin
     277  newWidth := source.Width div 4;
     278  newHeight := source.Height div 4;
     279  result := source.NewBitmap(newWidth,newHeight);
     280  for yb := 0 to newHeight-1 do
     281  begin
     282    pdest := result.ScanLine[yb];
     283    psrc1 := source.Scanline[yb shl 2];
     284    psrc2 := source.Scanline[yb shl 2+1];
     285    psrc3 := source.Scanline[yb shl 2+2];
     286    psrc4 := source.Scanline[yb shl 2+3];
     287    for xb := newWidth-1 downto 0 do
     288    begin
     289      asum := psrc1^.alpha + (psrc1+1)^.alpha + (psrc1+2)^.alpha + (psrc1+3)^.alpha +
     290              psrc2^.alpha + (psrc2+1)^.alpha + (psrc2+2)^.alpha + (psrc2+3)^.alpha +
     291              psrc3^.alpha + (psrc3+1)^.alpha + (psrc3+2)^.alpha + (psrc3+3)^.alpha +
     292              psrc4^.alpha + (psrc4+1)^.alpha + (psrc4+2)^.alpha + (psrc4+3)^.alpha;
     293      if asum = 0 then
     294        pdest^ := BGRAPixelTransparent
     295      else if asum = 4080 then
     296      begin
     297        pdest^.alpha := 255;
     298        pdest^.red := (psrc1^.red + (psrc1+1)^.red + (psrc1+2)^.red + (psrc1+3)^.red +
     299              psrc2^.red + (psrc2+1)^.red + (psrc2+2)^.red + (psrc2+3)^.red +
     300              psrc3^.red + (psrc3+1)^.red + (psrc3+2)^.red + (psrc3+3)^.red +
     301              psrc4^.red + (psrc4+1)^.red + (psrc4+2)^.red + (psrc4+3)^.red + 8) shr 4;
     302        pdest^.green := (psrc1^.green + (psrc1+1)^.green + (psrc1+2)^.green + (psrc1+3)^.green +
     303              psrc2^.green + (psrc2+1)^.green + (psrc2+2)^.green + (psrc2+3)^.green +
     304              psrc3^.green + (psrc3+1)^.green + (psrc3+2)^.green + (psrc3+3)^.green +
     305              psrc4^.green + (psrc4+1)^.green + (psrc4+2)^.green + (psrc4+3)^.green + 8) shr 4;
     306        pdest^.blue := (psrc1^.blue + (psrc1+1)^.blue + (psrc1+2)^.blue + (psrc1+3)^.blue +
     307              psrc2^.blue + (psrc2+1)^.blue + (psrc2+2)^.blue + (psrc2+3)^.blue +
     308              psrc3^.blue + (psrc3+1)^.blue + (psrc3+2)^.blue + (psrc3+3)^.blue +
     309              psrc4^.blue + (psrc4+1)^.blue + (psrc4+2)^.blue + (psrc4+3)^.blue + 8) shr 4;
     310      end else
     311      begin
     312        pdest^.alpha := asum shr 4;
     313        a1 := psrc1^.alpha;
     314        a2 := (psrc1+1)^.alpha;
     315        a3 := (psrc1+2)^.alpha;
     316        a4 := (psrc1+3)^.alpha;
     317        a5 := psrc2^.alpha;
     318        a6 := (psrc2+1)^.alpha;
     319        a7 := (psrc2+2)^.alpha;
     320        a8 := (psrc2+3)^.alpha;
     321        a9 := psrc3^.alpha;
     322        a10 := (psrc3+1)^.alpha;
     323        a11 := (psrc3+2)^.alpha;
     324        a12 := (psrc3+3)^.alpha;
     325        a13 := psrc4^.alpha;
     326        a14 := (psrc4+1)^.alpha;
     327        a15 := (psrc4+2)^.alpha;
     328        a16 := (psrc4+3)^.alpha;
     329        pdest^.red := (psrc1^.red*a1 + (psrc1+1)^.red*a2 + (psrc1+2)^.red*a3 + (psrc1+3)^.red*a4 +
     330              psrc2^.red*a5 + (psrc2+1)^.red*a6 + (psrc2+2)^.red*a7 + (psrc2+3)^.red*a8 +
     331              psrc3^.red*a9 + (psrc3+1)^.red*a10 + (psrc3+2)^.red*a11 + (psrc3+3)^.red*a12 +
     332              psrc4^.red*a13 + (psrc4+1)^.red*a14 + (psrc4+2)^.red*a15 + (psrc4+3)^.red*a16 + (asum shr 1)) div asum;
     333        pdest^.green := (psrc1^.green*a1 + (psrc1+1)^.green*a2 + (psrc1+2)^.green*a3 + (psrc1+3)^.green*a4 +
     334              psrc2^.green*a5 + (psrc2+1)^.green*a6 + (psrc2+2)^.green*a7 + (psrc2+3)^.green*a8 +
     335              psrc3^.green*a9 + (psrc3+1)^.green*a10 + (psrc3+2)^.green*a11 + (psrc3+3)^.green*a12 +
     336              psrc4^.green*a13 + (psrc4+1)^.green*a14 + (psrc4+2)^.green*a15 + (psrc4+3)^.green*a16 + (asum shr 1)) div asum;
     337        pdest^.blue := (psrc1^.blue*a1 + (psrc1+1)^.blue*a2 + (psrc1+2)^.blue*a3 + (psrc1+3)^.blue*a4 +
     338              psrc2^.blue*a5 + (psrc2+1)^.blue*a6 + (psrc2+2)^.blue*a7 + (psrc2+3)^.blue*a8 +
     339              psrc3^.blue*a9 + (psrc3+1)^.blue*a10 + (psrc3+2)^.blue*a11 + (psrc3+3)^.blue*a12 +
     340              psrc4^.blue*a13 + (psrc4+1)^.blue*a14 + (psrc4+2)^.blue*a15 + (psrc4+3)^.blue*a16 + (asum shr 1)) div asum;
     341      end;
     342      inc(psrc1,4);
     343      inc(psrc2,4);
     344      inc(psrc3,4);
     345      inc(psrc4,4);
     346      inc(pdest);
     347    end;
     348  end;
     349end;
     350
     351function SimpleStretchSmallerFactor(source: TBGRACustomBitmap; fx,fy: integer): TBGRACustomBitmap;
     352var xb,yb,ys,iy,ix: integer;
     353    pdest: PBGRAPixel;
     354    psrc: array of PBGRAPixel;
     355    psrci: PBGRAPixel;
     356    asum,maxsum: integer;
     357    newWidth,newHeight: integer;
     358    r,g,b,nbi: integer;
     359begin
     360  newWidth := source.Width div fx;
     361  newHeight := source.Height div fy;
     362  result := source.NewBitmap(newWidth,newHeight);
     363  ys := 0;
     364  maxsum := 255*fx*fy;
     365  nbi := fx*fy;
     366  setlength(psrc, fy);
     367  for yb := 0 to newHeight-1 do
     368  begin
     369    pdest := result.ScanLine[yb];
     370    for iy := fy-1 downto 0 do
     371    begin
     372      psrc[iy] := source.Scanline[ys];
     373      inc(ys);
     374    end;
     375    for xb := newWidth-1 downto 0 do
     376    begin
     377      asum := 0;
     378      for iy := fy-1 downto 0 do
     379      begin
     380        psrci := psrc[iy];
     381        for ix := fx-1 downto 0 do
     382          asum += (psrci+ix)^.alpha;
     383      end;
     384      if asum = 0 then
     385        pdest^ := BGRAPixelTransparent
     386      else if asum = maxsum then
     387      begin
     388        pdest^.alpha := 255;
     389        r := 0;
     390        g := 0;
     391        b := 0;
     392        for iy := fy-1 downto 0 do
     393        begin
     394          psrci := psrc[iy];
     395          for ix := fx-1 downto 0 do
     396          begin
     397            with (psrci+ix)^ do
     398            begin
     399              r += red;
     400              g += green;
     401              b += blue;
     402            end;
     403          end;
     404        end;
     405        pdest^.red := (r + (nbi shr 1)) div nbi;
     406        pdest^.green := (g + (nbi shr 1)) div nbi;
     407        pdest^.blue := (b + (nbi shr 1)) div nbi;
     408      end else
     409      begin
     410        pdest^.alpha := (asum + (nbi shr 1)) div nbi;
     411        r := 0;
     412        g := 0;
     413        b := 0;
     414        for iy := fy-1 downto 0 do
     415        begin
     416          psrci := psrc[iy];
     417          for ix := fx-1 downto 0 do
     418          begin
     419            with (psrci+ix)^ do
     420            begin
     421              r += integer(red)*integer(alpha);
     422              g += integer(green)*integer(alpha);
     423              b += integer(blue)*integer(alpha);
     424            end;
     425          end;
     426        end;
     427        pdest^.red := (r + (asum shr 1)) div asum;
     428        pdest^.green := (g + (asum shr 1)) div asum;
     429        pdest^.blue := (b + (asum shr 1)) div asum;
     430      end;
     431      for iy := fy-1 downto 0 do
     432        inc(psrc[iy],fx);
     433      inc(pdest);
     434    end;
     435  end;
     436end;
     437
     438function SimpleStretchSmaller(bmp: TBGRACustomBitmap;
     439  newWidth, newHeight: integer): TBGRACustomBitmap;
     440var
     441  x_dest, y_dest: integer;
     442  inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src: integer;
     443  x_src, y_src, prev_x_src, prev_y_src: integer;
     444  x_src2, y_src2: integer;
     445
     446  xb, yb: integer;
     447  v1, v2, v3, v4, v4shr1: int64;
     448  nb,a:     integer;
     449  pdest, psrc, psrcscan: PBGRAPixel;
     450  lineDelta, delta: integer;
     451
     452begin
     453  if (newWidth > bmp.Width) or (newHeight > bmp.Height) then
     454    raise ERangeError.Create('SimpleStretchSmaller: New dimensions must be smaller or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
     455
     456  if (newWidth = 0) or (newHeight = 0) or (bmp.Width = 0) or (bmp.Height = 0) then
     457  begin
     458    Result := bmp.NewBitmap(NewWidth, NewHeight);
     459    exit;
     460  end;
     461
     462  if (newWidth*2 = bmp.Width) and (newHeight*2 = bmp.Height) then
     463  begin
     464    result := SimpleStretchSmallerFactor2(bmp);
     465    exit
     466  end
     467  else
     468  if (newWidth*4 = bmp.Width) and (newHeight*4 = bmp.Height) then
     469  begin
     470    result := SimpleStretchSmallerFactor4(bmp);
     471    exit;
     472  end
     473  else
     474  if (newWidth < bmp.Width) and (newHeight < bmp.Height) and
     475     (bmp.Width mod newWidth = 0) and (bmp.Height mod newHeight = 0) then
     476  begin
     477    result := SimpleStretchSmallerFactor(bmp, bmp.Width div newWidth, bmp.Height div newHeight);
     478    exit;
     479  end;
     480
     481  Result := bmp.NewBitmap(NewWidth, NewHeight);
     482
     483  bmp.LoadFromBitmapIfNeeded;
     484
     485  inc_x_src := bmp.Width div newWidth;
     486  mod_x_src := bmp.Width mod newWidth;
     487  inc_y_src := bmp.Height div newHeight;
     488  mod_y_src := bmp.Height mod newHeight;
     489
     490  if bmp.lineOrder = riloTopToBottom then
     491    lineDelta := bmp.Width
     492  else
     493    lineDelta := -bmp.Width;
     494
     495  y_src     := 0;
     496  acc_y_src := 0;
     497  for y_dest := 0 to newHeight - 1 do
     498  begin
     499    PDest := Result.ScanLine[y_dest];
     500
     501    prev_y_src := y_src;
     502    Inc(y_src, inc_y_src);
     503    Inc(acc_y_src, mod_y_src);
     504    if acc_y_src >= newHeight then
     505    begin
     506      Dec(acc_y_src, newHeight);
     507      Inc(y_src);
     508    end;
     509    if y_src > prev_y_src then
     510      y_src2 := y_src - 1
     511    else
     512      y_src2 := y_src;
     513    psrcscan := bmp.Scanline[prev_y_src];
     514
     515    x_src     := 0;
     516    acc_x_src := 0;
     517    for x_dest := 0 to newWidth - 1 do
     518    begin
     519      prev_x_src := x_src;
     520      Inc(x_src, inc_x_src);
     521      Inc(acc_x_src, mod_x_src);
     522      if acc_x_src >= newWidth then
     523      begin
     524        Dec(acc_x_src, newWidth);
     525        Inc(x_src);
     526      end;
     527      if x_src > prev_x_src then
     528        x_src2 := x_src - 1
     529      else
     530        x_src2 := x_src;
     531
     532      v1    := 0;
     533      v2    := 0;
     534      v3    := 0;
     535      v4    := 0;
     536      nb    := 0;
     537      delta := lineDelta - (x_src2 - prev_x_src + 1);
     538
     539      PSrc  := psrcscan + prev_x_src;
     540      for yb := prev_y_src to y_src2 do
     541      begin
     542        for xb := prev_x_src to x_src2 do
     543        begin
     544          with PSrc^ do
     545          begin
     546            a := alpha;
     547                    {$HINTS OFF}
     548            v1 += integer(red) * a;
     549            v2 += integer(green) * a;
     550            v3 += integer(blue) * a;
     551                    {$HINTS ON}
     552          end;
     553          v4 += a;
     554          Inc(PSrc);
     555          Inc(nb);
     556        end;
     557        Inc(PSrc, delta);
     558      end;
     559
     560      if (v4 <> 0) and (nb <> 0) then
     561      begin
     562        v4shr1  := v4 shr 1;
     563        with PDest^ do
     564        begin
     565          red   := (v1 + v4shr1) div v4;
     566          green := (v2 + v4shr1) div v4;
     567          blue  := (v3 + v4shr1) div v4;
     568          alpha := (v4 + (nb shr 1)) div nb;
     569        end;
     570      end
     571      else
     572       PDest^ := BGRAPixelTransparent;
     573
     574      Inc(PDest);
     575    end;
     576  end;
     577  Result.InvalidateBitmap;
     578end;
     579
     580function SimpleStretch(bmp: TBGRACustomBitmap;
     581  NewWidth, NewHeight: integer): TBGRACustomBitmap;
     582var
     583  temp, newtemp: TBGRACustomBitmap;
     584begin
     585  if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
     586    Result := bmp.Duplicate
     587  else
     588  if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then
     589    Result := SimpleStretchLarger(bmp, NewWidth, NewHeight)
     590  else
     591  if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then
     592    Result := SimpleStretchSmaller(bmp, NewWidth, NewHeight)
     593  else
     594  begin
     595    temp := bmp;
     596
     597    if NewWidth < bmp.Width then
     598    begin
     599      newtemp := SimpleStretchSmaller(temp, NewWidth, temp.Height);
     600      if (temp <> bmp) then
     601        temp.Free;
     602      temp := newtemp;
     603    end;
     604
     605    if NewHeight < bmp.Height then
     606    begin
     607      newtemp := SimpleStretchSmaller(temp, temp.Width, NewHeight);
     608      if (temp <> bmp) then
     609        temp.Free;
     610      temp := newtemp;
     611    end;
     612
     613    if NewWidth > bmp.Width then
     614    begin
     615      newtemp := SimpleStretchLarger(temp, NewWidth, temp.Height);
     616      if (temp <> bmp) then
     617        temp.Free;
     618      temp := newtemp;
     619    end;
     620
     621    if NewHeight > bmp.Height then
     622    begin
     623      newtemp := SimpleStretchLarger(temp, temp.Width, NewHeight);
     624      if (temp <> bmp) then
     625        temp.Free;
     626      temp := newtemp;
     627    end;
     628
     629    if temp <> bmp then
     630      Result := temp
     631    else
     632      Result := bmp.Duplicate;
     633  end;
     634end;
     635
     636{---------------------------- Interpolation filters ----------------------------------------}
     637
     638function FineInterpolation(t: single; ResampleFilter: TResampleFilter): single;
     639begin
     640  if ResampleFilter = rfLinear then
     641    result := t else
     642  begin
     643    if t <= 0.5 then
     644      result := t*t*2 else
     645      result := 1-(1-t)*(1-t)*2;
     646    if ResampleFilter <> rfCosine then result := (result+t)*0.5;
     647  end;
     648end;
     649
     650{ TCubicKernel }
     651
     652function TCubicKernel.pow3(x: single): single;
     653begin
     654  if x <= 0.0 then
     655   result:=0.0
     656  else
     657   result:=x * x * x;
     658end;
     659
     660function TCubicKernel.Interpolation(t: single): single;
     661const globalfactor = 1/6;
     662begin
     663   if t > 2 then
     664     result := 0
     665   else
     666     result:= globalfactor *
     667       (pow3(t + 2 ) - 4 * pow3(t + 1 ) + 6 * pow3(t ) - 4 * pow3(t - 1 ) );
     668end;
     669
     670function TCubicKernel.ShouldCheckRange: boolean;
     671begin
     672  Result:= false;
     673end;
     674
     675function TCubicKernel.KernelWidth: single;
     676begin
     677  Result:= 2;
     678end;
     679
     680{ TMitchellKernel }
     681
     682function TMitchellKernel.Interpolation(t: single): single;
     683var
     684  tt, ttt: single;
     685const OneEighteenth = 1 / 18;
     686begin
     687  t := Abs(t);
     688  tt := Sqr(t);
     689  ttt := tt * t;
     690  if t < 1 then Result := (21 * ttt - 36 * tt + 16 ) * OneEighteenth
     691  else if t < 2 then Result := (- 7 * ttt + 36 * tt - 60 * t + 32) * OneEighteenth
     692  else Result := 0;
     693end;
     694
     695function TMitchellKernel.ShouldCheckRange: Boolean;
     696begin
     697  Result := True;
     698end;
     699
     700function TMitchellKernel.KernelWidth: single;
     701begin
     702  Result := 2;
     703end;
     704
     705{ TSplineKernel }
     706
     707constructor TSplineKernel.Create;
     708begin
     709  coeff := 0.5;
     710end;
     711
     712constructor TSplineKernel.Create(ACoeff: single);
     713begin
     714  Coeff := ACoeff;
     715end;
     716
     717function TSplineKernel.Interpolation(t: single): single;
     718var
     719  tt, ttt: single;
     720begin
     721  t := Abs(t);
     722  tt := Sqr(t);
     723  ttt := tt * t;
     724  if t < 1 then
     725    Result := (2 - Coeff) * ttt - (3 - Coeff) * tt + 1
     726  else if t < 2 then
     727    Result := -Coeff * (ttt - 5 * tt + 8 * t - 4)
     728  else
     729    Result := 0;
     730end;
     731
     732function TSplineKernel.ShouldCheckRange: Boolean;
     733begin
     734  Result := True;
     735end;
     736
     737function TSplineKernel.KernelWidth: single;
     738begin
     739  Result := 2;
     740end;
     741
     742{--------------------------------------------- Fine resample ------------------------------------------------}
     743
     744function FineResampleLarger(bmp: TBGRACustomBitmap;
     745  newWidth, newHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap;
     746type
     747  TInterpolationEntry = record
     748    isrc1,isrc2,factCorr: integer;
     749  end;
     750var
     751  yb, xb: integer;
     752  pdest,psrc1,psrc2:  PBGRAPixel;
     753  xsrc, ysrc, xfactor, yfactor: double;
     754  xTab,yTab: array of TInterpolationEntry;
     755  xInfo,yInfo: TInterpolationEntry;
     756  cUpLeft, cUpRight, cLowLeft, cLowRight: TBGRAPixel;
     757  factHoriz, factVert: single;
     758  fUpLeft, fUpRight, fLowLeft, fLowRight: integer;
     759  faUpLeft, faUpRight, faLowLeft, faLowRight: integer;
     760  rSum, gSum, bSum, aSum: integer;
     761  temp:   TBGRACustomBitmap;
     762begin
     763  if (newWidth < bmp.Width) or (newHeight < bmp.Height) then
     764    raise ERangeError.Create('FineResampleLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
     765
     766  if (newWidth = 0) or (newHeight = 0) then
     767  begin
     768    Result := bmp.NewBitmap(NewWidth, NewHeight);
     769    exit;
     770  end;
     771
     772  bmp.LoadFromBitmapIfNeeded;
     773
    43774  if (bmp.Width = 1) and (bmp.Height = 1) then
    44775  begin
     776    Result := bmp.NewBitmap(NewWidth, NewHeight);
    45777    Result.Fill(bmp.GetPixel(0, 0));
    46778    exit;
    … …  
    52784    temp.PutImage(0, 0, bmp, dmSet);
    53785    temp.PutImage(1, 0, bmp, dmSet);
    54     Result := FineResampleLarger(temp, 2, newHeight);
     786    Result := FineResampleLarger(temp, 2, newHeight, ResampleFilter);
    55787    temp.Free;
    56788    temp := Result;
    57     Result := SimpleStretch(temp, 1,temp.Height);
     789    Result := SimpleStretch(temp, newWidth,temp.Height);
    58790    temp.Free;
    59791    exit;
    … …  
    65797    temp.PutImage(0, 0, bmp, dmSet);
    66798    temp.PutImage(0, 1, bmp, dmSet);
    67     Result := FineResampleLarger(temp, newWidth, 2);
     799    Result := FineResampleLarger(temp, newWidth, 2, ResampleFilter);
    68800    temp.Free;
    69801    temp := Result;
    70     Result := SimpleStretch(temp, temp.Width,1);
     802    Result := SimpleStretch(temp, temp.Width,newHeight);
    71803    temp.Free;
    72804    exit;
    73805  end;
    74806
     807  Result := bmp.NewBitmap(NewWidth, NewHeight);
    75808  yfactor := (bmp.Height - 1) / (newHeight - 1);
    76809  xfactor := (bmp.Width - 1) / (newWidth - 1);
     810
     811  setlength(yTab, newHeight);
    77812  for yb := 0 to newHeight - 1 do
    78813  begin
     814    ysrc     := yb * yfactor;
     815    factVert := frac(ysrc);
     816    yTab[yb].isrc1   := floor(ysrc);
     817    yTab[yb].isrc2 := min(bmp.Height-1, ceil(ysrc));
     818    yTab[yb].factCorr := round(FineInterpolation(factVert,ResampleFilter)*256);
     819  end;
     820  setlength(xTab, newWidth);
     821  for xb := 0 to newWidth - 1 do
     822  begin
     823    xsrc     := xb * xfactor;
     824    factHoriz := frac(xsrc);
     825    xTab[xb].isrc1   := floor(xsrc);
     826    xTab[xb].isrc2 := min(bmp.Width-1,ceil(xsrc));
     827    xTab[xb].factCorr := round(FineInterpolation(factHoriz,ResampleFilter)*256);
     828  end;
     829
     830  for yb := 0 to newHeight - 1 do
     831  begin
    79832    pdest    := Result.Scanline[yb];
    80     ysrc     := yb * yfactor;
    81     iysrc1   := floor(ysrc);
    82     factVert := frac(ysrc);
    83     if (factVert = 0) then
    84       iysrc2 := iysrc1
    85     else
    86       iysrc2 := ceil(ysrc);
    87     factCorrY := 0.5 - cos(factVert * Pi) / 2;
     833    yInfo    := yTab[yb];
     834    psrc1    := bmp.scanline[yInfo.isrc1];
     835    psrc2    := bmp.scanline[yInfo.isrc2];
    88836    for xb := 0 to newWidth - 1 do
    89837    begin
    90       xsrc      := xb * xfactor;
    91       ixsrc1    := floor(xsrc);
    92       factHoriz := frac(xsrc);
    93       if (factHoriz = 0) then
    94         ixsrc2 := ixsrc1
    95       else
    96         ixsrc2 := ceil(xsrc);
    97       factCorrX := 0.5 - cos(factHoriz * Pi) / 2;
    98 
    99       cUpLeft   := bmp.GetPixel(ixsrc1, iysrc1);
    100       cUpRight  := bmp.GetPixel(ixsrc2, iysrc1);
    101       cLowLeft  := bmp.GetPixel(ixsrc1, iysrc2);
    102       cLowRight := bmp.GetPixel(ixsrc2, iysrc2);
    103 
    104       fUpLeft   := (1 - factCorrX) * (1 - factCorrY);
    105       fUpRight  := factCorrX * (1 - factCorrY);
    106       fLowLeft  := (1 - factCorrX) * factCorrY;
    107       fLowRight := factCorrX * factCorrY;
     838      xInfo  := xTab[xb];
     839
     840      cUpLeft   := (psrc1 + xInfo.isrc1)^;
     841      cUpRight  := (psrc1 + xInfo.isrc2)^;
     842      cLowLeft  := (psrc2 + xInfo.isrc1)^;
     843      cLowRight := (psrc2 + xInfo.isrc2)^;
     844
     845      fLowRight := (xInfo.factCorr * yInfo.factCorr + 128) shr 8;
     846      fLowLeft := yInfo.factCorr - fLowRight;
     847      fUpRight := xInfo.factCorr - fLowRight;
     848      fUpLeft := (256 - xInfo.factCorr) - fLowLeft;
    108849
    109850      faUpLeft   := fUpLeft * cUpLeft.alpha;
    … …  
    112853      faLowRight := fLowRight * cLowRight.alpha;
    113854
    114       Sum  := fUpLeft + fUpRight + fLowLeft + fLowRight;
    115855      rSum := cUpLeft.red * faUpLeft + cUpRight.red * faUpRight +
    116856        cLowLeft.red * faLowLeft + cLowRight.red * faLowRight;
    … …  
    125865        pdest^ := BGRAPixelTransparent
    126866      else
    127         pdest^ := BGRA(round(rSum / aSum), round(gSum / aSum),
    128           round(bSum / aSum), round(aSum / Sum));
     867        pdest^ := BGRA((rSum + aSum shr 1) div aSum, (gSum + aSum shr 1) div aSum,
     868          (bSum + aSum shr 1) div aSum, (aSum + 128) shr 8);
    129869      Inc(pdest);
    130870
    … …  
    133873end;
    134874
    135 function FastSimpleStretchLarger(bmp: TBGRADefaultBitmap;
    136   xFactor, yFactor: integer): TBGRADefaultBitmap;
    137 var
    138   y_src, yb, y_dest: integer;
    139 
    140   x_src, xb: integer;
    141   srcColor:  TBGRAPixel;
    142 
    143   PSrc:  PBGRAPixel;
    144   PDest: array of PBGRAPixel;
    145   temp:  PBGRAPixel;
    146 
    147 begin
    148   if (xFactor < 1) or (yFactor < 1) then
    149     raise ERangeError.Create('FastSimpleStretchLarger: New dimensions must be greater or equal (*'+IntToStr(xFactor)+'x*'+IntToStr(yFactor)+')');
    150 
    151   Result := bmp.NewBitmap(bmp.Width * xFactor, bmp.Height * yFactor);
    152   if (Result.Width = 0) or (Result.Height = 0) then
    153     exit;
    154 
    155   bmp.LoadFromBitmapIfNeeded;
    156 
    157   SetLength(PDest, yFactor);
    158   y_dest := 0;
    159   for y_src := 0 to bmp.Height - 1 do
    160   begin
    161     PSrc := bmp.Scanline[y_src];
    162     for yb := 0 to yFactor - 1 do
    163       PDest[yb] := Result.scanLine[y_dest + yb];
    164 
    165     for x_src := 0 to bmp.Width - 1 do
    166     begin
    167       srcColor := PSrc^;
    168       Inc(PSrc);
    169 
    170       for yb := 0 to yFactor - 1 do
    171       begin
    172         temp := PDest[yb];
    173         for xb := 0 to xFactor - 1 do
    174         begin
    175           temp^ := srcColor;
    176           Inc(temp);
    177         end;
    178         PDest[yb] := temp;
    179       end;
    180     end;
    181     Inc(y_dest, yFactor);
    182   end;
    183 
    184   Result.InvalidateBitmap;
    185 end;
    186 
    187 function SimpleStretchLarger(bmp: TBGRADefaultBitmap;
    188   newWidth, newHeight: integer): TBGRADefaultBitmap;
    189 var
    190   x_src, y_src: integer;
    191   inc_x_dest, mod_x_dest, acc_x_dest, inc_y_dest, mod_y_dest, acc_y_dest: integer;
    192   x_dest, y_dest, prev_x_dest, prev_y_dest: integer;
    193 
    194   xb, yb:      integer;
    195   srcColor:    TBGRAPixel;
    196   PDest, PSrc: PBGRAPixel;
    197   delta, lineDelta: integer;
    198 
    199 begin
    200   if (newWidth < bmp.Width) or (newHeight < bmp.Height) then
    201     raise ERangeError.Create('SimpleStretchLarger: New dimensions must be greater or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
    202 
    203   if ((newWidth div bmp.Width) * bmp.Width = newWidth) and
    204     ((newHeight div bmp.Height) * bmp.Height = newHeight) then
    205   begin
    206     Result := FastSimpleStretchLarger(bmp, newWidth div bmp.Width,
    207       newHeight div bmp.Height);
    208     exit;
    209   end;
    210 
    211   Result := bmp.NewBitmap(NewWidth, NewHeight);
    212   if (newWidth = 0) or (newHeight = 0) then
    213     exit;
    214 
    215   bmp.LoadFromBitmapIfNeeded;
    216 
    217   inc_x_dest := newwidth div bmp.Width;
    218   mod_x_dest := newwidth mod bmp.Width;
    219   inc_y_dest := newheight div bmp.Height;
    220   mod_y_dest := newheight mod bmp.Height;
    221 
    222   y_dest     := 0;
    223   acc_y_dest := bmp.Height div 2;
    224   if Result.LineOrder = riloTopToBottom then
    225     lineDelta := newWidth
    226   else
    227     lineDelta := -newWidth;
    228   for y_src := 0 to bmp.Height - 1 do
    229   begin
    230     prev_y_dest := y_dest;
    231     Inc(y_dest, inc_y_dest);
    232     Inc(acc_y_dest, mod_y_dest);
    233     if acc_y_dest >= bmp.Height then
    234     begin
    235       Dec(acc_y_dest, bmp.Height);
    236       Inc(y_dest);
    237     end;
    238 
    239     PSrc := bmp.Scanline[y_src];
    240 
    241     x_dest     := 0;
    242     acc_x_dest := bmp.Width div 2;
    243     for x_src := 0 to bmp.Width - 1 do
    244     begin
    245       prev_x_dest := x_dest;
    246       Inc(x_dest, inc_x_dest);
    247       Inc(acc_x_dest, mod_x_dest);
    248       if acc_x_dest >= bmp.Width then
    249       begin
    250         Dec(acc_x_dest, bmp.Width);
    251         Inc(x_dest);
    252       end;
    253 
    254       srcColor := PSrc^;
    255       Inc(PSrc);
    256 
    257       PDest := Result.scanline[prev_y_dest] + prev_x_dest;
    258       delta := lineDelta - (x_dest - prev_x_dest);
    259       for yb := prev_y_dest to y_dest - 1 do
    260       begin
    261         for xb := prev_x_dest to x_dest - 1 do
    262         begin
    263           PDest^ := srcColor;
    264           Inc(PDest);
    265         end;
    266         Inc(PDest, delta);
    267       end;
    268     end;
    269   end;
    270   Result.InvalidateBitmap;
    271 end;
    272 
    273 function SimpleStretchSmaller(bmp: TBGRADefaultBitmap;
    274   newWidth, newHeight: integer): TBGRADefaultBitmap;
    275 var
    276   x_dest, y_dest: integer;
    277   inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src: integer;
    278   x_src, y_src, prev_x_src, prev_y_src: integer;
    279   x_src2, y_src2: integer;
    280 
    281   xb, yb: integer;
    282   v1, v2, v3, v4, v4shr1: int64;
    283   nb:     integer;
    284   c:      TBGRAPixel;
    285   pdest, psrc: PBGRAPixel;
    286   lineDelta, delta: integer;
    287 begin
    288   if (newWidth > bmp.Width) or (newHeight > bmp.Height) then
    289     raise ERangeError.Create('SimpleStretchSmaller: New dimensions must be smaller or equal ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+'->'+IntToStr(newWidth)+'x'+IntToStr(newHeight)+')');
    290   Result := bmp.NewBitmap(NewWidth, NewHeight);
    291   if (newWidth = 0) or (newHeight = 0) or (bmp.Width = 0) or (bmp.Height = 0) then
    292     exit;
    293 
    294   bmp.LoadFromBitmapIfNeeded;
    295 
    296   inc_x_src := bmp.Width div newWidth;
    297   mod_x_src := bmp.Width mod newWidth;
    298   inc_y_src := bmp.Height div newHeight;
    299   mod_y_src := bmp.Height mod newHeight;
    300 
    301   if bmp.lineOrder = riloTopToBottom then
    302     lineDelta := bmp.Width
    303   else
    304     lineDelta := -bmp.Width;
    305 
    306   y_src     := 0;
    307   acc_y_src := 0;
    308   for y_dest := 0 to newHeight - 1 do
    309   begin
    310     PDest := Result.ScanLine[y_dest];
    311 
    312     prev_y_src := y_src;
    313     Inc(y_src, inc_y_src);
    314     Inc(acc_y_src, mod_y_src);
    315     if acc_y_src >= newHeight then
    316     begin
    317       Dec(acc_y_src, newHeight);
    318       Inc(y_src);
    319     end;
    320     if y_src > prev_y_src then
    321       y_src2 := y_src - 1
    322     else
    323       y_src2 := y_src;
    324 
    325     x_src     := 0;
    326     acc_x_src := 0;
    327     for x_dest := 0 to newWidth - 1 do
    328     begin
    329       prev_x_src := x_src;
    330       Inc(x_src, inc_x_src);
    331       Inc(acc_x_src, mod_x_src);
    332       if acc_x_src >= newWidth then
    333       begin
    334         Dec(acc_x_src, newWidth);
    335         Inc(x_src);
    336       end;
    337       if x_src > prev_x_src then
    338         x_src2 := x_src - 1
    339       else
    340         x_src2 := x_src;
    341 
    342       v1    := 0;
    343       v2    := 0;
    344       v3    := 0;
    345       v4    := 0;
    346       nb    := 0;
    347       delta := lineDelta - (x_src2 - prev_x_src + 1);
    348       PSrc  := bmp.Scanline[prev_y_src] + prev_x_src;
    349       for yb := prev_y_src to y_src2 do
    350       begin
    351         for xb := prev_x_src to x_src2 do
    352         begin
    353           c := PSrc^;
    354           Inc(PSrc);
    355                   {$HINTS OFF}
    356           v1 += integer(c.red) * integer(c.alpha);
    357           v2 += integer(c.green) * integer(c.alpha);
    358           v3 += integer(c.blue) * integer(c.alpha);
    359                   {$HINTS ON}
    360           v4 += c.alpha;
    361           Inc(nb);
    362         end;
    363         Inc(PSrc, delta);
    364       end;
    365 
    366       if (v4 <> 0) and (nb <> 0) then
    367       begin
    368         v4shr1  := v4 shr 1;
    369         c.red   := (v1 + v4shr1) div v4;
    370         c.green := (v2 + v4shr1) div v4;
    371         c.blue  := (v3 + v4shr1) div v4;
    372         c.alpha := (v4 + (nb shr 1)) div nb;
    373       end
    374       else
    375       begin
    376         c.alpha := 0;
    377         c.red   := 0;
    378         c.green := 0;
    379         c.blue  := 0;
    380       end;
    381       PDest^ := c;
    382       Inc(PDest);
    383     end;
    384   end;
    385   Result.InvalidateBitmap;
    386 end;
    387 
    388 function FineResampleSmaller(bmp: TBGRADefaultBitmap;
    389   newWidth, newHeight: integer): TBGRADefaultBitmap;
     875function FineResampleSmaller(bmp: TBGRACustomBitmap;
     876  newWidth, newHeight: integer): TBGRACustomBitmap;
    390877var
    391878  yb, xb, yb2, xb2: integer;
    … …  
    5711058end;
    5721059
    573 function FineResample(bmp: TBGRADefaultBitmap;
    574   NewWidth, NewHeight: integer): TBGRADefaultBitmap;
     1060function CreateInterpolator(style: TSplineStyle): TWideKernelFilter;
     1061begin
     1062  case Style of
     1063    ssInside, ssInsideWithEnds: result := TCubicKernel.Create;
     1064    ssCrossing, ssCrossingWithEnds: result := TMitchellKernel.Create;
     1065    ssOutside: result := TSplineKernel.Create(0.5);
     1066    ssRoundOutside: result := TSplineKernel.Create(0.75);
     1067    ssVertexToSide: result := TSplineKernel.Create(1);
     1068  else
     1069    raise Exception.Create('Unknown spline style');
     1070  end;
     1071end;
     1072
     1073function FineResample(bmp: TBGRACustomBitmap;
     1074  NewWidth, NewHeight: integer; ResampleFilter: TResampleFilter): TBGRACustomBitmap;
    5751075var
    576   temp, newtemp: TBGRADefaultBitmap;
    577 begin
     1076  temp, newtemp: TBGRACustomBitmap;
     1077  tempFilter1,tempFilter2: TWideKernelFilter;
     1078begin
     1079  case ResampleFilter of
     1080    rfBicubic: //blur
     1081    begin
     1082      tempFilter1 := TCubicKernel.Create;
     1083      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
     1084      tempFilter1.Free;
     1085      exit;
     1086    end;
     1087    rfMitchell:
     1088    begin
     1089      tempFilter1 := TMitchellKernel.Create;
     1090      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
     1091      tempFilter1.Free;
     1092      exit;
     1093    end;
     1094    rfSpline:
     1095    begin
     1096      tempFilter1 := TSplineKernel.Create;
     1097      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter1,tempFilter1);
     1098      tempFilter1.Free;
     1099      exit;
     1100    end;
     1101    rfBestQuality:
     1102    begin
     1103      tempFilter1 := TSplineKernel.Create;
     1104      tempFilter2 := TMitchellKernel.Create;
     1105      result := WideKernelResample(bmp,NewWidth,NewHeight,tempFilter2,tempFilter1);
     1106      tempFilter1.Free;
     1107      tempFilter2.Free;
     1108      exit;
     1109    end;
     1110  end;
     1111
    5781112  if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
    5791113    Result := bmp.Duplicate
    5801114  else
    5811115  if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then
    582     Result := FineResampleLarger(bmp, NewWidth, NewHeight)
     1116    Result := FineResampleLarger(bmp, NewWidth, NewHeight, ResampleFilter)
    5831117  else
    5841118  if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then
    … …  
    6061140    if NewWidth > bmp.Width then
    6071141    begin
    608       newtemp := FineResampleLarger(temp, NewWidth, temp.Height);
     1142      newtemp := FineResampleLarger(temp, NewWidth, temp.Height, ResampleFilter);
    6091143      if (temp <> bmp) then
    6101144        temp.Free;
    … …  
    6141148    if NewHeight > bmp.Height then
    6151149    begin
    616       newtemp := FineResampleLarger(temp, temp.Width, NewHeight);
     1150      newtemp := FineResampleLarger(temp, temp.Width, NewHeight, ResampleFilter);
    6171151      if (temp <> bmp) then
    6181152        temp.Free;
    … …  
    6271161end;
    6281162
    629 function SimpleStretch(bmp: TBGRADefaultBitmap;
    630   NewWidth, NewHeight: integer): TBGRADefaultBitmap;
     1163{------------------------ Wide kernel filtering adapted from Graphics32 ---------------------------}
     1164
     1165function Constrain(const Value, Lo, Hi: Integer): Integer;
     1166begin
     1167  if Value < Lo then
     1168        Result := Lo
     1169  else if Value > Hi then
     1170        Result := Hi
     1171  else
     1172        Result := Value;
     1173end;
     1174
     1175type
     1176  TPointRec = record
     1177    Pos: Integer;
     1178    Weight: Single;
     1179  end;
     1180
     1181  TCluster = array of TPointRec;
     1182  TMappingTable = array of TCluster;
     1183
     1184{$warnings off}
     1185function BuildMappingTable(
     1186  DstLo, DstHi: Integer;
     1187  ClipLo, ClipHi: Integer;
     1188  SrcLo, SrcHi: Integer;
     1189  KernelSmaller,KernelLarger: TWideKernelFilter): TMappingTable;
     1190Const FullEdge = false;
    6311191var
    632   temp, newtemp: TBGRADefaultBitmap;
    633 begin
    634   if (NewWidth = bmp.Width) and (NewHeight = bmp.Height) then
    635     Result := bmp.Duplicate
    636   else
    637   if (NewWidth >= bmp.Width) and (NewHeight >= bmp.Height) then
    638     Result := SimpleStretchLarger(bmp, NewWidth, NewHeight)
    639   else
    640   if (NewWidth <= bmp.Width) and (NewHeight <= bmp.Height) then
    641     Result := SimpleStretchSmaller(bmp, NewWidth, NewHeight)
    642   else
    643   begin
    644     temp := bmp;
    645 
    646     if NewWidth < bmp.Width then
    647     begin
    648       newtemp := SimpleStretchSmaller(temp, NewWidth, temp.Height);
    649       if (temp <> bmp) then
    650         temp.Free;
    651       temp := newtemp;
    652     end;
    653 
    654     if NewHeight < bmp.Height then
    655     begin
    656       newtemp := SimpleStretchSmaller(temp, temp.Width, NewHeight);
    657       if (temp <> bmp) then
    658         temp.Free;
    659       temp := newtemp;
    660     end;
    661 
    662     if NewWidth > bmp.Width then
    663     begin
    664       newtemp := SimpleStretchLarger(temp, NewWidth, temp.Height);
    665       if (temp <> bmp) then
    666         temp.Free;
    667       temp := newtemp;
    668     end;
    669 
    670     if NewHeight > bmp.Height then
    671     begin
    672       newtemp := SimpleStretchLarger(temp, temp.Width, NewHeight);
    673       if (temp <> bmp) then
    674         temp.Free;
    675       temp := newtemp;
    676     end;
    677 
    678     if temp <> bmp then
    679       Result := temp
    680     else
    681       Result := bmp.Duplicate;
    682   end;
     1192  SrcW, DstW, ClipW: Integer;
     1193  FilterWidth: Single;
     1194  Scale, OldScale: Single;
     1195  Center: Single;
     1196  Left, Right: Integer;
     1197  I, J, K: Integer;
     1198  Weight: Single;
     1199begin
     1200  SrcW := SrcHi - SrcLo;
     1201  DstW := DstHi - DstLo;
     1202  ClipW := ClipHi - ClipLo;
     1203  if SrcW = 0 then
     1204  begin
     1205    Result := nil;
     1206    Exit;
     1207  end
     1208  else if SrcW = 1 then
     1209  begin
     1210    SetLength(Result, ClipW);
     1211    for I := 0 to ClipW - 1 do
     1212    begin
     1213      SetLength(Result[I], 1);
     1214      Result[I][0].Pos := 0;
     1215      Result[I][0].Weight := 1;
     1216    end;
     1217    Exit;
     1218  end;
     1219  SetLength(Result, ClipW);
     1220  if ClipW = 0 then Exit;
     1221
     1222  if FullEdge then Scale := DstW / SrcW
     1223  else Scale := (DstW - 1) / (SrcW - 1);
     1224
     1225  K := 0;
     1226
     1227  if Scale = 0 then
     1228  begin
     1229    SetLength(Result[0], 1);
     1230    Result[0][0].Pos := (SrcLo + SrcHi) div 2;
     1231    Result[0][0].Weight := 1;
     1232  end
     1233  else if Scale < 1 then
     1234  begin
     1235    FilterWidth := KernelSmaller.KernelWidth;
     1236    OldScale := Scale;
     1237    Scale := 1 / Scale;
     1238    FilterWidth := FilterWidth * Scale;
     1239    for I := 0 to ClipW - 1 do
     1240    begin
     1241      if FullEdge then
     1242        Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
     1243      else
     1244        Center := SrcLo + (I - DstLo + ClipLo) * Scale;
     1245      Left := Floor(Center - FilterWidth);
     1246      Right := Ceil(Center + FilterWidth);
     1247      for J := Left to Right do
     1248      begin
     1249        Weight := KernelSmaller.Interpolation((Center - J) * OldScale) * OldScale;
     1250        if Weight <> 0 then
     1251        begin
     1252          K := Length(Result[I]);
     1253          SetLength(Result[I], K + 1);
     1254          Result[I][K].Pos := Constrain(J, SrcLo, SrcHi - 1);
     1255          Result[I][K].Weight := Weight;
     1256        end;
     1257      end;
     1258      if Length(Result[I]) = 0 then
     1259      begin
     1260        SetLength(Result[I], 1);
     1261        Result[I][0].Pos := Floor(Center);
     1262        Result[I][0].Weight := 1;
     1263      end;
     1264    end;
     1265  end
     1266  else // scale > 1
     1267  begin
     1268    FilterWidth := KernelLarger.KernelWidth;
     1269    Scale := 1 / Scale;
     1270    for I := 0 to ClipW - 1 do
     1271    begin
     1272      if FullEdge then
     1273        Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
     1274      else
     1275        Center := SrcLo + (I - DstLo + ClipLo) * Scale;
     1276      Left := Floor(Center - FilterWidth);
     1277      Right := Ceil(Center + FilterWidth);
     1278      for J := Left to Right do
     1279      begin
     1280        Weight := KernelLarger.Interpolation(Center - j);
     1281        if Weight <> 0 then
     1282        begin
     1283          K := Length(Result[I]);
     1284          SetLength(Result[I], k + 1);
     1285          Result[I][K].Pos := Constrain(j, SrcLo, SrcHi - 1);
     1286          Result[I][K].Weight := Weight;
     1287        end;
     1288      end;
     1289    end;
     1290  end;
     1291end;
     1292{$warnings on}
     1293
     1294function WideKernelResample(bmp: TBGRACustomBitmap;
     1295  NewWidth, NewHeight: integer; ResampleFilterSmaller, ResampleFilterLarger: TWideKernelFilter): TBGRACustomBitmap;
     1296type
     1297  TSum = record
     1298    sumR,sumG,sumB,sumA: single;
     1299  end;
     1300
     1301var
     1302  mapX,mapY: TMappingTable;
     1303  xb,yb,xc,yc,MapXLoPos,MapXHiPos: integer;
     1304  clusterX,clusterY: TCluster;
     1305  verticalSum: array of TSum;
     1306  scanlinesSrc: array of PBGRAPixel;
     1307  sum: TSum;
     1308  c: TBGRAPixel;
     1309  w,wa: single;
     1310  pdest: PBGRAPixel;
     1311begin
     1312  result := bmp.NewBitmap(NewWidth,NewHeight);
     1313  if (NewWidth=0) or (NewHeight=0) then exit;
     1314  mapX := BuildMappingTable(0,NewWidth,0,NewWidth,0,bmp.Width,ResampleFilterSmaller,ResampleFilterLarger);
     1315  mapY := BuildMappingTable(0,NewHeight,0,NewHeight,0,bmp.Height,ResampleFilterSmaller,ResampleFilterLarger);
     1316
     1317  MapXLoPos := MapX[0][0].Pos;
     1318  MapXHiPos := MapX[NewWidth - 1][High(MapX[NewWidth - 1])].Pos;
     1319
     1320  setlength(verticalSum, MapXHiPos-MapXLoPos+1);
     1321
     1322  setlength(scanlinesSrc, bmp.Height);
     1323  for yb := 0 to bmp.Height-1 do
     1324    scanlinesSrc[yb] := bmp.ScanLine[yb];
     1325
     1326  for yb := 0 to NewHeight-1 do
     1327  begin
     1328    clusterY := mapY[yb];
     1329
     1330    for xb := MapXLoPos to MapXHiPos do
     1331    begin
     1332      fillchar(verticalSum[xb - MapXLoPos],sizeof(verticalSum[xb - MapXLoPos]),0);
     1333      for yc := 0 to high(clusterY) do
     1334      with verticalSum[xb - MapXLoPos] do
     1335      begin
     1336        c := (scanlinesSrc[clusterY[yc].Pos]+xb)^;
     1337        w := clusterY[yc].Weight;
     1338        wa := w * c.alpha;
     1339        sumA += wa;
     1340        sumR += c.red * wa;
     1341        sumG += c.green * wa;
     1342        sumB += c.blue * wa;
     1343      end;
     1344    end;
     1345
     1346    pdest := result.Scanline[yb];
     1347
     1348    for xb := 0 to NewWidth-1 do
     1349    begin
     1350      clusterX := mapX[xb];
     1351      {$hints off}
     1352      fillchar(sum,sizeof(sum),0);
     1353      {$hints on}
     1354      for xc := 0 to high(clusterX) do
     1355      begin
     1356        w := clusterX[xc].Weight;
     1357        with verticalSum[ClusterX[xc].Pos - MapXLoPos] do
     1358        begin
     1359          sum.sumA += sumA*w;
     1360          sum.sumR += sumR*w;
     1361          sum.sumG += sumG*w;
     1362          sum.sumB += sumB*w;
     1363        end;
     1364      end;
     1365
     1366      if sum.sumA < 0.5 then
     1367        pdest^ := BGRAPixelTransparent else
     1368      begin
     1369        c.red := constrain(round(sum.sumR/sum.sumA),0,255);
     1370        c.green := constrain(round(sum.sumG/sum.sumA),0,255);
     1371        c.blue := constrain(round(sum.sumB/sum.sumA),0,255);
     1372        if sum.sumA > 255 then
     1373          c.alpha := 255 else
     1374          c.alpha := round(sum.sumA);
     1375        pdest^ := c;
     1376      end;
     1377      inc(pdest);
     1378    end;
     1379  end;
     1380
    6831381end;
    6841382
Note: See TracChangeset for help on using the changeset viewer.