unit fChart;

{$mode objfpc}{$H+}

// ©2014 by Markus Müller, MmVisual
// Free for use, without warranty

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LCLType,
  TAGraph, TASeries, TATransformations, TASources, TAFuncSeries, TATypes,
  TAChartUtils;

type

  { TfrmChart }

  TfrmChart = class(TForm)
    Chart: TChart;
    ChartLineSeries1: TLineSeries;
    ChartAxisTransformations1: TChartAxisTransformations;
    ChartAxisTransformations1LogarithmAxisTransform1: TLogarithmAxisTransform;
    ListChartSource1: TListChartSource;
    procedure ChartDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
    fMin, fMax: Double;
    bInitfMin: Boolean;
    bChartSourceInit: Boolean;
    function CloneLineSeriesWithLabels(ASeries: TLineSeries): TLineSeries;
  public
    { public declarations }
    lstSeries: TList;
    bWithLabel: Boolean; // Ansicht mit Labels
    Procedure SetXMinMax(fXMin, fXMax: Double); // Wird automatisch anhand der Daten ausgeführt
    Procedure AddKurve(sTitel: String; clColor: TColor = clNone); // Neue Kurve hinzufügen
    Procedure AddValue(fX, fY: Double); // Daten für die Kurve hinzufügen
  end;

var
  frmChart: TfrmChart;

implementation

{$R *.lfm}

{ TfrmChart }

procedure TfrmChart.ChartDblClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmChart.FormCreate(Sender: TObject);
begin
  lstSeries := TList.Create;
  fMin := 0;
  fMax := 0;
  bInitfMin := False;
  bChartSourceInit := False;
end;

procedure TfrmChart.FormDestroy(Sender: TObject);
begin
  lstSeries.Free;
end;

procedure TfrmChart.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  If Key = VK_ESCAPE Then Close;
end;

procedure TfrmChart.FormShow(Sender: TObject);
Var i: Integer;
begin
  If Not bChartSourceInit Then
    SetXMinMax(fMin, fMax);
  If bWithLabel Then
  Begin
    For i := 0 To lstSeries.Count - 1 Do
      CloneLineSeriesWithLabels(TLineSeries(lstSeries[i]));
  end;
end;

Procedure TfrmChart.SetXMinMax(fXMin, fXMax: Double);
const
  VALUES_PER_DECADE : array[0..5] of Double = (1.0, 2.0, 2.5, 3.0, 5.0, 7.5);
var
  i: Integer;
  decade: Double;
  x: Double;
Begin
  fMax := fXMax;
  fMin := fXMin;
  bInitfMin := True;
  // Skala Start ausrechnen
  x := 1000;
  while (x > 0.1) Do
  Begin
    If fMin >= x Then
      break;
    x := x / 10;
  end;
  If x <= 0.1 Then
    x := 0.1;
  fMin := x;
  // Skala Ende ausrechnen
  x := 1;
  while (x < fMax) Do
    x := x * 10;
  fMax := x;
  // Sicherheitsabfragen
  If (fMin = 0.1) And ((fMax = 0) or (fMax <= fMin)) Then
    fMax := 10
  Else If fMin = fMax Then
    fMax := fMax * 10
  Else If fMax < fMin Then
    fMax := fMin * 10;

  // Achsenmarkierungen erzeugen - es geht am besten mit einer ListSource
  ListChartSource1.Clear;
  decade := fMin;
  while decade <= fMax do begin
    for i:=0 to High(VALUES_PER_DECADE) do begin
      x := VALUES_PER_DECADE[i]*decade;
      if (decade < 5) Then
      Begin
        If i In [0, 1, 3, 4] Then
          ListChartSource1.Add(x, x);
      end ELse Begin
        If i In [0, 2, 4] Then
          ListChartSource1.Add(x, x);
      end;
    end;
    decade := decade * 10.0;
  end;
  bChartSourceInit := True;
end;

function TfrmChart.CloneLineSeriesWithLabels(ASeries: TLineSeries): TLineSeries;
begin
  Result := TLineSeries.Create(self);
  Result.AxisIndexX := ASeries.AxisIndexX;
  Result.AxisIndexY := ASeries.AxisIndexY;
  Result.Source := ASeries.Source;             // Dadurch werden die Daten automatisch in der Kopie verwendet
  Result.LinePen.Style := psClear;             // Verbindungslinie der Kopien ausschalten
  Result.ShowPoints := false;                  // Datenpunkt-Symbole der Kopie ausschalten
  Result.Marks.Style := smsLabel;              // Marks des Kopie aktivieren
  Result.Marks.LabelBrush.Color := ASeries.Marks.LabelBrush.Color;// Farbe der Marks aus Original übernehmen, am besten dort einstellen
  Result.Marks.Distance := 6;
  Result.Marks.LinkPen.Style := psClear;
  Result.Legend.Visible := False;
  Chart.AddSeries(Result);                    // Kopie in den Chart einfügen
  Result.ZPosition := Chart.SeriesCount;      // ... und über allen Originalkurven zeichnen
end;

Procedure TfrmChart.AddKurve(sTitel: String; clColor: TColor = clNone);
Const
  ccl: array[0..7] of TColor = (clLime, clRed, clBlue, clFuchsia, clGreen, clMaroon, clNavy, clPurple);
Var ls: TLineSeries;
begin
  If lstSeries.Count = 0 Then
  Begin
    ls := ChartLineSeries1;
    ls.Clear;
  end Else ls := TLineSeries.Create(Self);
  ls.Title := sTitel;
  ls.Legend.Visible := sTitel <> '';
  If clColor = clNone Then
    clColor := ccl[lstSeries.Count Mod (High(ccl) + 1)];
  ls.AxisIndexX := 1;
  ls.AxisIndexY := 0;
  ls.LinePen.Color := clColor;
  ls.LinePen.Width := 3;
  ls.ShowPoints := True;
  ls.Pointer.Brush.Color := clColor;
  ls.Pointer.Style := psCircle;
  ls.LineType := ltStepXY;
  ls.Marks.Style := smsNone;
  ls.Marks.LabelBrush.Color := clColor OR $00E0E0E0; // Hellere Hintergrundfarbe
  lstSeries.Add(ls);
  Chart.AddSeries(ls);
end;

Procedure TfrmChart.AddValue(fX, fY: Double);
Var ls: TLineSeries;
begin
  If lstSeries.Count = 0 Then
    AddKurve('');
  ls := TLineSeries(lstSeries.Items[lstSeries.Count - 1]);
  ls.AddXY(fX, fY, FormatFloat('0.00##', fY));
  If (fX < fMin) Or Not bInitfMin Then
    fMin := fX;
  bInitfMin := True;
  If (fX > fMax) Then
    fMax := fX;
end;

end.