unit Graph2D;

// from https://mitjastachowiak.de/components/pascal/Graph2D.pas

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, StdCtrls, ExtCtrls, Math, Controls, Forms, Graphics,
  mathconfig; // if not found, create this unit and define the type Precision as Single, Double or Extended and define Poly as specialisation of Polynom

type
 TPaintableGraph = class;

 {
  TGraph2D
  represents one 2D-Graph
 }
 TGraph2D = class(TPanel)
  const
   MinRange = 0.000000001;
   MaxRange = 100000000000000;
   PixDiffPerLine = 50;
   Speed = 10;
   PhysUnitSymbols : Array [0..18] of WideChar = (  'y',   'z',   'a',   'f',   'p',  'n', #181,  'u',  'm', #0, 'K', 'k', 'M', 'G',  'T',  'P',  'E',  'Z',  'Y');
   PhysUnitValues : Array [0..18] of Precision = (1E-24, 1E-21, 1E-18, 1E-15, 1E-12, 1E-9, 1E-6, 1E-6, 1E-3,  1, 1E3, 1E3, 1E6, 1E9, 1E12, 1E15, 1E18, 1E21, 1E24);
  type
   // some graph object definitions
   TAxisType = (HORIZONTAL, VERTICAL);
   TSyncRecord = set of TAxisType;
   TLineStyle = (SOLID, DASHED, DOTTED);
   TMouseEventType = (MouseMove, MouseDown, MouseUp, MouseOut);
   TFloatPoint = packed record
    x : Precision;
    y : Precision;
   end;
   TFunctionBuff = Array of TFloatPoint;

   {
    TAxis
    Respresents one Axis of the Graph. Axis' are are special purpose and does
    therefore not inherit from TRenderObj.
   }
   TAxis = class
    strict private
     graph : TPaintableGraph;
     _min, _max      : Precision;
     procedure writeMin(v:Precision);
     procedure writeMax(v:Precision);
    private
     fktMin, fktMax : Precision; //rendering of lines and functions stores the total maximum and minimum value in TAxis.fktMin/fktMax.
     moveStartMin   : Precision;
     procedure render;
    public
     color         : TColor;
     position      : Precision;
     axisType      : TAxisType;
     name          : ShortString;
     property min : Precision read _min write writeMin;
     property max : Precision read _max write writeMax;
     constructor create (_AxisType : TAxisType; _Graph : TGraph2D);
     function posToScreen(v : Precision) : integer;
     function screenToPos(v : integer) : Precision;
     procedure setFKTExtrema; // Sets min and max to cover fktMin and fktMax. Does not redraw.
   end;

   {
    TRenderObj
    Every graphical/mathematical object, which is rendered in a graph inherits
    from this base class. Usually all coordinates of such objects belong
    to one of the graph's coordinate system. Therefore, TRenderObject
    knows it's X and Y-axis.
   }
   TRenderObj = class
    strict private
     isObserving : boolean;
     procedure startStopObserving(v:boolean);
    protected
     graph : TPaintableGraph;
     property observe : boolean read isObserving write startStopObserving;
     procedure render; virtual; abstract;
     procedure mouseEvent({%H-}evType:TMouseEventType; {%H-}x,{%H-}y:integer); virtual; // when a mouse event is performed on a area in graph.mouseMap, which is marked by this object
     procedure observerEvent({%H-}evType:TMouseEventType; {%H-}x,{%H-}y:integer); virtual; // when this object is observing, any mouse action on the graph will trigger this method
     //procedure MouseAction(mouseX, mouseY:Cardinal; action:TMouseAction);
    public
     xAxis, yAxis : TAxis;
     visible : boolean;
     constructor create(_graph : TGraph2D);
     destructor destroy; override;
   end;

   {
    TLine
    represents a general curve in 2D-Space based on a list of points.
   }
   TLine = class(TRenderObj)
    protected
     procedure render; override;
    public
     isFunction : Boolean;
     buff : TFunctionBuff;
     style : TLineStyle;
     color : cardinal;
     constructor create(_Graph : TGraph2D);
     function toString : String; override;
     procedure fromString(str:String);
     destructor destroy; override;
   end;

   {
    TBar
    represents one vertical or horizontal line. Can be used to mark several
    sections of a function or whatever.
   }
   TBar = class(TRenderObj)
    strict private
     _setToClickPos : boolean;
     _position : Precision;
     procedure writePosition(v:Precision);
     procedure writeSetToClickPos(v:boolean);
    protected
     procedure observerEvent(evType:TMouseEventType; x,y:integer); override;
     procedure render; override;
    public
     onPosChanged : TNotifyEvent;
     barType : TAxisType;
     style : TLineStyle;
     property position : Precision read _position write writePosition;
     property setToClickPos : boolean read _setToClickPos write writeSetToClickPos;
     constructor create(_graph:TGraph2D; _barType:TAxisType);
   end;

   {
    TRect
    A simple rectangle.
   }
   TRect = class(TRenderObj)
    protected
     procedure render; override;
    public
     x1, x2, y1, y2 : Precision;
     borderStyle : TLineStyle;
     borderColor : Cardinal;
     fillColor : Cardinal;
     constructor create(_graph:TGraph2D);
   end;

   {
    TMovePoint
    Represents one point, which can be dragged and moved by the user.
   }
   TMovePoint = class(TRenderObj)
    type
     TPointStyle = (DOT);
    protected
     var
      _x, _y : Precision;
      moving : Boolean;
      hovered : Boolean;
     procedure writeX(v : Precision); virtual;
     procedure writeY(v : Precision); virtual;
     procedure render; override;
     procedure mouseEvent(evType:TMouseEventType; mx, my : integer); override;
    public
     var
      color : TColor;
      hoverColor : TColor;
      style : TPointStyle;
      size : Byte;
      movable : Boolean;
      onMove : TNotifyEvent;
     constructor create(_Graph:TGraph2D);
     property x : Precision read _x write writeX;
     property y : Precision read _y write writeY;
   end;

 

  strict private
   keyR    : Boolean;
   keyL    : Boolean;
   keyT    : Boolean;
   keyB    : Boolean;
   shiftS  : TShiftState;
   timer   : TTimer;
   linePos : TPoint;
   move    : Boolean;
   startC  : TPoint;
   lineLength    : cardinal;
   _mouseMap     : Array of TRenderObj;
   lastMouseObj  : TRenderObj;
   keyCatcher    : TEdit;
   renderObjects : Array of TRenderObj;
   procedure mouseDown(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer); reintroduce;
   procedure mouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer); reintroduce;
   procedure mouseMove(Sender: TObject; {%H-}Shift: TShiftState; X, Y: Integer); reintroduce;
   procedure mouseWheel(Sender: TObject; {%H-}Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var {%H-}Handled: Boolean);
   procedure timerEV(Sender : TObject);
   procedure keyDown(Sender: TObject; var Key: Word; Shift: TShiftState); reintroduce;
   procedure keyUp(Sender: TObject; var Key: Word; Shift: TShiftState); reintroduce;
   function readRenderCount : Cardinal; inline;
   function readRenderObjects(i : Cardinal) : TRenderObj; inline;
  private
   isSynchronizing : Boolean;
   syncNext        : TGraph2D;
   syncRecord      : TSyncRecord;
   procedure sync(syncSrc:TGraph2D); // is called from the previous graph in the sync loop
  protected
   _bmp : TBitmap;
   _completeRepaint : Boolean;
   observers : Array of TRenderObj;
   {%H-}constructor _create(_Owner:TComponent);  // the constructor is replaced with a function create, which creates the graph as a TPaintableGraph
   function readMouseMap(x, y:integer) : TRenderObj;
   procedure writeMouseMap(x, y:integer; obj:TRenderObj);
   function readCanvas : TCanvas; inline;
   property canvas : TCanvas read readCanvas;
   procedure _moveTo(x, y : integer);
   property bmp : TBitmap read _bmp;
   procedure _styledLineTo(x, y : integer; Style : TLineStyle);
   class procedure _getPosOfRegularPoints(From,UpTo : Double; Count : Word; var Start,Space : Double);
   class function intPower(Basis : Double; Exp : Integer) : Double;
   class function round(f : precision):integer;
  public
   bgColor : TColor;
   xAxis   : Array of TAxis;
   yAxis   : Array of TAxis;
   class var defaultMaxDigits : Byte;
   class function create(_Owner:TComponent) : TGraph2D; reintroduce;
   property renderObj[i : Cardinal] : TRenderObj read readRenderObjects;
   property renderObjCount : Cardinal read readRenderCount;
   procedure removeRenderObj(obj : TRenderObj);
   procedure synchronize(syncSrc:TGraph2D; syncRec:TSyncRecord=[HORIZONTAL, VERTICAL]); // starts synchronisation with an other graph
   procedure doPaint(Sender : TObject);
   class function floatToPhysStr(f : Double; maxDigits : byte = 255) : String;
   destructor destroy; override;
 end;

 {
  TPaintableGraph
  Holds several methods to enable render objects to paint on the graph.
  This is some kind of friendly visibility to render objects.
 }
 TPaintableGraph = class (TGraph2D)
  protected
   {%H-}constructor _create(_Owner:TComponent);
  public
   property bmp : TBitmap read _bmp;
   property completeRepaint : boolean read _completeRepaint;
   property mouseMap[x, y:integer]:TRenderObj read readMouseMap write writeMouseMap;
   property canvas : TCanvas read readCanvas;
   procedure moveTo(x, y : integer); inline;
   procedure styledLineTo(x, y : integer; Style : TLineStyle); inline;
   class procedure getPosOfRegularPoints(From,UpTo : Double; Count : Word; var Start,Space : Double); inline;
 end;

implementation

{ TGraph2D.TRect }

constructor TGraph2D.TRect.create(_graph: TGraph2D);
begin
  inherited create(_graph);
  x1 := 0;
  x2 := 0;
  y1 := 0;
  y2 := 0;
  borderColor := clBlack;
  fillColor := clNone;
  borderStyle := SOLID;
end;

procedure TGraph2D.TRect.render;
var
  ix1, ix2, iy1, iy2 : integer;
begin
  ix1 := xAxis.posToScreen(x1);
  ix2 := xAxis.posToScreen(x2);
  iy1 := yAxis.posToScreen(y1);
  iy2 := yAxis.posToScreen(y2);
  if (fillColor <> clNone) then begin
    graph.canvas.pen.color := fillColor;
    graph.canvas.brush.color := fillColor;
    graph.canvas.rectangle(ix1, iy1, ix2, iy2);
  end;
  graph.canvas.pen.color := borderColor;
  graph.canvas.Line(0, 0, 0, 0);  // why ever this is necessary...
  graph.moveTo(ix1, iy1);
  graph.styledLineTo(ix2, iy1, borderStyle);
  graph.styledLineTo(ix2, iy2, borderStyle);
  graph.styledLineTo(ix1, iy2, borderStyle);
  graph.styledLineTo(ix1, iy1, borderStyle);
end;



{ TPaintableGraph }

constructor TPaintableGraph._create(_Owner: TComponent);
begin
  inherited;
end;

procedure TPaintableGraph.moveTo(x, y: integer);
begin
  _moveTo(x, y);
end;

procedure TPaintableGraph.styledLineTo(x, y: integer; Style: TLineStyle);
begin
  _styledLineTo(x, y, style);
end;

class procedure TPaintableGraph.getPosOfRegularPoints(From, UpTo: Double;
  Count: Word; var Start, Space: Double);
begin
  _getPosOfRegularPoints(from, upTo, count, start, space);
end;



{ TRenderObj }

constructor TGraph2D.TRenderObj.create(_graph: TGraph2D);
begin
 inherited Create;
 graph := TPaintableGraph(_graph);
 SetLength(Graph.RenderObjects, Length(graph.RenderObjects)+1);
 graph.renderObjects[Length(graph.RenderObjects)-1] := self;
 xAxis := graph.xAxis[0];
 yAxis := graph.yAxis[0];
 visible := true;
end;

procedure TGraph2D.TRenderObj.startStopObserving(v: boolean);
var
 i : integer;
begin
 if (isObserving = v) then exit;
 isObserving := v;
 if (v) then begin // add self to observers
  i := Length(graph.observers);
  SetLength(graph.observers, i+1);
  graph.observers[i] := self;
 end else begin // remove self from observers
  i := 0;
  while (i < length(graph.observers)) do begin
   if (graph.observers[i] = self) then begin
    for i := i to Length(graph.observers)-2 do graph.observers[i] := graph.observers[i+1];
    setLength(graph.observers, Length(graph.observers)-1);
    exit;
   end;
   i += 1;
  end;
 end;
end;

procedure TGraph2D.TRenderObj.mouseEvent(evType: TMouseEventType; x, y: integer);
begin
end;

procedure TGraph2D.TRenderObj.observerEvent(evType: TMouseEventType; x,y: integer);
begin
end;

destructor TGraph2D.TRenderObj.destroy;
begin
 observe := false;
 graph.removeRenderObj(self);
 inherited;
end;

 

 

constructor TGraph2D.TLine.create(_Graph: TGraph2D);
begin
 inherited;
 isFunction := false;
 style := SOLID;
 color := $FFFFFFFF; // this will mark the color as invalid (max value of TColor is $7FFFFFFF)
 buff := nil;
end;

function TGraph2D.TLine.toString: String;
var i : integer;
begin
  Result := '';
  for i := 0 to Length(buff)-1 do Result += FloatToStr(buff[i].x)+#9+FloatToStr(buff[i].y)+#10#13;
end;

procedure TGraph2D.TLine.fromString(str: String);
var
 i : integer;
 s : ShortString;
begin
  SetLength(buff, 0);
  s := '';
  for i := 1 to Length(str) do begin
    if (str[i] = #10) then continue;
    if (str[i] = #9) then begin
      SetLength(buff, Length(buff)+1);
      buff[Length(buff)-1].y := 0;
      buff[Length(buff)-1].x := StrToFloat(s);
      s := '';
      continue;
    end;
    if (str[i] = #13) then begin
      if (Length(buff) = 0) then continue;
      buff[Length(buff)-1].y := StrToFloat(s);
      s := '';
      continue;
    end;
    if (Length(s) >= 40) then raise Exception.Create('Too many chars for one float value!');
    s += str[i];
  end;
end;

procedure TGraph2D.TLine.Render;
var i : integer;
begin
 if (color and (1 shl 31) = 0) then Graph.Canvas.Pen.Color := color
 else Graph.Canvas.Pen.Color := yAxis.Color;
 if (Length(Buff) < 2) then exit;
 for i := 0 to Length(Buff) - 1 do begin
  if (isFunction) and (Buff[i].x >= XAxis.Min) and (Buff[i].x <= xAxis.Max) then begin
   if (Buff[i].y > yAxis.FktMax) then YAxis.FktMax := buff[i].y;
   if (Buff[i].y < yAxis.FktMin) then YAxis.FktMin := buff[i].y;
  end;
  if (i = 0) then Graph.moveTo(xAxis.PosToScreen(buff[0].x), yAxis.PosToScreen(buff[0].y))
  else Graph.styledLineTo(xAxis.PosToScreen(buff[i].x), yAxis.PosToScreen(buff[i].y), style);
 end;
end;

destructor TGraph2D.TLine.destroy;
begin
 SetLength(Buff, 0);
 inherited;
end;


 

{ TBar }

constructor TGraph2D.TBar.Create(_Graph : TGraph2D; _BarType : TAxisType);
begin
 inherited Create(_Graph);
 BarType := _BarType;
 Position := 0;
 _setToClickPos := false;
 onPosChanged := nil;
 Style := SOLID;
end;

procedure TGraph2D.TBar.writePosition(v: Precision);
begin
 _position := v;
 if assigned(onPosChanged) then onPosChanged(self);
end;

procedure TGraph2D.TBar.writeSetToClickPos(v: boolean);
begin
 _setToClickPos := v;
 self.observe := v;
end;

procedure TGraph2D.TBar.observerEvent(evType: TMouseEventType; x, y: integer);
begin
 inherited observerEvent(evType, x, y);
 if (setToClickPos) and (evType = TMouseEventType.MouseDown) then begin
  if (BarType = VERTICAL) then self.Position := self.xAxis.ScreenToPos(x)
  else self.Position := self.yAxis.ScreenToPos(y);
  graph.DoPaint(self);
 end;
end;

procedure TGraph2D.TBar.Render;
var p : integer;
begin
 if (BarType = VERTICAL) then begin
  p := XAxis.PosToScreen(Position);
  Graph.MoveTo(p, 0);
  Graph.StyledLineTo(p, Graph.Height, Style);
 end else begin
  p := XAxis.PosToScreen(Position);
  Graph.MoveTo(0, p);
  Graph.StyledLineTo(Graph.Width, p, Style);
 end;
end;

 


{ TMovePoint}

constructor TGraph2D.TMovePoint.Create(_Graph: TGraph2D);
begin
 inherited;
 movable := false;
 moving := false;
 size := 4;
 _x := 0;
 _y := 0;
 color := clBlack;
 hoverColor := clBlue;
 hovered := false;
 onMove := nil;
end;

procedure TGraph2D.TMovePoint.writeX(v: Precision);
begin
 _x := v;
 if (assigned(onMove)) then onMove(self);
 if (not moving) then Graph.Repaint;
end;

procedure TGraph2D.TMovePoint.writeY(v: Precision);
begin
 _y := v;
 if (assigned(onMove)) then onMove(self);
 if (not moving) then Graph.Repaint;
end;

procedure TGraph2D.TMovePoint.Render;
var i,j,xp,yp : integer;
begin
 if (hovered) then Graph.Canvas.Pen.Color := hoverColor
 else Graph.Canvas.Pen.Color := color;
 case (self.style) of
  Dot : begin
   Graph.Canvas.Brush.Color := Graph.Canvas.Pen.Color;
   xp := XAxis.PosToScreen(self._x);
   yp := YAxis.PosToScreen(self._y);
   Graph.Canvas.EllipseC(xp, yp, self.size, self.size);
   if (movable) then
     for i := -size to size do
       for j := -size to size do
         if (cardinal(i*i + j*j) < cardinal(size*size)) then graph.mouseMap[xp+i, yp+j] := self;
  end;
 end;
 if (moving) then for i := 0 to Graph.Width-1 do for j := 0 to Graph.Height-1 do Graph.MouseMap[i, j] := self;
 Graph.Canvas.Pen.Color := clBlack;
end;

procedure TGraph2D.TMovePoint.mouseEvent(evType: TMouseEventType; mx, my: integer);
begin
 inherited;
 if (hovered <> (evType <> MouseOut)) then begin
  hovered := evType <> MouseOut;
  Graph.Repaint;
 end;
 case (evType) of
  TMouseEventType.MouseDown : moving := true;
  TMouseEventType.MouseMove : if (moving) then begin
   self.x := XAxis.ScreenToPos(mx);
   self.y := YAxis.ScreenToPos(my);
   Graph.Repaint;
  end;
  TMouseEventType.MouseUp : if (moving) then begin
   moving := false;
   Graph.Repaint;
  end;
 end;
end;

 


{ TAxis }

constructor TGraph2D.TAxis.create(_AxisType: TAxisType; _Graph: TGraph2D);
begin
 inherited Create;
 AxisType := _AxisType;
 graph := TPaintableGraph(_graph);
 Name := '';
 Color := clBlack;
 Position := 0;
 Min := -1;
 Max := 1;
 if (AxisType = VERTICAL) then begin
  SetLength(Graph.YAxis, Length(Graph.YAxis)+1);
  Graph.YAxis[Length(Graph.YAxis)-1] := self;
 end else begin
  SetLength(Graph.XAxis, Length(Graph.XAxis)+1);
  Graph.XAxis[Length(Graph.XAxis)-1] := self;
 end;
end;

procedure TGraph2D.TAxis.setFKTExtrema;
begin
 if (FktMin >= FktMax) then exit;
 min := FktMin - (FktMax - FktMin)/10;
 max := FktMax + (FktMax - FktMin)/10;
end;

function TGraph2D.TAxis.posToScreen(v: Precision): integer;
var s : Precision;
begin
 s := (v - Min) / (Max - Min);  // [Min , Max] auf [0, 1]
 if (AxisType = VERTICAL) then Result := Round((1-s) * Graph.Height) // [0, 1] auf [Height, 0]
 else Result := Round(s * Graph.Width); // [0, 1] auf [0, Width]
end;

function TGraph2D.TAxis.screenToPos(v: integer): Precision;
var s : Precision;
begin
 if (Graph.Width = 0) or (Graph.Height = 0) then begin Result := 0; exit; end;
 if (AxisType = VERTICAL) then s := 1 - v / Graph.Height // [0, Height] auf [1, 0]
 else s := v / Graph.Width; // [0, Width] auf [0, 1]
 Result := Min + s * (Max-Min); // [0, 1] auf [Min, Max]
end;

procedure TGraph2D.TAxis.writeMin(v: Precision);
begin
  _min := v;
  if (min >= max) then _max := min+1;
  if (not graph.isSynchronizing) and (axisType in graph.syncRecord) then graph.syncNext.sync(graph);
end;

procedure TGraph2D.TAxis.writeMax(v: Precision);
begin
  _max := v;
  if (min >= max) then _min := max-1;
  if (not graph.isSynchronizing) and (axisType in graph.syncRecord) then graph.syncNext.sync(graph);
end;

procedure TGraph2D.TAxis.render;
var
 Pos : integer;
 LineLength : integer;
 i,j,k      : integer;
 d,e        : double;
 s          : String;
 b          : Byte;
begin
 if (min >= max) then exit;
 FktMin := 1E23;
 FktMax := -1E23;
 Graph.Canvas.Pen.Color := Color;
 Graph.Canvas.Brush.Color := Graph.bgColor;
 Graph.Canvas.Font.Color := Color;
 if (AxisType = VERTICAL) then begin
  Pos := Graph.XAxis[0].PosToScreen(Position);
  if (Pos < 0) then Pos := 0;
  if (Pos >= Graph.Width) then Pos := Graph.Width - 1;
  k := Pos + 1;
  if (k + 20 > Graph.Width) then begin b := 1; k := Graph.Width - 1; end else b := 0;
  LineLength := Floor(Graph.Height / PixDiffPerLine);
  Graph.GetPosOfRegularPoints(Min, Max, LineLength, d{%H-}, e{%H-});
  for i := 0 to LineLength - 1 do begin
   j := PosToScreen((d + e*i));
   if (abs(d + e*i) < e/2) then s := '0'
   else s := Graph.FloatToPhysStr(d + e*i);
   Graph.Canvas.TextOut(k-b*10*Length(s), j - 1, s);
   Graph.Canvas.Line(k - 2,j,k + 2,j);
  end;
  Graph.Canvas.Line(k, 0, k, Graph.Height);
  if (Name <> '') then Graph.Canvas.TextOut(k - integer(b*Length(Name)*10), 0, Name);
 end else begin
  Pos := Graph.YAxis[0].PosToScreen(Position);
  if (Pos < 0) then Pos := 0;
  if (Pos >= Graph.Height) then Pos := Graph.Height - 1;
  k := Pos + 1;
  if (k + 18 > Graph.Height) then k := Graph.Height - 18;
  LineLength := Floor(Graph.Width / PixDiffPerLine);
  Graph.GetPosOfRegularPoints(Min, Max, LineLength, d, e);
  for i := 0 to LineLength - 1 do begin
   j := PosToScreen((d + e*i));
   if (abs(d + e*i) < e/2) then s := '0'
   else s := FloatToPhysStr(d + e*i);
   Graph.Canvas.TextOut(j + 1, k, s);
   Graph.Canvas.Line(j,Pos + 2,j,Pos - 2);
  end;
  Graph.Canvas.Line(0, Pos, Graph.Width, Pos);
 end;
end;

 


{ TGraph2D }

constructor TGraph2D._create(_Owner : TComponent);
begin
 inherited create(_Owner);
 syncNext := self;
 isSynchronizing := false;
 observers := nil;
 PCardinal(@bgColor)^ := $FFFFAA00;
 _mouseMap := nil;
 lastMouseObj := nil;
 LineLength := 0;
 _bmp := TBitmap.Create;
 _bmp.PixelFormat := pf32bit;
 bmp.Width := Width;
 bmp.Height := Height;
 renderObjects := nil;
 _completeRepaint := false;
 Self.OnPaint := @DoPaint;
 Move := false;
 OnMouseDown := @MouseDown;
 OnMouseUp := @MouseUp;
 OnMouseMove := @MouseMove;
 OnMouseWheel := @MouseWheel;
 KeyL := false;
 KeyR := false;
 KeyT := false;
 KeyB := false;
 ShiftS := [];
 Timer := TTimer.Create(self);
 Timer.Interval := 40;
 Timer.Enabled := false;
 Timer.OnTimer := @TimerEv;
 OnMouseDown := @MouseDown;
 OnMouseUp := @MouseUp;
 OnMouseMove := @MouseMove;
 OnMouseWheel := @MouseWheel;
 OnKeyDown := @KeyDown;
 OnKeyUp := @KeyUp;
 KeyCatcher := TEdit.Create(self);
 KeyCatcher.Parent := self;
 KeyCatcher.OnKeyDown := @KeyDown;
 KeyCatcher.OnKeyUp := @KeyUp;
 KeyCatcher.ReadOnly := true;
 KeyCatcher.OnEnter := @DoPaint;
 KeyCatcher.OnExit := @DoPaint;
 KeyCatcher.Top := -100;
 XAxis := nil;
 YAxis := nil;
 TAxis.Create(HORIZONTAL, self);
 TAxis.Create(VERTICAL, self)
end;

class function TGraph2D.create(_Owner: TComponent): TGraph2D;
begin
  result := TPaintableGraph._create(_Owner);
end;

procedure TGraph2D.removeRenderObj(obj: TRenderObj);
var
 i : integer;
 b : Boolean;
begin
 b := false;
 for i := 0 to Length(self.RenderObjects)-1 do begin
  if (self.RenderObjects[i] = obj) then b := true;
  if (b) and (i < Length(self.RenderObjects)-1) then self.RenderObjects[i] := self.RenderObjects[i+1];
 end;
 if (self.lastMouseObj = obj) then self.lastMouseObj := nil;
 for i := 0 to Length(self._MouseMap)-1 do if (self._MouseMap[i] = obj) then self._MouseMap[i] := nil;
 if (b) then SetLength(self.RenderObjects, Length(self.RenderObjects)-1);
 obj.Graph := nil;
end;

procedure TGraph2D.synchronize(syncSrc: TGraph2D; syncRec: TSyncRecord);
var
  sn : TGraph2D;
  f : TAxisType;
begin
  if (syncSrc = self) then raise Exception.create('Cannot sync with self!');
  if (self.syncNext <> self) then raise Exception.create('Object is already synchronized!');
  syncRecord := syncRec;
  for f in syncRec do include(syncSrc.syncRecord, f);
  sn := syncSrc.syncNext; // store remaining loop until initial synchronisation is done. No need to let initial synchronisation circle.
  syncSrc.syncNext := self;
  self.syncNext := syncSrc;
  sync(syncSrc);
  self.syncNext := sn;
end;

function TGraph2D.readCanvas : TCanvas; inline;
begin
 Result := bmp.canvas;
end;

function TGraph2D.readMouseMap(x, y: integer): TRenderObj;
begin
  Result := nil;
  if (x < self.Width) and (x >= 0) and (y < self.Height) and (y >= 0) then begin
    x := self.Width * y + x;
    if (x < Length(_MouseMap)) then Result := _MouseMap[x];
  end;
end;

procedure TGraph2D.writeMouseMap(x, y: integer; obj: TRenderObj);
begin
  if (x < self.Width) and (x >= 0) and (y < self.Height) and (y >= 0) then begin
    x := self.Width * y + x;
    if (x >= Length(_MouseMap)) then begin
      y := Length(_MouseMap);
      SetLength(_MouseMap, self.Height * self.Width);
      for y := y to Length(_MouseMap)-1 do _MouseMap[y] := nil;
    end;
    _MouseMap[x] := obj;
  end;
end;

function TGraph2D.readRenderCount: Cardinal;
begin
  Result := Length(RenderObjects);
end;

function TGraph2D.readRenderObjects(i: Cardinal): TRenderObj;
begin
  Result := RenderObjects[i];
end;

procedure TGraph2D.sync(syncSrc: TGraph2D);
var i : integer;
begin
  if (syncSrc = self) then exit; // one complete loop is done
  isSynchronizing := true;
  if (HORIZONTAL in syncRecord) then
    for i := 0 to length(xAxis)-1 do
      if (i < length(syncSrc.xAxis)) then begin
        xAxis[i].min := syncSrc.xAxis[i].min;
        xAxis[i].max := syncSrc.xAxis[i].max;
      end;
  if (VERTICAL in syncRecord) then
    for i := 0 to length(yAxis)-1 do
      if (i < length(syncSrc.yAxis)) then begin
        yAxis[i].min := syncSrc.yAxis[i].min;
        yAxis[i].max := syncSrc.yAxis[i].max;
      end;
  self.Invalidate;
  isSynchronizing := false;
  syncNext.sync(syncSrc);
end;

procedure TGraph2D.mouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i : integer;
  obj : TRenderObj;
begin
  obj := readMouseMap(x, y);
  if (obj <> nil) then obj.mouseEvent(TMouseEventType.MouseDown, X, Y)
  else begin
    KeyCatcher.SetFocus;
    StartC.X := X;
    StartC.Y := Y;
    for i := 0 to Length(XAxis)-1 do XAxis[i].MoveStartMin := XAxis[i].Min;
    for i := 0 to Length(YAxis)-1 do YAxis[i].MoveStartMin := YAxis[i].Min;
    Move := true;
  end;
  for i := 0 to Length(observers)-1 do observers[i].observerEvent(TMouseEventType.MouseDown, X, Y);
end;

procedure TGraph2D.mouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  obj : TRenderObj;
  i : integer;
begin
  if (Move) then Move := false
  else begin
    obj := readMouseMap(x, y);
    if (obj <> nil) then obj.mouseEvent(TMouseEventType.MouseUp, X, Y);
  end;
  for i := 0 to Length(observers)-1 do observers[i].observerEvent(TMouseEventType.MouseUp, X, Y);
end;

procedure TGraph2D.mouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
 d : Double;
 i : integer;
 obj : TRenderObj;
begin
  if (Move) then begin
    for i := 0 to Length(XAxis)-1 do begin
      d := XAxis[i].Max - XAxis[i].Min;
      XAxis[i].Min := XAxis[i].MoveStartMin + (StartC.X - X) / Width * d;
      XAxis[i].Max := XAxis[i].Min + d;
    end;
    for i := 0 to Length(YAxis)-1 do begin
      d := YAxis[i].Max - YAxis[i].Min;
      YAxis[i].Min := YAxis[i].MoveStartMin - (StartC.Y - Y) / Height * d;
      YAxis[i].Max := YAxis[i].Min + d;
    end;
    DoPaint(Sender);
  end else begin
    obj := readMouseMap(x, y);
    if (lastMouseObj <> obj) and (lastMouseObj <> nil) then lastMouseObj.mouseEvent(TMouseEventType.MouseOut, X, Y);
    lastMouseObj := obj;
    if (obj <> nil) then obj.mouseEvent(TMouseEventType.MouseMove, X, Y);
  end;
  for i := 0 to Length(observers)-1 do observers[i].observerEvent(TMouseEventType.MouseMove, X, Y);
end;

procedure TGraph2D.mouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Sx, Sy, mi, ma : Precision;
  i : integer;
  WheelDeltaX,WheelDeltaY : integer;
begin
  if (Width <= 0) then exit;
  if (Height <= 0) then exit;
  WheelDeltaX := Round(WheelDelta / 1000 * Width);
  WheelDeltaY := Round(WheelDelta / 1000 * Height);
  Sx := MousePos.X / Width;
  Sy := MousePos.Y / Height;
  for i := 0 to Length(XAxis)-1 do begin
    mi := XAxis[i].ScreenToPos(Round(WheelDeltaX * Sx));
    ma := XAxis[i].ScreenToPos(Width - Round(WheelDeltaX * (1 - Sx)));
    XAxis[i].Min := mi;
    XAxis[i].Max := ma;
  end;
  for i := 0 to Length(YAxis)-1 do begin
    ma := YAxis[i].ScreenToPos(Round(WheelDeltaY * Sy));
    mi := YAxis[i].ScreenToPos(Height - Round(WheelDeltaY * (1 - Sy)));
    YAxis[i].Min := mi;
    YAxis[i].Max := ma;
  end;
  DoPaint(Sender);
end;

procedure TGraph2D.timerEV(Sender: TObject);
var
  SX1,SY1,SX2,SY2 : shortint;
  mi, ma : Precision;
  i : integer;
begin
  if (not KeyT) and (not KeyB) and (not KeyL) and (not KeyR) then begin Timer.Enabled := false; exit; end;
  SX1 := 0;
  SY1 := 0;
  SX2 := 0;
  SY2 := 0;
  if (KeyR) and (not KeyL) then begin SX1 := Speed; SX2 := Speed; end;
  if (KeyL) and (not KeyR) then begin SX1 := -Speed; SX2 := -Speed; end;
  if (KeyR) and (KeyL) and (ssCtrl in ShiftS) then begin SX1 := -Speed; SX2 := Speed; end;
  if (KeyR) and (KeyL) and (not (ssCtrl in ShiftS)) then begin SX1 := Speed; SX2 := -Speed; end;

  if (KeyB) and (not KeyT) then begin SY1 := Speed; SY2 := Speed; end;
  if (KeyT) and (not KeyB) then begin SY1 := -Speed; SY2 := -Speed; end;
  if (KeyT) and (KeyB) and (ssCtrl in ShiftS) then begin SY1 := -Speed; SY2 := Speed; end;
  if (KeyT) and (KeyB) and (not (ssCtrl in ShiftS)) then begin SY1 := Speed; SY2 := -Speed; end;

  for i := 0 to Length(XAxis)-1 do begin
    mi := XAxis[i].ScreenToPos(SX1);
    ma := XAxis[i].ScreenToPos(Width + SX2);
    XAxis[i].Min := mi;
    XAxis[i].Max := ma;
  end;
  for i := 0 to Length(YAxis)-1 do begin
    ma := YAxis[i].ScreenToPos(SY1);
    mi := YAxis[i].ScreenToPos(Height + SY2);
    YAxis[i].Min := mi;
    YAxis[i].Max := ma;
  end;
  DoPaint(Sender);
end;

procedure TGraph2D.keyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = 37) then KeyL := true
  else if (Key = 38) then KeyT := true
  else if (Key = 39) then KeyR := true
  else if (Key = 40) then KeyB := true;
  ShiftS := Shift;
  Timer.Enabled := true;
end;

procedure TGraph2D.keyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = 37) then KeyL := false
  else if (Key = 38) then KeyT := false
  else if (Key = 39) then KeyR := false
  else if (Key = 40) then KeyB := false;
  ShiftS := Shift;
end;

procedure TGraph2D.doPaint(Sender: TObject);
var i : integer;
begin
  if (Length(_MouseMap) > 0) then FillChar(_MouseMap[0], Length(_MouseMap)*SizeOf(Pointer), #0);
  if (Sender = self) then _completeRepaint := false else _completeRepaint := true;
  if (Width <> BMP.Width) or (Height <> BMP.Height) then begin
    BMP.Width := self.Width;
    BMP.Height := self.Height;
    if (Length(_MouseMap) > self.Width * self.Height * 2) then SetLength(_MouseMap, self.Width * self.Height);
  end;
  canvas.Brush.Color := bgColor;
  canvas.FillRect(0,0,Width,Height);
  for i := 0 to Length(XAxis)-1 do XAxis[i].Render;
  for i := 0 to Length(YAxis)-1 do YAxis[i].Render;
  for i := 0 to Length(RenderObjects)-1 do if (RenderObjects[i].visible) then RenderObjects[i].Render;
  if (KeyCatcher.Focused) then begin
    canvas.Brush.Color := clBlue;
    canvas.FrameRect(0,0,Width,Height);
  end;
  TPanel(self).Canvas.Draw(0, 0, BMP);
end;

procedure TGraph2D._moveTo(x, y: integer);
begin
  LinePos.X := x;
  LinePos.Y := y;
end;

procedure TGraph2D._styledLineTo(x, y: integer; Style: TLineStyle);
var
  lastPos : TPoint;
  _x, _y, w, m : integer;
  d, e : ShortInt;
begin
  lastPos := LinePos;
  LinePos.X := x;
  LinePos.Y := y;
  if (lastPos.x < 0) and (x < 0) or (lastPos.x > Canvas.Width) and (x > Canvas.Width) or (lastPos.y < 0) and (y < 0) or (lastPos.y > Canvas.Height) and (y > Canvas.Height) then exit; // Linien, die komplett außerhalb liehen, verwerfen
  w := LineLength;
  if (Abs(x-lastPos.x) >= Abs(y-lastPos.y)) then begin
    _x := lastPos.x;
    m := x;
    if (lastPos.x < x) then begin
      d := 1;
      if (_x < 0) then _x := 0;
      if (m > Canvas.Width) then m := Canvas.Width;
    end else begin
      d := -1;
      if (_x > Canvas.Width) then _x := Canvas.Width;
      if (m < 0) then m := 0;
    end;
    if (lastPos.y < y) then e := 1 else e := -1;
    while (_x <> m) do begin
      _y := Trunc(lastPos.y + (Y-lastPos.y+e) / (x-lastPos.x+d) * (_x-lastPos.x));
      case (Style) of
       SOLID : Canvas.Pixels[_x, _y] := Canvas.Pen.Color;
       DASHED : if ((w div 3) mod 2 = 0) then Canvas.Pixels[_x, _y] := Canvas.Pen.Color;
       DOTTED : if (w mod 2 = 0) then Canvas.Pixels[_x, _y] := Canvas.Pen.Color;
      end;
      w := w + 1;
      _x := _x + d;
    end;
  end else begin
    _y := lastPos.y;
    m := y;
    if (lastPos.y < y) then begin
     d := 1;
     if (_y < 0) then _y := 0;
     if (m > Canvas.Height) then m := Canvas.Height;
   end else begin
     d := -1;
     if (_y > Canvas.Height) then _y := Canvas.Height;
     if (m < 0) then m := 0;
   end;
   if (lastPos.x < x) then e := 1 else e := -1;
   while (_y <> m) do begin
     _x := Trunc(lastPos.x + (x-lastPos.x+e) / (y-lastPos.y+d) * (_y-lastPos.y));
     case (Style) of
      SOLID : Canvas.Pixels[_x, _y] := Canvas.Pen.Color;
      DASHED : if ((w div 3) mod 2 = 0) then Canvas.Pixels[_x, _y] := Canvas.Pen.Color;
      DOTTED : if (w mod 2 = 0) then Canvas.Pixels[_x, _y] := Canvas.Pen.Color;
     end;
     w := w + 1;
     _y := _y + d;
   end;
  end;
  LineLength := w;
  if (LineLength > 65535) then LineLength := 0;
end;

{procedure TGraph2D.SaveDataToStream(str : TStream; Resolution : Cardinal = 100);
var
 fkts : Array of Array of TFunction;
 i,j,k : integer;
 x,y : Precision;
 s : AnsiString;
begin
 if (Length(XAxis) <> 1) then raise Exception.Create('Export for more than one X-Axis not implemented!');
 fkts := nil;
 // alle Funktionen(-Namen) finden
 for i := 0 to Length(RenderObjects)-1 do if (RenderObjects[i] is TFunction) then begin
  if (TFunction(RenderObjects[i]).Name = '') then j := Length(fkts) else j := 0;
  while (j < Length(fkts)) do if (fkts[j][0].Name = TFunction(RenderObjects[i]).Name) then break else j := j + 1;
  if (j = Length(fkts)) then begin SetLength(fkts, j+1); fkts[j] := nil; end;
  k := Length(fkts[j]);
  SetLength(fkts[j], k+1);
  fkts[j][k] := TFunction(RenderObjects[i]);
 end;
 // Kopfzeile schreiben
 s := XAxis[0].Name;
 for i := 0 to Length(fkts)-1 do s := s + #9 + fkts[i][0].Name;
 s := s + #13#10;
 str.Write(s[1], Length(s));
 // Daten schreiben
 for i := 0 to Resolution do begin
  x := XAxis[0].Min + (XAxis[0].Max - XAxis[0].Min) * i / Resolution;
  s := FloatToStr(x);
  for j := 0 to Length(fkts)-1 do begin
   y := Poly.NaN;
   for k := 0 to Length(fkts[j])-1 do begin y := fkts[j][k].Fkt.Calc(x); if (not Poly.IsNaN(y)) then break; end;
   s := s + #9 + FloatToStr(y);
  end;
  s := s + #13#10;
  str.Write(s[1], Length(s));
 end;
end;    }

destructor TGraph2D.destroy;
var
  i : integer;
  sn : TGraph2D;
begin
  sn := self;
  repeat
    if (sn.syncNext = self) then begin
      sn.syncNext := self.syncNext;
      break;
    end else sn := sn.syncNext;
  until false;
  self.syncNext := self;
  for i := Length(RenderObjects)-1 downto 0 do RenderObjects[i].Destroy;
  for i := Length(XAxis)-1 downto 0 do XAxis[i].Destroy;
  for i := Length(YAxis)-1 downto 0 do YAxis[i].Destroy;
  BMP.Free;
  inherited Destroy;
end;

 

 

class function TGraph2D.round(f: precision): integer;
begin
  if (f > MAXINT) or (isNaN(f)) then Result := MAXINT
  else if (f < -MAXINT) then Result := - MAXINT
  else Result := System.round(f);
end;

class function TGraph2D.floatToPhysStr(f: Double; maxDigits: byte): String;
var
  g : Double;
  i : integer;
begin
  if (maxDigits = 255) then maxDigits := defaultMaxDigits;
  if (isNaN(f)) then begin Result := 'NaN'; exit; end;
  if (f = 0) then begin Result := '0'; exit; end;
  for i := 0 to Length(physUnitValues)-1 do begin
    g := f / physUnitValues[i];
    if (abs(g) < 1000) then begin
      Result := FloatToStrF(g, FFgeneral, maxDigits, maxDigits);
      if (physUnitSymbols[i] <> #0) then Result := Result + String(physUnitSymbols[i]);
      exit;
    end;
  end;
  Result := FloatToStr(f);
end;

class function TGraph2D.intPower(Basis: Double; Exp: Integer): Double;
var i : integer;
begin
  Result := 1;
  for i := 0 to abs(Exp) - 1 do Result := Result * Basis;
  if (Exp < 0) then Result := 1 / Result;
end;

class procedure TGraph2D._getPosOfRegularPoints(From, UpTo: Double; Count: Word; var Start, Space: Double);
var
  Exp : integer;
  K   : Byte;
  D   : Double;
function GetNextSpace : Double;
begin
  if (K = 5) then K := 2
  else if (K = 2) then K := 1
  else begin
    K := 5;
    dec(Exp);
  end;
  Result := K * IntPower(10,Exp);
end;

begin
  if (UpTo = From) then UpTo := From+1;
  Exp := floor(Ln(Abs(UpTo - From)) / Ln(10)) + 1;
  K := 2;
  Space := K * IntPower(10,Exp);
  repeat begin
    D := GetNextSpace;
    if (D * Count >= UpTo - From) then begin
      Space := D;
      Start := ceil(From / Space) * Space;
    end;
  end until (D * Count < UpTo - From);
end;

initialization
if (SizeOf(Precision) = 4) then {%H-}TGraph2D.defaultMaxDigits := 7
else {%H-}TGraph2D.defaultMaxDigits := 15;

end.