/Source/FR_CHART.PAS

http://github.com/FastReports/FreeReport · Pascal · 537 lines · 466 code · 52 blank · 19 comment · 47 complexity · 07590ae78203c07f3e9e4374af0c049f MD5 · raw file

  1. {*****************************************}
  2. { }
  3. { FastReport v2.3 }
  4. { Chart Add-In Object }
  5. { }
  6. { Copyright (c) 1998-99 by Tzyganenko A. }
  7. { }
  8. {*****************************************}
  9. unit FR_Chart;
  10. interface
  11. {$I FR.inc}
  12. uses
  13. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  14. FR_Class, ExtCtrls, TeeProcs, TeEngine, Chart, Series, StdCtrls, FR_Ctrls,
  15. ComCtrls, Menus;
  16. type
  17. TChartOptions = packed record
  18. ChartType: Byte;
  19. Dim3D, IsSingle, ShowLegend, ShowAxis, ShowMarks, Colored: Boolean;
  20. MarksStyle: Byte;
  21. Top10Num: Integer;
  22. Reserved: Array[0..35] of Byte;
  23. end;
  24. TfrChartObject = class(TComponent) // fake component
  25. end;
  26. TfrChartView = class(TfrView)
  27. private
  28. CurStr: Integer;
  29. LastLegend: String;
  30. function ShowChart: Boolean;
  31. public
  32. Chart: TChartOptions;
  33. LegendObj, ValueObj, Top10Label: String;
  34. constructor Create; override;
  35. procedure Assign(From: TfrView); override;
  36. procedure Draw(Canvas: TCanvas); override;
  37. procedure Print(Stream: TStream); override;
  38. procedure LoadFromStream(Stream: TStream); override;
  39. procedure SaveToStream(Stream: TStream); override;
  40. procedure DefinePopupMenu(Popup: TPopupMenu); override;
  41. procedure OnHook(View: TfrView); override;
  42. end;
  43. TfrChartForm = class(TfrObjEditorForm)
  44. Image1: TImage;
  45. Page1: TPageControl;
  46. Tab1: TTabSheet;
  47. GroupBox1: TGroupBox;
  48. SB1: TfrSpeedButton;
  49. SB2: TfrSpeedButton;
  50. SB3: TfrSpeedButton;
  51. SB4: TfrSpeedButton;
  52. SB5: TfrSpeedButton;
  53. SB6: TfrSpeedButton;
  54. Tab2: TTabSheet;
  55. Button1: TButton;
  56. Button2: TButton;
  57. GroupBox2: TGroupBox;
  58. Label1: TLabel;
  59. E1: TEdit;
  60. Label2: TLabel;
  61. E2: TEdit;
  62. GroupBox3: TGroupBox;
  63. CB1: TCheckBox;
  64. CB2: TCheckBox;
  65. CB3: TCheckBox;
  66. CB4: TCheckBox;
  67. CB6: TCheckBox;
  68. CB5: TCheckBox;
  69. Tab3: TTabSheet;
  70. GroupBox4: TGroupBox;
  71. RB1: TRadioButton;
  72. RB2: TRadioButton;
  73. RB3: TRadioButton;
  74. RB4: TRadioButton;
  75. RB5: TRadioButton;
  76. GroupBox5: TGroupBox;
  77. Label3: TLabel;
  78. Label4: TLabel;
  79. E3: TEdit;
  80. E4: TEdit;
  81. Label5: TLabel;
  82. Chart1: TChart;
  83. procedure FormCreate(Sender: TObject);
  84. private
  85. { Private declarations }
  86. public
  87. { Public declarations }
  88. procedure ShowEditor(t: TfrView); override;
  89. end;
  90. implementation
  91. uses FR_Intrp, FR_Pars, FR_Utils, FR_Const;
  92. {$R *.DFM}
  93. type
  94. THackView = class(TfrView)
  95. end;
  96. TSeriesClass = class of TChartSeries;
  97. var
  98. frChartForm: TfrChartForm;
  99. SChart: TChart;
  100. const
  101. ChartTypes: Array[0..5] of TSeriesClass =
  102. (TLineSeries, TAreaSeries, TPointSeries,
  103. TBarSeries, THorizBarSeries, TPieSeries);
  104. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  105. var
  106. i: Integer;
  107. begin
  108. i := Pos;
  109. while (i <= Length(Fields)) and (Fields[i] <> ';') do Inc(i);
  110. Result := Copy(Fields, Pos, i - Pos);
  111. if (i <= Length(Fields)) and (Fields[i] = ';') then Inc(i);
  112. Pos := i;
  113. end;
  114. constructor TfrChartView.Create;
  115. begin
  116. inherited Create;
  117. with Chart do
  118. begin
  119. Dim3D := True;
  120. IsSingle := True;
  121. ShowLegend := True;
  122. ShowMarks := True;
  123. Colored := True;
  124. end;
  125. Typ := gtAddIn;
  126. BaseName := 'Chart';
  127. Flags := Flags or flWantHook;
  128. end;
  129. procedure TfrChartView.Assign(From: TfrView);
  130. begin
  131. inherited Assign(From);
  132. Chart := TfrChartView(From).Chart;
  133. LegendObj := TfrChartView(From).LegendObj;
  134. ValueObj := TfrChartView(From).ValueObj;
  135. Top10Label := TfrChartView(From).Top10Label;
  136. end;
  137. function TfrChartView.ShowChart: Boolean;
  138. var
  139. i, j, c1, c2: Integer;
  140. LegS, ValS, s: String;
  141. Ser: TChartSeries;
  142. EMF: TMetafile;
  143. function Str2Float(s: String): Double;
  144. begin
  145. s := Trim(s);
  146. while (Length(s) > 0) and not (s[1] in ['0'..'9']) do
  147. s := Copy(s, 2, 255); // trim all non-digit chars at the begin
  148. while (Length(s) > 0) and not (s[Length(s)] in ['0'..'9']) do
  149. s := Copy(s, 1, Length(s) - 1); // trim all non-digit chars at the end
  150. while Pos(ThousandSeparator, s) <> 0 do
  151. Delete(s, Pos(ThousandSeparator, s), 1);
  152. Result := 0;
  153. try
  154. Result := StrToFloat(s);
  155. except
  156. on exception do;
  157. end;
  158. end;
  159. procedure SortValues(var LegS, ValS: String);
  160. var
  161. i, j: Integer;
  162. sl: TStringList;
  163. s: String;
  164. d: Double;
  165. begin
  166. sl := TStringList.Create;
  167. sl.Sorted := True;
  168. i := 1; j := 1;
  169. while i <= Length(LegS) do
  170. sl.Add(SysUtils.Format('%12.3f', [Str2Float(ExtractFieldName(ValS, j))]) + '=' +
  171. ExtractFieldName(LegS, i));
  172. LegS := ''; ValS := '';
  173. for i := 1 to Chart.Top10Num do
  174. begin
  175. s := sl[sl.Count - i];
  176. ValS := ValS + Copy(s, 1, Pos('=', s) - 1) + ';';
  177. LegS := LegS + Copy(s, Pos('=', s) + 1, 255) + ';';
  178. end;
  179. i := sl.Count - Chart.Top10Num - 1; d := 0;
  180. while i >= 0 do
  181. begin
  182. s := sl[i];
  183. d := d + Str2Float(Copy(s, 1, Pos('=', s) - 1));
  184. Dec(i);
  185. end;
  186. LegS := LegS + Top10Label + ';';
  187. ValS := ValS + FloatToStr(d) + ';';
  188. sl.Free;
  189. end;
  190. begin
  191. Result := False;
  192. SChart.RemoveAllSeries;
  193. with Chart do
  194. begin
  195. SChart.Frame.Visible := False;
  196. SChart.LeftWall.Brush.Style := bsClear;
  197. SChart.BottomWall.Brush.Style := bsClear;
  198. SChart.View3D := Dim3D;
  199. SChart.Legend.Visible := ShowLegend;
  200. SChart.AxisVisible := ShowAxis;
  201. SChart.View3DWalls := ChartType <> 5;
  202. {$IFDEF Delphi4}
  203. SChart.BackWall.Brush.Style := bsClear;
  204. SChart.View3DOptions.Elevation := 315;
  205. SChart.View3DOptions.Rotation := 360;
  206. SChart.View3DOptions.Orthogonal := ChartType <> 5;
  207. {$ENDIF}
  208. end;
  209. if Memo.Count > 0 then
  210. LegS := Memo[0] else
  211. LegS := '';
  212. if Memo.Count > 1 then
  213. ValS := Memo[1] else
  214. ValS := '';
  215. if (LegS = '') or (ValS = '') then Exit;
  216. if LegS[Length(LegS)] <> ';' then
  217. LegS := LegS + ';';
  218. if ValS[Length(ValS)] <> ';' then
  219. ValS := ValS + ';';
  220. if Chart.IsSingle then
  221. begin
  222. Ser := ChartTypes[Chart.ChartType].Create(SChart);
  223. SChart.AddSeries(Ser);
  224. if Chart.Colored then
  225. Ser.ColorEachPoint := True;
  226. Ser.Marks.Visible := Chart.ShowMarks;
  227. Ser.Marks.Style := TSeriesMarksStyle(Chart.MarksStyle);
  228. c1 := 0;
  229. for i := 1 to Length(LegS) do
  230. if LegS[i] = ';' then Inc(c1);
  231. c2 := 0;
  232. for i := 1 to Length(ValS) do
  233. if ValS[i] = ';' then Inc(c2);
  234. if c1 <> c2 then Exit;
  235. if (Chart.Top10Num > 0) and (c1 > Chart.Top10Num) then
  236. SortValues(LegS, ValS);
  237. i := 1; j := 1;
  238. while i <= Length(LegS) do
  239. begin
  240. s := ExtractFieldName(ValS, j);
  241. Ser.Add(Str2Float(s), ExtractFieldName(LegS, i), clTeeColor);
  242. end;
  243. end
  244. else
  245. begin
  246. c1 := 0;
  247. for i := 1 to Length(LegS) do
  248. if LegS[i] = ';' then Inc(c1);
  249. if c1 <> Memo.Count - 1 then Exit;
  250. i := 1;
  251. c1 := 1;
  252. while i <= Length(LegS) do
  253. begin
  254. Ser := ChartTypes[Chart.ChartType].Create(SChart);
  255. SChart.AddSeries(Ser);
  256. Ser.Title := ExtractFieldName(LegS, i);
  257. Ser.Marks.Visible := Chart.ShowMarks;
  258. Ser.Marks.Style := TSeriesMarksStyle(Chart.MarksStyle);
  259. ValS := Memo[c1];
  260. if ValS[Length(ValS)] <> ';' then
  261. ValS := ValS + ';';
  262. j := 1;
  263. while j <= Length(ValS) do
  264. begin
  265. s := ExtractFieldName(ValS, j);
  266. Ser.Add(Str2Float(s), '', clTeeColor);
  267. end;
  268. Inc(c1);
  269. end;
  270. end;
  271. with Canvas do
  272. begin
  273. SChart.Color := FillColor;
  274. EMF := SChart.TeeCreateMetafile(False, Rect(0, 0, SaveDX, SaveDY));
  275. StretchDraw(DRect, EMF);
  276. EMF.Free;
  277. end;
  278. Result := True;
  279. end;
  280. procedure TfrChartView.Draw(Canvas: TCanvas);
  281. begin
  282. BeginDraw(Canvas);
  283. Memo1.Assign(Memo);
  284. CalcGaps;
  285. if not ShowChart then
  286. ShowBackground;
  287. ShowFrame;
  288. RestoreCoord;
  289. end;
  290. procedure TfrChartView.Print(Stream: TStream);
  291. begin
  292. BeginDraw(Canvas);
  293. Memo1.Assign(Memo);
  294. CurReport.InternalOnEnterRect(Memo1, Self);
  295. frInterpretator.DoScript(Script);
  296. if not Visible then Exit;
  297. Stream.Write(Typ, 1);
  298. frWriteString(Stream, ClassName);
  299. SaveToStream(Stream);
  300. end;
  301. procedure TfrChartView.LoadFromStream(Stream: TStream);
  302. var
  303. b: Byte;
  304. function ReadString(Stream: TStream): String;
  305. begin
  306. if frVersion >= 23 then
  307. {$IFDEF FREEREP2217READ}
  308. begin
  309. if (frVersion = 23) and FRE_COMPATIBLE_READ then
  310. Result := frReadString2217(Stream) // load in bad format
  311. else
  312. Result := frReadString(Stream); // load in current format
  313. end
  314. else
  315. {$ELSE}
  316. Result := frReadString(Stream) else
  317. {$ENDIF}
  318. Result := frReadString22(Stream);
  319. end;
  320. begin
  321. inherited LoadFromStream(Stream);
  322. with Stream do
  323. begin
  324. Read(b, 1);
  325. Read(Chart, SizeOf(Chart));
  326. LegendObj := ReadString(Stream);
  327. ValueObj := ReadString(Stream);
  328. Top10Label := ReadString(Stream);
  329. end;
  330. end;
  331. procedure TfrChartView.SaveToStream(Stream: TStream);
  332. var
  333. b: Byte;
  334. begin
  335. inherited SaveToStream(Stream);
  336. with Stream do
  337. begin
  338. b := 0; // internal chart version
  339. Write(b, 1);
  340. Write(Chart, SizeOf(Chart));
  341. frWriteString(Stream, LegendObj);
  342. frWriteString(Stream, ValueObj);
  343. frWriteString(Stream, Top10Label);
  344. end;
  345. end;
  346. procedure TfrChartView.DefinePopupMenu(Popup: TPopupMenu);
  347. begin
  348. // no specific items in popup menu
  349. end;
  350. procedure TfrChartView.OnHook(View: TfrView);
  351. var
  352. i: Integer;
  353. s: String;
  354. begin
  355. if Memo.Count < 2 then
  356. begin
  357. Memo.Clear;
  358. Memo.Add('');
  359. Memo.Add('');
  360. end;
  361. i := -1;
  362. if AnsiCompareText(View.Name, LegendObj) = 0 then
  363. begin
  364. i := 0;
  365. Inc(CurStr);
  366. end
  367. else if AnsiCompareText(View.Name, ValueObj) = 0 then
  368. i := CurStr;
  369. if Chart.IsSingle then
  370. CurStr := 1;
  371. if i >= 0 then
  372. begin
  373. if Memo.Count <= i then
  374. while Memo.Count <= i do
  375. Memo.Add('');
  376. if THackView(View).Memo1.Count > 0 then
  377. begin
  378. s := THackView(View).Memo1[0];
  379. if LastLegend <> s then
  380. Memo[i] := Memo[i] + s + ';';
  381. LastLegend := s;
  382. end;
  383. end;
  384. end;
  385. {------------------------------------------------------------------------}
  386. procedure TfrChartForm.ShowEditor(t: TfrView);
  387. procedure SetButton(b: Array of TfrSpeedButton; n: Integer);
  388. begin
  389. b[n].Down := True;
  390. end;
  391. function GetButton(b: Array of TfrSpeedButton): Integer;
  392. var
  393. i: Integer;
  394. begin
  395. Result := 0;
  396. for i := 0 to High(b) do
  397. if b[i].Down then
  398. Result := i;
  399. end;
  400. procedure SetRButton(b: Array of TRadioButton; n: Integer);
  401. begin
  402. b[n].Checked := True;
  403. end;
  404. function GetRButton(b: Array of TRadioButton): Integer;
  405. var
  406. i: Integer;
  407. begin
  408. Result := 0;
  409. for i := 0 to High(b) do
  410. if b[i].Checked then
  411. Result := i;
  412. end;
  413. begin
  414. Page1.ActivePage := Tab1;
  415. with TfrChartView(t), Chart do
  416. begin
  417. SetButton([SB1, SB2, SB3, SB4, SB5, SB6], ChartType);
  418. SetRButton([RB1, RB2, RB3, RB4, RB5], MarksStyle);
  419. CB1.Checked := Dim3D;
  420. CB2.Checked := IsSingle;
  421. CB3.Checked := ShowLegend;
  422. CB4.Checked := ShowAxis;
  423. CB5.Checked := ShowMarks;
  424. CB6.Checked := Colored;
  425. E1.Text := LegendObj;
  426. E2.Text := ValueObj;
  427. E3.Text := IntToStr(Top10Num);
  428. E4.Text := Top10Label;
  429. if ShowModal = mrOk then
  430. begin
  431. frDesigner.BeforeChange;
  432. ChartType := GetButton([SB1, SB2, SB3, SB4, SB5, SB6]);
  433. MarksStyle := GetRButton([RB1, RB2, RB3, RB4, RB5]);
  434. Dim3D := CB1.Checked;
  435. IsSingle := CB2.Checked;
  436. ShowLegend := CB3.Checked;
  437. ShowAxis := CB4.Checked;
  438. ShowMarks := CB5.Checked;
  439. Colored := CB6.Checked;
  440. LegendObj := E1.Text;
  441. ValueObj := E2.Text;
  442. Top10Num := StrToInt(E3.Text);
  443. Top10Label := E4.Text;
  444. end;
  445. end;
  446. end;
  447. procedure TfrChartForm.FormCreate(Sender: TObject);
  448. begin
  449. Caption := LoadStr(frRes + 590);
  450. Tab1.Caption := LoadStr(frRes + 591);
  451. Tab2.Caption := LoadStr(frRes + 592);
  452. Tab3.Caption := LoadStr(frRes + 604);
  453. GroupBox1.Caption := LoadStr(frRes + 593);
  454. GroupBox2.Caption := LoadStr(frRes + 594);
  455. GroupBox3.Caption := LoadStr(frRes + 595);
  456. GroupBox4.Caption := LoadStr(frRes + 605);
  457. GroupBox5.Caption := LoadStr(frRes + 611);
  458. CB1.Caption := LoadStr(frRes + 596);
  459. CB2.Caption := LoadStr(frRes + 597);
  460. CB3.Caption := LoadStr(frRes + 598);
  461. CB4.Caption := LoadStr(frRes + 599);
  462. CB5.Caption := LoadStr(frRes + 600);
  463. CB6.Caption := LoadStr(frRes + 601);
  464. RB1.Caption := LoadStr(frRes + 606);
  465. RB2.Caption := LoadStr(frRes + 607);
  466. RB3.Caption := LoadStr(frRes + 608);
  467. RB4.Caption := LoadStr(frRes + 609);
  468. RB5.Caption := LoadStr(frRes + 610);
  469. Label1.Caption := LoadStr(frRes + 602);
  470. Label2.Caption := LoadStr(frRes + 603);
  471. Label3.Caption := LoadStr(frRes + 612);
  472. Label4.Caption := LoadStr(frRes + 613);
  473. Label5.Caption := LoadStr(frRes + 614);
  474. Button1.Caption := LoadStr(SOk);
  475. Button2.Caption := LoadStr(SCancel);
  476. end;
  477. initialization
  478. frChartForm := TfrChartForm.Create(nil);
  479. SChart := frChartForm.Chart1;
  480. frRegisterObject(TfrChartView, frChartForm.Image1.Picture.Bitmap,
  481. LoadStr(SInsChart), frChartForm);
  482. finalization
  483. frChartForm.Free;
  484. frChartForm := nil;
  485. end.