* added more interpolation filters for Canvas.StretchDraw.

* More work done on bitmap theme.

7 files changed, 795 insertions, 8 deletions

diff --git a/prototypes/fpgui2/source/core/fpgfx.pas b/prototypes/fpgui2/source/core/fpgfx.pas
index fce957ce..6f8af25f 100644
--- a/prototypes/fpgui2/source/core/fpgfx.pas
+++ b/prototypes/fpgui2/source/core/fpgfx.pas
@@ -111,6 +111,8 @@ type
 
 
   TfpgImage = class(TfpgImageImpl)
+  public
+    function    ImageFromRect(var ARect: TRect): TfpgImage;
   end;
 
 
@@ -1037,6 +1039,32 @@ begin
 end;
 
 
+{ TfpgImage }
+
+function TfpgImage.ImageFromRect(var ARect: TRect): TfpgImage;
+var
+  x, y: TfpgCoord;
+  ix, iy: TfpgCoord;
+begin
+  SortRect(ARect);
+  
+  Result := TfpgImage.Create;
+  Result.AllocateImage(ColorDepth, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
+  Result.UpdateImage;
+  
+  iy := -1;
+  for y := ARect.Top to ARect.Bottom-1 do
+  begin
+    Inc(iy);
+    ix := -1;
+    for x := ARect.Left to ARect.Right-1 do
+    begin
+      Inc(ix);
+      Result.Colors[ix, iy] := Colors[x, y];
+    end;
+  end;
+end;
+
 initialization
   uApplication    := nil;
   fpgTimers       := nil;
diff --git a/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk b/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk
index d32a03a0..4e261b61 100644
--- a/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk
+++ b/prototypes/fpgui2/source/core/gdi/fpGFX2.lpk
@@ -24,7 +24,7 @@
     <License Value="Modified LGPL

 "/>

     <Version Minor="1"/>

-    <Files Count="18">

+    <Files Count="19">

       <Item1>

         <Filename Value="..\gfxbase.pas"/>

         <UnitName Value="gfxbase"/>

@@ -97,6 +97,10 @@
         <Filename Value="..\..\gui\gui_listbox.pas"/>

         <UnitName Value="gui_listbox"/>

       </Item18>

+      <Item19>
+        <Filename Value="..\gfx_extinterpolation.pas"/>
+        <UnitName Value="gfx_extinterpolation"/>
+      </Item19>
     </Files>

     <RequiredPkgs Count="1">

       <Item1>

diff --git a/prototypes/fpgui2/source/core/gfx_extinterpolation.pas b/prototypes/fpgui2/source/core/gfx_extinterpolation.pas
new file mode 100644
index 00000000..633c1e49
--- /dev/null
+++ b/prototypes/fpgui2/source/core/gfx_extinterpolation.pas
@@ -0,0 +1,585 @@
+unit gfx_extinterpolation;
+
+{
+Some more interpolation filters for TfpgCanvas.StretchDraw:
+Bessel, Gaussian and Sinc are infinite impulse response (IIR),
+the others are finite impulse response (FIR). The implementation
+of Bessel and Sinc are windowed with Blackman filter.
+
+This unit was ported from fcl-image which is part of FPC. A few
+more filters have also been added.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, gfxbase;
+
+type
+
+  TBlackmanInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TBlackmanSincInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TBlackmanBesselInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TGaussianInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  // a.k.a. "Nearest Neighbour" filter
+  TBoxInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  THermiteInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TLanczosInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TQuadraticInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TCubicInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TCatromInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  TBilinearInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  THanningInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+
+
+  THammingInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+  
+  
+  TBSplineInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+  
+  
+  TBellInterpolation = class(TfpgBaseInterpolation)
+  protected
+    function  Filter(x: double): double; override;
+    function  MaxSupport: double; override;
+  end;
+  
+
+implementation
+
+
+// BesselOrderOne: computes Bessel function of x in the first kind of order 0
+
+function J1 (x : double) : double;
+const Pone : array[0..8] of double =
+    (  0.581199354001606143928050809e+21,
+      -0.6672106568924916298020941484e+20,
+       0.2316433580634002297931815435e+19,
+      -0.3588817569910106050743641413e+17,
+       0.2908795263834775409737601689e+15,
+      -0.1322983480332126453125473247e+13,
+       0.3413234182301700539091292655e+10,
+      -0.4695753530642995859767162166e+7,
+       0.270112271089232341485679099e+4
+    );
+    Qone : array [0..8] of double =
+    ( 0.11623987080032122878585294e+22,
+      0.1185770712190320999837113348e+20,
+      0.6092061398917521746105196863e+17,
+      0.2081661221307607351240184229e+15,
+      0.5243710262167649715406728642e+12,
+      0.1013863514358673989967045588e+10,
+      0.1501793594998585505921097578e+7,
+      0.1606931573481487801970916749e+4,
+      0.1e+1
+    );
+var
+  p, q : double;
+  r : 0..8;
+begin
+  p := Pone[8];
+  q := Qone[8];
+  for r := 7 downto 0 do
+    begin
+    p := p*x*x+pOne[r];
+    q := q*X*X+Qone[r];
+    end;
+  result := p / q;
+end;
+
+function P1 (x : double) : double;
+const Pone : array[0..5] of double =
+    ( 0.352246649133679798341724373e+5,
+      0.62758845247161281269005675e+5,
+      0.313539631109159574238669888e+5,
+      0.49854832060594338434500455e+4,
+      0.2111529182853962382105718e+3,
+      0.12571716929145341558495e+1
+    );
+    Qone : array [0..5] of double =
+    ( 0.352246649133679798068390431e+5,
+      0.626943469593560511888833731e+5,
+      0.312404063819041039923015703e+5,
+      0.4930396490181088979386097e+4,
+      0.2030775189134759322293574e+3,
+      0.1e+1
+    );
+var
+  x8, p, q: double;
+  r: 0..5;
+begin
+  p := Pone[5];
+  q := Qone[5];
+  x8 := 8.0 / x;
+  for r := 4 downto 0 do
+    begin
+    p := p*x8*x8+pOne[r];
+    q := q*x8*x8+Qone[r];
+    end;
+  result := p / q;
+end;
+
+function Q1 (x : double) : double;
+const Pone : array[0..5] of double =
+    ( 0.3511751914303552822533318e+3,
+      0.7210391804904475039280863e+3,
+      0.4259873011654442389886993e+3,
+      0.831898957673850827325226e+2,
+      0.45681716295512267064405e+1,
+      0.3532840052740123642735e-1
+    );
+    Qone : array [0..5] of double =
+    ( 0.74917374171809127714519505e+4,
+      0.154141773392650970499848051e+5,
+      0.91522317015169922705904727e+4,
+      0.18111867005523513506724158e+4,
+      0.1038187585462133728776636e+3,
+      0.1e+1
+    );
+var
+  x8, p, q: double;
+  r : 0..5;
+begin
+  p := Pone[5];
+  q := Qone[5];
+  x8 := 8.0 / x;
+  for r := 4 downto 0 do
+    begin
+    p := p*x8*x8+pOne[r];
+    q := q*x8*x8+Qone[r];
+    end;
+  result := p / q;
+end;
+
+function BesselOrderOne (x : double) : double;
+var
+  p, q, OneOverSqrt2, sinx, cosx: double;
+begin
+  if x = 0.0 then
+    result := 0.0
+  else
+    begin
+    p := x;
+    if x < 0.0 then
+      x := -x;
+    if x < 8.0 then
+      result := p * J1(x)
+    else
+      begin
+      OneOverSqrt2 := 1.0 / sqrt(2.0);
+      sinx := sin(x);
+      cosx := cos(x);
+      result := sqrt(2.0/(PI*x)) *
+           ( P1(x)*(OneOverSqrt2*(sinx-cosx))
+             - 8.0/x*Q1(x)*(-OneOverSqrt2*(sinx+cosx))
+           );
+      if p < 0.0 then
+        result := -result;
+      end
+    end;
+end;
+
+// Functions to aid calculations
+
+function Bessel (x : double) : double;
+begin
+  if x = 0.0 then
+    result := PI / 4.0
+  else
+    result := BesselOrderOne(PI * x) / (2.0 * x);
+end;
+
+function Sinc (x : double) : double;
+var xx : double;
+begin
+  if x = 0.0 then
+    result := 1.0
+  else
+    begin
+    xx := PI*x;
+    result := sin(xx) / (xx);
+    end;
+end;
+
+function Blackman (x : double) : double;
+var xpi : double;
+begin
+  xpi := PI * x;
+  result := 0.42 + 0.5 * cos(xpi) + 0.08 * cos(2*xpi);
+end;
+
+{ THermiteInterpolation }
+
+function THermiteInterpolation.Filter(x: double): double;
+begin
+  if x < -1.0 then
+    result := 0.0
+  else if x < 0.0 then
+    result := (2.0*(-x)-3.0)*(-x)*(-x)+1.0
+  else if x < 1.0 then
+    result := (2.0*x-3.0)*x*x+1.0
+  else
+    result := 0;
+end;
+
+function THermiteInterpolation.MaxSupport: double;
+begin
+  result := 1.0;
+end;
+
+{ TLanczosInterpolation }
+
+function TLanczosInterpolation.Filter(x: double): double;
+begin
+  if x < -3.0 then
+    result := 0.0
+  else if x < 0.0 then
+    result := sinc(-x)*sinc(-x/3.0)
+  else if x < 3.0 then
+    result := sinc(x)*sinc(x/3.0)
+  else
+    result := 0.0;
+end;
+
+function TLanczosInterpolation.MaxSupport: double;
+begin
+  result := 3.0;
+end;
+
+{ TQuadraticInterpolation }
+
+function TQuadraticInterpolation.Filter(x: double): double;
+begin
+  if x < -1.5 then
+    result := 0.0
+  else if x < -0.5 then
+    begin
+    x := x + 1.5;
+    result := 0.5*x*x;
+    end
+  else if x < 0.5 then
+    result := 0.75 - x*x
+  else if x < 1.5 then
+    begin
+    x := x - 1.5;
+    result := 0.5*x*x;
+    end
+  else
+    result := 0.0;
+end;
+
+function TQuadraticInterpolation.MaxSupport: double;
+begin
+  result := 1.5;
+end;
+
+{ TCubicInterpolation }
+
+function TCubicInterpolation.Filter(x: double): double;
+begin
+  if x < -2.0 then
+    result := 0.0
+  else if x < -1.0 then
+    begin
+    x := x +2.0;
+    result := x*x*x / 6.0;
+    end
+  else if x < 0.0 then
+    result := (4.0+x*x*(-6.0-3.0*x)) / 6.0
+  else if x < 1.0 then
+    result := (4.0+x*x*(-6.0+3.0*x)) / 6.0
+  else if x < 2.0 then
+    begin
+    x := 2.0 - x;
+    result := x*x*x / 6.0;
+    end
+  else
+    result := 0.0;
+end;
+
+function TCubicInterpolation.MaxSupport: double;
+begin
+  result := 2.0;
+end;
+
+{ TCatromInterpolation }
+
+function TCatromInterpolation.Filter(x: double): double;
+begin
+  if x < -2.0 then
+    result := 0.0
+  else if x < -1.0 then
+    result := 0.5*(4.0+x*(8.0+x*(5.0+x)))
+  else if x < 0.0 then
+    result := 0.5*(2.0+x*x*(-5.0-3.0*x))
+  else if x < 1.0 then
+    result := 0.5*(2.0+x*x*(-5.0+3.0*x))
+  else if x < 2.0 then
+    result := 0.5*(4.0+x*(-8.0+x*(5.0-x)))
+  else
+    result := 0.0;
+end;
+
+function TCatromInterpolation.MaxSupport: double;
+begin
+  result := 2.0;
+end;
+
+{ THanningInterpolation }
+
+function THanningInterpolation.Filter(x: double): double;
+begin
+  if x < -1.0 then
+    result := 0.0
+  else if x <= 1.0 then
+    result := 0.5+0.5*cos(PI*x)
+  else
+    result := 0.0;
+end;
+
+function THanningInterpolation.MaxSupport: double;
+begin
+  result := 1.0;
+end;
+
+{ THammingInterpolation }
+
+function THammingInterpolation.Filter(x: double): double;
+begin
+  if x < -1.0 then
+    result := 0.0
+  else if x <= 1.0 then
+    result := 0.54+0.46*cos(PI*x)
+  else
+    result := 0.0;
+end;
+
+function THammingInterpolation.MaxSupport: double;
+begin
+  result := 1.0;
+end;
+
+{ TBilinearInterpolation }
+
+function TBilinearInterpolation.Filter(x: double): double;
+begin
+  if x < -1.0 then
+    result := 0.0
+  else if x < 0.0 then
+    result := 1 + x
+  else if x < 1.0 then
+    result := 1 - x
+  else
+    result := 0.0;
+end;
+
+function TBilinearInterpolation.MaxSupport: double;
+begin
+  result := 1.0;
+end;
+
+{ TBoxInterpolation }
+
+function TBoxInterpolation.Filter(x: double): double;
+begin
+  if x < -0.5 then
+    result := 0.0
+  else if x < 0.5 then
+    result := 1.0
+  else
+    result := 0.0;
+end;
+
+function TBoxInterpolation.MaxSupport: double;
+begin
+  result := 0.5;
+end;
+
+{ TGaussianInterpolation }
+
+function TGaussianInterpolation.Filter(x: double): double;
+begin
+  result := exp(-2.0*x*x) * sqrt(2.0/PI);
+end;
+
+function TGaussianInterpolation.MaxSupport: double;
+begin
+  result := 1.25;
+end;
+
+{ TBlackmanBesselInterpolation }
+
+function TBlackmanBesselInterpolation.Filter(x: double): double;
+begin
+  result := Blackman(x/MaxSupport) * Bessel (x);
+end;
+
+function TBlackmanBesselInterpolation.MaxSupport: double;
+begin
+  Result := 3.2383;
+end;
+
+{ TBlackmanSincInterpolation }
+
+function TBlackmanSincInterpolation.Filter(x: double): double;
+begin
+  Result := Blackman(x/MaxSupport) * Sinc(x);
+end;
+
+function TBlackmanSincInterpolation.MaxSupport: double;
+begin
+  Result := 4.0;
+end;
+
+{ TBlackmanInterpolation }
+
+function TBlackmanInterpolation.Filter(x: double): double;
+begin
+  Result := Blackman (x);
+end;
+
+function TBlackmanInterpolation.MaxSupport: double;
+begin
+  Result := 1.0;
+end;
+
+{ TBSplineInterpolation }
+
+function TBSplineInterpolation.Filter(x: double): double;
+var
+  tt: double;
+  Value: double;
+begin
+  if (x < 0.0) then
+    Value := -x
+  else
+    Value := x;
+    
+  if (Value < 1.0) then
+  begin
+    tt := Sqr(Value);
+    Result := 0.5*tt*Value - tt + 2.0 / 3.0;
+  end
+  else if (Value < 2.0) then
+  begin
+    Value := 2.0 - Value;
+    Result := 1.0/6.0 * Sqr(Value) * Value;
+  end else
+    Result := 0.0;
+end;
+
+function TBSplineInterpolation.MaxSupport: double;
+begin
+  Result := 2.0;
+end;
+
+{ TBellInterpolation }
+
+function TBellInterpolation.Filter(x: double): double;
+var
+  Value: double;
+begin
+  if (x < 0.0) then
+    Value := -x
+  else
+    Value := x;
+    
+  if (Value < 0.5) then
+    Result := 0.75 - Sqr(Value)
+  else if (Value < 1.5) then
+  begin
+    Value := Value - 1.5;
+    Result := 0.5 * Sqr(Value);
+  end
+  else
+    Result := 0.0;
+end;
+
+function TBellInterpolation.MaxSupport: double;
+begin
+  Result := 1.5;
+end;
+
+end.
+
+
diff --git a/prototypes/fpgui2/source/core/gfxbase.pas b/prototypes/fpgui2/source/core/gfxbase.pas
index 19918c60..9dfb9830 100644
--- a/prototypes/fpgui2/source/core/gfxbase.pas
+++ b/prototypes/fpgui2/source/core/gfxbase.pas
@@ -217,6 +217,7 @@ type
   TfpgCanvasBase = class(TObject)
   private
     FInterpolation: TfpgCustomInterpolation;
+    procedure SetInterpolation(const AValue: TfpgCustomInterpolation);
   protected
     FBufferedDraw: boolean;
     FBeginDrawCount: integer;
@@ -250,12 +251,14 @@ type
     procedure   SetPixel(X, Y: integer; const AValue: TfpgColor); virtual; abstract;
   public
     constructor Create; virtual;
+    destructor  Destroy; override;
     procedure   DrawRectangle(x, y, w, h: TfpgCoord); overload;
     procedure   DrawRectangle(r: TfpgRect); overload;
     procedure   DrawLine(x1, y1, x2, y2: TfpgCoord);
     procedure   DrawImage(x, y: TfpgCoord; img: TfpgImageBase);
     procedure   DrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer);
     procedure   StretchDraw (x, y, w, h: TfpgCoord; ASource: TfpgImageBase);
+    procedure   CopyRect(x, y: TfpgCoord; ACanvas: TfpgCanvasBase; var SourceRect: TRect);
     procedure   DrawString(x, y: TfpgCoord; const txt: string);
     procedure   FillRectangle(x, y, w, h: TfpgCoord); overload;
     procedure   FillRectangle(r: TfpgRect); overload;
@@ -281,6 +284,7 @@ type
     property    TextColor: TfpgColor read FTextColor;
     property    Font: TfpgFontBase read FFont write SetFont;
     property    Pixels[X, Y: integer]: TfpgColor read GetPixel write SetPixel;
+    property    InterpolationFilter: TfpgCustomInterpolation read FInterpolation write SetInterpolation;
   end;
 
 
@@ -361,6 +365,8 @@ function fpgGetAlpha(const AColor: TfpgColor): word;
 
 { Points }
 function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean;
+procedure SortRect(var ARect: TRect);
+procedure SortRect(var left, top, right, bottom: integer);
 
 implementation
 
@@ -564,6 +570,30 @@ begin
             (APoint.y < ARect.Bottom);
 end;
 
+procedure SortRect(var ARect: TRect);
+begin
+  with ARect do
+    SortRect(left, top, right, bottom);
+end;
+
+procedure SortRect(var left, top, right, bottom: integer);
+var
+  r: integer;
+begin
+  if left > right then
+  begin
+    r       := left;
+    left    := right;
+    right   := r;
+  end;
+  if top > bottom then
+  begin
+    r       := top;
+    top     := bottom;
+    bottom  := r;
+  end;
+end;
+
 { TfpgRect }
 
 procedure TfpgRect.SetRect(aleft, atop, awidth, aheight: TfpgCoord);
@@ -669,11 +699,23 @@ end;
 
 { TfpgCanvasBase }
 
+procedure TfpgCanvasBase.SetInterpolation(const AValue: TfpgCustomInterpolation);
+begin
+  FInterpolation.Free;
+  FInterpolation := AValue;
+end;
+
 constructor TfpgCanvasBase.Create;
 begin
   FBufferedDraw := True;
 end;
 
+destructor TfpgCanvasBase.Destroy;
+begin
+  FInterpolation.Free;
+  inherited Destroy;
+end;
+
 procedure TfpgCanvasBase.DrawRectangle(x, y, w, h: TfpgCoord);
 begin
   DoDrawRectangle(x, y, w, h);
@@ -722,6 +764,21 @@ begin
   end;
 end;
 
+procedure TfpgCanvasBase.CopyRect(x, y: TfpgCoord; ACanvas: TfpgCanvasBase;
+  var SourceRect: TRect);
+var
+  xx, r, t: TfpgCoord;
+begin
+  SortRect(SourceRect);
+  with SourceRect do
+    for r := left to right do
+    begin
+      xx := r - left + x;
+      for t := bottom to top do
+        Pixels[xx, (t - bottom + y)] := ACanvas.Pixels[r, t];
+    end;
+end;
+
 procedure TfpgCanvasBase.DrawString(x, y: TfpgCoord; const txt: string);
 var
   underline: integer;
diff --git a/prototypes/fpgui2/source/core/x11/fpGFX2.lpk b/prototypes/fpgui2/source/core/x11/fpGFX2.lpk
index baadf4e9..5255aeb1 100644
--- a/prototypes/fpgui2/source/core/x11/fpGFX2.lpk
+++ b/prototypes/fpgui2/source/core/x11/fpGFX2.lpk
@@ -24,7 +24,7 @@
     <License Value="Modified LGPL
 "/>
     <Version Minor="1"/>
-    <Files Count="20">
+    <Files Count="21">
       <Item1>
         <Filename Value="x11_xft.pas"/>
         <UnitName Value="x11_xft"/>
@@ -105,6 +105,10 @@
         <Filename Value="../../gui/gui_memo.pas"/>
         <UnitName Value="gui_memo"/>
       </Item20>
+      <Item21>
+        <Filename Value="../gfx_extinterpolation.pas"/>
+        <UnitName Value="gfx_extinterpolation"/>
+      </Item21>
     </Files>
     <RequiredPkgs Count="1">
       <Item1>
diff --git a/prototypes/fpgui2/source/core/x11/fpGFX2.pas b/prototypes/fpgui2/source/core/x11/fpGFX2.pas
index c3e31cad..d4a75395 100644
--- a/prototypes/fpgui2/source/core/x11/fpGFX2.pas
+++ b/prototypes/fpgui2/source/core/x11/fpGFX2.pas
@@ -10,7 +10,7 @@ uses
   x11_xft, x11_keyconv, gfxbase, gfxbaseinterfaces, gfx_x11, fpgfx, 
     gfx_stdimages, gfx_imgfmt_bmp, gfx_widget, gui_form, gui_label, gui_button, 
     gui_edit, gui_combobox, gui_popupwindow, gui_scrollbar, gfx_UTF8utils, 
-    gui_dialogs, gui_listbox, gui_memo; 
+    gui_dialogs, gui_listbox, gui_memo, gfx_extinterpolation; 
 
 implementation
 
diff --git a/prototypes/fpgui2/tests/themetest.lpr b/prototypes/fpgui2/tests/themetest.lpr
index 9fd396cd..ed4cc66b 100644
--- a/prototypes/fpgui2/tests/themetest.lpr
+++ b/prototypes/fpgui2/tests/themetest.lpr
@@ -14,7 +14,8 @@ uses
   gui_scrollbar,
   gui_button,
   gui_label,
-  gfx_imgfmt_bmp;
+  gfx_imgfmt_bmp,
+  gfx_extinterpolation;
 
 type
   { Note:
@@ -85,6 +86,8 @@ type
     procedure   btnCloseClick(Sender: TObject);
     procedure   CreateButtons;
     procedure   CreateScrollbars;
+  protected
+    procedure   HandlePaint; override;
   public
     constructor Create(AOwner: TComponent); override;
   end;
@@ -103,6 +106,8 @@ procedure TThemeScrollbar.HandlePaint;
 var
   imgwidth: integer;
   x: integer;
+  part: TfpgImage;
+  r: TRect;
 begin
   Canvas.BeginDraw;
 //  inherited HandlePaint;
@@ -130,12 +135,24 @@ begin
     { top button }
 //    if Pressed then
 //      Canvas.DrawButtonFace(x, y, w, h, [btnIsEmbedded, btnIsPressed])
-      Canvas.DrawImagePart(0, 0, image, state*imgwidth, 0, imgwidth, 21);
+      state := 4;
+      r.Left := (state * imgwidth);
+      r.Top := 0;
+      r.Right := (r.Left + imgwidth);
+      r.Bottom := 21;
+      part := image.ImageFromRect(r);
+      Canvas.DrawImagePart(0, 0, image, r.Left, r.Top, width, width);
+//      Canvas.DrawImage(0, 0, part);
+      writeln('Width ', Width);
+      writeln('Height ', Height);
+//      Canvas.StretchDraw(0, 0, width, width, part);
+      part.Free;
+//      Canvas.DrawImagePart(0, 0, image, state*imgwidth, 0, imgwidth, 21);
 //    else
 //      Canvas.DrawButtonFace(x, y, w, h, [btnIsEmbedded]);
 
     { bottom button }
-    DrawButton(0, Height - Width, Width, Width, 'sys.sb.down', FEndBtnPressed);
+{    DrawButton(0, Height - Width, Width, Width, 'sys.sb.down', FEndBtnPressed);
   end
   else
   begin
@@ -144,7 +161,8 @@ begin
   end;
 
   DrawSlider(True);
-
+}
+  end;
   Canvas.EndDraw;
 end;
 
@@ -155,7 +173,8 @@ var
   NewState: Integer;
 begin
   inherited HandleMouseMove(x, y, btnstate, shiftstate);
-
+  exit;
+  
   Pt := Point(X, Y);
   NewState := 0;
   if PtInRect(TopRect, Pt) then
@@ -175,9 +194,13 @@ end;
 constructor TThemeScrollbar.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+  Width := 17;
   State := 0;
   image := LoadImage_BMP(SetDirSeparators('../images/themes/luna/scrollbar.bmp'));
+//  image.CreateMaskFromSample(0, 0);
   image.UpdateImage;
+  
+  Canvas.InterpolationFilter := TBilinearInterpolation.Create;
 end;
 
 destructor TThemeScrollbar.Destroy;
@@ -433,6 +456,92 @@ begin
   sbsilverHor.ThemeImage  := bmp;
 end;
 
+procedure TMainForm.HandlePaint;
+var
+  image: TfpgImage;
+  img: TfpgImage;
+  part: TfpgImage;
+  r: TRect;
+  x, y: TfpgCoord;
+begin
+  Canvas.BeginDraw;
+  inherited HandlePaint;
+  
+  
+  image := LoadImage_BMP(SetDirSeparators('../images/themes/luna/scrollbar.bmp'));
+//  image.CreateMaskFromSample(0, 0);
+  image.UpdateImage;
+
+  Canvas.InterpolationFilter := TfpgMitchelInterpolation.Create;
+  Canvas.StretchDraw(0, 0, Width, 21, image);
+
+  Canvas.InterpolationFilter := TBilinearInterpolation.Create;
+  Canvas.StretchDraw(0, 23, Width, 21, image);
+  
+  r.Left    := 0;
+  r.Top     := 0;
+  r.Right   := 32;
+  r.Bottom  := 21;
+  img := image.ImageFromRect(r);    // now we have the complete widget 32x21
+  // we need 17x17 size
+
+  Canvas.DrawImage(5, 46, img);
+
+  x := 5;
+  y := 69;
+  
+  // left border
+  r.Left    := 0;
+  r.Top     := 0;
+  r.Right   := 2;
+  r.Bottom  := 21;
+  part := img.ImageFromRect(r);
+  Canvas.StretchDraw(x, y, 3, 17, part);
+  
+  // top border
+  r.Left    := 2;
+  r.Top     := 0;
+  r.Right   := 32-2;
+  r.Bottom  := 2;
+  part := img.ImageFromRect(r);
+  Canvas.StretchDraw(x+2+r.Left, y+R.Top, 17-(2*2), r.Bottom-r.Top, part);
+  part.Free;
+
+  // bottom border
+  r.Left    := 2;
+  r.Top     := 21-2;
+  r.Right   := 32-2;
+  r.Bottom  := 21;
+  part := img.ImageFromRect(r);
+  Canvas.StretchDraw(x+2+r.Left, y+R.Top, 17-(2*2), r.Bottom-r.Top, part);
+  part.Free;
+
+  // right border
+  r.Left    := 32-2;
+  r.Top     := 0;
+  r.Right   := 32;
+  r.Bottom  := 21;
+  part := img.ImageFromRect(r);
+  Canvas.StretchDraw(x+4+r.Left, y+R.Top, r.Right-r.Left, 17, part);
+  part.Free;
+
+  // main body
+  r.Left    := 3;
+  r.Top     := 3;
+  r.Right   := 32-2;
+  r.Bottom  := 21-2;
+  part := img.ImageFromRect(r);
+  Canvas.StretchDraw(x+4+r.Left, y+2+R.Top, 17-(2*2), 17-(2*2), part);
+  part.Free;
+
+//  Canvas.StretchDraw(5, 69, 17, 17, partimg);
+  
+  img.Free;
+
+
+  Canvas.EndDraw;
+end;
+
 constructor TMainForm.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);