From 6e67aa98e8652210efa077317d88acde4ed45095 Mon Sep 17 00:00:00 2001
From: juha <juha@lazarus-ide.org>
Date: Sat, 16 Apr 2011 09:55:42 +0000
Subject: [PATCH] LCL: Implemented TCanvas.Frame3D with Delphi compatible
 parameter signature + a wrapper func. Patch by Stephano, issue #8328

git-svn-id: trunk@30305 -
---
 lcl/extctrls.pp        | 10 ++++++++++
 lcl/graphics.pp        |  2 ++
 lcl/include/canvas.inc | 39 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 51 insertions(+)

diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp
index 9fc9c0fe49..219949d630 100644
--- a/lcl/extctrls.pp
+++ b/lcl/extctrls.pp
@@ -1311,6 +1311,9 @@ const
   TCN_SELCHANGE = TCN_FIRST - 1;
   TCN_SELCHANGING = TCN_FIRST - 2;
 
+procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
+  TopColor, BottomColor: TColor; const FrameWidth: integer);
+
 procedure Register;
 
 implementation
@@ -1321,6 +1324,13 @@ uses
 
 {.$define INSTALL_TUNTABBEDNOTEBOOK}
 
+// Wrapper function for TCanvas.Frame3D.
+procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
+  TopColor, BottomColor: TColor; const FrameWidth: integer);
+begin
+  ACanvas.Frame3D(ARect, TopColor, BottomColor, FrameWidth);
+end;
+
 procedure Register;
 begin
   RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]);
diff --git a/lcl/graphics.pp b/lcl/graphics.pp
index 496365f4ed..cbab45aa77 100644
--- a/lcl/graphics.pp
+++ b/lcl/graphics.pp
@@ -1104,6 +1104,8 @@ type
                         FillStyle: TFillStyle); virtual;
     procedure Frame3d(var ARect: TRect; const FrameWidth: integer;
                       const Style: TGraphicsBevelCut); virtual;
+    procedure Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
+                      const FrameWidth: integer); overload;
     procedure Frame(const ARect: TRect); virtual; // border using pen
     procedure Frame(X1,Y1,X2,Y2: Integer);     // border using pen
     procedure FrameRect(const ARect: TRect); virtual; // border using brush
diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc
index f7e2085db1..da6304bda0 100644
--- a/lcl/include/canvas.inc
+++ b/lcl/include/canvas.inc
@@ -970,6 +970,45 @@ begin
   Changed;
 end;
 
+{------------------------------------------------------------------------------
+  Method:   TCanvas.Frame3D
+  Params:   Rect
+  Returns:  the inflated rectangle (the inner rectangle without the frame)
+
+ ------------------------------------------------------------------------------}
+procedure TCanvas.Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
+  const FrameWidth: integer);
+var
+  Delta, W, ii : Integer;
+begin
+  if ARect.Bottom-ARect.Top > ARect.Right-ARect.Left
+  then
+    W := ARect.Right-ARect.Left+1
+  else
+    W := ARect.Bottom-ARect.Top+1;
+
+  if FrameWidth > W then
+    W := W-1
+  else
+    W := FrameWidth;
+
+  for ii := 1 to W do
+  begin
+    Pen.Color := TopColor;
+    MoveTo(ARect.Left,    ARect.Bottom-1);
+    LineTo(ARect.Left,    ARect.Top);
+    LineTo(ARect.Right-1, ARect.Top);
+    Pen.Color := BottomColor;
+    LineTo(ARect.Right-1, ARect.Bottom-1);
+    LineTo(ARect.Left,    ARect.Bottom-1);
+
+    Inc(ARect.Left);
+    Inc(ARect.Top);
+    Dec(ARect.Right);
+    Dec(ARect.Bottom);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   procedure TCanvas.Frame(const ARect: TRect);