From d8824e070082bdbdfbada8ca34228ac1ff3f04e1 Mon Sep 17 00:00:00 2001
From: sekelsenmat <sekelsenmat@lazarus-ide.org>
Date: Thu, 17 Nov 2011 12:26:40 +0000
Subject: [PATCH] Starts a new unit, lazcanvas.pas, for adding extensions for
 TFPImageCanvas to support all our TCanvas features

git-svn-id: trunk@33581 -
---
 .gitattributes     |  1 +
 lcl/alllclunits.pp |  2 +-
 lcl/lazcanvas.pas  | 77 ++++++++++++++++++++++++++++++++++++++++++++++
 lcl/lclbase.lpk    | 14 ++++-----
 4 files changed, 85 insertions(+), 9 deletions(-)
 create mode 100644 lcl/lazcanvas.pas

diff --git a/.gitattributes b/.gitattributes
index fd39d0ffe9..9ad306d032 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -5753,6 +5753,7 @@ lcl/languages/lclstrconsts.sk.po svneol=native#text/plain
 lcl/languages/lclstrconsts.tr.po svneol=native#text/plain
 lcl/languages/lclstrconsts.uk.po svneol=native#text/plain
 lcl/languages/lclstrconsts.zh_CN.po svneol=native#text/utf8
+lcl/lazcanvas.pas svneol=native#text/pascal
 lcl/lazconfigstorage.pas svneol=native#text/pascal
 lcl/lazhelphtml.pas svneol=native#text/pascal
 lcl/lazhelpintf.pas svneol=native#text/pascal
diff --git a/lcl/alllclunits.pp b/lcl/alllclunits.pp
index a9a4ebf20c..352771f314 100644
--- a/lcl/alllclunits.pp
+++ b/lcl/alllclunits.pp
@@ -24,7 +24,7 @@ uses
   WSControls, WSDesigner, WSDialogs, WSExtCtrls, WSExtDlgs, WSFactory, 
   WSForms, WSGrids, WSImgList, WSLCLClasses, WSMenus, WSPairSplitter, WSProc, 
   WSReferences, WSSpin, WSStdCtrls, WSToolwin, ActnList, Arrow, AsyncProcess, 
-  AvgLvlTree, ButtonPanel, Buttons, Calendar, RegisterLCL, ValEdit, 
+  AvgLvlTree, ButtonPanel, Buttons, Calendar, RegisterLCL, ValEdit, lazcanvas, 
   LazarusPackageIntf;
 
 implementation
diff --git a/lcl/lazcanvas.pas b/lcl/lazcanvas.pas
new file mode 100644
index 0000000000..70a494cffd
--- /dev/null
+++ b/lcl/lazcanvas.pas
@@ -0,0 +1,77 @@
+{
+ /***************************************************************************
+                              lazcanvas.pas
+                              ---------------
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  Author: Felipe Monteiro de Carvalho
+
+  Abstract:
+    Classes and functions for extending TFPImageCanvas to support more stretching
+    filters and to support all features from the LCL TCanvas
+}
+unit lazcanvas;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  // RTL
+  Classes, SysUtils,
+  // FCL-Image
+  fpimgcanv, fpcanvas, fpimage;
+
+type
+
+  { TFPSharpInterpolation }
+
+  // This does a very sharp and square interpolation for stretching,
+  // similar to StretchBlt from the Windows API
+  TFPSharpInterpolation = class (TFPCustomInterpolation)
+  protected
+    procedure Execute (x,y,w,h : integer); override;
+  end;
+
+implementation
+
+{ TFPWindowsSharpInterpolation }
+
+procedure TFPSharpInterpolation.Execute(x, y, w, h: integer);
+// paint Image on Canvas at x,y,w*h
+var
+  srcx, srcy: Integer; // current coordinates in the source image
+  dx, dy: Integer; // current coordinates in the destination canvas
+  lWidth, lHeight: Integer; // Image size
+begin
+  if (w<=0) or (h<=0) or (image.Width=0) or (image.Height=0) then
+    exit;
+
+  lWidth := Image.Width-1;
+  lHeight := Image.Height-1;
+
+  for dx := 0 to w-1 do
+   for dy := 0 to h-1 do
+   begin
+     srcx := Round((dx / w) * lWidth);
+     srcy := Round((dy / w) * lHeight);
+     Canvas.Colors[dx+x, dy+y] := Image.Colors[srcx, srcy];
+   end;
+end;
+
+end.
+
diff --git a/lcl/lclbase.lpk b/lcl/lclbase.lpk
index 2f7eab14c1..1ecd8822af 100644
--- a/lcl/lclbase.lpk
+++ b/lcl/lclbase.lpk
@@ -4,7 +4,7 @@
     <Name Value="LCLBase"/>
     <Author Value="Lazarus"/>
     <CompilerOptions>
-      <Version Value="10"/>
+      <Version Value="11"/>
       <SearchPaths>
         <IncludeFiles Value="include"/>
         <OtherUnitFiles Value="forms;widgetset"/>
@@ -12,12 +12,6 @@
       </SearchPaths>
       <Conditionals Value="if SrcOS&lt;>'win' then
   UnitPath := 'nonwin32';"/>
-      <Linking>
-        <Debugging>
-          <GenerateDebugInfo Value="True"/>
-          <DebugInfoType Value="dsAuto"/>
-        </Debugging>
-      </Linking>
       <Other>
         <Verbosity>
           <ShowNotes Value="False"/>
@@ -37,7 +31,7 @@
     <License Value="modified LGPL-2
 "/>
     <Version Major="1" Release="1"/>
-    <Files Count="285">
+    <Files Count="286">
       <Item1>
         <Filename Value="barchart.pp"/>
         <UnitName Value="BarChart"/>
@@ -1184,6 +1178,10 @@
         <HasRegisterProc Value="True"/>
         <UnitName Value="ValEdit"/>
       </Item285>
+      <Item286>
+        <Filename Value="lazcanvas.pas"/>
+        <UnitName Value="lazcanvas"/>
+      </Item286>
     </Files>
     <LazDoc Paths="../docs/xml/lcl"/>
     <i18n>