source: trunk/Sibyl/Addon/CHART.PAS@ 377

Last change on this file since 377 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 121.5 KB
Line 
1//Chart Components for Sibyl (Normal and Database aware)
2//for this version, the property editors are missing and will be added soon.
3//For these components demos are also available (PIEDEMO.SPR and BARDEMO.SPR)
4//(C) 1997 SpeedSoft
5//Disclosure prohibited, Comments and suggestions welcome
6//- mail to 100614.306@compuserve.com !
7
8
9Unit Chart;
10
11Interface
12
13Uses
14 SysUtils,Classes, Forms, Graphics, ExtCtrls, StdCtrls, Buttons,
15 DbBase;
16
17Type
18 TChart=Class;
19 TChartSeries=Class;
20
21 //Chart series values
22 TChartValue=Class
23 Private
24 FValue:Extended;
25 FSerie:TChartSeries;
26 FOutlined:Boolean;
27 FOutlineColor:TColor;
28 FFillColor:TColor;
29 FLabel:PString;
30 FStartAngle,FSweepAngle:Extended;
31 FEndPoint:TPoint;
32 FProcessed:Boolean;
33 Private
34 Procedure SetOutlined(NewValue:Boolean);
35 Procedure SetOutlineColor(NewValue:TColor);
36 Procedure SetFillColor(NewValue:TColor);
37 Function GetLabel:String;
38 Procedure SetLabel(Const NewValue:String);
39 Procedure SetValue(Const NewValue:Extended);
40 Public
41 Constructor Create(Serie:TChartSeries;Outlined:Boolean;
42 OutlineColor,FillColor:TColor;
43 Const aLabel:String;Value:Extended);Virtual;
44 Destructor Destroy;Override;
45 Public
46 Property Outlined:Boolean read FOutlined write SetOutlined;
47 Property OutlineColor:TColor read FOutlineColor write SetOutlineColor;
48 Property FillColor:TColor read FFillColor write SetFillColor;
49 Property ValueLabel:String read GetLabel write SetLabel;
50 Property Value:Extended read FValue write SetValue;
51 Property Serie:TChartSeries read FSerie;
52 End;
53
54 {$M+}
55 TSeriesTitleAlignment=(staLeft,staCenter,staRight);
56 TSeriesMarksStyle=(smsValue,smsPercent,smsLabel,smsLabelPercent,
57 smsLabelValue,smsLegend);
58 {$M-}
59
60 //Chart marks
61 TSeriesMarks=Class
62 Private
63 FTransparent:Boolean;
64 FArrowPen:TPenStyle;
65 FArrowColor:TColor;
66 FArrowLength:LongInt;
67 FBackColor:TColor;
68 FBorderColor:TColor;
69 FBorderPen:TPenStyle;
70 FFont:TFont;
71 FStyle:TSeriesMarksStyle;
72 FVisible:Boolean;
73 FSerie:TChartSeries;
74 FFormatStr:PChar;
75 FMargin:LongInt;
76 Private
77 Procedure SetTransparent(NewValue:Boolean);
78 Procedure SetArrowPen(NewValue:TPenStyle);
79 Procedure SetArrowColor(NewValue:TColor);
80 Procedure SetArrowLength(NewValue:LongInt);
81 Procedure SetBackColor(NewValue:TColor);
82 Procedure SetBorderColor(NewValue:TColor);
83 Procedure SetBorderPen(NewValue:TPenStyle);
84 Function GetFont:TFont;
85 Procedure SetFont(NewValue:TFont);
86 Procedure SetStyle(NewValue:TSeriesMarksStyle);
87 Procedure SetVisible(NewValue:Boolean);
88 Function GetFormatStr:String;
89 Procedure SetFormatStr(Const NewValue:String);
90 Procedure SetMargin(NewValue:LongInt);
91 Public
92 Constructor Create(Serie:TChartSeries);Virtual;
93 Destructor Destroy;Override;
94 Public
95 Property Transparent:Boolean read FTransparent write SetTransparent;
96 Property ArrowPen:TPenStyle read FArrowPen write SetArrowPen;
97 Property ArrowColor:TColor read FArrowColor write SetArrowColor;
98 Property ArrowLength:LongInt read FArrowLength write SetArrowLength;
99 Property BackColor:TColor read FBackColor write SetBackColor;
100 Property Style:TSeriesMarksStyle read FStyle write SetStyle;
101 Property Font:TFont read GetFont write SetFont;
102 Property BorderPen:TPenStyle read FBorderPen write SetBorderPen;
103 Property BorderColor:TColor read FBorderColor write SetBorderColor;
104 Property Visible:Boolean read FVisible write SetVisible;
105 Property Serie:TChartSeries read FSerie;
106 Property FormatStr:String read GetFormatStr write SetFormatStr;
107 Property Margin:LongInt read FMargin write SetMargin;
108 End;
109
110 //Chart series
111 TChartSeries=Class(TComponent)
112 Private
113 FChart:TChart;
114 FValues:TList;
115 FTitle:TStrings;
116 FTitleVisible:Boolean;
117 FTitleAlignment:TSeriesTitleAlignment;
118 FActive:Boolean;
119 FMarks:TSeriesMarks;
120 FFont:TFont;
121 FTitleColor:TColor;
122 FDataLink:TTableDataLink;
123 FLabelSource:PString;
124 FValueSource:PString;
125 Private
126 Function GetValueCount:LongInt;
127 Function GetChartValue(Index:LongInt):TChartValue;
128 Procedure SetTitleAlignment(NewValue:TSeriesTitleAlignment);
129 Procedure SetTitleVisible(NewValue:Boolean);
130 Procedure SetTitle(NewValue:TStrings);
131 Procedure SetActive(NewValue:Boolean);
132 Function GetFont:TFont;
133 Procedure SetFont(NewValue:TFont);
134 Procedure SetTitleColor(NewValue:TColor);
135 Procedure SetDataSource(NewValue:TDataSource);
136 Function GetDataSource:TDataSource;
137 Function GetLabelSource:String;
138 Procedure SetLabelSource(Const NewValue:String);
139 Function GetValueSource:String;
140 Procedure SetValueSource(Const NewValue:String);
141 Procedure SetDBValues(Update:Boolean);
142 Protected
143 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
144 Public
145 Constructor Create(Chart:TChart;Title:TStrings;TitleVisible:Boolean;
146 TitleAlignment:TSeriesTitleAlignment);Virtual;
147 Destructor Destroy;Override;
148 Procedure AddValue(Const Value:Extended;Const aLabel:String;
149 Outlined:Boolean;OutlineColor,FillColor:TColor);
150 Procedure AddAutoValue(Const Value:Extended;Const aLabel:String;
151 Outlined:Boolean;OutlineColor:TColor);
152 Procedure AddY(Const Value:Extended;Const aLabel:String;FillColor:TColor);
153 Procedure RemoveValue(Index:LongInt);
154 Procedure ClearValues;
155 Public
156 Property Active:Boolean read FActive write SetActive;
157 Property ValueCount:LongInt read GetValueCount;
158 Property Values[Index:LongInt]:TChartValue read GetChartValue;
159 Property Chart:TChart read FChart;
160 Property TitleAlignment:TSeriesTitleAlignment read FTitleAlignment write SetTitleAlignment;
161 Property TitleVisible:Boolean read FTitleVisible write SetTitleVisible;
162 Property Title:TStrings read FTitle write SetTitle;
163 Property TitleColor:TColor read FTitleColor write SetTitleColor;
164 Property Marks:TSeriesMarks read FMarks;
165 Property Font:TFont read GetFont write SetFont;
166 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
167 Property ValueSource:String read GetValueSource write SetValueSource;
168 Property LabelSource:String read GetLabelSource write SetLabelSource;
169 End;
170
171 {$M+}
172 TLegendAlignment=(laLeft,laRight,laTop,laBottom);
173 TLegendTextStyle=(ltsPlain,ltsLeftValue,ltsRightValue,ltsLeftPercent,
174 ltsRightPercent);
175 {$M-}
176
177 //Chart legend
178 TChartLegend=Class
179 Private
180 FChart:TChart;
181 FAlignment:TLegendAlignment;
182 FShadowColor:TColor;
183 FShadowSize:Byte;
184 FTextStyle:TLegendTextStyle;
185 FFrameColor:TColor;
186 FFrameStyle:TPenStyle;
187 FVisible:Boolean;
188 FMaxLines:Byte;
189 FTopPosPercentage:Byte;
190 FColorWidthPercentage:Byte;
191 FXMargin:Byte;
192 FYMargin:Byte;
193 FFont:TFont;
194 FFormatStr:PString;
195 FBackColor:TColor;
196 Private
197 Procedure SetAlignment(NewValue:TLegendAlignment);
198 Procedure SetShadowColor(NewValue:TColor);
199 Procedure SetShadowSize(NewValue:Byte);
200 Procedure SetTextStyle(NewValue:TLegendTextStyle);
201 Procedure SetFrameColor(NewValue:TColor);
202 Procedure SetFrameStyle(NewValue:TPenStyle);
203 Procedure SetVisible(NewValue:Boolean);
204 Procedure SetMaxLines(NewValue:Byte);
205 Procedure SetTopPosPercentage(NewValue:Byte);
206 Procedure SetColorWidthPercentage(NewValue:Byte);
207 Procedure SetXMargin(NewValue:Byte);
208 Procedure SetYMargin(NewValue:Byte);
209 Function GetFont:TFont;
210 Procedure SetFont(NewValue:TFont);
211 Function GetFormatStr:String;
212 Procedure SetFormatStr(Const NewValue:String);
213 Procedure SetBackColor(NewValue:TColor);
214 Public
215 Constructor Create(Chart:TChart);Virtual;
216 Destructor Destroy;Override;
217 Public
218 Property Chart:TChart read FChart;
219 Property Alignment:TLegendAlignment read FAlignment write SetAlignment;
220 Property ShadowColor:TColor read FShadowColor write SetShadowColor;
221 Property ShadowSize:Byte read FShadowSize write SetShadowSize;
222 Property TextStyle:TLegendTextStyle read FTextStyle write SetTextStyle;
223 Property FrameColor:TColor read FFrameColor write SetFrameColor;
224 Property FrameStyle:TPenStyle read FFrameStyle write SetFrameStyle;
225 Property Visible:Boolean read FVisible write SetVisible;
226 Property MaxLines:Byte read FMaxLines write SetMaxLines;
227 Property TopPosPercentage:Byte read FTopPosPercentage write SetTopPosPercentage;
228 Property ColorWidthPercentage:Byte read FColorWidthPercentage write SetColorWidthPercentage;
229 Property XMargin:Byte read FXMargin write SetXMargin;
230 Property YMargin:Byte read FYMargin write SetYMargin;
231 Property Font:TFont read GetFont write SetFont;
232 Property FormatStr:String read GetFormatStr write SetFormatStr;
233 Property BackColor:TColor read FBackColor write SetBackColor;
234 End;
235
236 {$M+}
237 TGradientStyle=(grsNone,grsLeftRight,grsRightLeft,grsBottomTop,grsTopBottom);
238 {$M-}
239
240 //Abtract chart base class
241 TChart=Class(TPanel)
242 Private
243 FSeries:TList;
244 FView3D:Boolean;
245 FPercent3D:Byte;
246 FUpdateCount:LongInt;
247 FMarginLeft,FMarginRight,FMarginBottom,FMarginTop:Byte;
248 FGradientStyle:TGradientStyle;
249 FGradientStart:TColor;
250 FGradientEnd:TColor;
251 FLegend:TChartLegend;
252 FDesignSerie:TChartSeries;
253 Private
254 Procedure SetView3D(NewValue:Boolean);
255 Procedure SetPercent3D(NewValue:Byte);
256 Function GetSeriesCount:LongInt;
257 Function GetChartSerie(Index:LongInt):TChartSeries;
258 Procedure SetMarginLeft(NewValue:Byte);
259 Procedure SetMarginRight(NewValue:Byte);
260 Procedure SetMarginBottom(NewValue:Byte);
261 Procedure SetMarginTop(NewValue:Byte);
262 Procedure SetGradientStyle(NewValue:TGradientStyle);
263 Procedure SetGradientStart(NewValue:TColor);
264 Procedure SetGradientEnd(NewValue:TColor);
265 Procedure CreateDesignSerie;
266 Procedure DrawGradient(rc:TRect;HColor,LColor:TColor;Style:TGradientStyle);
267 Protected
268 Function GetChartStrDim(v:TChartValue;Var CX,CY:LongInt):String;Virtual;
269 Procedure InvalidateGraph;Virtual;
270 Procedure DrawLegend(Serie:TChartSeries;Var ClientRect:TRect);Virtual;
271 Function GetLegendExtent(Serie:TChartSeries;Var CX,CY,ColorWidth:LongInt;
272 Width,Height:LongInt):LongInt;Virtual;
273 Public
274 Procedure SetupComponent;Override;
275 Destructor Destroy;Override;
276 Procedure AddSerie(Title:String;TitleVisible:Boolean;
277 TitleAlignment:TSeriesTitleAlignment);
278 Procedure BeginUpdate;
279 Procedure EndUpdate;
280 Function DrawChartFrame:TRect;
281 Public
282 Property SeriesCount:LongInt read GetSeriesCount;
283 Property Series[Index:LongInt]:TChartSeries read GetChartSerie;
284 Property Legend:TChartLegend read FLegend;
285 Published
286 Property View3D:Boolean read FView3D write SetView3D;
287 Property Percent3D:Byte read FPercent3D write SetPercent3D;
288 Property MarginLeft:Byte read FMarginLeft write SetMarginLeft;
289 Property MarginRight:Byte read FMarginRight write SetMarginRight;
290 Property MarginBottom:Byte read FMarginBottom write SetMarginBottom;
291 Property MarginTop:Byte read FMarginTop write SetMarginTop;
292 Property GradientStyle:TGradientStyle read FGradientStyle write SetGradientStyle;
293 Property GradientStart:TColor read FGradientStart write SetGradientStart;
294 Property GradientEnd:TColor read FGradientEnd write SetGradientEnd;
295 End;
296
297 //Pie Chart
298 TPieChart=Class(TChart)
299 Private
300 FRotation:Word;
301 FCircled:Boolean;
302 Private
303 Procedure SetRotation(NewValue:Word);
304 Procedure SetCircled(NewValue:Boolean);
305 Procedure CalcMarksRect(Serie:TChartSeries;Var PieRect:TRect);
306 Procedure DrawMarks(s:TChartSeries;PieRect:TRect;
307 PieBottom,CenterX,CenterY,RadiusX,RadiusY:LongInt;
308 ChartRect:TRect;HandleClip:Boolean);
309 Protected
310 Procedure InvalidateGraph;Override;
311 Public
312 Procedure SetupComponent;Override;
313 Procedure Redraw(Const rec:TRect);Override;
314 Published
315 Property Rotation:Word read FRotation write SetRotation;
316 Property Circled:Boolean read FCircled write SetCircled;
317 End;
318
319 TDBPieChart=Class(TPieChart)
320 Private
321 Procedure SetDataSource(NewValue:TDataSource);
322 Function GetDataSource:TDataSource;
323 Function GetLabelSource:String;
324 Procedure SetLabelSource(Const NewValue:String);
325 Function GetValueSource:String;
326 Procedure SetValueSource(Const NewValue:String);
327 Public
328 Procedure Redraw(Const rec:TRect);Override;
329 Published
330 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
331 Property ValueSource:String read GetValueSource write SetValueSource;
332 Property LabelSource:String read GetLabelSource write SetLabelSource;
333 End;
334
335 TBarChartStyle=(bcsRectangle,bcsRectGradient);
336
337 TBarChart=Class(TChart)
338 Private
339 FPercentBarWidth:Byte;
340 FPercentBarOffset:Integer;
341 FPointsPerPage:LongWord;
342 FLeftWallVisible:Boolean;
343 FLeftWallColor:TColor;
344 FBottomWallVisible:Boolean;
345 FBottomWallColor:TColor;
346 FBackWallVisible:Boolean;
347 FBackWallColor:TColor;
348 FSeparationPercent:Byte;
349 FVAxisGrid:Boolean;
350 FHAxisGrid:Boolean;
351 FAxisFormatStr:PString;
352 FVAxisVisible:Boolean;
353 FHAxisVisible:Boolean;
354 FVAxisTicksLen:Byte;
355 FHAxisTicksLen:Byte;
356 FStyle:TBarChartStyle;
357 Private
358 Procedure SetPercentBarWidth(NewValue:Byte);
359 Procedure SetPercentBarOffset(NewValue:Integer);
360 Procedure SetPointsPerPage(NewValue:LongWord);
361 Procedure SetLeftWallVisible(NewValue:Boolean);
362 Procedure SetLeftWallColor(NewValue:TColor);
363 Procedure SetBottomWallVisible(NewValue:Boolean);
364 Procedure SetBottomWallColor(NewValue:TColor);
365 Procedure SetBackWallVisible(NewValue:Boolean);
366 Procedure SetBackWallColor(NewValue:TColor);
367 Procedure SetSeparationPercent(NewValue:Byte);
368 Procedure SetVAxisGrid(NewValue:Boolean);
369 Procedure SetHAxisGrid(NewValue:Boolean);
370 Function GetAxisFormatStr:String;
371 Procedure SetAxisFormatStr(Const NewValue:String);
372 Procedure SetVAxisVisible(NewValue:Boolean);
373 Procedure SetHAxisVisible(NewValue:Boolean);
374 Procedure SetVAxisTicksLen(NewValue:Byte);
375 Procedure SetHAxisTicksLen(NewValue:Byte);
376 Procedure SetStyle(NewValue:TBarChartStyle);
377 Protected
378 Procedure InvalidateGraph;Override;
379 Public
380 Procedure SetupComponent;Override;
381 Destructor Destroy;Override;
382 Procedure Redraw(Const rec:TRect);Override;
383 Published
384 Property PercentBarWidth:Byte read FPercentBarWidth write SetPercentBarWidth;
385 Property PercentBarOffset:Integer read FPercentBarOffset write SetPercentBarOffset;
386 Property PointsPerPage:LongWord read FPointsPerPage write SetPointsPerPage;
387 Property LeftWallVisible:Boolean read FLeftWallVisible write SetLeftWallVisible;
388 Property LeftWallColor:TColor read FLeftWallColor write SetLeftWallColor;
389 Property BottomWallVisible:Boolean read FBottomWallVisible write SetBottomWallVisible;
390 Property BottomWallColor:TColor read FBottomWallColor write SetBottomWallColor;
391 Property BackWallVisible:Boolean read FBackWallVisible write SetBackWallVisible;
392 Property BackWallColor:TColor read FBackWallColor write SetBackWallColor;
393 Property SeparationPercent:Byte read FSeparationPercent write SetSeparationPercent;
394 Property VAxisGrid:Boolean read FVAxisGrid write SetVAxisGrid;
395 Property HAxisGrid:Boolean read FHAxisGrid write SetHAxisGrid;
396 Property AxisFormatStr:String read GetAxisFormatStr write SetAxisFormatStr;
397 Property VAxisVisible:Boolean read FVAxisVisible write SetVAxisVisible;
398 Property HAxisVisible:Boolean read FHAxisVisible write SetHAxisVisible;
399 Property VAxisTicksLen:Byte read FVAxisTicksLen write SetVAxisTicksLen;
400 Property HAxisTicksLen:Byte read FHAxisTicksLen write SetHAxisTicksLen;
401 Property Style:TBarChartStyle read FStyle write SetStyle;
402 End;
403
404 TDBBarChart=Class(TBarChart)
405 Private
406 Procedure SetDataSource(NewValue:TDataSource);
407 Function GetDataSource:TDataSource;
408 Function GetLabelSource:String;
409 Procedure SetLabelSource(Const NewValue:String);
410 Function GetValueSource:String;
411 Procedure SetValueSource(Const NewValue:String);
412 Public
413 Procedure Redraw(Const rec:TRect);Override;
414 Published
415 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
416 Property ValueSource:String read GetValueSource write SetValueSource;
417 Property LabelSource:String read GetLabelSource write SetLabelSource;
418 End;
419
420Implementation
421
422{$IFDEF OS2}
423Uses PmWin,PmGpi;
424{$ENDIF}
425{$IFDEF WIN32}
426Uses WinUser,WinGDI;
427{$ENDIF}
428
429
430{
431ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
432º º
433º Speed-Pascal/2 Version 2.0 º
434º º
435º Speed-Pascal Component Classes (SPCC) º
436º º
437º This section: TChartValue Class Implementation º
438º º
439º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
440º º
441ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
442}
443
444Procedure TChartValue.SetOutlined(NewValue:Boolean);
445Begin
446 If FOutlined=NewValue Then exit;
447 FOutlined:=NewValue;
448 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
449End;
450
451Procedure TChartValue.SetOutlineColor(NewValue:TColor);
452Begin
453 If FOutlineColor=NewValue Then exit;
454 FOutlineColor:=NewValue;
455 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
456End;
457
458Procedure TChartValue.SetFillColor(NewValue:TColor);
459Begin
460 If FFillColor=NewValue Then exit;
461 FFillColor:=NewValue;
462 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
463End;
464
465Function TChartValue.GetLabel:String;
466Begin
467 If FLabel<>Nil Then Result:=FLabel^
468 Else Result:='';
469End;
470
471Procedure TChartValue.SetLabel(Const NewValue:String);
472Begin
473 If FLabel<>Nil Then
474 Begin
475 If FLabel^=NewValue Then exit;
476 FreeMem(FLabel,length(FLabel^)+1);
477 End;
478 GetMem(FLabel,length(NewValue)+1);
479 FLabel^:=NewValue;
480 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
481End;
482
483Procedure TChartValue.SetValue(Const NewValue:Extended);
484Begin
485 If FValue=NewValue Then exit;
486 FValue:=NewValue;
487 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
488End;
489
490Constructor TChartValue.Create(Serie:TChartSeries;Outlined:Boolean;
491 OutlineColor,FillColor:TColor;
492 Const aLabel:String;Value:Extended);
493Begin
494 Inherited Create;
495
496 FSerie:=Serie;
497 FOutlined:=Outlined;
498 FOutlineColor:=OutlineColor;
499 FFillColor:=FillColor;
500 GetMem(FLabel,length(aLabel)+1);
501 FLabel^:=aLabel;
502 FValue:=Value;
503End;
504
505Destructor TChartValue.Destroy;
506Begin
507 FSerie.FValues.Remove(Self);
508 If FLabel<>Nil Then FreeMem(FLabel,length(FLabel^)+1);
509 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
510
511 Inherited Destroy;
512End;
513
514{
515ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
516º º
517º Speed-Pascal/2 Version 2.0 º
518º º
519º Speed-Pascal Component Classes (SPCC) º
520º º
521º This section: TSeriesMarks Class Implementation º
522º º
523º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
524º º
525ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
526}
527
528Procedure TSeriesMarks.SetTransparent(NewValue:Boolean);
529Begin
530 If NewValue=FTransparent Then exit;
531 FTransparent:=NewValue;
532 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
533End;
534
535Procedure TSeriesMarks.SetArrowPen(NewValue:TPenStyle);
536Begin
537 If NewValue=FArrowPen Then exit;
538 FArrowPen:=NewValue;
539 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
540End;
541
542Procedure TSeriesMarks.SetArrowColor(NewValue:TColor);
543Begin
544 If NewValue=FArrowColor Then exit;
545 FArrowColor:=NewValue;
546 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
547End;
548
549Procedure TSeriesMarks.SetArrowLength(NewValue:LongInt);
550Begin
551 If NewValue=FArrowLength Then exit;
552 FArrowLength:=NewValue;
553 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
554End;
555
556Procedure TSeriesMarks.SetBackColor(NewValue:TColor);
557Begin
558 If NewValue=FBackColor Then exit;
559 FBackColor:=NewValue;
560 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
561End;
562
563Procedure TSeriesMarks.SetBorderColor(NewValue:TColor);
564Begin
565 If NewValue=FBorderColor Then exit;
566 FBorderColor:=NewValue;
567 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
568End;
569
570Procedure TSeriesMarks.SetBorderPen(NewValue:TPenStyle);
571Begin
572 If NewValue=FBorderPen Then exit;
573 FBorderPen:=NewValue;
574 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
575End;
576
577Procedure TSeriesMarks.SetFont(NewValue:TFont);
578Begin
579 If FFont=NewValue Then exit;
580 FFont:=NewValue;
581 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
582End;
583
584Function TSeriesMarks.GetFont:TFont;
585Begin
586 If FFont=Nil Then Result:=FSerie.FChart.Font
587 Else Result:=FFont;
588End;
589
590
591Procedure TSeriesMarks.SetStyle(NewValue:TSeriesMarksStyle);
592Begin
593 If FStyle=NewValue Then exit;
594 FStyle:=NewValue;
595 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
596End;
597
598Procedure TSeriesMarks.SetVisible(NewValue:Boolean);
599Begin
600 If FVisible=NewValue Then exit;
601 FVisible:=NewValue;
602 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
603End;
604
605Constructor TSeriesMarks.Create(Serie:TChartSeries);
606Begin
607 Inherited Create;
608
609 FSerie:=Serie;
610 FVisible:=True;
611 FTransparent:=False;
612 FArrowPen:=psSolid;
613 FArrowLength:=5;
614 FArrowColor:=clBlack;
615 FBackColor:=clInfo;
616 FBorderPen:=psSolid;
617 FStyle:=smsLabelValue;
618 FMargin:=10;
619End;
620
621Destructor TSeriesMarks.Destroy;
622Begin
623 If FFormatStr<>Nil Then FreeMem(FFormatStr,length(FFormatStr^)+1);
624 Inherited Destroy;
625End;
626
627Function TSeriesMarks.GetFormatStr:String;
628Begin
629 If FFormatStr<>Nil Then Result:=FFormatStr^
630 Else Result:='';
631End;
632
633Procedure TSeriesMarks.SetFormatStr(Const NewValue:String);
634Begin
635 If FFormatStr<>Nil Then
636 Begin
637 If FFormatStr^=NewValue Then exit;
638 FreeMem(FFormatStr,length(FFormatStr^)+1);
639 End;
640 GetMem(FFormatStr,length(NewValue)+1);
641 FFormatStr^:=NewValue;
642 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
643End;
644
645Procedure TSeriesMarks.SetMargin(NewValue:LongInt);
646Begin
647 If NewValue=FMargin Then exit;
648 FMargin:=NewValue;
649 If FSerie.FChart.FUpdateCount=0 Then FSerie.FChart.Invalidate;
650End;
651
652{
653ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
654º º
655º Speed-Pascal/2 Version 2.0 º
656º º
657º Speed-Pascal Component Classes (SPCC) º
658º º
659º This section: TChartSeries Class Implementation º
660º º
661º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
662º º
663ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
664}
665
666Constructor TChartSeries.Create(Chart:TChart;Title:TStrings;TitleVisible:Boolean;
667 TitleAlignment:TSeriesTitleAlignment);
668Begin
669 Inherited Create(Nil);
670
671 FChart:=Chart;
672 FValues.Create;
673 FMarks.Create(Self);
674 FTitle:=TStringList.Create;
675 FTitle.Assign(Title);
676 FTitleVisible:=TitleVisible;
677 FTitleColor:=clBlack;
678 FDataLink.Create(Self);
679 FDataLink.OnDataChange:=DataChange;
680 Include(FDataLink.ComponentState, csDetail);
681End;
682
683Destructor TChartSeries.Destroy;
684Var
685 l:LongInt;
686Begin
687 FDataLink.OnDataChange:=Nil;
688 FDataLink.Destroy;
689 FDataLink:=Nil;
690 If FLabelSource<>Nil Then FreeMem(FLabelSource,length(FLabelSource^)+1);
691 FLabelSource:=Nil;
692 If FValueSource<>Nil Then FreeMem(FValueSource,length(FValueSource^)+1);
693 FValueSource:=Nil;
694
695 FTitle.Destroy;
696 FTitle:=Nil;
697 If Self<>FChart.FDesignSerie Then FChart.FSeries.Remove(Self);
698
699 l:=FChart.FUpdateCount;
700 ClearValues;
701 FValues.Destroy;
702 FValues:=Nil;
703 FMarks.Destroy;
704 FMarks:=Nil;
705 FChart.FUpdateCount:=l;
706
707 Inherited Destroy;
708End;
709
710Procedure TChartSeries.RemoveValue(Index:LongInt);
711Var v:TChartValue;
712 l:LongInt;
713Begin
714 l:=FChart.FUpdateCount;
715 FChart.FUpdateCount:=1;
716 v:=FValues[Index];
717 v.Destroy;
718 FChart.FUpdateCount:=l;
719 If FChart.FUpdateCount=0 THEN FChart.Invalidate;
720End;
721
722Procedure TChartSeries.ClearValues;
723Var l,t:LongInt;
724 v:TChartValue;
725Begin
726 l:=FChart.FUpdateCount;
727 FChart.FUpdateCount:=1;
728 For t:=FValues.Count-1 Downto 0 Do
729 Begin
730 v:=FValues[t];
731 v.Destroy;
732 End;
733 FChart.FUpdateCount:=l;
734 If FChart.FUpdateCount=0 THEN FChart.Invalidate;
735End;
736
737Procedure TChartSeries.SetDBValues(Update:Boolean);
738Var DataSet:TDataSet;
739 t:LongInt;
740 v:TChartValue;
741 Value:Extended;
742 ValueLabel:String;
743 Field:TField;
744 SaveCurrentRow,SaveCurrentField:LongInt;
745Begin
746 If FDataLink=Nil Then exit;
747
748 If ((not Update)Or(FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)Or
749 (FDataLink.DataSource.DataSet.Active=False)Or(ValueSource='')) Then
750 Begin
751 inc(FChart.FUpdateCount);
752 For t:=FValues.Count-1 Downto 0 Do
753 Begin
754 v:=FValues[t];
755 v.Destroy;
756 End;
757 FValues.Destroy;
758 FValues.Create;
759 If Designed Then If ((FDataLink.DataSource=Nil)Or
760 (FDataLink.DataSource.DataSet=Nil)Or
761 (FDataLink.DataSource.DataSet.Active=False)Or
762 (ValueSource='')) Then
763 Begin
764 AddValue(20,'cars',True,clBlack,clRed);
765 AddValue(50,'bikes',True,clBlack,clGreen);
766 AddValue(40,'food',True,clBlack,clBlue);
767 AddValue(10,'guns',True,clBlack,clYellow);
768 AddValue(20,'shirts',True,clBlack,clAqua);
769 End;
770 dec(FChart.FUpdateCount);
771 End;
772
773 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)Or
774 (FDataLink.DataSource.DataSet.Active=False)Or(ValueSource='')) Then exit;
775
776 DataSet:=FDataLink.DataSource.DataSet;
777
778 SaveCurrentRow:=DataSet.CurrentRow;
779 SaveCurrentField:=DataSet.CurrentField;
780
781 DataSet.First;
782 While not DataSet.EOF Do
783 Begin
784 Field:=DataSet.FieldByName(ValueSource);
785 Value:=Field.AsFloat;
786 If LabelSource='' Then ValueLabel:=''
787 Else
788 Begin
789 Field:=DataSet.FieldByName(LabelSource);
790 ValueLabel:=Field.AsString;
791 End;
792
793 If ((not Update)Or(DataSet.CurrentRow>FValues.Count-1)Or
794 (FValues.Count=0)) Then AddAutoValue(Value,ValueLabel,True,clBlack)
795 Else
796 Begin
797 v:=FValues[DataSet.CurrentRow];
798 v.Value:=Value;
799 v.ValueLabel:=ValueLabel;
800 End;
801
802 DataSet.Next;
803 End;
804
805 If SaveCurrentRow>=0 Then DataSet.CurrentRow:=SaveCurrentRow;
806 If SaveCurrentField>=0 Then DataSet.CurrentField:=SaveCurrentField;
807End;
808
809Procedure TChartSeries.SetDataSource(NewValue:TDataSource);
810Begin
811 If FDataLink.DataSource=NewValue Then exit;
812 FDataLink.DataSource:=NewValue;
813 SetDBValues(False);
814 If FChart.FUpdateCount=0 THEN FChart.Invalidate;
815End;
816
817Function TChartSeries.GetDataSource:TDataSource;
818Begin
819 Result:=FDataLink.DataSource;
820End;
821
822Function TChartSeries.GetLabelSource:String;
823Begin
824 If FLabelSource<>Nil Then Result:=FLabelSource^
825 Else Result:='';
826End;
827
828Procedure TChartSeries.SetLabelSource(Const NewValue:String);
829Begin
830 If FLabelSource<>Nil Then
831 Begin
832 If FLabelSource^=NewValue Then exit;
833 FreeMem(FLabelSource,length(FLabelSource^)+1);
834 End;
835 GetMem(FLabelSource,length(NewValue)+1);
836 FLabelSource^:=NewValue;
837 If ((FDataLink.DataSource<>Nil)And(FDataLink.DataSource.DataSet<>Nil)) Then
838 SetDBValues(False);
839 If FChart.FUpdateCount=0 THEN FChart.Invalidate;
840End;
841
842Function TChartSeries.GetValueSource:String;
843Begin
844 If FValueSource<>Nil Then Result:=FValueSource^
845 Else Result:='';
846End;
847
848Procedure TChartSeries.SetValueSource(Const NewValue:String);
849Begin
850 If FValueSource<>Nil Then
851 Begin
852 If FValueSource^=NewValue Then exit;
853 FreeMem(FValueSource,length(FValueSource^)+1);
854 End;
855 GetMem(FValueSource,length(NewValue)+1);
856 FValueSource^:=NewValue;
857 If ((FDataLink.DataSource<>Nil)And(FDataLink.DataSource.DataSet<>Nil)) Then
858 SetDBValues(False);
859 If FChart.FUpdateCount=0 THEN FChart.Invalidate;
860End;
861
862Procedure TChartSeries.DataChange(Sender:TObject;Event:TDataChange);
863Begin
864 If Event=dePositionChanged Then exit;
865 SetDBValues(True);
866 If FChart.FUpdateCount=0 Then FChart.Invalidate;
867End;
868{$HINTS ON}
869
870Procedure TChartSeries.SetTitleColor(NewValue:TColor);
871Begin
872 If NewValue=FTitleColor Then exit;
873 FTitleColor:=NewValue;
874 IF FChart.FUpdateCount=0 THEN FChart.Invalidate;
875End;
876
877Procedure TChartSeries.SetFont(NewValue:TFont);
878Begin
879 If FFont=NewValue Then exit;
880 FFont:=NewValue;
881 IF FChart.FUpdateCount=0 THEN FChart.Invalidate;
882End;
883
884Function TChartSeries.GetFont:TFont;
885Begin
886 If FFont=Nil Then Result:=FChart.Font
887 Else Result:=FFont;
888End;
889
890Procedure TChartSeries.SetActive(NewValue:Boolean);
891Var t:LongInt;
892 s:TChartSeries;
893Begin
894 If FActive=NewValue Then exit;
895 FActive:=NewValue;
896 If FChart.FUpdateCount=0 Then FChart.Invalidate;
897End;
898
899Procedure TChartSeries.SetTitleAlignment(NewValue:TSeriesTitleAlignment);
900Begin
901 If NewValue=FTitleAlignment Then exit;
902 FTitleAlignment:=NewValue;
903 If FChart.FUpdateCount=0 Then FChart.Invalidate;
904End;
905
906Procedure TChartSeries.SetTitleVisible(NewValue:Boolean);
907Begin
908 If NewValue=FTitleVisible Then exit;
909 FTitleVisible:=NewValue;
910 If FChart.FUpdateCount=0 Then FChart.Invalidate;
911End;
912
913Procedure TChartSeries.SetTitle(NewValue:TStrings);
914Begin
915 If NewValue.Equals(FTitle) Then exit;
916 FTitle.Assign(NewValue);
917 If FChart.FUpdateCount=0 Then FChart.Invalidate;
918End;
919
920Procedure TChartSeries.AddY(Const Value:Extended;Const aLabel:String;FillColor:TColor);
921Begin
922 AddValue(Value,aLabel,True,clBlack,FillColor);
923End;
924
925Procedure TChartSeries.AddValue(Const Value:Extended;Const aLabel:String;
926 Outlined:Boolean;OutlineColor,FillColor:TColor);
927Var v:TChartValue;
928Begin
929 v.Create(Self,Outlined,OutlineColor,FillColor,aLabel,Value);
930 FValues.Add(v);
931 If FChart.FUpdateCount=0 Then FChart.Invalidate;
932End;
933
934Const AutoColors:Array[0..14] Of TColor=
935 (
936 clRed,clGreen,clNavy,clYellow,
937 clBlue,clFuchsia,clLime,clAqua,
938 clMaroon,clDkGray,clPurple,clTeal,
939 clSilver,clOlive,clWhite
940 );
941
942Procedure TChartSeries.AddAutoValue(Const Value:Extended;Const aLabel:String;
943 Outlined:Boolean;OutlineColor:TColor);
944Var FillColor:TColor;
945Begin
946 If FValues.Count<15 Then FillColor:=AutoColors[FValues.Count]
947 Else
948 Begin //Randomize Color Value
949 Randomize;
950 FillColor:=ValuesToRGB(Random(256),Random(256),Random(256));
951 End;
952 AddValue(Value,aLabel,Outlined,OutlineColor,FillColor);
953End;
954
955
956Function TChartSeries.GetValueCount:LongInt;
957Begin
958 Result:=FValues.Count;
959End;
960
961Function TChartSeries.GetChartValue(Index:LongInt):TChartValue;
962Begin
963 Result:=FValues[Index];
964End;
965
966{
967ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
968º º
969º Speed-Pascal/2 Version 2.0 º
970º º
971º Speed-Pascal Component Classes (SPCC) º
972º º
973º This section: TChartLegend Class Implementation º
974º º
975º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
976º º
977ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
978}
979
980Procedure TChartLegend.SetAlignment(NewValue:TLegendAlignment);
981Begin
982 If FAlignment=NewValue Then exit;
983 FAlignment:=NewValue;
984 If FChart.FUpdateCount=0 Then FChart.Invalidate;
985End;
986
987Procedure TChartLegend.SetShadowColor(NewValue:TColor);
988Begin
989 If FShadowColor=NewValue Then exit;
990 FShadowColor:=NewValue;
991 If FChart.FUpdateCount=0 Then FChart.Invalidate;
992End;
993
994Procedure TChartLegend.SetShadowSize(NewValue:Byte);
995Begin
996 If FShadowSize=NewValue Then exit;
997 FShadowSize:=NewValue;
998 If FChart.FUpdateCount=0 Then FChart.Invalidate;
999End;
1000
1001Procedure TChartLegend.SetBackColor(NewValue:TColor);
1002Begin
1003 If FBackColor=NewValue Then exit;
1004 FBackColor:=NewValue;
1005 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1006End;
1007
1008Procedure TChartLegend.SetTextStyle(NewValue:TLegendTextStyle);
1009Begin
1010 If FTextStyle=NewValue Then exit;
1011 FTextStyle:=NewValue;
1012 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1013End;
1014
1015Procedure TChartLegend.SetFrameColor(NewValue:TColor);
1016Begin
1017 If FFrameColor=NewValue Then exit;
1018 FFrameColor:=NewValue;
1019 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1020End;
1021
1022Procedure TChartLegend.SetFrameStyle(NewValue:TPenStyle);
1023Begin
1024 If FFrameStyle=NewValue Then exit;
1025 FFrameStyle:=NewValue;
1026 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1027End;
1028
1029Procedure TChartLegend.SetVisible(NewValue:Boolean);
1030Begin
1031 If FVisible=NewValue Then exit;
1032 FVisible:=NewValue;
1033 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1034End;
1035
1036Procedure TChartLegend.SetMaxLines(NewValue:Byte);
1037Begin
1038 If FMaxLines=NewValue Then exit;
1039 FMaxLines:=NewValue;
1040 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1041End;
1042
1043Procedure TChartLegend.SetTopPosPercentage(NewValue:Byte);
1044Begin
1045 If FTopPosPercentage=NewValue Then exit;
1046 FTopPosPercentage:=NewValue;
1047 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1048End;
1049
1050Procedure TChartLegend.SetColorWidthPercentage(NewValue:Byte);
1051Begin
1052 If FColorWidthPercentage=NewValue Then exit;
1053 FColorWidthPercentage:=NewValue;
1054 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1055End;
1056
1057Procedure TChartLegend.SetXMargin(NewValue:Byte);
1058Begin
1059 If FXMargin=NewValue Then exit;
1060 FXMargin:=NewValue;
1061 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1062End;
1063
1064Procedure TChartLegend.SetYMargin(NewValue:Byte);
1065Begin
1066 If FYMargin=NewValue Then exit;
1067 FYMargin:=NewValue;
1068 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1069End;
1070
1071Procedure TChartLegend.SetFont(NewValue:TFont);
1072Begin
1073 If FFont=NewValue Then exit;
1074 FFont:=NewValue;
1075 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1076End;
1077
1078Function TChartLegend.GetFont:TFont;
1079Begin
1080 If FFont=Nil Then Result:=FChart.Font
1081 Else Result:=FFont;
1082End;
1083
1084Function TChartLegend.GetFormatStr:String;
1085Begin
1086 If FFormatStr<>Nil Then Result:=FFormatStr^
1087 Else Result:='';
1088End;
1089
1090Procedure TChartLegend.SetFormatStr(Const NewValue:String);
1091Begin
1092 If FFormatStr<>Nil Then
1093 Begin
1094 If FFormatStr^=NewValue Then exit;
1095 FreeMem(FFormatStr,length(FFormatStr^)+1);
1096 End;
1097 GetMem(FFormatStr,length(NewValue)+1);
1098 FFormatStr^:=NewValue;
1099 If FChart.FUpdateCount=0 Then FChart.Invalidate;
1100End;
1101
1102Constructor TChartLegend.Create(Chart:TChart);
1103Begin
1104 Inherited Create;
1105
1106 FChart:=Chart;
1107 FAlignment:=laLeft;
1108 FShadowColor:=clBlack;
1109 FShadowSize:=2;
1110 FTextStyle:=ltsPlain;
1111 FFrameColor:=clBlack;
1112 FFrameStyle:=psSolid;
1113 FVisible:=True;
1114 FMaxLines:=255;
1115 FTopPosPercentage:=50;
1116 FColorWidthPercentage:=20;
1117 FXMargin:=5;
1118 FYMargin:=2;
1119 FBackColor:=clWhite;
1120End;
1121
1122Destructor TChartLegend.Destroy;
1123Begin
1124 If FFormatStr<>Nil Then FreeMem(FFormatStr,length(FFormatStr^)+1);
1125 Inherited Destroy;
1126End;
1127
1128{
1129ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1130º º
1131º Speed-Pascal/2 Version 2.0 º
1132º º
1133º Speed-Pascal Component Classes (SPCC) º
1134º º
1135º This section: TChart Class Implementation º
1136º º
1137º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1138º º
1139ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1140}
1141
1142Procedure TChart.SetupComponent;
1143Begin
1144 Inherited SetupComponent;
1145
1146 FSeries.Create;
1147 Width:=310;
1148 Height:=240;
1149 FView3D:=True;
1150 FPercent3D:=15;
1151 Name:='Chart';
1152 FMarginLeft:=3;
1153 FMarginRight:=3;
1154 FMarginBottom:=3;
1155 FMarginTop:=3;
1156 FGradientStyle:=grsNone;
1157 FGradientStart:=clYellow;
1158 FGradientEnd:=clWhite;
1159 FLegend.Create(Self);
1160End;
1161
1162Function TChart.DrawChartFrame:TRect;
1163Var OuterRaisedColor:TColor;
1164 OuterLoweredColor:TColor;
1165 InnerRaisedColor:TColor;
1166 InnerLoweredColor:TColor;
1167 rc1:TRect;
1168
1169 Procedure DrawFrame(rc:TRect;FrameWidth:LongInt;HiColor,LoColor:TColor);
1170 Var PointsArray:Array[0..5] Of TPoint;
1171 offs:LongInt;
1172 Begin
1173 offs := FrameWidth-1;
1174
1175 If FrameWidth > 1 Then
1176 Begin
1177 PointsArray[0] := Point(rc.Left,rc.Bottom);
1178 PointsArray[1] := Point(rc.Left+offs,rc.Bottom+offs);
1179 PointsArray[2] := Point(rc.Left+offs,rc.Top-offs);
1180 PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
1181 PointsArray[4] := Point(rc.Right,rc.Top);
1182 PointsArray[5] := Point(rc.Left,rc.Top);
1183 Canvas.Pen.color := HiColor;
1184 Canvas.Polygon(PointsArray);
1185 PointsArray[2] := Point(rc.Right-offs,rc.Bottom+offs);
1186 PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
1187 PointsArray[4] := Point(rc.Right,rc.Top);
1188 PointsArray[5] := Point(rc.Right,rc.Bottom);
1189 Canvas.Pen.color := LoColor;
1190 Canvas.Polygon(PointsArray);
1191 End
1192 Else Canvas.ShadowedBorder(rc1,HiColor,LoColor);
1193 End;
1194Begin
1195 If BevelInner = bvRaised Then
1196 Begin
1197 InnerRaisedColor := clBtnHighlight;
1198 InnerLoweredColor := clBtnShadow;
1199 End
1200 Else
1201 Begin
1202 InnerRaisedColor := clBtnShadow;
1203 InnerLoweredColor := clBtnHighlight;
1204 End;
1205
1206 If BevelOuter = bvRaised Then
1207 Begin
1208 OuterRaisedColor := clBtnHighlight;
1209 OuterLoweredColor := clBtnShadow;
1210 End
1211 Else
1212 Begin
1213 OuterRaisedColor := clBtnShadow;
1214 OuterLoweredColor := clBtnHighlight;
1215 End;
1216
1217 rc1 := ClientRect;
1218 DrawSystemBorder(Self,rc1,BorderStyle);
1219
1220 If BevelOuter <> bvNone Then If BevelWidth > 0 Then
1221 Begin
1222 DrawFrame(rc1,BevelWidth,OuterRaisedColor,OuterLoweredColor);
1223 Forms.InflateRect(rc1,-BevelWidth,-BevelWidth);
1224 End;
1225
1226 If BorderWidth > 0 Then
1227 Begin
1228 DrawFrame(rc1,BorderWidth,color,color);
1229 Forms.InflateRect(rc1,-BorderWidth,-BorderWidth);
1230 End;
1231
1232 If BevelInner <> bvNone Then If BevelWidth > 0 Then
1233 Begin
1234 DrawFrame(rc1,BevelWidth,InnerRaisedColor,InnerLoweredColor);
1235 Forms.InflateRect(rc1,-BevelWidth,-BevelWidth);
1236 End;
1237
1238 result := rc1;
1239End;
1240
1241
1242Destructor TChart.Destroy;
1243Var t:LongInt;
1244 s:TChartSeries;
1245Begin
1246 FUpdateCount:=1;
1247 For t:=FSeries.Count-1 Downto 0 Do
1248 Begin
1249 s:=FSeries[t];
1250 s.Destroy;
1251 End;
1252 FSeries.Destroy;
1253 FLegend.Destroy;
1254 If FDesignSerie<>Nil Then FDesignSerie.Destroy;
1255
1256 Inherited Destroy;
1257End;
1258
1259Procedure TChart.AddSerie(Title:String;TitleVisible:Boolean;
1260 TitleAlignment:TSeriesTitleAlignment);
1261Var s:TChartSeries;
1262 ts:TStringList;
1263Begin
1264 If FDesignSerie<>Nil Then
1265 Begin
1266 FDesignSerie.Destroy;
1267 FDesignSerie:=Nil;
1268 End;
1269 ts.Create;
1270 ts.Text:=Title;
1271 s.Create(Self,ts,TitleVisible,TitleAlignment);
1272 ts.Destroy;
1273 FSeries.Add(s);
1274 s.Active:=True;
1275End;
1276
1277Procedure TChart.CreateDesignSerie;
1278Var ts:TStringList;
1279 DBSerie,DBValues:Boolean;
1280 DataSource:TDataSource;
1281Begin
1282 If FSeries.Count>0 Then DataSource:=TChartSeries(FSeries[0]).DataSource
1283 Else DataSource:=Nil;
1284 DBSerie:=Self Is TDBPieChart;
1285 DBSerie:=DBSerie Or (Self Is TDBBarChart);
1286
1287 If DBSerie Then
1288 Begin
1289 DBValues:=((DataSource=Nil)Or(TDBPieChart(Self).ValueSource='')Or
1290 (DataSource.DataSet=Nil)Or(DataSource.DataSet.Active=False));
1291 End
1292 Else DBValues:=True;
1293
1294 DBValues:=DBValues And Designed;
1295
1296 If DBSerie Then
1297 Begin
1298 If FSeries.Count>0 Then If FDesignSerie=Nil Then FDesignSerie:=FSeries[0];
1299
1300 If FDesignSerie<>Nil Then
1301 Begin
1302 If FDesignSerie.ValueCount=0 Then
1303 Begin
1304 If DBValues Then
1305 Begin
1306 FDesignSerie.AddValue(20,'cars',True,clBlack,clRed);
1307 FDesignSerie.AddValue(50,'bikes',True,clBlack,clGreen);
1308 FDesignSerie.AddValue(40,'food',True,clBlack,clBlue);
1309 FDesignSerie.AddValue(10,'guns',True,clBlack,clYellow);
1310 FDesignSerie.AddValue(20,'shirts',True,clBlack,clAqua);
1311 End;
1312 End;
1313 //Else If not DBValues Then FDesignSerie.ClearValues;
1314 If FSeries.Count=0 Then FSeries.Add(FDesignSerie);
1315 FDesignSerie:=Nil;
1316 End;
1317 If FSeries.Count>0 Then exit;
1318 End
1319 Else If not Designed Then exit;
1320
1321 If FDesignSerie<>Nil Then exit;
1322 ts.Create;
1323 If DBSerie Then
1324 Begin
1325 If Designed Then ts.Add('Serie')
1326 Else ts.Add('');
1327 End
1328 Else ts.Add('Serie');
1329 FDesignSerie.Create(Self,ts,True,staCenter);
1330 If DBSerie Then FSeries.Add(FDesignSerie);
1331 ts.Destroy;
1332
1333 If DBValues Then
1334 Begin
1335 FDesignSerie.AddValue(20,'cars',True,clBlack,clRed);
1336 FDesignSerie.AddValue(50,'bikes',True,clBlack,clGreen);
1337 FDesignSerie.AddValue(40,'food',True,clBlack,clBlue);
1338 FDesignSerie.AddValue(10,'guns',True,clBlack,clYellow);
1339 FDesignSerie.AddValue(20,'shirts',True,clBlack,clAqua);
1340 End;
1341
1342 FDesignSerie.Active:=True;
1343 If DBSerie Then FDesignSerie:=Nil;
1344End;
1345
1346Function TChart.GetSeriesCount:LongInt;
1347Begin
1348 Result:=FSeries.Count;
1349End;
1350
1351Function TChart.GetChartSerie(Index:LongInt):TChartSeries;
1352Begin
1353 Result:=FSeries[Index];
1354End;
1355
1356Procedure TChart.SetView3D(NewValue:Boolean);
1357Begin
1358 If NewValue=FView3D Then exit;
1359 FView3D:=NewValue;
1360 Invalidate;
1361End;
1362
1363Procedure TChart.SetPercent3D(NewValue:Byte);
1364Begin
1365 If NewValue=FPercent3D Then exit;
1366 If NewValue>100 Then NewValue:=100;
1367 FPercent3D:=NewValue;
1368 InvalidateGraph;
1369End;
1370
1371Procedure TChart.InvalidateGraph;
1372Begin
1373 Invalidate;
1374End;
1375
1376Procedure TChart.DrawGradient(rc:TRect;HColor,LColor:TColor;Style:TGradientStyle);
1377Var
1378 DRed,DGreen,DBlue,DR,DG,DB:Extended;
1379 StartLoop,EndLoop:LongInt;
1380 rec:TRect;
1381 H,W:LongInt;
1382Begin
1383 H:=rc.Top-rc.Bottom;
1384 W:=rc.Right-rc.Left;
1385 DRed:=TRGB(LColor).Red;
1386 DGreen:=TRGB(LColor).Green;
1387 DBlue:=TRGB(LColor).Blue;
1388 DR:=TRGB(HColor).Red-DRed;
1389 DG:=TRGB(HColor).Green-DGreen;
1390 DB:=TRGB(HColor).Blue-DBlue;
1391
1392 Case Style Of
1393 grsBottomTop,grsTopBottom:
1394 Begin
1395 DR:=DR / H;
1396 DG:=DG / H;
1397 DB:=DB / H;
1398 End
1399 Else
1400 Begin
1401 DR:=DR / W;
1402 DG:=DG / W;
1403 DB:=DB / W;
1404 End;
1405 End; //case
1406
1407 If Style=grsBottomTop Then
1408 Begin
1409 StartLoop:=rc.Bottom;
1410 EndLoop:=rc.Bottom+(rc.Top-rc.Bottom);
1411 End
1412 Else If Style=grsTopBottom Then
1413 Begin
1414 StartLoop:=rc.Bottom+(rc.Top-rc.Bottom);
1415 EndLoop:=rc.Bottom;
1416 End
1417 Else If Style=grsLeftRight Then
1418 Begin
1419 StartLoop:=rc.Left;
1420 EndLoop:=rc.Left+(rc.Right-rc.Left);
1421 End
1422 Else
1423 Begin
1424 StartLoop:=rc.Left+(rc.Right-rc.Left);
1425 EndLoop:=rc.Left;
1426 End;
1427
1428 While StartLoop<>EndLoop Do
1429 Begin
1430 If Style In [grsBottomTop,grsTopBottom] Then
1431 Begin
1432 rec.Left:=rc.Left;
1433 rec.Right:=rc.Right;
1434 rec.Bottom:=StartLoop;
1435 rec.Top:=rec.Bottom+3;
1436 If Style=grsTopBottom Then
1437 Begin
1438 If rec.Top<EndLoop Then exit;
1439 End
1440 Else If rec.Bottom>EndLoop Then exit;
1441
1442 If rec.Top>rc.Top Then rec.Top:=rc.Top;
1443 If rec.Bottom<rc.Bottom Then rec.Bottom:=rc.Bottom;
1444 End
1445 Else
1446 Begin
1447 rec.Left:=StartLoop;
1448 rec.Right:=rec.Left+8;
1449 rec.Bottom:=rc.Bottom;
1450 rec.Top:=rc.Top;
1451 If Style=grsRightLeft Then
1452 Begin
1453 If rec.Right<EndLoop Then exit;
1454 End
1455 Else If rec.Left>EndLoop Then exit;
1456
1457 If rec.Right>rc.Right Then rec.Right:=rc.Right;
1458 If rec.Left<rc.Left Then rec.Left:=rc.Left;
1459 End;
1460 Canvas.FillRect(rec,ValuesToRGB(Round(DRed),Round(DGreen),Round(DBlue)));
1461
1462 DRed:=DRed+DR*3;
1463 If DRed>255 Then DRed:=255;
1464 DGreen:=DGreen+DG*3;
1465 If DGreen>255 Then DGreen:=255;
1466 DBlue:=DBlue+DB*3;
1467 If DBlue>255 Then DBlue:=255;
1468
1469 If Style In [grsBottomTop,grsLeftRight] Then
1470 Begin
1471 inc(StartLoop,3);
1472 If Style=grsLeftRight Then
1473 Begin
1474 inc(StartLoop,5);
1475 DRed:=DRed+DR*5;
1476 If DRed>255 Then DRed:=255;
1477 DGreen:=DGreen+DG*5;
1478 If DGreen>255 Then DGreen:=255;
1479 DBlue:=DBlue+DB*5;
1480 If DBlue>255 Then DBlue:=255;
1481 End;
1482 End
1483 Else
1484 Begin
1485 dec(StartLoop,3);
1486 If Style=grsRightLeft Then
1487 Begin
1488 dec(StartLoop,5);
1489 DRed:=DRed+DR*5;
1490 If DRed>255 Then DRed:=255;
1491 DGreen:=DGreen+DG*5;
1492 If DGreen>255 Then DGreen:=255;
1493 DBlue:=DBlue+DB*5;
1494 If DBlue>255 Then DBlue:=255;
1495 End;
1496 End;
1497 End; //While
1498End;
1499
1500Procedure TChart.SetMarginLeft(NewValue:Byte);
1501Begin
1502 If NewValue=FMarginLeft Then exit;
1503 If NewValue>100 Then NewValue:=100;
1504 FMarginLeft:=NewValue;
1505 If FUpdateCount=0 Then Invalidate;
1506End;
1507
1508Procedure TChart.SetMarginRight(NewValue:Byte);
1509Begin
1510 If NewValue=FMarginRight Then exit;
1511 If NewValue>100 Then NewValue:=100;
1512 FMarginRight:=NewValue;
1513 If FUpdateCount=0 Then Invalidate;
1514End;
1515
1516Procedure TChart.SetMarginBottom(NewValue:Byte);
1517Begin
1518 If NewValue=FMarginBottom Then exit;
1519 If NewValue>100 Then NewValue:=100;
1520 FMarginBottom:=NewValue;
1521 If FUpdateCount=0 Then Invalidate;
1522End;
1523
1524Procedure TChart.SetMarginTop(NewValue:Byte);
1525Begin
1526 If NewValue=FMarginTop Then exit;
1527 If NewValue>100 Then NewValue:=100;
1528 FMarginTop:=NewValue;
1529 If FUpdateCount=0 Then Invalidate;
1530End;
1531
1532Procedure TChart.SetGradientStyle(NewValue:TGradientStyle);
1533Begin
1534 If NewValue=FGradientStyle Then exit;
1535 FGradientStyle:=NewValue;
1536 If FUpdateCount=0 Then Invalidate;
1537End;
1538
1539Procedure TChart.SetGradientStart(NewValue:TColor);
1540Begin
1541 If NewValue=FGradientStart Then exit;
1542 FGradientStart:=NewValue;
1543 If FUpdateCount=0 Then Invalidate;
1544End;
1545
1546Procedure TChart.SetGradientEnd(NewValue:TColor);
1547Begin
1548 If NewValue=FGradientEnd Then exit;
1549 FGradientEnd:=NewValue;
1550 If FUpdateCount=0 Then Invalidate;
1551End;
1552
1553Procedure TChart.BeginUpdate;
1554Begin
1555 If FUpdateCount = 0 Then
1556 Begin
1557 If Handle <> 0 Then
1558 Begin
1559 {$IFDEF OS2}
1560 WinEnableWindowUpdate(Handle,False);
1561 {$ENDIF}
1562 {$IFDEF Win95}
1563 SendMessage(Handle,WM_SETREDRAW,0,0);
1564 {$ENDIF}
1565 End;
1566 End;
1567 Inc(FUpdateCount);
1568End;
1569
1570
1571Procedure TChart.EndUpdate;
1572Begin
1573 If FUpdateCount=0 Then Exit;
1574 Dec(FUpdateCount);
1575 If FUpdateCount = 0 Then
1576 Begin
1577 If Handle <> 0 Then
1578 Begin
1579 {$IFDEF OS2}
1580 WinEnableWindowUpdate(Handle,True);
1581 {$ENDIF}
1582 {$IFDEF Win95}
1583 SendMessage(Handle,WM_SETREDRAW,1,0);
1584 {$ENDIF}
1585 End;
1586 Invalidate;
1587 End;
1588End;
1589
1590Function TChart.GetChartStrDim(v:TChartValue;Var CX,CY:LongInt):String;
1591Var
1592 SaveFont:TFont;
1593Begin
1594 CX:=0;
1595 CY:=0;
1596 If v.Serie.Marks.Visible Then
1597 Begin
1598 Case v.Serie.Marks.Style Of
1599 smsValue:Result:=FormatFloat(v.Serie.Marks.FormatStr,v.Value);
1600 smsPercent:Result:=FormatFloat(v.Serie.Marks.FormatStr,v.FSweepAngle*100/360)+'%';
1601 smsLabel:Result:=v.ValueLabel;
1602 smsLabelPercent:Result:=v.ValueLabel+' '+
1603 FormatFloat(v.Serie.Marks.FormatStr,v.FSweepAngle*100/360)+'%';
1604 smsLabelValue:Result:=v.ValueLabel+' '+
1605 FormatFloat(v.Serie.Marks.FormatStr,v.Value);
1606 smsLegend:Result:=v.ValueLabel; //???
1607 End;
1608
1609 SaveFont:=Canvas.Font;
1610 Canvas.Font:=v.Serie.Marks.Font;
1611 Canvas.GetTextExtent(Result,CX,CY);
1612 Canvas.Font:=SaveFont;
1613 inc(CX,2); //Border
1614 inc(CY,2); //Border
1615 End;
1616End;
1617
1618Function TChart.GetLegendExtent(Serie:TChartSeries;
1619 Var CX,CY,ColorWidth:LongInt;
1620 Width,Height:LongInt):LongInt;
1621Var t:LongInt;
1622 v:TChartValue;
1623 SaveFont:TFont;
1624 s:String;
1625 CX1,CY1:LongInt;
1626 Lines:Byte;
1627 X,Y:LongInt;
1628Begin
1629 SaveFont:=Canvas.Font;
1630 Canvas.Font:=Legend.Font;
1631
1632 //L„ngsten String ermitteln
1633 CX:=0;
1634 CY:=0;
1635 If Serie<>Nil Then For t:=0 To Serie.FValues.Count-1 Do
1636 Begin
1637 v:=Serie.FValues[t];
1638
1639 Case Legend.TextStyle Of
1640 ltsPlain:s:=v.ValueLabel;
1641 ltsLeftValue:s:=FormatFloat(Legend.FormatStr,v.Value)+' '+v.ValueLabel;
1642 ltsRightValue:s:=v.ValueLabel+' '+FormatFloat(Legend.FormatStr,v.Value);
1643 ltsLeftPercent:s:=FormatFloat(Legend.FormatStr,v.FSweepAngle*100/360)+'%'+
1644 ' '+v.ValueLabel;
1645 ltsRightPercent:s:=v.ValueLabel+' '+
1646 FormatFloat(Legend.FormatStr,v.FSweepAngle*100/360)+'%';
1647 End; //case
1648
1649 Canvas.GetTextExtent(s,CX1,CY1);
1650 If CX1>CX Then CX:=CX1;
1651 End;
1652
1653 CX:=CX+3;
1654
1655 ColorWidth:=(CX*Legend.ColorWidthPercentage) Div 100;
1656
1657 //CY ermitteln
1658 Lines:=0;
1659 If Legend.Alignment In [laLeft,laRight] Then
1660 Begin
1661 Y:=Height;
1662 CY:=0;
1663 Result:=CX;
1664 End
1665 Else
1666 Begin
1667 Y:=Height Div 2; //maximal die H„lfte fr horz Legende
1668 CY:=CY1+Legend.YMargin;
1669 Result:=0;
1670 End;
1671
1672 X:=0;
1673
1674 If Serie<>Nil Then For t:=0 To Serie.FValues.Count-1 Do
1675 Begin
1676 v:=Serie.FValues[t];
1677
1678 Case Legend.TextStyle Of
1679 ltsPlain:s:=v.ValueLabel;
1680 ltsLeftValue:s:=FormatFloat(Legend.FormatStr,v.Value)+' '+v.ValueLabel;
1681 ltsRightValue:s:=v.ValueLabel+' '+FormatFloat(Legend.FormatStr,v.Value);
1682 ltsLeftPercent:s:=FormatFloat(Legend.FormatStr,v.FSweepAngle*100/360)+'%'+
1683 ' '+v.ValueLabel;
1684 ltsRightPercent:s:=v.ValueLabel+' '+
1685 FormatFloat(Legend.FormatStr,v.FSweepAngle*100/360)+'%';
1686 End; //case
1687
1688 Canvas.GetTextExtent(s,CX1,CY1);
1689
1690 Case Legend.Alignment Of
1691 laLeft,laRight:
1692 Begin
1693 If Y-CY1-Legend.YMargin<0 Then break;
1694 dec(Y,CY1+Legend.YMargin);
1695 inc(CY,CY1+Legend.YMargin);
1696 inc(Lines);
1697 If Y<0 Then break;
1698 If Lines>Legend.MaxLines Then break;
1699 End;
1700 Else
1701 Begin
1702 If X+CX+ColorWidth+6+Legend.XMargin>Width Then
1703 Begin
1704 dec(X,ColorWidth+6+Legend.XMargin);
1705 If X>Result Then Result:=X;
1706 inc(Lines);
1707 dec(Y,CY1+Legend.YMargin);
1708 inc(CY,CY1+Legend.YMargin);
1709 If Y<0 Then break;
1710 If Lines>Legend.MaxLines Then break;
1711 X:=0;
1712 End;
1713
1714 inc(X,CX+ColorWidth+6+Legend.XMargin);
1715 End;
1716 End; //case
1717 End;
1718
1719 If Legend.Alignment In [laBottom,laTop] Then
1720 Begin
1721 If X>Result Then Result:=X;
1722 Inc(Result,2);
1723 End;
1724
1725 Canvas.Font:=SaveFont;
1726End;
1727
1728Procedure TChart.DrawLegend(Serie:TChartSeries;Var ClientRect:TRect);
1729Var CX,CY,CX1,CY1,ColorWidth:LongInt;
1730 rc,rc1:TRect;
1731 SaveFont:TFont;
1732 X,Y:LongInt;
1733 Lines:Byte;
1734 t:LongInt;
1735 v:TChartValue;
1736 s:String;
1737 SaveColor:TColor;
1738 W:LongInt;
1739
1740 Procedure DrawLegendLabel(X,Y:LongInt;Const s:String);
1741 Var rc1:TRect;
1742 SaveColor:TColor;
1743 Begin
1744 SaveColor:=Canvas.Pen.Color;
1745 Canvas.Pen.Color:=v.FillColor;
1746 rc1.Left:=X+2;
1747 rc1.Right:=rc1.Left+ColorWidth;
1748 rc1.Bottom:=Y+2;
1749 rc1.Top:=Y+CY1-4;
1750 Forms.InflateRect(rc1,-1,-1);
1751 Canvas.Box(rc1);
1752 Canvas.Pen.Color:=SaveColor;
1753 Forms.InflateRect(rc1,1,1);
1754 Canvas.Rectangle(rc1);
1755
1756 Canvas.Pen.Color:=Legend.BackColor;
1757
1758 rc1.Left:=X;
1759 rc1.Right:=rc1.Left+1;
1760 rc1.Bottom:=Y;
1761 rc1.Top:=rc1.Bottom+CY1-1;
1762 Canvas.Box(rc1);
1763
1764 rc1.Left:=rc1.Right;
1765 rc1.Right:=rc1.Left+ColorWidth+1;
1766 rc1.Top:=rc1.Bottom+1;
1767 Canvas.Box(rc1);
1768
1769 rc1.Bottom:=Y+CY1-3;
1770 rc1.Top:=rc1.Bottom+2;
1771 Canvas.Box(rc1);
1772
1773 rc1.Left:=X+3+ColorWidth;
1774 rc1.Right:=rc1.Left+3;
1775 rc1.Bottom:=Y;
1776 rc1.Top:=rc1.Bottom+CY1-1;
1777 Canvas.Box(rc1);
1778
1779 rc1.Left:=X+3+ColorWidth+4+CX1;
1780 rc1.Right:=rc.Right-1;
1781 Canvas.Box(rc1);
1782
1783 rc1.Left:=X;
1784 rc1.Right:=rc.Right-1;
1785 rc1.Bottom:=Y-Legend.YMargin;
1786 If rc1.Bottom<rc.Bottom+1 Then rc1.Bottom:=rc.Bottom+1;
1787 rc1.Top:=Y-1;
1788 Canvas.Box(rc1);
1789
1790 Canvas.Pen.Color:=SaveColor;
1791
1792 inc(X,3+ColorWidth+4);
1793 Canvas.TextOut(X,Y,s);
1794 End;
1795
1796Begin
1797 If ((not Legend.Visible)Or(Legend.MaxLines=0)) Then exit;
1798
1799 W:=GetLegendExtent(Serie,CX,CY,ColorWidth,ClientRect.Right-ClientRect.Left,
1800 ClientRect.Top-ClientRect.Bottom);
1801
1802 If CY=0 Then exit;
1803
1804 Case Legend.Alignment Of
1805 laLeft:
1806 Begin
1807 rc.Left:=ClientRect.Left;
1808 rc.Bottom:=ClientRect.Bottom+0+Legend.ShadowSize; //50%
1809 rc.Right:=rc.Left+CX+ColorWidth+2+6;
1810 rc.Top:=rc.Bottom+CY+2;
1811 inc(ClientRect.Left,CX+ColorWidth+2+6+Legend.ShadowSize);
1812 End;
1813 laRight:
1814 Begin
1815 rc.Left:=ClientRect.Right-CX-ColorWidth-2-2-6;
1816 rc.Bottom:=ClientRect.Bottom+0+Legend.ShadowSize; //50%
1817 rc.Right:=ClientRect.Right-2;
1818 rc.Top:=rc.Bottom+CY+2;
1819 dec(ClientRect.Right,CX+ColorWidth+2+6+Legend.ShadowSize);
1820 End;
1821 laTop:
1822 Begin
1823 rc.Left:=ClientRect.Left+((ClientRect.Right-ClientRect.Left-W) Div 2);
1824 rc.Right:=rc.Left+W;
1825 rc.Bottom:=ClientRect.Top-CY-2;
1826 rc.Top:=ClientRect.Top;
1827 dec(ClientRect.Top,CY+2+Legend.ShadowSize);
1828 End;
1829 laBottom:
1830 Begin
1831 rc.Left:=ClientRect.Left+((ClientRect.Right-ClientRect.Left-W) Div 2);
1832 rc.Right:=rc.Left+W;
1833 rc.Bottom:=ClientRect.Bottom+Legend.ShadowSize+2;
1834 rc.Top:=rc.Bottom+CY+2;
1835 inc(ClientRect.Bottom,CY+2+Legend.ShadowSize);
1836 End;
1837 End; //case
1838
1839 Canvas.Pen.Color:=Legend.FrameColor;
1840 Canvas.Brush.Color:=Legend.BackColor;
1841 SaveFont:=Canvas.Font;
1842 Canvas.Font:=Legend.Font;
1843
1844 Canvas.Rectangle(rc);
1845 X:=rc.Left+1;
1846 Y:=rc.Top;
1847 CY1:=0;
1848 Lines:=0;
1849 If Serie<>Nil Then For t:=0 To Serie.FValues.Count-1 Do
1850 Begin
1851 v:=Serie.FValues[t];
1852
1853 Case Legend.TextStyle Of
1854 ltsPlain:s:=v.ValueLabel;
1855 ltsLeftValue:s:=FormatFloat(Legend.FormatStr,v.Value)+' '+v.ValueLabel;
1856 ltsRightValue:s:=v.ValueLabel+' '+FormatFloat(Legend.FormatStr,v.Value);
1857 ltsLeftPercent:s:=FormatFloat(Legend.FormatStr,v.FSweepAngle*100/360)+'%'+
1858 ' '+v.ValueLabel;
1859 ltsRightPercent:s:=v.ValueLabel+' '+
1860 FormatFloat(Legend.FormatStr,v.FSweepAngle*100/360)+'%';
1861 End; //case
1862
1863 Canvas.GetTextExtent(s,CX1,CY1);
1864
1865 Case Legend.Alignment Of
1866 laLeft,laRight:
1867 Begin
1868 If Y-CY1-Legend.YMargin<rc.Bottom Then break;
1869
1870 DrawLegendLabel(X,Y-CY1,s);
1871
1872 dec(Y,CY1+Legend.YMargin);
1873 inc(CY,CY1+Legend.YMargin);
1874 inc(Lines);
1875 If Y<rc.Bottom Then break;
1876 If Lines>Legend.MaxLines Then break;
1877 End;
1878 Else
1879 Begin
1880 If X+CX+ColorWidth+6+Legend.XMargin>rc.Right Then
1881 Begin
1882 inc(Lines);
1883 dec(Y,CY1+Legend.YMargin);
1884 If Y<rc.Bottom Then
1885 Begin
1886 inc(Y,CY1);
1887 break;
1888 End;
1889 If Lines>Legend.MaxLines Then break;
1890 X:=rc.Left+1;
1891 End;
1892
1893 DrawLegendLabel(X,Y-CY1,s);
1894
1895 SaveColor:=Canvas.Pen.Color;
1896 Canvas.Pen.Color:=Legend.BackColor;
1897 rc1.Left:=X+CX+ColorWidth+6;
1898 rc1.Right:=rc1.Left+Legend.XMargin;
1899 If rc1.Right>rc.Right-1 Then rc1.Right:=rc.Right-1;
1900 rc1.Bottom:=Y-CY1;
1901 If rc1.Bottom<rc.Bottom+1 Then rc1.Bottom:=rc.Bottom+1;
1902 rc1.Top:=Y-1;
1903 Canvas.Box(rc1);
1904 Canvas.Pen.Color:=SaveColor;
1905
1906 inc(X,CX+ColorWidth+6+Legend.XMargin);
1907 End;
1908 End; //case
1909 End;
1910
1911 If Legend.Alignment In [laBottom,laTop] Then dec(Y,CY1+Legend.YMargin);
1912 SaveColor:=Canvas.Pen.Color;
1913 Canvas.Pen.Color:=Legend.BackColor;
1914 rc1.Left:=rc.Left+1;
1915 rc1.Right:=rc.Right-1;
1916 rc1.Bottom:=rc.Bottom+1;
1917 rc1.Top:=Y-1;
1918 If rc1.Top>=rc1.Bottom Then Canvas.Box(rc1);
1919
1920 If Legend.ShadowSize>0 Then
1921 Begin
1922 rc1.Left:=rc.Right;
1923 rc1.Right:=rc1.Left+Legend.ShadowSize;
1924 rc1.Bottom:=rc.Bottom-Legend.ShadowSize;
1925 rc1.Top:=rc.Top-Legend.ShadowSize;
1926
1927 Canvas.Pen.Color:=Legend.ShadowColor;
1928 Canvas.Box(rc1);
1929
1930 Canvas.BeginPath;
1931 Canvas.Rectangle(rc1);
1932 Canvas.EndPath;
1933 Canvas.PathToClipRegion(paDiff);
1934
1935 rc1.Left:=rc.Left+Legend.ShadowSize;
1936 rc1.Right:=rc.Right;
1937 rc1.Bottom:=rc.Bottom-Legend.ShadowSize;
1938 rc1.Top:=rc.Bottom;
1939 Canvas.Box(rc1);
1940
1941 Canvas.BeginPath;
1942 Canvas.Rectangle(rc1);
1943 Canvas.EndPath;
1944 Canvas.PathToClipRegion(paDiff);
1945 End;
1946
1947 Canvas.Pen.Color:=SaveColor;
1948
1949
1950 Canvas.BeginPath;
1951 Canvas.Rectangle(rc);
1952 Canvas.EndPath;
1953 Canvas.PathToClipRegion(paDiff);
1954
1955 Canvas.Font:=SaveFont;
1956End;
1957
1958{
1959ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1960º º
1961º Speed-Pascal/2 Version 2.0 º
1962º º
1963º Speed-Pascal Component Classes (SPCC) º
1964º º
1965º This section: TPieChart Class Implementation º
1966º º
1967º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1968º º
1969ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1970}
1971
1972Procedure TPieChart.CalcMarksRect(Serie:TChartSeries;Var PieRect:TRect);
1973Var t:LongInt;
1974 v:TChartValue;
1975 MiddleAngle:Extended;
1976 s:String;
1977 CX,CY:LongInt;
1978 MaxX,MaxY:LongInt;
1979Begin
1980 MaxX:=0;
1981 MaxY:=0;
1982 For t:=0 To Serie.ValueCount-1 Do
1983 Begin
1984 v:=Serie.FValues[t];
1985
1986 GetChartStrDim(v,CX,CY);
1987 If CX>MaxX Then MaxX:=CX;
1988 If CY>MaxY Then MaxY:=CY;
1989 End;
1990
1991 //Margins
1992 inc(MaxX,Serie.Marks.Margin);
1993 inc(MaxY,Serie.Marks.Margin);
1994
1995 inc(PieRect.Left,MaxX);
1996 dec(PieRect.Right,MaxX);
1997 inc(PieRect.Bottom,MaxY);
1998 dec(PieRect.Top,MaxY);
1999End;
2000
2001Procedure TPieChart.DrawMarks(s:TChartSeries;PieRect:TRect;
2002 PieBottom,CenterX,CenterY,RadiusX,RadiusY:LongInt;
2003 ChartRect:TRect;HandleClip:Boolean);
2004Var t:LongInt;
2005 v:TChartValue;
2006 MiddleAngle:Extended;
2007 pt,TangentPoint:TPoint;
2008 Margin:LongInt;
2009 rc:TRect;
2010 PieHeight:LongInt;
2011 Correct:Extended;
2012 CX,CY:LongInt;
2013 ss:String;
2014 SaveFont:TFont;
2015 SaveColor:TColor;
2016Begin
2017 SetTrigMode(Deg);
2018
2019 PieHeight:=Round(((PieRect.Top-PieRect.Bottom)*FPercent3d)/100);
2020
2021 For t:=0 To s.FValues.Count-1 Do
2022 Begin
2023 v:=s.FValues[t];
2024 MiddleAngle:=v.FStartAngle+v.FSweepAngle/2;
2025 If MiddleAngle>360 Then MiddleAngle:=MiddleAngle-360;
2026
2027 Canvas.Pen.Color:=s.Marks.ArrowColor;
2028
2029 Canvas.Arc(CenterX,CenterY,RadiusX,RadiusY,MiddleAngle,0);
2030 TangentPoint:=Canvas.PenPos;
2031
2032 //eine Strecke in Richtung Mittelpunkt mit Marks.ArrowLength
2033 If not HandleClip Then
2034 Begin
2035 Margin:=s.Marks.ArrowLength;
2036 If ((MiddleAngle>=0)And(MiddleAngle<=90)) Then //Quadrant 1
2037 Begin
2038 If MiddleAngle<=45 Then
2039 Begin
2040 pt.X:=TangentPoint.X-Margin;
2041 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2042 Else pt.Y:=TangentPoint.Y-(Margin/cot(MiddleAngle));
2043 End
2044 Else
2045 Begin
2046 pt.Y:=TangentPoint.Y-Margin;
2047 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2048 Else pt.X:=TangentPoint.X-(Margin/tan(MiddleAngle));
2049 End;
2050 End
2051 Else If ((MiddleAngle>90)And(MiddleAngle<=180)) Then //Quadrant 2
2052 Begin
2053 MiddleAngle:=90-(MiddleAngle-90);
2054 If MiddleAngle<=45 Then
2055 Begin
2056 pt.X:=TangentPoint.X+Margin;
2057 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2058 Else pt.Y:=TangentPoint.Y-(Margin/cot(MiddleAngle));
2059 End
2060 Else
2061 Begin
2062 pt.Y:=TangentPoint.Y-Margin;
2063 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2064 Else pt.X:=TangentPoint.X+(Margin/tan(MiddleAngle));
2065 End;
2066 End
2067 Else If ((MiddleAngle>180)And(MiddleAngle<=270)) Then //Quadrant 3
2068 Begin
2069 MiddleAngle:=MiddleAngle-180;
2070 If MiddleAngle<=45 Then
2071 Begin
2072 pt.X:=TangentPoint.X+Margin;
2073 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2074 Else pt.Y:=TangentPoint.Y+(Margin/cot(MiddleAngle));
2075 End
2076 Else
2077 Begin
2078 pt.Y:=TangentPoint.Y+Margin;
2079 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2080 Else pt.X:=TangentPoint.X+(Margin/tan(MiddleAngle));
2081 End;
2082 End
2083 Else //Quadrant 4
2084 Begin
2085 MiddleAngle:=90-(MiddleAngle-270);
2086 If MiddleAngle<=45 Then
2087 Begin
2088 pt.X:=TangentPoint.X-Margin;
2089 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2090 Else pt.Y:=TangentPoint.Y+(Margin/cot(MiddleAngle));
2091 End
2092 Else
2093 Begin
2094 pt.Y:=TangentPoint.Y+Margin;
2095 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2096 Else pt.X:=TangentPoint.X-(Margin/tan(MiddleAngle));
2097 End;
2098 End;
2099
2100 Canvas.LineTo(pt.X,pt.Y);
2101 End;
2102
2103 //von TangentenPunt eine Strecke von Marks.Margin zeichnen
2104 MiddleAngle:=v.FStartAngle+v.FSweepAngle/2;
2105 If MiddleAngle>360 Then MiddleAngle:=MiddleAngle-360;
2106
2107 Margin:=s.Marks.Margin;
2108
2109 //H”he Pie bercksichtigen
2110 If ((FView3D)And(MiddleAngle>180)And(MiddleAngle<360)) Then
2111 Margin:=Margin+Abs(Sin(MiddleAngle-180))*PieHeight
2112 Else
2113 Margin:=Margin+Abs(Sin(MiddleAngle-180))*Margin;
2114
2115 If ((MiddleAngle>=0)And(MiddleAngle<=90)) Then //Quadrant 1
2116 Begin
2117 If MiddleAngle<=45 Then
2118 Begin
2119 pt.X:=TangentPoint.X+Margin;
2120 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2121 Else pt.Y:=TangentPoint.Y+(Margin/cot(MiddleAngle));
2122 End
2123 Else
2124 Begin
2125 pt.Y:=TangentPoint.Y+Margin;
2126 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2127 Else pt.X:=TangentPoint.X+(Margin/tan(MiddleAngle));
2128 End;
2129 End
2130 Else If ((MiddleAngle>90)And(MiddleAngle<=180)) Then //Quadrant 2
2131 Begin
2132 MiddleAngle:=90-(MiddleAngle-90);
2133 If MiddleAngle<=45 Then
2134 Begin
2135 pt.X:=TangentPoint.X-Margin;
2136 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2137 Else pt.Y:=TangentPoint.Y+(Margin/cot(MiddleAngle));
2138 End
2139 Else
2140 Begin
2141 pt.Y:=TangentPoint.Y+Margin;
2142 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2143 Else pt.X:=TangentPoint.X-(Margin/tan(MiddleAngle));
2144 End;
2145 End
2146 Else If ((MiddleAngle>180)And(MiddleAngle<=270)) Then //Quadrant 3
2147 Begin
2148 MiddleAngle:=MiddleAngle-180;
2149 If MiddleAngle<=45 Then
2150 Begin
2151 pt.X:=TangentPoint.X-Margin;
2152 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2153 Else pt.Y:=TangentPoint.Y-(Margin/cot(MiddleAngle));
2154 End
2155 Else
2156 Begin
2157 pt.Y:=TangentPoint.Y-Margin;
2158 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2159 Else pt.X:=TangentPoint.X-(Margin/tan(MiddleAngle));
2160 End;
2161 End
2162 Else //Quadrant 4
2163 Begin
2164 MiddleAngle:=90-(MiddleAngle-270);
2165 If MiddleAngle<=45 Then
2166 Begin
2167 pt.X:=TangentPoint.X+Margin;
2168 If ((MiddleAngle=0)Or(MiddleAngle=180)) Then pt.Y:=TangentPoint.Y
2169 Else pt.Y:=TangentPoint.Y-(Margin/cot(MiddleAngle));
2170 End
2171 Else
2172 Begin
2173 pt.Y:=TangentPoint.Y-Margin;
2174 If ((MiddleAngle=90)Or(MiddleAngle=270)) Then pt.X:=TangentPoint.X
2175 Else pt.X:=TangentPoint.X+(Margin/tan(MiddleAngle));
2176 End;
2177 End;
2178
2179 If not HandleClip Then
2180 Begin
2181 Canvas.PenPos:=TangentPoint;
2182 Canvas.LineTo(pt.X,pt.Y);
2183 End;
2184
2185 If HandleClip Then
2186 Begin
2187 Canvas.BeginPath;
2188 Canvas.PenPos:=TangentPoint;
2189 Canvas.LineTo(pt.X,pt.Y);
2190 Canvas.EndPath;
2191 Canvas.PathToClipRegion(paDiff);
2192 End;
2193
2194 If HandleClip Then
2195 Begin
2196 //Draw mark
2197 Case v.Serie.Marks.Style Of
2198 smsValue:ss:=FormatFloat(v.Serie.Marks.FormatStr,v.Value);
2199 smsPercent:ss:=FormatFloat(v.Serie.Marks.FormatStr,v.FSweepAngle*100/360)+'%';
2200 smsLabel:ss:=v.ValueLabel;
2201 smsLabelPercent:ss:=v.ValueLabel+' '+
2202 FormatFloat(v.Serie.Marks.FormatStr,v.FSweepAngle*100/360)+'%';
2203 smsLabelValue:ss:=v.ValueLabel+' '+
2204 FormatFloat(v.Serie.Marks.FormatStr,v.Value);
2205 smsLegend:ss:=v.ValueLabel; //???
2206 End;
2207
2208 SaveFont:=Canvas.Font;
2209 Canvas.Font:=v.Serie.Marks.Font;
2210 Canvas.GetTextExtent(ss,CX,CY);
2211 Canvas.Font:=SaveFont;
2212 inc(CX,2); //Border
2213 inc(CY,2); //Border
2214
2215 Canvas.Brush.Color:=s.Marks.BackColor;
2216 rc.Left:=pt.X;
2217 rc.Bottom:=pt.Y;
2218
2219 MiddleAngle:=v.FStartAngle+v.FSweepAngle/2;
2220 If MiddleAngle>360 Then MiddleAngle:=MiddleAngle-360;
2221
2222 If ((MiddleAngle>90)And(MiddleAngle<270)) Then
2223 Begin
2224 rc.Right:=rc.Left;
2225 rc.Left:=rc.Right-CX+2;
2226
2227 If rc.Left<ChartRect.Left Then
2228 Begin
2229 rc.Left:=ChartRect.Left;
2230 rc.Right:=rc.Left+CX-2;
2231 End;
2232 End
2233 Else
2234 Begin
2235 rc.Right:=rc.Left+CX-2;
2236 If rc.Right>ChartRect.Right Then
2237 Begin
2238 rc.Right:=ChartRect.Right;
2239 rc.Left:=rc.Right-CX+2;
2240 End;
2241 End;
2242
2243 If ((MiddleAngle>180)And(MiddleAngle<360)) Then
2244 Begin
2245 rc.Top:=rc.Bottom;
2246 rc.Bottom:=rc.Top-CY+2;
2247
2248 If rc.Bottom<ChartRect.Bottom Then
2249 Begin
2250 rc.Bottom:=ChartRect.Bottom;
2251 rc.Top:=rc.Bottom+CY-2;
2252 End;
2253 End
2254 Else
2255 Begin
2256 rc.Top:=rc.Bottom+CY-2;
2257 If rc.Top>ChartRect.Top Then
2258 Begin
2259 rc.Top:=ChartRect.Top;
2260 rc.Bottom:=rc.Top-CY+2;
2261 End;
2262 End;
2263
2264 Canvas.TextOut(rc.Left,rc.Bottom,ss);
2265 Canvas.Rectangle(rc);
2266 Canvas.BeginPath;
2267 Canvas.Rectangle(rc);
2268 Canvas.EndPath;
2269 Canvas.PathToClipRegion(paDiff);
2270 End;
2271 End;
2272End;
2273
2274Procedure TPieChart.Redraw(Const rec:TRect);
2275Var t,t1:LongInt;
2276 s:TChartSeries;
2277 v:TChartValue;
2278 CenterX,CenterY,RadiusX,RadiusY:LongInt;
2279 Sum:Extended;
2280 FRot,Angle,SAngle,StartAngle,SweepAngle:Extended;
2281 ChartRect,PieRect,rc,clRect:TRect;
2282 LastTopPos,LastBottomPos,pt1:TPoint;
2283 Processed:LongInt;
2284 ShadowColor:TColor;
2285 red,green,blue:Byte;
2286 W,H:LongInt;
2287 PieBottom,CX,CY:LongInt;
2288 Title:TStrings;
2289 SaveFont:TFont;
2290 Save:TPenStyle;
2291Begin
2292 rc:=rec;
2293 Forms.InflateRect(rc,1,1);
2294 Canvas.ClipRect:=rc;
2295
2296 //Calculate overall sum of all values
2297 Sum:=0;
2298 s:=Nil;
2299 For t:=0 To FSeries.Count-1 Do
2300 Begin
2301 s:=FSeries[t];
2302 If s.Active Then
2303 Begin
2304 For t1:=0 To s.FValues.Count-1 Do
2305 Begin
2306 v:=s.FValues[t1];
2307 Sum:=Sum+v.Value;
2308 v.FProcessed:=False;
2309 End;
2310 break;
2311 End;
2312 End;
2313 If s<>Nil Then If s.Active=False Then s:=Nil;
2314
2315 If s=Nil Then If Designed Then
2316 Begin
2317 CreateDesignSerie;
2318 s:=FDesignSerie;
2319 Sum:=0;
2320 For t1:=0 To s.FValues.Count-1 Do
2321 Begin
2322 v:=s.FValues[t1];
2323 Sum:=Sum+v.Value;
2324 v.FProcessed:=False;
2325 End;
2326 End;
2327
2328 //calculate percentage value of each value and startpoint
2329 StartAngle:=Rotation;
2330 If s<>Nil Then For t:=0 To s.FValues.Count-1 Do
2331 Begin
2332 v:=s.FValues[t];
2333 v.FStartAngle:=StartAngle;
2334 v.FSweepAngle:=Round((v.Value*360)/Sum);
2335 StartAngle:=v.FStartAngle+v.FSweepAngle;
2336 End;
2337
2338 clRect:=DrawChartFrame;
2339
2340 ChartRect:=clRect;
2341 inc(ChartRect.Left,MarginLeft);
2342 inc(ChartRect.Bottom,MarginBottom);
2343 dec(ChartRect.Right,MarginRight);
2344 dec(ChartRect.Top,MarginTop);
2345
2346 If s<>Nil Then If s.TitleVisible Then
2347 Begin
2348 Title:=s.Title;
2349 If Title.Count>0 Then
2350 Begin
2351 SaveFont:=Canvas.Font;
2352 Canvas.Font:=s.Font;
2353 End;
2354 For t:=0 To Title.Count-1 Do
2355 Begin
2356 Canvas.GetTextExtent(Title.Strings[t],CX,CY);
2357 dec(ChartRect.Top,CY);
2358 End;
2359 If Title.Count>0 Then Canvas.Font:=SaveFont;
2360 End;
2361
2362 //Draw the chart's legend
2363 DrawLegend(s,ChartRect);
2364
2365 W:=ChartRect.Right-ChartRect.Left;
2366 H:=ChartRect.Top-ChartRect.Bottom;
2367 inc(ChartRect.Bottom,Round(H*MarginBottom/100));
2368 dec(ChartRect.Top,Round(H*MarginTop/100));
2369 inc(ChartRect.Left,Round(W*MarginLeft/100));
2370 dec(ChartRect.Right,Round(W*MarginRight/100));
2371
2372 //calculate radius and center of pie
2373 PieRect:=ChartRect;
2374 //If marks are shown, reduce the size of the pierect
2375 If s<>Nil Then If s.Marks.Visible Then CalcMarksRect(s,PieRect);
2376
2377 If FView3D Then PieBottom:=PieRect.Bottom+Round(((PieRect.Top-PieRect.Bottom)*FPercent3d)/100)
2378 Else PieBottom:=PieRect.Bottom;
2379
2380 RadiusX:=(PieRect.Right-PieRect.Left) Div 2;
2381 RadiusY:=(PieRect.Top-PieBottom) Div 2;
2382 If FCircled Then
2383 Begin
2384 If RadiusX>RadiusY Then RadiusX:=RadiusY
2385 Else RadiusY:=RadiusX;
2386 End;
2387
2388 CenterX:=PieRect.Left+RadiusX;
2389 CenterY:=PieBottom+RadiusY;
2390
2391 If s<>Nil Then For t:=0 To s.FValues.Count-1 Do
2392 Begin
2393 v:=s.FValues[t];
2394 If v.Outlined Then Canvas.Pen.Color:=v.OutlineColor
2395 Else Canvas.Pen.Color:=v.FillColor;
2396 Canvas.Brush.Color:=v.FillColor;
2397
2398 Canvas.Pie(CenterX,CenterY,RadiusX,RadiusY,v.FStartAngle,v.FSweepAngle);
2399 Canvas.Arc(CenterX,CenterY,RadiusX,RadiusY,v.FStartAngle+v.FSweepAngle,0);
2400 v.FEndPoint:=Canvas.PenPos;
2401 End;
2402
2403 If FView3D Then If s<>Nil Then
2404 Begin
2405 LastTopPos:=Point(PieRect.Left,PieBottom+RadiusY);
2406 LastBottomPos:=Point(PieRect.Left,PieRect.Bottom+RadiusY);
2407 StartAngle:=180;
2408
2409 t:=0;
2410 Processed:=0;
2411 If s.FValues.Count>0 Then
2412 Repeat;
2413 v:=s.FValues[t];
2414 SAngle:=v.FStartAngle; //StartWinkel
2415 If SAngle>=360 Then SAngle:=SAngle-360;
2416 SweepAngle:=v.FSweepAngle;
2417 If SweepAngle>=360 Then SweepAngle:=SweepAngle-360;
2418 Angle:=SAngle+SweepAngle; //EndWinkel
2419
2420 If SAngle<={FRotation+}StartAngle Then
2421 If ((Angle{v.FStartAngle+v.FSweepAngle}>=180)Or(Processed>0)) Then
2422 If not v.FProcessed Then
2423 Begin
2424 v.FProcessed:=True;
2425 inc(Processed);
2426
2427 RGBToValues(v.FillColor,red,green,blue);
2428 If red>40 Then red:=red-40
2429 Else red:=0;
2430 If blue>40 Then blue:=blue-40
2431 Else blue:=0;
2432 If green>40 Then green:=green-40
2433 Else Green:=0;
2434 ShadowColor:=ValuesToRGB(red,green,blue);
2435
2436 If v.Outlined Then Canvas.Pen.Color:=v.OutlineColor
2437 Else Canvas.Pen.Color:=ShadowColor;
2438 Canvas.PenPos:=LastTopPos;
2439 Canvas.LineTo(LastBottomPos.X,LastBottomPos.Y);
2440
2441 Canvas.Pen.Color:=ShadowColor;
2442
2443 Canvas.BeginPath;
2444 Canvas.PenPos:=LastTopPos;
2445 If Angle<StartAngle Then Angle:=Angle+360;
2446 SweepAngle:=Angle-StartAngle;
2447 If StartAngle+SweepAngle>360 Then SweepAngle:=360-StartAngle;
2448 Canvas.Arc(CenterX,PieBottom+RadiusY-1,
2449 RadiusX,RadiusY,StartAngle,SweepAngle);
2450
2451 SAngle:=270-(StartAngle+SweepAngle-180);
2452 If SAngle>360 Then SAngle:=SAngle-360;
2453 //Draw clockwise arc
2454 If SweepAngle=0 Then SweepAngle:=0.000000000000000001;
2455 Canvas.Arc(CenterX,PieRect.Bottom+RadiusY+1,RadiusX,RadiusY,
2456 SAngle,-SweepAngle);
2457 Canvas.EndPath;
2458 Canvas.FillPath;
2459
2460 If v.Outlined Then Canvas.Pen.Color:=v.OutlineColor
2461 Else Canvas.Pen.Color:=ShadowColor;
2462
2463 Canvas.Arc(CenterX,PieRect.Bottom+RadiusY+1,RadiusX,RadiusY,
2464 StartAngle+SweepAngle,0);
2465 pt1:=LastBottomPos;
2466 LastBottomPos:=Canvas.PenPos;
2467
2468 Canvas.PenPos:=LastTopPos;
2469 Canvas.LineTo(pt1.X,pt1.Y);
2470
2471 Canvas.PenPos:=LastBottomPos;
2472 If v.FEndPoint.Y>PieBottom+RadiusY Then
2473 Canvas.LineTo(PieRect.Left+RadiusX*2,PieBottom+RadiusY)
2474 Else
2475 Canvas.LineTo(v.FEndPoint.X,v.FEndPoint.Y);
2476 Canvas.Arc(CenterX,PieRect.Bottom+RadiusY,
2477 RadiusX,RadiusY,StartAngle,SweepAngle);
2478
2479 LastTopPos.X:=v.FEndPoint.X;
2480 LastTopPos.Y:=v.FEndPoint.Y;
2481 StartAngle:=StartAngle+SweepAngle;
2482 If StartAngle=360 Then break;
2483 End;
2484
2485 inc(t);
2486 If t>=s.FValues.Count Then t:=0;
2487 Until Processed=s.FValues.Count;
2488 End;
2489
2490 If s<>Nil Then
2491 Begin
2492 If s.Marks.Visible Then DrawMarks(s,PieRect,PieBottom,
2493 CenterX,CenterY,
2494 RadiusX,RadiusY,
2495 ChartRect,False);
2496 Canvas.BeginPath;
2497 Canvas.Arc(CenterX,CenterY,RadiusX,RadiusY,0,180);
2498 Canvas.LineTo(PieRect.Left,PieRect.Bottom+RadiusY);
2499 Canvas.Arc(CenterX,PieRect.Bottom+RadiusY,RadiusX,RadiusY,180,180);
2500 Canvas.LineTo(PieRect.Left+RadiusX*2,PieBottom+RadiusY);
2501 Canvas.EndPath;
2502 Canvas.PathToClipRegion(paDiff);
2503
2504 If s.Marks.Visible Then DrawMarks(s,PieRect,PieBottom,
2505 CenterX,CenterY,
2506 RadiusX,RadiusY,
2507 ChartRect,True);
2508 End;
2509
2510 If GradientStyle=grsNone Then Canvas.FillRect(clRect,Color)
2511 Else DrawGradient(clRect,FGradientEnd,FGradientStart,FGradientStyle);
2512
2513 If s<>Nil Then If s.TitleVisible Then
2514 Begin
2515 ChartRect:=clRect;
2516 inc(ChartRect.Left,MarginLeft);
2517 inc(ChartRect.Bottom,MarginBottom);
2518 dec(ChartRect.Right,MarginRight);
2519 dec(ChartRect.Top,MarginTop);
2520
2521 Canvas.Pen.Color:=s.TitleColor;
2522 Canvas.Brush.Mode:=bmTransparent;
2523 Title:=s.Title;
2524 If Title.Count>0 Then
2525 Begin
2526 SaveFont:=Canvas.Font;
2527 Canvas.Font:=s.Font;
2528 End;
2529 For t:=0 To Title.Count-1 Do
2530 Begin
2531 Canvas.GetTextExtent(Title.Strings[t],CX,CY);
2532 Case s.TitleAlignment Of
2533 staLeft:rc.Left:=ChartRect.Left;
2534 staCenter:
2535 Begin
2536 rc.Left:=ChartRect.Left+(((ChartRect.Right-ChartRect.Left)-CX) Div 2);
2537 If rc.Left<ChartRect.Left Then rc.Left:=ChartRect.Left;
2538 End;
2539 staRight:rc.Left:=ChartRect.Right-CX;
2540 End; //case
2541
2542 rc.Right:=rc.Left+CX;
2543 rc.Bottom:=ChartRect.Top-CY;
2544 dec(ChartRect.Top,CY);
2545 rc.Top:=rc.Bottom+CY;
2546 Canvas.TextOut(rc.Left,rc.Bottom,Title.Strings[t]);
2547 End;
2548 If Title.Count>0 Then Canvas.Font:=SaveFont;
2549 Canvas.Brush.Mode:=bmOpaque;
2550 End;
2551
2552End;
2553
2554Procedure TPieChart.SetRotation(NewValue:Word);
2555Begin
2556 If NewValue=FRotation Then exit;
2557 If NewValue>=360 Then NewValue:=NewValue-360;
2558 FRotation:=NewValue;
2559 InvalidateGraph;
2560End;
2561
2562Procedure TPieChart.SetCircled(NewValue:Boolean);
2563Begin
2564 If NewValue=FCircled Then exit;
2565 FCircled:=NewValue;
2566 Invalidate;
2567End;
2568
2569Procedure TPieChart.SetupComponent;
2570Begin
2571 Inherited SetupComponent;
2572
2573 Name:='PieChart';
2574End;
2575
2576Procedure TPieChart.InvalidateGraph;
2577Var rc:TRect;
2578 clRect,ChartRect:TRect;
2579 t:LongInt;
2580 s:TChartSeries;
2581 Title:TStrings;
2582 SaveFont:TFont;
2583 CX,CY,ColorWidth:LongInt;
2584 Sum:Extended;
2585 v:TChartValue;
2586 StartAngle:Extended;
2587Begin
2588 If Handle=0 Then exit;
2589
2590 If FSeries.Count=0 Then
2591 Begin
2592 Invalidate;
2593 exit;
2594 End;
2595
2596 s:=Nil;
2597 For t:=0 To FSeries.Count-1 Do
2598 Begin
2599 s:=FSeries[t];
2600 If s.Active Then break;
2601 End;
2602
2603 If s=Nil Then If Designed Then
2604 Begin
2605 CreateDesignSerie;
2606 s:=FDesignSerie;
2607 End;
2608
2609 If ((s=Nil)Or(not s.Active)) Then
2610 Begin
2611 Invalidate;
2612 exit;
2613 End;
2614
2615 rc:=ClientRect;
2616 clRect:=DrawChartFrame;
2617
2618 ChartRect:=clRect;
2619 inc(ChartRect.Left,MarginLeft);
2620 inc(ChartRect.Bottom,MarginBottom);
2621 dec(ChartRect.Right,MarginRight);
2622 dec(ChartRect.Top,MarginTop);
2623
2624 If s.TitleVisible Then
2625 Begin
2626 Title:=s.Title;
2627 If Title.Count>0 Then
2628 Begin
2629 SaveFont:=Canvas.Font;
2630 Canvas.Font:=s.Font;
2631 End;
2632 For t:=0 To Title.Count-1 Do
2633 Begin
2634 Canvas.GetTextExtent(Title.Strings[t],CX,CY);
2635 dec(ChartRect.Top,CY);
2636 End;
2637 If Title.Count>0 Then Canvas.Font:=SaveFont;
2638 End;
2639
2640 If ((Legend.Visible)And(Legend.MaxLines>0)) Then
2641 Begin
2642 Sum:=0;
2643 For t:=0 To s.FValues.Count-1 Do
2644 Begin
2645 v:=s.FValues[t];
2646 Sum:=Sum+v.Value;
2647 v.FProcessed:=False;
2648 End;
2649
2650 //calculate percentage value of each value and startpoint
2651 StartAngle:=Rotation;
2652 For t:=0 To s.FValues.Count-1 Do
2653 Begin
2654 v:=s.FValues[t];
2655 v.FStartAngle:=StartAngle;
2656 v.FSweepAngle:=Round((v.Value*360)/Sum);
2657 StartAngle:=v.FStartAngle+v.FSweepAngle;
2658 End;
2659
2660 GetLegendExtent(s,CX,CY,ColorWidth,ChartRect.Right-ChartRect.Left,
2661 ChartRect.Top-ChartRect.Bottom);
2662 Case Legend.Alignment Of
2663 laLeft:inc(ChartRect.Left,CX+ColorWidth+2+6+Legend.ShadowSize);
2664 laRight:dec(ChartRect.Right,CX+ColorWidth+2+6+Legend.ShadowSize);
2665 laTop:dec(ChartRect.Top,CY+2+Legend.ShadowSize);
2666 laBottom:inc(ChartRect.Bottom,CY+2+Legend.ShadowSize);
2667 End; //case
2668 End;
2669
2670 Redraw(ChartRect);
2671End;
2672
2673{
2674ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2675º º
2676º Speed-Pascal/2 Version 2.0 º
2677º º
2678º Speed-Pascal Component Classes (SPCC) º
2679º º
2680º This section: TDBPieChart Class Implementation º
2681º º
2682º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2683º º
2684ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2685}
2686
2687
2688Procedure TDBPieChart.SetDataSource(NewValue:TDataSource);
2689Begin
2690 CreateDesignSerie;
2691 If FSeries.Count>0 Then TChartSeries(FSeries[0]).DataSource:=NewValue;
2692End;
2693
2694Function TDBPieChart.GetDataSource:TDataSource;
2695Begin
2696 CreateDesignSerie;
2697 If FSeries.Count>0 Then Result:=TChartSeries(FSeries[0]).DataSource
2698 Else Result:=Nil;
2699End;
2700
2701Function TDBPieChart.GetLabelSource:String;
2702Begin
2703 CreateDesignSerie;
2704 If FSeries.Count>0 Then Result:=TChartSeries(FSeries[0]).LabelSource
2705 Else Result:='';
2706End;
2707
2708Procedure TDBPieChart.SetLabelSource(Const NewValue:String);
2709Begin
2710 CreateDesignSerie;
2711 If FSeries.Count>0 Then TChartSeries(FSeries[0]).LabelSource:=NewValue;
2712End;
2713
2714Function TDBPieChart.GetValueSource:String;
2715Begin
2716 If FSeries.Count>0 Then Result:=TChartSeries(FSeries[0]).ValueSource
2717 Else Result:='';
2718End;
2719
2720Procedure TDBPieChart.SetValueSource(Const NewValue:String);
2721Begin
2722 CreateDesignSerie;
2723 If FSeries.Count>0 Then TChartSeries(FSeries[0]).ValueSource:=NewValue;
2724End;
2725
2726Procedure TDBPieChart.Redraw(Const rec:TRect);
2727Var l:LongInt;
2728Begin
2729 l:=FUpdateCount;
2730 FUpdateCount:=1;
2731 CreateDesignSerie;
2732 FUpdateCount:=l;
2733 Inherited Redraw(rec);
2734End;
2735
2736{
2737ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2738º º
2739º Speed-Pascal/2 Version 2.0 º
2740º º
2741º Speed-Pascal Component Classes (SPCC) º
2742º º
2743º This section: TBarChart Class Implementation º
2744º º
2745º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2746º º
2747ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2748}
2749
2750Procedure TBarChart.SetupComponent;
2751Begin
2752 Inherited SetupComponent;
2753 FPercentBarWidth:=70;
2754 FPercent3D:=20;
2755 FLeftWallVisible:=True;
2756 FLeftWallColor:=clAqua;
2757 FBottomWallVisible:=True;
2758 FBottomWallColor:=clWhite;
2759 FBackWallVisible:=True;
2760 FBackWallColor:=clAqua;
2761 FSeparationPercent:=10;
2762 FVAxisGrid:=True;
2763 FHAxisGrid:=True;
2764 FVAxisVisible:=True;
2765 FVAxisTicksLen:=4;
2766 FHAxisVisible:=True;
2767 FHAxisTicksLen:=4;
2768
2769 Name:='BarChart';
2770End;
2771
2772Destructor TBarChart.Destroy;
2773Begin
2774 If FAxisFormatStr<>Nil Then FreeMem(FAxisFormatStr,length(FAxisFormatStr^)+1);
2775 FAxisFormatStr:=Nil;
2776 Inherited Destroy;
2777End;
2778
2779Function TBarChart.GetAxisFormatStr:String;
2780Begin
2781 If FAxisFormatStr<>Nil Then Result:=FAxisFormatStr^
2782 Else Result:='';
2783End;
2784
2785Procedure TBarChart.SetAxisFormatStr(Const NewValue:String);
2786Begin
2787 If FAxisFormatStr<>Nil Then
2788 Begin
2789 If NewValue=FAxisFormatStr^ Then exit;
2790 FreeMem(FAxisFormatStr,length(FAxisFormatStr^)+1);
2791 End;
2792 GetMem(FAxisFormatStr,length(NewValue)+1);
2793 FAxisFormatStr^:=NewValue;
2794 InvalidateGraph;
2795End;
2796
2797Procedure TBarChart.SetPercentBarWidth(NewValue:Byte);
2798Begin
2799 If NewValue=FPercentBarWidth Then exit;
2800 If NewValue>100 Then NewValue:=100;
2801 FPercentBarWidth:=NewValue;
2802 InvalidateGraph;
2803End;
2804
2805Procedure TBarChart.SetPointsPerPage(NewValue:LongWord);
2806Begin
2807 If NewValue=FPointsPerPage Then exit;
2808 FPointsPerPage:=NewValue;
2809 InvalidateGraph;
2810End;
2811
2812Procedure TBarChart.SetPercentBarOffset(NewValue:Integer);
2813Begin
2814 If NewValue=FPercentBarOffset Then exit;
2815 If NewValue<-100 Then NewValue:=-100;
2816 If NewValue>100 Then NewValue:=100;
2817 FPercentBarOffset:=NewValue;
2818 InvalidateGraph;
2819End;
2820
2821
2822Procedure TBarChart.InvalidateGraph;
2823Var rc:TRect;
2824 clRect,ChartRect:TRect;
2825 t:LongInt;
2826 s:TChartSeries;
2827 Title:TStrings;
2828 SaveFont:TFont;
2829 CX,CY,ColorWidth:LongInt;
2830 Sum:Extended;
2831 v:TChartValue;
2832 StartAngle:Extended;
2833Begin
2834 If Handle=0 Then exit;
2835
2836 If FSeries.Count=0 Then
2837 Begin
2838 Invalidate;
2839 exit;
2840 End;
2841
2842 s:=Nil;
2843 For t:=0 To FSeries.Count-1 Do
2844 Begin
2845 s:=FSeries[t];
2846 If s.Active Then break;
2847 End;
2848
2849 If s=Nil Then If Designed Then
2850 Begin
2851 CreateDesignSerie;
2852 s:=FDesignSerie;
2853 End;
2854
2855 If ((s=Nil)Or(not s.Active)) Then
2856 Begin
2857 Invalidate;
2858 exit;
2859 End;
2860
2861 rc:=ClientRect;
2862 clRect:=DrawChartFrame;
2863
2864 ChartRect:=clRect;
2865 inc(ChartRect.Left,MarginLeft);
2866 inc(ChartRect.Bottom,MarginBottom);
2867 dec(ChartRect.Right,MarginRight);
2868 dec(ChartRect.Top,MarginTop);
2869
2870 If s.TitleVisible Then
2871 Begin
2872 Title:=s.Title;
2873 If Title.Count>0 Then
2874 Begin
2875 SaveFont:=Canvas.Font;
2876 Canvas.Font:=s.Font;
2877 End;
2878 For t:=0 To Title.Count-1 Do
2879 Begin
2880 Canvas.GetTextExtent(Title.Strings[t],CX,CY);
2881 dec(ChartRect.Top,CY);
2882 End;
2883 If Title.Count>0 Then Canvas.Font:=SaveFont;
2884 End;
2885
2886 If ((Legend.Visible)And(Legend.MaxLines>0)) Then
2887 Begin
2888 Sum:=0;
2889 For t:=0 To s.FValues.Count-1 Do
2890 Begin
2891 v:=s.FValues[t];
2892 Sum:=Sum+v.Value;
2893 v.FProcessed:=False;
2894 End;
2895
2896 GetLegendExtent(s,CX,CY,ColorWidth,ChartRect.Right-ChartRect.Left,
2897 ChartRect.Top-ChartRect.Bottom);
2898 Case Legend.Alignment Of
2899 laLeft:inc(ChartRect.Left,CX+ColorWidth+2+6+Legend.ShadowSize);
2900 laRight:dec(ChartRect.Right,CX+ColorWidth+2+6+Legend.ShadowSize);
2901 laTop:dec(ChartRect.Top,CY+2+Legend.ShadowSize);
2902 laBottom:inc(ChartRect.Bottom,CY+2+Legend.ShadowSize);
2903 End; //case
2904 End;
2905
2906 Redraw(ChartRect);
2907End;
2908
2909Procedure TBarChart.SetLeftWallVisible(NewValue:Boolean);
2910Begin
2911 If NewValue=FLeftWallVisible Then exit;
2912 FLeftWallVisible:=NewValue;
2913 InvalidateGraph;
2914End;
2915
2916Procedure TBarChart.SetLeftWallColor(NewValue:TColor);
2917Begin
2918 If NewValue=FLeftWallColor Then exit;
2919 FLeftWallColor:=NewValue;
2920 InvalidateGraph;
2921End;
2922
2923Procedure TBarChart.SetBottomWallVisible(NewValue:Boolean);
2924Begin
2925 If NewValue=FBottomWallVisible Then exit;
2926 FBottomWallVisible:=NewValue;
2927 InvalidateGraph;
2928End;
2929
2930Procedure TBarChart.SetBottomWallColor(NewValue:TColor);
2931Begin
2932 If NewValue=FBottomWallColor Then exit;
2933 FBottomWallColor:=NewValue;
2934 InvalidateGraph;
2935End;
2936
2937Procedure TBarChart.SetBackWallVisible(NewValue:Boolean);
2938Begin
2939 If NewValue=FBackWallVisible Then exit;
2940 FBackWallVisible:=NewValue;
2941 InvalidateGraph;
2942End;
2943
2944Procedure TBarChart.SetBackWallColor(NewValue:TColor);
2945Begin
2946 If NewValue=FBackWallColor Then exit;
2947 FBackWallColor:=NewValue;
2948 InvalidateGraph;
2949End;
2950
2951Procedure TBarChart.SetSeparationPercent(NewValue:Byte);
2952Begin
2953 If NewValue=FSeparationPercent Then exit;
2954 FSeparationPercent:=NewValue;
2955 InvalidateGraph;
2956End;
2957
2958Procedure TBarChart.SetVAxisGrid(NewValue:Boolean);
2959Begin
2960 If NewValue=FVAxisGrid Then exit;
2961 FVAxisGrid:=NewValue;
2962 InvalidateGraph;
2963End;
2964
2965Procedure TBarChart.SetHAxisGrid(NewValue:Boolean);
2966Begin
2967 If NewValue=FHAxisGrid Then exit;
2968 FHAxisGrid:=NewValue;
2969 InvalidateGraph;
2970End;
2971
2972Procedure TBarChart.SetVAxisVisible(NewValue:Boolean);
2973Begin
2974 If NewValue=FVAxisVisible Then exit;
2975 FVAxisVisible:=NewValue;
2976 InvalidateGraph;
2977End;
2978
2979Procedure TBarChart.SetHAxisVisible(NewValue:Boolean);
2980Begin
2981 If NewValue=FHAxisVisible Then exit;
2982 FHAxisVisible:=NewValue;
2983 InvalidateGraph;
2984End;
2985
2986Procedure TBarChart.SetVAxisTicksLen(NewValue:Byte);
2987Begin
2988 If NewValue=FVAxisTicksLen Then exit;
2989 FVAxisTicksLen:=NewValue;
2990 InvalidateGraph;
2991End;
2992
2993Procedure TBarChart.SetHAxisTicksLen(NewValue:Byte);
2994Begin
2995 If NewValue=FHAxisTicksLen Then exit;
2996 FHAxisTicksLen:=NewValue;
2997 InvalidateGraph;
2998End;
2999
3000Procedure TBarChart.SetStyle(NewValue:TBarChartStyle);
3001Begin
3002 If NewValue=FStyle Then exit;
3003 FStyle:=NewValue;
3004 InvalidateGraph;
3005End;
3006
3007Procedure TBarChart.Redraw(Const rec:TRect);
3008Var t,t1:LongInt;
3009 s,s1,FirstSerie,LastSerie:TChartSeries;
3010 v:TChartValue;
3011 Title:TStrings;
3012 SaveFont:TFont;
3013 rc,rc1,rc2,clRect,ChartRect,BarRect:TRect;
3014 CX,CY,W,H,HH:LongInt;
3015 W3d,BarWidth,MarginWidth:LongInt;
3016 Percent:Extended;
3017 X,Y:LongInt;
3018 red,green,blue:Byte;
3019 ShadowColor:TColor;
3020 LastX0:LongInt;
3021 SeriesCount:LongInt;
3022 MaxValue,MinValue,e,RangeValue:Extended;
3023 Range:Extended;
3024 VAxisLen,HAxisLen:LongInt;
3025 ss:String;
3026 YY:Extended;
3027Label l,l1,l2;
3028Begin
3029 rc:=rec;
3030 Forms.InflateRect(rc,1,1);
3031 Canvas.ClipRect:=rc;
3032
3033 clRect:=DrawChartFrame;
3034
3035 ChartRect:=clRect;
3036 inc(ChartRect.Left,MarginLeft);
3037 inc(ChartRect.Bottom,MarginBottom);
3038 dec(ChartRect.Right,MarginRight);
3039 dec(ChartRect.Top,MarginTop);
3040
3041 //Look for first active serie
3042 s1:=Nil;
3043 For t:=0 To FSeries.Count-1 Do
3044 Begin
3045 s:=FSeries[t];
3046 If s.Active Then
3047 Begin
3048 s1:=s;
3049 break;
3050 End;
3051 End;
3052
3053 If s1=Nil Then If Designed Then
3054 Begin
3055 CreateDesignSerie;
3056 s1:=FDesignSerie;
3057 End;
3058
3059 If s1<>Nil Then If s1.TitleVisible Then
3060 Begin
3061 Title:=s1.Title;
3062 If Title.Count>0 Then
3063 Begin
3064 SaveFont:=Canvas.Font;
3065 Canvas.Font:=s1.Font;
3066 End;
3067 For t:=0 To Title.Count-1 Do
3068 Begin
3069 Canvas.GetTextExtent(Title.Strings[t],CX,CY);
3070 dec(ChartRect.Top,CY);
3071 End;
3072 If Title.Count>0 Then Canvas.Font:=SaveFont;
3073 End;
3074
3075 //Draw the chart's legend
3076 DrawLegend(s1,ChartRect);
3077
3078 SeriesCount:=0;
3079 If FSeries.Count>0 Then
3080 Begin
3081 For t:=0 To FSeries.Count-1 Do
3082 Begin
3083 s:=FSeries[t];
3084 If s.Active Then If s.FValues.Count>0 Then inc(SeriesCount);
3085 End;
3086 End
3087 Else If s1<>Nil Then inc(SeriesCount);
3088
3089 W:=ChartRect.Right-ChartRect.Left;
3090 H:=ChartRect.Top-ChartRect.Bottom;
3091 inc(ChartRect.Bottom,Round(H*MarginBottom/100));
3092 dec(ChartRect.Top,Round(H*MarginTop/100));
3093 inc(ChartRect.Left,Round(W*MarginLeft/100));
3094 dec(ChartRect.Right,Round(W*MarginRight/100));
3095 W:=ChartRect.Right-ChartRect.Left;
3096 H:=ChartRect.Top-ChartRect.Bottom;
3097
3098 //calculate radius and center of pie
3099 BarRect:=ChartRect;
3100
3101 //calculate width of Bars
3102 W:=BarRect.Right-BarRect.Left;
3103 H:=BarRect.Top-BarRect.Bottom;
3104 If ((View3D)And(Percent3d>0)And(SeriesCount>0)) Then W3d:=(W Div SeriesCount Div 4*Percent3d) Div 100
3105 Else W3d:=0;
3106 dec(W,W3d*SeriesCount);
3107 dec(H,W3d);
3108
3109 If SeriesCount>0 Then
3110 Begin
3111 dec(H,W3D Div 2);
3112 For t:=FSeries.Count-1 Downto 0 Do
3113 Begin
3114 s:=FSeries[t];
3115 If s.Active Then goto l1;
3116 End;
3117 If s1<>Nil Then
3118 Begin
3119 dec(H,W3D Div 2);
3120 s:=s1;
3121 goto l1;
3122 End;
3123 End
3124 Else If s1<>Nil Then
3125 Begin
3126 dec(H,W3D Div 2);
3127 s:=s1;
3128l1:
3129 If s.Marks.Visible Then
3130 Begin
3131 SaveFont:=Canvas.Font;
3132 Canvas.Font:=s.Marks.Font;
3133 Canvas.GetTextExtent('AByT',CX,CY);
3134 dec(H,CY+s.Marks.ArrowLength*2);
3135 Canvas.Font:=SaveFont;
3136 End;
3137 End;
3138
3139 For t:=1 To FSeries.Count-1 Do
3140 Begin
3141 s:=FSeries[t];
3142 If s.Active Then
3143 If s.FValues.Count>0 Then dec(W,(W3d Div 2)+15);
3144 End;
3145 dec(W,W3d*(SeriesCount-1));
3146
3147 MaxValue:=0;
3148 MinValue:=0;
3149 FirstSerie:=Nil;
3150 If FSeries.Count>0 Then
3151 Begin
3152 For t:=0 To FSeries.Count-1 Do
3153 Begin
3154 s:=FSeries[t];
3155 If s.Active Then
3156 Begin
3157l2:
3158 If FirstSerie=Nil Then FirstSerie:=s;
3159 LastSerie:=s;
3160 If t>0 Then If s.FValues.Count>0 Then dec(H,W3d+W3d Div 2);
3161 For t1:=0 To s.FValues.Count-1 Do
3162 Begin
3163 v:=s.FValues[t1];
3164 If v.Value>MaxValue Then MaxValue:=v.Value;
3165 If v.Value<MinValue Then MinValue:=v.Value;
3166 End;
3167 End;
3168 End
3169 End
3170 Else If s1<>Nil Then
3171 Begin
3172 t:=0;
3173 s:=s1;
3174 goto l2;
3175 End;
3176
3177 If HAxisVisible Then If LastSerie<>Nil Then
3178 Begin
3179 dec(H,HAxisTicksLen);
3180 HAxisLen:=0;
3181 For t1:=0 To LastSerie.FValues.Count-1 Do
3182 Begin
3183 v:=LastSerie.FValues[t1];
3184 ss:=v.ValueLabel;
3185 Canvas.GetTextExtent(ss,CX,CY);
3186 If CY>HAxisLen Then HAxisLen:=CY;
3187 End;
3188
3189 dec(H,HAxisLen+2);
3190 inc(BarRect.Bottom,HAxisLen+2);
3191 End;
3192
3193 inc(H,(W3d Div 2)*(SeriesCount-1));
3194 RangeValue:=MaxValue-MinValue;
3195 RangeValue:=RangeValue/SeparationPercent;
3196 Range:=H*SeparationPercent/100;
3197
3198 If VAxisVisible Then
3199 Begin
3200 dec(W,VAxisTicksLen);
3201 e:=MinValue;
3202 VAxisLen:=0;
3203 If RangeValue>0 Then While e<=MaxValue Do
3204 Begin
3205 If e=0 Then ss:='0'
3206 Else ss:=FormatFloat(AxisFormatStr,e);
3207 Canvas.GetTextExtent(ss,CX,CY);
3208 If CX>VAxisLen Then VAxisLen:=CX;
3209 e:=e+RangeValue;
3210 End;
3211 dec(W,VAxisLen+2);
3212 inc(BarRect.Left,VAxisLen+2);
3213 End;
3214
3215 BarWidth:=(W*PercentBarWidth) Div 100;
3216 MarginWidth:=W-BarWidth;
3217
3218 If PointsPerPage<>0 Then BarWidth:=BarWidth Div PointsPerPage
3219 Else
3220 Begin
3221 //determine serie with most points
3222 t1:=0;
3223 If FSeries.Count>0 Then For t:=0 To FSeries.Count-1 Do
3224 Begin
3225 s:=FSeries[t];
3226 If s.Active Then
3227 If s.FValues.Count>t1 Then t1:=s.FValues.Count;
3228 End
3229 Else If s1<>Nil Then t1:=s1.FValues.Count;
3230 If t1>0 Then BarWidth:=BarWidth Div t1;
3231 End;
3232
3233 Y:=BarRect.Bottom;
3234 LastX0:=BarRect.Left+W3D*SeriesCount+BarWidth-15;
3235 If FSeries.Count>0 Then For t:=0 To FSeries.Count-1 Do
3236 Begin
3237 X:=LastX0-BarWidth+15;
3238 s:=FSeries[t];
3239 If not s.Active Then continue;
3240l:
3241 For t1:=0 To s.FValues.Count-1 Do
3242 Begin
3243 v:=s.FValues[t1];
3244
3245 RGBToValues(v.FillColor,red,green,blue);
3246 If red>40 Then red:=red-40
3247 Else red:=0;
3248 If blue>40 Then blue:=blue-40
3249 Else blue:=0;
3250 If green>40 Then green:=green-40
3251 Else Green:=0;
3252 ShadowColor:=ValuesToRGB(red,green,blue);
3253
3254 rc1.Left:=X;
3255 rc1.Right:=rc1.Left+BarWidth;
3256 rc1.Bottom:=Y;
3257 If MinValue<0 Then
3258 Begin
3259 Percent:=(-MinValue*100)/(MaxValue-MinValue);
3260 inc(rc1.Bottom,Round((H*Percent)/100));
3261 HH:=H;
3262 dec(HH,Round((H*Percent)/100));
3263 End
3264 Else HH:=H;
3265 If MaxValue<>0 Then Percent:=(v.Value*100)/MaxValue
3266 Else Percent:=0;
3267 rc1.Top:=rc1.Bottom+W3D*SeriesCount+Round((HH*Percent)/100);
3268 dec(rc1.Top,(W3d Div 2)*(SeriesCount-1));
3269 If rc1.Top<rc1.Bottom Then
3270 Begin
3271 HH:=rc1.Top;
3272 rc1.Top:=rc1.Bottom;
3273 rc1.Bottom:=HH;
3274 End;
3275
3276 Case Style Of
3277 bcsRectangle:
3278 Begin
3279 Canvas.Pen.Color:=v.FillColor;
3280 Canvas.Box(rc1);
3281 Canvas.Pen.Color:=v.OutlineColor;
3282 Canvas.Rectangle(rc1);
3283 Canvas.ExcludeClipRect(rc1);
3284 End;
3285 bcsRectGradient:
3286 Begin
3287 dec(rc1.Bottom,2);
3288 DrawGradient(rc1,v.FillColor,clWhite,grsTopBottom);
3289 inc(rc1.Bottom,2);
3290 Canvas.Pen.Color:=v.OutlineColor;
3291 Canvas.Rectangle(rc1);
3292 Canvas.ExcludeClipRect(rc1);
3293 End;
3294 End; //case
3295
3296 inc(X,BarWidth);
3297 If ((PointsPerPage<>0)And(s.FValues.Count>PointsPerPage)) Then inc(X,MarginWidth Div PointsPerPage)
3298 Else inc(X,MarginWidth Div s.FValues.Count);
3299
3300 If t1+1=PointsPerPage Then break;
3301 End;
3302
3303 //exclude the rectangles for 3d
3304 If ((PointsPerPage<>0)And(s.FValues.Count>PointsPerPage)) Then dec(X,MarginWidth Div PointsPerPage)
3305 Else dec(X,MarginWidth Div s.FValues.Count);
3306 dec(X,BarWidth);
3307 For t1:=s.FValues.Count-1 DownTo 0 Do
3308 Begin
3309 v:=s.FValues[t1];
3310
3311 RGBToValues(v.FillColor,red,green,blue);
3312 If red>40 Then red:=red-40
3313 Else red:=0;
3314 If blue>40 Then blue:=blue-40
3315 Else blue:=0;
3316 If green>40 Then green:=green-40
3317 Else Green:=0;
3318 ShadowColor:=ValuesToRGB(red,green,blue);
3319
3320 rc1.Left:=X;
3321 rc1.Right:=rc1.Left+BarWidth;
3322 rc1.Bottom:=Y;
3323 If MinValue<0 Then
3324 Begin
3325 Percent:=(-MinValue*100)/(MaxValue-MinValue);
3326 inc(rc1.Bottom,Round((H*Percent)/100));
3327 HH:=H;
3328 dec(HH,Round((H*Percent)/100));
3329 End
3330 Else HH:=H;
3331 If MaxValue<>0 Then Percent:=(v.Value*100)/MaxValue
3332 Else Percent:=0;
3333 rc1.Top:=rc1.Bottom+W3D*SeriesCount+Round((HH*Percent)/100);
3334 dec(rc1.Top,(W3d Div 2)*(SeriesCount-1));
3335 If rc1.Top<rc1.Bottom Then
3336 Begin
3337 HH:=rc1.Top;
3338 rc1.Top:=rc1.Bottom;
3339 rc1.Bottom:=HH;
3340 End;
3341
3342 v.FEndPoint:=Point(rc1.Left+BarWidth Div 2,rc1.Bottom);
3343
3344 If t1=0 Then LastX0:=rc1.Right+W3d Div 2;
3345
3346 Canvas.Pen.Color:=ShadowColor;
3347 Canvas.Polygon([Point(rc1.Left,rc1.Top),
3348 Point(rc1.Left+W3d Div 2,rc1.Top+W3d Div 2),
3349 Point(rc1.Left+W3d Div 2+BarWidth,rc1.Top+W3d Div 2),
3350 Point(rc1.Left+BarWidth,rc1.Top)]);
3351
3352 Canvas.Pen.Color:=v.OutlineColor;
3353 Canvas.PolyLine([Point(rc1.Left,rc1.Top),
3354 Point(rc1.Left+W3d Div 2,rc1.Top+W3d Div 2),
3355 Point(rc1.Right+W3d Div 2,rc1.Top+W3d Div 2),
3356 Point(rc1.Right,rc1.Top)]);
3357
3358 Canvas.Pen.Color:=ShadowColor;
3359 Canvas.Polygon([Point(rc1.Right,rc1.Bottom),
3360 Point(rc1.Right,rc1.Top),
3361 Point(rc1.Right+W3d Div 2,rc1.Top+W3d Div 2),
3362 Point(rc1.Right+W3d Div 2,rc1.Bottom+W3d Div 2)]);
3363
3364 Canvas.Pen.Color:=v.OutlineColor;
3365 Canvas.PolyLine([Point(rc1.Right,rc1.Bottom),
3366 Point(rc1.Right,rc1.Top),
3367 Point(rc1.Right+W3d Div 2,rc1.Top+W3d Div 2),
3368 Point(rc1.Right+W3d Div 2,rc1.Bottom+W3d Div 2),
3369 Point(rc1.Right,rc1.Bottom)]);
3370
3371 If s.Marks.Visible Then
3372 Begin
3373 SaveFont:=Canvas.Font;
3374 ss:=GetChartStrDim(v,CX,CY);
3375 Canvas.Brush.Color:=s.Marks.BackColor;
3376
3377 rc2.Left:=rc1.Left+((rc1.Right-rc1.Left) Div 2)+W3d Div 2-CX Div 2;
3378 rc2.Right:=rc2.Left+CX;
3379 rc2.Bottom:=rc1.Top+W3d Div 2+s.Marks.ArrowLength;
3380 rc2.Top:=rc2.Bottom+CY;
3381 Canvas.Pen.Color:=s.Marks.BackColor;
3382 Canvas.Box(rc2);
3383 Canvas.Pen.Color:=s.Marks.BorderColor;
3384 Canvas.Brush.Mode:=bmTransparent;
3385 Canvas.TextOut(rc2.Left,rc2.Bottom,ss);
3386 Canvas.Brush.Mode:=bmOpaque;
3387 Canvas.Rectangle(rc2);
3388 Canvas.BeginPath;
3389 Canvas.Rectangle(rc2);
3390 Canvas.EndPath;
3391 Canvas.PathToClipRegion(paDiff);
3392
3393 Canvas.Pen.Color:=s.Marks.ArrowColor;
3394 Canvas.PenPos:=Point(rc2.Left+(rc2.Right-rc2.Left) Div 2,rc2.Bottom);
3395 Canvas.LineTo(rc2.Left+(rc2.Right-rc2.Left) Div 2,rc2.Bottom-s.Marks.ArrowLength-2);
3396
3397 Canvas.BeginPath;
3398 Canvas.PenPos:=Point(rc2.Left+(rc2.Right-rc2.Left) Div 2,rc2.Bottom);
3399 Canvas.LineTo(rc2.Left+(rc2.Right-rc2.Left) Div 2,rc2.Bottom-s.Marks.ArrowLength-2);
3400 Canvas.EndPath;
3401 Canvas.PathToClipRegion(paDiff);
3402
3403 Canvas.Font:=SaveFont;
3404 End;
3405
3406 Canvas.BeginPath;
3407 Canvas.PolyLine([Point(rc1.Left,rc1.Top),
3408 Point(rc1.Left+W3d Div 2,rc1.Top+W3d Div 2),
3409 Point(rc1.Left+W3d Div 2+BarWidth,rc1.Top+W3d Div 2),
3410 Point(rc1.Left+BarWidth,rc1.Top)]);
3411
3412 Canvas.EndPath;
3413 Canvas.PathToClipRegion(paDiff);
3414
3415 Canvas.BeginPath;
3416 Canvas.PolyLine([Point(rc1.Right,rc1.Bottom),
3417 Point(rc1.Right,rc1.Top),
3418 Point(rc1.Right+W3d Div 2,rc1.Top+W3d Div 2),
3419 Point(rc1.Right+W3d Div 2,rc1.Bottom+W3d Div 2)]);
3420 Canvas.EndPath;
3421 Canvas.PathToClipRegion(paDiff);
3422
3423 If ((PointsPerPage<>0)And(s.FValues.Count>PointsPerPage)) Then dec(X,MarginWidth Div PointsPerPage)
3424 Else dec(X,MarginWidth Div s.FValues.Count);
3425 dec(X,BarWidth);
3426
3427 If t1+1=PointsPerPage Then break;
3428 End;
3429
3430 inc(Y,W3d Div 2);
3431 If t>FSeries.Count-1 Then Break;
3432 End
3433 Else If s1<>Nil Then
3434 Begin
3435 s:=s1;
3436 X:=LastX0-BarWidth+15;
3437 t:=1;
3438 goto l;
3439 End;
3440
3441 For t:=1 To FSeries.Count-1 Do
3442 Begin
3443 s:=FSeries[t];
3444 If s.Active Then
3445 If s.FValues.Count>0 Then inc(W,(W3d Div 2)+15);
3446 End;
3447 dec(W,W3d);
3448
3449 rc1.Left:=BarRect.Left+(W3d*SeriesCount);
3450 rc1.Bottom:=BarRect.Bottom+(W3d*SeriesCount);
3451 rc1.Right:=rc1.Left+W+(W3d*SeriesCount);
3452 rc1.Top:=BarRect.Top;
3453
3454 //Draw Walls
3455 If LeftWallVisible Then
3456 Begin
3457 Canvas.Pen.Color:=LeftWallColor;
3458 Canvas.Polygon([Point(BarRect.Left,BarRect.Bottom),
3459 Point(BarRect.Left,BarRect.Top-(W3D*SeriesCount)),
3460 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Top),
3461 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount))
3462 ]);
3463 End;
3464
3465 If BottomWallVisible Then
3466 Begin
3467 Canvas.Pen.Color:=BottomWallColor;
3468 Canvas.Polygon([Point(BarRect.Left,BarRect.Bottom),
3469 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount)),
3470 Point(BarRect.Left+(W3D*SeriesCount*2)+W,BarRect.Bottom+(W3D*SeriesCount)),
3471 Point(BarRect.Left+(W3D*SeriesCount)+W,BarRect.Bottom)
3472 ]);
3473 End;
3474
3475 If BackWallVisible Then
3476 Begin
3477 Canvas.Pen.Color:=BackWallColor;
3478 Canvas.Box(rc1);
3479 End;
3480
3481 X:=BarRect.Left;
3482 YY:=BarRect.Bottom;
3483 //Canvas.Pen.Style:=psDash;
3484 Canvas.Pen.Color:=clDkGray;
3485 If FHAxisGrid Then While YY<BarRect.Top-W3d*SeriesCount Do
3486 Begin
3487 Canvas.PenPos:=Point(X,Round(YY));
3488 Canvas.LineTo(X+W3D*SeriesCount,Round(YY)+W3D*SeriesCount);
3489 YY:=YY+Range;
3490 End;
3491 //Canvas.Pen.Style:=psSolid;
3492 Canvas.Pen.Color:=clBlack;
3493
3494 If BottomWallVisible Then
3495 Begin
3496 Canvas.PolyLine([Point(BarRect.Left,BarRect.Bottom),
3497 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount)),
3498 Point(BarRect.Left+(W3D*SeriesCount*2)+W,BarRect.Bottom+(W3D*SeriesCount)),
3499 Point(BarRect.Left+(W3D*SeriesCount)+W,BarRect.Bottom),
3500 Point(BarRect.Left,BarRect.Bottom)
3501 ]);
3502 Canvas.BeginPath;
3503 Canvas.PolyLine([Point(BarRect.Left,BarRect.Bottom),
3504 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount)),
3505 Point(BarRect.Left+(W3D*SeriesCount*2)+W,BarRect.Bottom+(W3D*SeriesCount)),
3506 Point(BarRect.Left+(W3D*SeriesCount)+W,BarRect.Bottom)
3507 ]);
3508
3509 Canvas.EndPath;
3510 Canvas.PathToClipRegion(paDiff);
3511 End;
3512
3513 If LeftWallVisible Then
3514 Begin
3515 Canvas.PolyLine([Point(BarRect.Left,BarRect.Bottom),
3516 Point(BarRect.Left,BarRect.Top-(W3D*SeriesCount)),
3517 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Top),
3518 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount))
3519 ]);
3520 Canvas.BeginPath;
3521 Canvas.PolyLine([Point(BarRect.Left,BarRect.Bottom),
3522 Point(BarRect.Left,BarRect.Top-(W3D*SeriesCount)),
3523 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Top),
3524 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount))
3525 ]);
3526 Canvas.EndPath;
3527 Canvas.PathToClipRegion(paDiff);
3528 End;
3529
3530 If BackWallVisible Then
3531 Begin
3532 Canvas.Rectangle(rc1);
3533 X:=BarRect.Left+W3D*SeriesCount;
3534 YY:=BarRect.Bottom+W3D*SeriesCount;
3535 Canvas.Pen.Style:=psDash;
3536 Canvas.Pen.Color:=clDkGray;
3537 If FVAxisGrid Then While YY<BarRect.Top Do
3538 Begin
3539 Canvas.PenPos:=Point(X,Round(YY));
3540 Canvas.LineTo(X+W3D*SeriesCount+W,Round(YY));
3541
3542 YY:=YY+Range;
3543 End;
3544 If FHAxisGrid Then If s1<>Nil Then For t:=0 To s1.FValues.Count-1 Do
3545 Begin
3546 v:=s1.FValues[t];
3547 Canvas.PenPos:=Point(v.FEndPoint.X+W3d*SeriesCount,v.FEndPoint.Y+W3d*SeriesCount);
3548 Canvas.LineTo(v.FEndPoint.X+W3d*SeriesCount,BarRect.Top);
3549 End;
3550
3551 Canvas.Pen.Style:=psSolid;
3552 Canvas.Pen.Color:=clBlack;
3553
3554 Canvas.BeginPath;
3555 Canvas.Rectangle(rc1);
3556 Canvas.EndPath;
3557 Canvas.PathToClipRegion(paDiff);
3558 End;
3559
3560 If GradientStyle=grsNone Then Canvas.FillRect(clRect,Color)
3561 Else DrawGradient(clRect,FGradientEnd,FGradientStart,FGradientStyle);
3562
3563 Canvas.Pen.Color:=clBlack;
3564
3565 If not LeftWallVisible Then
3566 Canvas.PolyLine([Point(BarRect.Left,BarRect.Bottom),
3567 Point(BarRect.Left,BarRect.Top-(W3D*SeriesCount)),
3568 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Top),
3569 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount))
3570 ]);
3571
3572 If VAxisVisible Then
3573 Begin
3574 e:=MinValue;
3575 Canvas.Brush.Mode:=bmTransparent;
3576 YY:=BarRect.Bottom;
3577 If RangeValue>0 Then While YY<BarRect.Top-W3d*SeriesCount Do
3578 Begin
3579 If e=0 Then ss:='0'
3580 Else ss:=FormatFloat(AxisFormatStr,e);
3581 Canvas.GetTextExtent(ss,CX,CY);
3582 Canvas.TextOut(BarRect.Left-CX-2-VAxisTicksLen,Round(YY)-CY Div 2,ss);
3583 If VAxisTicksLen>0 Then
3584 Begin
3585 Canvas.PenPos:=Point(BarRect.Left,Round(YY));
3586 Canvas.LineTo(BarRect.Left-VAxisTicksLen,Round(YY));
3587 End;
3588 e:=e+RangeValue;
3589 YY:=YY+Range;
3590 End;
3591 Canvas.Brush.Mode:=bmOpaque;
3592 End;
3593
3594 If HAxisVisible Then If FirstSerie<>Nil Then
3595 Begin
3596 Canvas.Brush.Mode:=bmTransparent;
3597 For t1:=0 To FirstSerie.ValueCount-1 Do
3598 Begin
3599 v:=FirstSerie.Values[t1];
3600 Canvas.PenPos:=Point(v.FEndPoint.X,BarRect.Bottom);
3601 Canvas.LineTo(v.FEndPoint.X,BarRect.Bottom-HAxisTicksLen);
3602 ss:=v.ValueLabel;
3603 Canvas.GetTextExtent(ss,CX,CY);
3604 Canvas.TextOut(v.FEndPoint.X-CX Div 2,BarRect.Bottom-2-HAxisTicksLen-CY,ss);
3605 End;
3606 Canvas.Brush.Mode:=bmOpaque;
3607 End;
3608
3609 If not BottomWallVisible Then
3610 Canvas.PolyLine([Point(BarRect.Left,BarRect.Bottom),
3611 Point(BarRect.Left+(W3D*SeriesCount),BarRect.Bottom+(W3D*SeriesCount)),
3612 Point(BarRect.Left+(W3D*SeriesCount*2)+W,BarRect.Bottom+(W3D*SeriesCount)),
3613 Point(BarRect.Left+(W3D*SeriesCount)+W,BarRect.Bottom),
3614 Point(BarRect.Left,BarRect.Bottom)
3615 ]);
3616
3617 If not BackWallVisible Then
3618 Begin
3619 Canvas.Rectangle(rc1);
3620
3621 X:=BarRect.Left+W3D*SeriesCount;
3622 YY:=BarRect.Bottom+W3D*SeriesCount;
3623 Canvas.Pen.Style:=psDash;
3624 Canvas.Pen.Color:=clDkGray;
3625 If FVAxisGrid Then While YY<BarRect.Top Do
3626 Begin
3627 Canvas.PenPos:=Point(X,Round(YY));
3628 Canvas.LineTo(X+W3D*SeriesCount+W,Round(YY));
3629
3630 YY:=YY+Range;
3631 End;
3632 If FHAxisGrid Then If s1<>Nil Then For t:=0 To s1.FValues.Count-1 Do
3633 Begin
3634 v:=s1.FValues[t];
3635 Canvas.PenPos:=Point(v.FEndPoint.X+W3d*SeriesCount,v.FEndPoint.Y+W3d*SeriesCount);
3636 Canvas.LineTo(v.FEndPoint.X+W3d*SeriesCount,BarRect.Top);
3637 End;
3638
3639 Canvas.Pen.Style:=psSolid;
3640 Canvas.Pen.Color:=clBlack;
3641 End;
3642
3643 If s1<>Nil Then If s1.TitleVisible Then
3644 Begin
3645 ChartRect:=clRect;
3646 inc(ChartRect.Left,MarginLeft);
3647 inc(ChartRect.Bottom,MarginBottom);
3648 dec(ChartRect.Right,MarginRight);
3649 dec(ChartRect.Top,MarginTop);
3650
3651 Canvas.Pen.Color:=s.TitleColor;
3652 Canvas.Brush.Mode:=bmTransparent;
3653 Title:=s1.Title;
3654 If Title.Count>0 Then
3655 Begin
3656 SaveFont:=Canvas.Font;
3657 Canvas.Font:=s1.Font;
3658 End;
3659 For t:=0 To Title.Count-1 Do
3660 Begin
3661 Canvas.GetTextExtent(Title.Strings[t],CX,CY);
3662 Case s.TitleAlignment Of
3663 staLeft:rc.Left:=ChartRect.Left;
3664 staCenter:
3665 Begin
3666 rc.Left:=ChartRect.Left+(((ChartRect.Right-ChartRect.Left)-CX) Div 2);
3667 If rc.Left<ChartRect.Left Then rc.Left:=ChartRect.Left;
3668 End;
3669 staRight:rc.Left:=ChartRect.Right-CX;
3670 End; //case
3671
3672 rc.Right:=rc.Left+CX;
3673 rc.Bottom:=ChartRect.Top-CY;
3674 dec(ChartRect.Top,CY);
3675 rc.Top:=rc.Bottom+CY;
3676 Canvas.TextOut(rc.Left,rc.Bottom,Title.Strings[t]);
3677 End;
3678 If Title.Count>0 Then Canvas.Font:=SaveFont;
3679 Canvas.Brush.Mode:=bmOpaque;
3680 End;
3681
3682End;
3683
3684{
3685ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3686º º
3687º Speed-Pascal/2 Version 2.0 º
3688º º
3689º Speed-Pascal Component Classes (SPCC) º
3690º º
3691º This section: TDBBarChart Class Implementation º
3692º º
3693º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3694º º
3695ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3696}
3697
3698
3699Procedure TDBBarChart.SetDataSource(NewValue:TDataSource);
3700Begin
3701 CreateDesignSerie;
3702 If FSeries.Count>0 Then TChartSeries(FSeries[0]).DataSource:=NewValue;
3703End;
3704
3705Function TDBBarChart.GetDataSource:TDataSource;
3706Begin
3707 CreateDesignSerie;
3708 If FSeries.Count>0 Then Result:=TChartSeries(FSeries[0]).DataSource
3709 Else Result:=Nil;
3710End;
3711
3712Function TDBBarChart.GetLabelSource:String;
3713Begin
3714 CreateDesignSerie;
3715 If FSeries.Count>0 Then Result:=TChartSeries(FSeries[0]).LabelSource
3716 Else Result:='';
3717End;
3718
3719Procedure TDBBarChart.SetLabelSource(Const NewValue:String);
3720Begin
3721 CreateDesignSerie;
3722 If FSeries.Count>0 Then TChartSeries(FSeries[0]).LabelSource:=NewValue;
3723End;
3724
3725Function TDBBarChart.GetValueSource:String;
3726Begin
3727 If FSeries.Count>0 Then Result:=TChartSeries(FSeries[0]).ValueSource
3728 Else Result:='';
3729End;
3730
3731Procedure TDBBarChart.SetValueSource(Const NewValue:String);
3732Begin
3733 CreateDesignSerie;
3734 If FSeries.Count>0 Then TChartSeries(FSeries[0]).ValueSource:=NewValue;
3735End;
3736
3737Procedure TDBBarChart.Redraw(Const rec:TRect);
3738Var l:LongInt;
3739Begin
3740 l:=FUpdateCount;
3741 FUpdateCount:=1;
3742 CreateDesignSerie;
3743 FUpdateCount:=l;
3744 Inherited Redraw(rec);
3745End;
3746
3747
3748Initialization
3749 RegisterClasses([TPieChart,TBarChart,TDBPieChart,TDBBarChart]);
3750End.
Note: See TracBrowser for help on using the repository browser.