fr_chart.pas

FreeReport 2.34 consists of the report engine, designer and previewer, with capabilities comparable

{*****************************************}
{                                         }
{             FastReport v2.3             }
{           Chart Add-In Object           }
{                                         }
{  Copyright (c) 1998-99 by Tzyganenko A. }
{                                         }
{*****************************************}

unit FR_Chart;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FR_Class, ExtCtrls, TeeProcs, TeEngine, Chart, Series, StdCtrls, FR_Ctrls,
  ComCtrls, Menus;

type
  TChartOptions = packed record
    ChartType: Byte;
    Dim3D, IsSingle, ShowLegend, ShowAxis, ShowMarks, Colored: Boolean;
    MarksStyle: Byte;
    Top10Num: Integer;
    Reserved: Array[0..35] of Byte;
  end;

  TfrChartObject = class(TComponent)  // fake component
  end;

  TfrChartView = class(TfrView)
  private
    CurStr: Integer;
    LastLegend: String;
    function ShowChart: Boolean;
  public
    Chart: TChartOptions;
    LegendObj, ValueObj, Top10Label: String;
    constructor Create; override;
    procedure Assign(From: TfrView); override;
    procedure Draw(Canvas: TCanvas); override;
    procedure Print(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure OnHook(View: TfrView); override;
  end;

  TfrChartForm = class(TfrObjEditorForm)
    Image1: TImage;
    Page1: TPageControl;
    Tab1: TTabSheet;
    GroupBox1: TGroupBox;
    SB1: TfrSpeedButton;
    SB2: TfrSpeedButton;
    SB3: TfrSpeedButton;
    SB4: TfrSpeedButton;
    SB5: TfrSpeedButton;
    SB6: TfrSpeedButton;
    Tab2: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    E1: TEdit;
    Label2: TLabel;
    E2: TEdit;
    GroupBox3: TGroupBox;
    CB1: TCheckBox;
    CB2: TCheckBox;
    CB3: TCheckBox;
    CB4: TCheckBox;
    CB6: TCheckBox;
    CB5: TCheckBox;
    Tab3: TTabSheet;
    GroupBox4: TGroupBox;
    RB1: TRadioButton;
    RB2: TRadioButton;
    RB3: TRadioButton;
    RB4: TRadioButton;
    RB5: TRadioButton;
    GroupBox5: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    E3: TEdit;
    E4: TEdit;
    Label5: TLabel;
    Chart1: TChart;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowEditor(t: TfrView); override;
  end;


implementation

uses FR_Intrp, FR_Pars, FR_Utils, FR_Const;

{$R *.DFM}

type
  THackView = class(TfrView)
  end;

  TSeriesClass = class of TChartSeries;

var
  frChartForm: TfrChartForm;
  SChart: TChart;

const
  ChartTypes: Array[0..5] of TSeriesClass =
    (TLineSeries, TAreaSeries, TPointSeries,
     TBarSeries, THorizBarSeries, TPieSeries);

function ExtractFieldName(const Fields: string; var Pos: Integer): string;
var
  i: Integer;
begin
  i := Pos;
  while (i <= Length(Fields)) and (Fields[i] <> ';') do Inc(i);
  Result := Copy(Fields, Pos, i - Pos);
  if (i <= Length(Fields)) and (Fields[i] = ';') then Inc(i);
  Pos := i;
end;

constructor TfrChartView.Create;
begin
  inherited Create;
  with Chart do
  begin
    Dim3D := True;
    IsSingle := True;
    ShowLegend := True;
    ShowMarks := True;
    Colored := True;
  end;
  Typ := gtAddIn;
  BaseName := 'Chart';
  Flags := Flags or flWantHook;
end;

procedure TfrChartView.Assign(From: TfrView);
begin
  inherited Assign(From);
  Chart := TfrChartView(From).Chart;
  LegendObj := TfrChartView(From).LegendObj;
  ValueObj := TfrChartView(From).ValueObj;
  Top10Label := TfrChartView(From).Top10Label;
end;

function TfrChartView.ShowChart: Boolean;
var
  i, j, c1, c2: Integer;
  LegS, ValS, s: String;
  Ser: TChartSeries;
  EMF: TMetafile;

  function Str2Float(s: String): Double;
  begin
    s := Trim(s);
    while (Length(s) > 0) and not (s[1] in ['0'..'9']) do
      s := Copy(s, 2, 255);           // trim all non-digit chars at the begin
    while (Length(s) > 0) and not (s[Length(s)] in ['0'..'9']) do
      s := Copy(s, 1, Length(s) - 1); // trim all non-digit chars at the end
    while Pos(ThousandSeparator, s) <> 0 do
      Delete(s, Pos(ThousandSeparator, s), 1);
    Result := 0;
    try
      Result := StrToFloat(s);
    except
      on exception do;
    end;
  end;

  procedure SortValues(var LegS, ValS: String);
  var
    i, j: Integer;
    sl: TStringList;
    s: String;
    d: Double;
  begin
    sl := TStringList.Create;
    sl.Sorted := True;

    i := 1; j := 1;
    while i <= Length(LegS) do
      sl.Add(SysUtils.Format('%12.3f', [Str2Float(ExtractFieldName(ValS, j))]) + '=' +
             ExtractFieldName(LegS, i));

    LegS := ''; ValS := '';
    for i := 1 to Chart.Top10Num do
    begin
      s := sl[sl.Count - i];
      ValS := ValS + Copy(s, 1, Pos('=', s) - 1) + ';';
      LegS := LegS + Copy(s, Pos('=', s) + 1, 255) + ';';
    end;

    i := sl.Count - Chart.Top10Num - 1; d := 0;
    while i >= 0 do
    begin
      s := sl[i];
      d := d + Str2Float(Copy(s, 1, Pos('=', s) - 1));
      Dec(i);
    end;

    LegS := LegS + Top10Label + ';';
    ValS := ValS + FloatToStr(d) + ';';
    sl.Free;
  end;


begin
  Result := False;
  SChart.RemoveAllSeries;
  with Chart do
  begin
    SChart.Frame.Visible := False;
    SChart.LeftWall.Brush.Style := bsClear;
    SChart.BottomWall.Brush.Style := bsClear;

    SChart.View3D := Dim3D;
    SChart.Legend.Visible := ShowLegend;
    SChart.AxisVisible := ShowAxis;
    SChart.View3DWalls := ChartType <> 5;
{$IFDEF Delphi4}
    SChart.BackWall.Brush.Style := bsClear;
    SChart.View3DOptions.Elevation := 315;
    SChart.View3DOptions.Rotation := 360;
    SChart.View3DOptions.Orthogonal := ChartType <> 5;
{$ENDIF}
  end;

  if Memo.Count > 0 then
    LegS := Memo[0] else
    LegS := '';
  if Memo.Count > 1 then
    ValS := Memo[1] else
    ValS := '';

  if (LegS = '') or (ValS = '') then Exit;
  if LegS[Length(LegS)] <> ';' then
    LegS := LegS + ';';
  if ValS[Length(ValS)] <> ';' then
    ValS := ValS + ';';

  if Chart.IsSingle then
  begin
    Ser := ChartTypes[Chart.ChartType].Create(SChart);
    SChart.AddSeries(Ser);
    if Chart.Colored then
      Ser.ColorEachPoint := True;
    Ser.Marks.Visible := Chart.ShowMarks;
    Ser.Marks.Style := TSeriesMarksStyle(Chart.MarksStyle);

    c1 := 0;
    for i := 1 to Length(LegS) do
      if LegS[i] = ';' then Inc(c1);
    c2 := 0;
    for i := 1 to Length(ValS) do
      if ValS[i] = ';' then Inc(c2);
    if c1 <> c2 then Exit;

    if (Chart.Top10Num > 0) and (c1 > Chart.Top10Num) then
      SortValues(LegS, ValS);
    i := 1; j := 1;
    while i <= Length(LegS) do
    begin
      s := ExtractFieldName(ValS, j);
      Ser.Add(Str2Float(s), ExtractFieldName(LegS, i), clTeeColor);
    end;
  end
  else
  begin
    c1 := 0;
    for i := 1 to Length(LegS) do
      if LegS[i] = ';' then Inc(c1);
    if c1 <> Memo.Count - 1 then Exit;

    i := 1;
    c1 := 1;
    while i <= Length(LegS) do
    begin
      Ser := ChartTypes[Chart.ChartType].Create(SChart);
      SChart.AddSeries(Ser);
      Ser.Title := ExtractFieldName(LegS, i);
      Ser.Marks.Visible := Chart.ShowMarks;
      Ser.Marks.Style := TSeriesMarksStyle(Chart.MarksStyle);
      ValS := Memo[c1];
      if ValS[Length(ValS)] <> ';' then
        ValS := ValS + ';';
      j := 1;
      while j <= Length(ValS) do
      begin
        s := ExtractFieldName(ValS, j);
        Ser.Add(Str2Float(s), '', clTeeColor);
      end;
      Inc(c1);
    end;
  end;

  with Canvas do
  begin
    SChart.Color := FillColor;
    EMF := SChart.TeeCreateMetafile(False, Rect(0, 0, SaveDX, SaveDY));
    StretchDraw(DRect, EMF);
    EMF.Free;
  end;
  Result := True;
end;

procedure TfrChartView.Draw(Canvas: TCanvas);
begin
  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  CalcGaps;
  if not ShowChart then
    ShowBackground;
  ShowFrame;
  RestoreCoord;
end;

procedure TfrChartView.Print(Stream: TStream);
begin
  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  frInterpretator.DoScript(Script);
  if not Visible then Exit;

  Stream.Write(Typ, 1);
  frWriteString(Stream, ClassName);
  SaveToStream(Stream);
end;

procedure TfrChartView.LoadFromStream(Stream: TStream);
var
  b: Byte;
  function ReadString(Stream: TStream): String;
  begin
    if frVersion >= 23 then
    {$IFDEF FREEREP2217READ}
    begin
      if (frVersion = 23) and FRE_COMPATIBLE_READ then
        Result := frReadString2217(Stream) // load in bad format
      else
        Result := frReadString(Stream); // load in current format
    end
    else
    {$ELSE}
      Result := frReadString(Stream) else
    {$ENDIF}
      Result := frReadString22(Stream);
  end;
begin
  inherited LoadFromStream(Stream);
  with Stream do
  begin
    Read(b, 1);
    Read(Chart, SizeOf(Chart));
    LegendObj := ReadString(Stream);
    ValueObj := ReadString(Stream);
    Top10Label := ReadString(Stream);
  end;
end;

procedure TfrChartView.SaveToStream(Stream: TStream);
var
  b: Byte;
begin
  inherited SaveToStream(Stream);
  with Stream do
  begin
    b := 0; // internal chart version
    Write(b, 1);
    Write(Chart, SizeOf(Chart));
    frWriteString(Stream, LegendObj);
    frWriteString(Stream, ValueObj);
    frWriteString(Stream, Top10Label);
  end;
end;

procedure TfrChartView.DefinePopupMenu(Popup: TPopupMenu);
begin
  // no specific items in popup menu
end;

procedure TfrChartView.OnHook(View: TfrView);
var
  i: Integer;
  s: String;
begin
  if Memo.Count < 2 then
  begin
    Memo.Clear;
    Memo.Add('');
    Memo.Add('');
  end;
  i := -1;
  if AnsiCompareText(View.Name, LegendObj) = 0 then
  begin
    i := 0;
    Inc(CurStr);
  end
  else if AnsiCompareText(View.Name, ValueObj) = 0 then
    i := CurStr;
  if Chart.IsSingle then
    CurStr := 1;

  if i >= 0 then
  begin
    if Memo.Count <= i then
      while Memo.Count <= i do
        Memo.Add('');
    if THackView(View).Memo1.Count > 0 then
    begin
      s := THackView(View).Memo1[0];
      if LastLegend <> s then
        Memo[i] := Memo[i] + s + ';';
      LastLegend := s;
    end;
  end;
end;


{------------------------------------------------------------------------}
procedure TfrChartForm.ShowEditor(t: TfrView);
  procedure SetButton(b: Array of TfrSpeedButton; n: Integer);
  begin
    b[n].Down := True;
  end;
  function GetButton(b: Array of TfrSpeedButton): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 0 to High(b) do
      if b[i].Down then
        Result := i;
  end;
  procedure SetRButton(b: Array of TRadioButton; n: Integer);
  begin
    b[n].Checked := True;
  end;
  function GetRButton(b: Array of TRadioButton): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 0 to High(b) do
      if b[i].Checked then
        Result := i;
  end;
begin
  Page1.ActivePage := Tab1;
  with TfrChartView(t), Chart do
  begin
    SetButton([SB1, SB2, SB3, SB4, SB5, SB6], ChartType);
    SetRButton([RB1, RB2, RB3, RB4, RB5], MarksStyle);
    CB1.Checked := Dim3D;
    CB2.Checked := IsSingle;
    CB3.Checked := ShowLegend;
    CB4.Checked := ShowAxis;
    CB5.Checked := ShowMarks;
    CB6.Checked := Colored;
    E1.Text := LegendObj;
    E2.Text := ValueObj;
    E3.Text := IntToStr(Top10Num);
    E4.Text := Top10Label;
    if ShowModal = mrOk then
    begin
      frDesigner.BeforeChange;
      ChartType := GetButton([SB1, SB2, SB3, SB4, SB5, SB6]);
      MarksStyle := GetRButton([RB1, RB2, RB3, RB4, RB5]);
      Dim3D := CB1.Checked;
      IsSingle := CB2.Checked;
      ShowLegend := CB3.Checked;
      ShowAxis := CB4.Checked;
      ShowMarks := CB5.Checked;
      Colored := CB6.Checked;
      LegendObj := E1.Text;
      ValueObj := E2.Text;
      Top10Num := StrToInt(E3.Text);
      Top10Label := E4.Text;
    end;
  end;
end;

procedure TfrChartForm.FormCreate(Sender: TObject);
begin
  Caption := LoadStr(frRes + 590);
  Tab1.Caption := LoadStr(frRes + 591);
  Tab2.Caption := LoadStr(frRes + 592);
  Tab3.Caption := LoadStr(frRes + 604);
  GroupBox1.Caption := LoadStr(frRes + 593);
  GroupBox2.Caption := LoadStr(frRes + 594);
  GroupBox3.Caption := LoadStr(frRes + 595);
  GroupBox4.Caption := LoadStr(frRes + 605);
  GroupBox5.Caption := LoadStr(frRes + 611);
  CB1.Caption := LoadStr(frRes + 596);
  CB2.Caption := LoadStr(frRes + 597);
  CB3.Caption := LoadStr(frRes + 598);
  CB4.Caption := LoadStr(frRes + 599);
  CB5.Caption := LoadStr(frRes + 600);
  CB6.Caption := LoadStr(frRes + 601);
  RB1.Caption := LoadStr(frRes + 606);
  RB2.Caption := LoadStr(frRes + 607);
  RB3.Caption := LoadStr(frRes + 608);
  RB4.Caption := LoadStr(frRes + 609);
  RB5.Caption := LoadStr(frRes + 610);
  Label1.Caption := LoadStr(frRes + 602);
  Label2.Caption := LoadStr(frRes + 603);
  Label3.Caption := LoadStr(frRes + 612);
  Label4.Caption := LoadStr(frRes + 613);
  Label5.Caption := LoadStr(frRes + 614);
  Button1.Caption := LoadStr(SOk);
  Button2.Caption := LoadStr(SCancel);
end;

initialization
  frChartForm := TfrChartForm.Create(nil);
  SChart := frChartForm.Chart1;
  frRegisterObject(TfrChartView, frChartForm.Image1.Picture.Bitmap,
    LoadStr(SInsChart), frChartForm);

finalization
  frChartForm.Free;
  frChartForm := nil;

end.