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