1 unit Main;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, ComCtrls, ExtCtrls, StdCtrls, SysUtils, FileUtil, Forms, Controls,
9   Graphics, Dialogs, TAGraph, TAGUIConnectorBGRA, TASeries, TASources,
10   TAAnimatedSource, TACustomSource, BGRASliceScaling;
11 
12 type
13 
14   { TForm1 }
15 
16   TForm1 = class(TForm)
17     btnStartStop: TButton;
18     cbAntialiasing: TCheckBox;
19     cbPie: TCheckBox;
20     ChartGUIConnectorBGRA1: TChartGUIConnectorBGRA;
21     cbUseConnector: TCheckBox;
22     chSimple: TChart;
23     chSimpleAreaSeries1: TAreaSeries;
24     chSimpleBarSeries1: TBarSeries;
25     chSimpleLineSeries1: TLineSeries;
26     chSimplePieSeries1: TPieSeries;
27     chBarEffects: TChart;
28     chBarEffectsBarSeries1: TBarSeries;
29     Image1: TImage;
30     ListChartSource1: TListChartSource;
31     PageControl1: TPageControl;
32     PaintBox1: TPaintBox;
33     Panel1: TPanel;
34     Panel2: TPanel;
35     RandomChartSource1: TRandomChartSource;
36     rgAnimation: TRadioGroup;
37     rgStyle: TRadioGroup;
38     Splitter1: TSplitter;
39     tsSimple: TTabSheet;
40     tsBarEffects: TTabSheet;
41     procedure btnStartStopClick(Sender: TObject);
42     procedure cbAntialiasingChange(Sender: TObject);
43     procedure cbPieChange(Sender: TObject);
44     procedure cbUseConnectorChange(Sender: TObject);
45     procedure chSimpleAfterPaint(ASender: TChart);
46     procedure chBarEffectsBarSeries1BeforeDrawBar(ASender: TBarSeries;
47       ACanvas: TCanvas; const ARect: TRect; APointIndex, AStackIndex: Integer;
48       var ADoDefaultDrawing: Boolean);
49     procedure FormCreate(Sender: TObject);
50     procedure FormDestroy(Sender: TObject);
51     procedure PaintBox1Paint(Sender: TObject);
52     procedure rgAnimationClick(Sender: TObject);
53     procedure rgStyleClick(Sender: TObject);
54   private
55     FAnimatedSource: TCustomAnimatedChartSource;
56     FSliceScaling: TBGRASliceScaling;
57     procedure OnGetItem(
58       ASource: TCustomAnimatedChartSource;
59       AIndex: Integer; var AItem: TChartDataItem);
60   end;
61 
62 var
63   Form1: TForm1;
64 
65 implementation
66 
67 {$R *.lfm}
68 
69 uses
70   Math, BGRABitmap, BGRABitmapTypes, BGRAGradients,
71   TABGRAUtils, TAChartUtils, TADrawerBGRA, TADrawerCanvas, TADrawUtils,
72   TAGeometry;
73 
74 { TForm1 }
75 
76 procedure TForm1.btnStartStopClick(Sender: TObject);
77 begin
78   if FAnimatedSource.IsAnimating then
79     FAnimatedSource.Stop
80   else
81     FAnimatedSource.Start;
82 end;
83 
84 procedure TForm1.cbAntialiasingChange(Sender: TObject);
85 begin
86   if cbAntialiasing.Checked then
87     chSimple.AntialiasingMode := amOn
88   else
89     chSimple.AntialiasingMode := amOff;
90 end;
91 
92 procedure TForm1.cbPieChange(Sender: TObject);
93 begin
94   chSimplePieSeries1.Active := cbPie.Checked;
95 end;
96 
97 procedure TForm1.cbUseConnectorChange(Sender: TObject);
98 begin
99   if cbUseConnector.Checked then
100     chSimple.GUIConnector := ChartGUIConnectorBGRA1
101   else
102     chSimple.GUIConnector := nil;
103 end;
104 
105 procedure TForm1.chSimpleAfterPaint(ASender: TChart);
106 begin
107   Unused(ASender);
108   PaintBox1.Invalidate;
109 end;
110 
111 procedure TForm1.chBarEffectsBarSeries1BeforeDrawBar(ASender: TBarSeries;
112   ACanvas: TCanvas; const ARect: TRect; APointIndex, AStackIndex: Integer;
113   var ADoDefaultDrawing: Boolean);
114 var
115   temp, stretched: TBGRABitmap;
116   sz: TPoint;
117   lightPos: TPoint;
118 begin
119   Unused(ASender);
120   Unused(APointIndex, AStackIndex);
121   ADoDefaultDrawing := false;
122   sz := ARect.BottomRight - ARect.TopLeft;
123   case rgStyle.ItemIndex of
124     0: begin
125       temp := TBGRABitmap.Create(
126         FSliceScaling.BitmapWidth,
127         Round(FSliceScaling.BitmapWidth * sz.Y / sz.X));
128       stretched := nil;
129       try
130         FSliceScaling.Draw(temp, 0, 0, temp.Width, temp.Height);
131         temp.ResampleFilter := rfLinear;
132         stretched := temp.Resample(sz.x, sz.Y, rmFineResample) as TBGRABitmap;
133         stretched.Draw(ACanvas, ARect, False);
134       finally
135         temp.Free;
136         stretched.Free;
137       end;
138     end;
139     1: DrawChocolateBar(ASender, ACanvas, ARect, APointIndex, false);
140     2: DrawPhong3DBar(ASender, ACanvas, ARect, APointIndex);
141   end;
142 end;
143 
144 procedure TForm1.FormCreate(Sender: TObject);
145 begin
146   FAnimatedSource := TCustomAnimatedChartSource.Create(Self);
147   FAnimatedSource.Origin := ListChartSource1;
148   FAnimatedSource.AnimationInterval := 30;
149   FAnimatedSource.AnimationTime := 1000;
150   FAnimatedSource.OnGetItem := @OnGetItem;
151 
152   chBarEffectsBarSeries1.Source := FAnimatedSource;
153   chBarEffects.BackColor:= BGRAToColor(CSSDarkSlateBlue);
154   chSimple.BackColor:= BGRAToColor(CSSYellowGreen);
155   chSimple.Color:= BGRAToColor(CSSYellowGreen);
156   chSimple.BackColor := BGRAToColor(CSSBeige);
157 
158   FSliceScaling := TBGRASliceScaling.Create(Image1.Picture.Bitmap, 70, 0, 35, 0);
159   FSliceScaling.AutodetectRepeat;
160 end;
161 
162 procedure TForm1.FormDestroy(Sender: TObject);
163 begin
164   FSliceScaling.Free;
165 end;
166 
167 procedure TForm1.PaintBox1Paint(Sender: TObject);
168 var
169   bmp: TBGRABitmap;
170   id: IChartDrawer;
171   rp: TChartRenderingParams;
172 begin
173   bmp := TBGRABitmap.Create(PaintBox1.Width, PaintBox1.Height);
174   chSimple.DisableRedrawing;
175   try
176     chSimple.Title.Text.Text := 'BGRABitmap';
177     id := TBGRABitmapDrawer.Create(bmp);
178     id.DoGetFontOrientation := @CanvasGetFontOrientationFunc;
179     rp := chSimple.RenderingParams;
180     chSimple.Draw(id, Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
181     chSimple.RenderingParams := rp;
182     bmp.Draw(PaintBox1.Canvas, 0, 0);
183     chSimple.Title.Text.Text := 'Standard';
184   finally
185     chSimple.EnableRedrawing;
186     bmp.Free;
187   end;
188 end;
189 
190 procedure TForm1.OnGetItem(
191   ASource: TCustomAnimatedChartSource;
192   AIndex: Integer; var AItem: TChartDataItem);
193 begin
194   case rgAnimation.ItemIndex of
195   0: AItem.Y *= ASource.Progress;
196   1:
197     if ASource.Count * ASource.Progress < AIndex then
198       AItem.Y := 0;
199   2:
200     case Sign(Trunc(ASource.Count * ASource.Progress) - AIndex) of
201       0: AItem.Y *= Frac(ASource.Count * ASource.Progress);
202       -1: AItem.Y := 0;
203     end;
204   end;
205 end;
206 
207 procedure TForm1.rgAnimationClick(Sender: TObject);
208 begin
209   FAnimatedSource.Start;
210 end;
211 
212 procedure TForm1.rgStyleClick(Sender: TObject);
213 var
214   d: Integer;
215 begin
216   d := IfThen(rgStyle.ItemIndex = 2, 10, 0);
217   chBarEffects.Depth := d;
218   chBarEffectsBarSeries1.Depth := d;
219   chBarEffectsBarSeries1.ZPosition := d;
220   chBarEffects.BottomAxis.ZPosition := d;
221   FAnimatedSource.Start;
222 end;
223 
224 end.
225 
226