PageRenderTime 20ms CodeModel.GetById 12ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 0ms

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