TAChart: Add "3D" bar style to "bgra" demo. Based on code by "circular".

git-svn-id: trunk@40108 -

components/tachart/demo/bgra/Main.lfm

@@ -138,12 +138,12 @@ object Form1: TForm1
         TabOrder = 0
         object rgAnimation: TRadioGroup
           Left = 1
-          Height = 97
+          Height = 85
           Top = 1
           Width = 120
           Align = alTop
           AutoFill = True
-          Caption = ' Method '
+          Caption = ' Animation '
           ChildSizing.LeftRightSpacing = 6
           ChildSizing.TopBottomSpacing = 6
           ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
@@ -152,7 +152,7 @@ object Form1: TForm1
           ChildSizing.ShrinkVertical = crsScaleChilds
           ChildSizing.Layout = cclLeftToRightThenTopToBottom
           ChildSizing.ControlsPerLine = 1
-          ClientHeight = 79
+          ClientHeight = 67
           ClientWidth = 116
           ItemIndex = 0
           Items.Strings = (
@@ -166,7 +166,7 @@ object Form1: TForm1
         object btnStartStop: TButton
           Left = 6
           Height = 25
-          Top = 178
+          Top = 194
           Width = 75
           Caption = 'Start / stop'
           OnClick = btnStartStopClick
@@ -286,8 +286,8 @@ object Form1: TForm1
         end
         object rgStyle: TRadioGroup
           Left = 1
-          Height = 69
-          Top = 98
+          Height = 85
+          Top = 86
           Width = 120
           Align = alTop
           AutoFill = True
@@ -300,14 +300,15 @@ object Form1: TForm1
           ChildSizing.ShrinkVertical = crsScaleChilds
           ChildSizing.Layout = cclLeftToRightThenTopToBottom
           ChildSizing.ControlsPerLine = 1
-          ClientHeight = 51
+          ClientHeight = 67
           ClientWidth = 116
           ItemIndex = 0
           Items.Strings = (
             'Box'
             'Chocolate'
+            '3D'
           )
-          OnClick = rgAnimationClick
+          OnClick = rgStyleClick
           TabOrder = 2
         end
       end

components/tachart/demo/bgra/Main.pas

@@ -48,6 +48,7 @@ type
     procedure FormDestroy(Sender: TObject);
     procedure PaintBox1Paint(Sender: TObject);
     procedure rgAnimationClick(Sender: TObject);
+    procedure rgStyleClick(Sender: TObject);
   private
     FAnimatedSource: TCustomAnimatedChartSource;
     FSliceScaling: TBGRASliceScaling;
@@ -90,6 +91,87 @@ begin
   end;
 end;
 
+procedure DrawPhong3DBar(ASeries: TBarSeries; ACanvas: TCanvas; ARect: TRect);
+
+  function CreatePhong3DBar(
+    ALightPos: TPoint; ARect: TRect; ADepth: Integer;
+    AColor: TBGRAPixel): TBGRABitmap;
+  var
+    phong: TPhongShading;
+    i: Integer;
+    map: TBGRABitmap;
+    h: TBGRAPixel;
+    t: TPoint;
+  begin
+    t := MaxPoint(ARect.BottomRight - ARect.TopLeft, Point(0, 0));
+    map := TBGRABitmap.Create(t.X + ADepth,t.Y + ADepth);
+    try
+      map.FillRect(0, ADepth, t.X, t.Y + ADepth, BGRAWhite, dmSet);
+      for i := 1 to ADepth do begin
+        h := MapHeightToBGRA((ADepth - i) / ADepth, 255);
+        map.SetHorizLine(i, ADepth - i, t.X - 1 + i - 1, h);
+        map.SetVertLine(t.X - 1 + i, ADepth - i, t.Y + ADepth - 1 - i, h);
+      end;
+      Result := TBGRABitmap.Create(t.X + ADepth, t.Y + ADepth);
+      if (Result.width = 0) or (Result.Height = 0) then exit;
+      phong := TPhongShading.Create;
+      try
+        phong.AmbientFactor := 0.5;
+        phong.LightPosition := ALightPos - ARect.TopLeft;
+        phong.Draw(Result, map, ADepth, 0, 0, AColor);
+      finally
+        phong.Free;
+      end;
+    finally
+      map.Free;
+    end;
+  end;
+
+  function DrawContour(ABar: TBGRABitmap): TPoint;
+  var
+    size: TPoint;
+    temp: TBGRABitmap;
+    margin, depth: integer;
+  begin
+    Result := point(0, 0);
+    if ASeries.BarPen.Style = psClear then exit;
+    size := ARect.BottomRight - ARect.TopLeft;
+    if ASeries.BarPen.Width > 1 then begin
+      margin := (ASeries.BarPen.Width + 1) div 2;
+      Result := Point(margin, margin);
+      temp := TBGRABitmap.Create(ABar.Width + 2 * margin, ABar.Height + 2 * margin);
+      temp.PutImage(Result.X, Result.Y, ABar, dmSet);
+      BGRAReplace(ABar, temp);
+    end;
+    depth := ASeries.Depth;
+    with ABar.CanvasBGRA do begin
+      Pen.Assign(ASeries.BarPen);
+      Brush.Style := bsClear;
+      Polygon([
+         Point(Result.x + 0, Result.y + depth),
+         Point(Result.x + depth, Result.y + 0),
+         Point(Result.x + size.x - 1 + depth, Result.y + 0),
+         Point(Result.x + size.x - 1 + depth, Result.y + size.y - 1),
+         Point(Result.x + size.x - 1, Result.y + size.y - 1 + depth),
+         Point(Result.x + 0, Result.y + size.y - 1 + depth)
+      ]);
+    end;
+  end;
+
+var
+  bar: TBGRABitmap;
+begin
+  bar := CreatePhong3DBar(
+    Point(ASeries.ParentChart.ClientWidth div 2, 0),
+    ARect, ASeries.Depth, ColorToBGRA(ASeries.BarBrush.Color));
+  try
+    with (ARect.TopLeft - DrawContour(bar)) do
+      bar.Draw(ACanvas, X, Y - ASeries.Depth, false);
+  finally
+    bar.Free;
+  end;
+end;
+
 { TForm1 }
 
 procedure TForm1.btnStartStopClick(Sender: TObject);
@@ -158,6 +240,8 @@ begin
           Free;
         end;
     end;
+    2:
+      DrawPhong3DBar(ASender, ACanvas, ARect);
   end;
 end;
 
@@ -229,5 +313,16 @@ begin
   FAnimatedSource.Start;
 end;
 
+procedure TForm1.rgStyleClick(Sender: TObject);
+var
+  d: Integer;
+begin
+  d := IfThen(rgStyle.ItemIndex = 2, 10, 0);
+  chBarEffects.Depth := d;
+  chBarEffectsBarSeries1.Depth := d;
+  chBarEffectsBarSeries1.ZPosition := d;
+  FAnimatedSource.Start;
+end;
+
 end.