Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue35/eval_dan/EVAL_DAN.ZIP/Mathcomp.pas

Pascal/Delphi Source File | 1997-12-30 | 42.6 KB | 1,595 lines

unit mathcomp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TVector2D = record
    x,y: double;
  end;

  TVector3D = record
    X,Y,Z: Double;
  end;

  TTokenType = (ttUnknown,ttOperation,ttVariable,ttConstant);

  //TVariableList
  PVariableRecord = ^TVariableRecord;
  TVariableRecord = record
    VarData: Double;
    VarName: String;
  end;

  //Forward declarations
  TExpressionTree = class;

  TVarList = class(TList)
  private
    function GetVars(Index: String): PVariableRecord;
  public
    property Vars[Index: String]: PVariableRecord read GetVars;
    //Methods
    destructor Destroy; override;
    function GetIndex(AValue: String): Integer;
    function NewVar(AName: String; AData: Double): PVariableRecord;
  end;

  TExpressionNode = class(TObject)
  private
    FValue: String;
    FParent: TExpressionNode;
    FTokenType: TTokenType;
    FChildren: TList;
    FValidValue: Boolean;
    FNumValue: Double;
    FVarPointer: PVariableRecord;
    FTree: TExpressionTree;
  public
    property Value: String read FValue write FValue;
    property Parent: TExpressionNode read FParent write FParent;
    property TokenType: TTokenType read FTokenType write FTokenType;
    property Children: TList read FChildren write FChildren;
    property ValidValue: Boolean read FValidValue write FValidValue;
    property NumValue: Double read FNumValue write FNumValue;
    property VarPointer: PVariableRecord read FVarPointer write FVarPointer;
    property Tree: TExpressionTree read FTree write FTree;
    //Methods
    function CreateChild: TExpressionNode;
    function Evaluate(SuppressErrors,UseVars: Boolean): Double;
    constructor Create(AOwner: TExpressionNode; ATree: TExpressionTree);
    destructor Destroy; override;
  end;

  TExpressionTree = class(TPersistent)
  private
    FTopNode: TExpressionNode;
    FExpression: String;
    FCheckSyntax: Boolean;
    FTokens: TStringList;
    FVarList: TVarList;
    procedure SetExpression(AValue: String);
  public
    property TopNode: TExpressionNode read FTopNode write FTopNode;
    property Expression: String read FExpression write SetExpression;
    property CheckSyntax: Boolean read FCheckSyntax write FCheckSyntax;
    property Tokens: TStringList read FTokens write FTokens;
    property VarList: TVarList read FVarList write FVarList;
    //Methods
    constructor Create;
    destructor Destroy; override;
    procedure MakeTokens;
    procedure RemoveBadTokens;
  end;

  TDataSet2D = class(TObject)
  private
    FData: pointer;
    FCount: Longint;
    function GetData(Index: Longint): TVector2D;
    procedure SetData(Index: Longint; AValue: TVector2D);
    procedure SetCount(AValue: longint);
  public
    property Data[Index: longint]: TVector2D read GetData write SetData;
    property Count: longint read FCount write SetCount;
    constructor Create(ACount: Longint);
    destructor Destroy; override;
  end;

  TDataSet3D = class(TObject)
  private
    FData: pointer;
    FCount: Longint;
    function GetData(Index: Longint): TVector3D;
    procedure SetData(Index: Longint; AValue: TVector3D);
    procedure SetCount(AValue: longint);
  public
    property Data[Index: longint]: TVector3D read GetData write SetData;
    property Count: longint read FCount write SetCount;
    constructor Create(ACount: Longint);
    destructor Destroy; override;
  end;

  TDataLabel = class(TObject)
  private
    FData: String;
    Fx,Fy: integer;
  public
    property Data: string read FData write FData;
    property x: integer read Fx write Fx;
    property y: integer read Fy write Fy;
  end;

  {TAxesView}

  TAxesAlign = (aaPositive,aaNegative);
  TCoord2DFunc = function (InV: TVector2D): TVector2D of Object;
  TCoord3DFunc = function (InV: TVector3D): TVector3D of Object;

  TAxesView = class(TCustomControl)
  private
    { Private declarations }
    FXMin,FXMax,FXScale,FYMin,FYMax,FYScale: double;
    FShowGrid,FShowAxes,FShowLabels,FAutoUpdate: Boolean;
    FXAxisColor,FYAxisColor,FGridColor: TColor;
    FOnGetMathCoord,FOnGetRealCoord: TCoord2DFunc;
    FRXScale,FRYScale: Double;
    FOrigin: TVector2D;
    FGrid: TDataSet2D;
    FLabels: TList;
    FDecimals: Integer;
    FAlignLabelX,FAlignLabelY: TAxesAlign;
    FOnPaint: TNotifyEvent;
    procedure SetXMin(AValue: Double);
    procedure SetXMax(AValue: Double);
    procedure SetXScale(AValue: Double);
    procedure SetYMin(AValue: Double);
    procedure SetYMax(AValue: Double);
    procedure SetYScale(AValue: Double);
    procedure SetShowGrid(AValue: Boolean);
    procedure SetShowAxes(AValue: Boolean);
    procedure SetShowLabels(AValue: Boolean);
    procedure SetXAxisColor(AValue: TColor);
    procedure SetYAxisColor(AValue: TColor);
    procedure SetGridColor(AValue: TColor);
    procedure SetAlignLabelX(AValue: TAxesAlign);
    procedure SetAlignLabelY(AValue: TAxesAlign);
    procedure SetDecimals(AValue: Integer);
    procedure FontChange(Sender: TObject); virtual;
    //inherited methods
  protected
    { Protected declarations }
    procedure DrawAxes; virtual;
    procedure DrawGrid; virtual;
    procedure DrawLabels; virtual;
  public
    { Public declarations }
    property Labels: TList read FLabels write FLabels;
    property RXScale: double read FRXScale;
    property RYScale: double read FRYScale;
    property Origin: TVector2D read FOrigin;
    property Grid: TDataSet2D read FGrid;
    //Methods
    procedure DoAutoPan(X,Y: Integer); virtual;
    procedure Zoom(Percent: Integer);
    procedure SetScale(AXMin,AXMax,AXScale,AYMin,AYMax,AYScale: Double);
    function GetMathCoord(InV: TVector2D): TVector2D; virtual;
    function GetRealCoord(InV: TVector2D): TVector2D; virtual;
    procedure RecalcScale; virtual;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  published
    { Published declarations }
    property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate;
    property AlignLabelX: TAxesAlign read FAlignLabelX write SetAlignLabelX;
    property AlignLabelY: TAxesAlign read FAlignLabelY write SetAlignLabelY;
    property XMin: double read FXMin write SetXMin;
    property XMax: double read FXMax write SetXMax;
    property XScale: double read FXScale write SetXScale;
    property YMin: double read FYMin write SetYMin;
    property YMax: double read FYMax write SetYMax;
    property YScale: double read FYScale write SetYScale;
    property ShowGrid: Boolean read FShowGrid write SetShowGrid;
    property ShowAxes: Boolean read FShowAxes write SetShowAxes;
    property ShowLabels: Boolean read FShowLabels write SetShowLabels;
    property XAxisColor: TColor read FXAxisColor write SetXAxisColor;
    property YAxisColor: TColor read FYAxisColor write SetYAxisColor;
    property GridColor: TColor read FGridColor write SetGridColor;
    property Decimals: Integer read FDecimals write SetDecimals;
    //Inherited properties to be published
    property Color;
    property Font;
    property Align;
    //Events
    property OnGetMathCoord: TCoord2DFunc read FOnGetMathCoord write FOnGetMathCoord;
    property OnGetRealCoord: TCoord2DFunc read FOnGetRealCoord write FOnGetRealCoord;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    //Inherited events to be published
    property OnEnter;
    property OnExit;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

const
  ValidOps = ['+','-','*','/',')','(','^','='];

procedure Register;
function V2D(x,y: double): TVector2D;
function V3D(vx,vy,vz: double): TVector3D;
function V2D2Point(V: TVector2D): TPoint;
function V3DXY(V: TVector3D): TVector2D;
function V3DXZ(V: TVector3D): TVector2D;
function V3DZY(V: TVector3D): TVector2D;
function V3D2STR(V: TVector3D): String;

implementation

//-----Global routines-----//

function V3D(vx,vy,vz: double): TVector3D;
begin
  with Result do
  begin
    X := vx;
    Y := vy;
    Z := vz;
  end;
end;

function V3DXY(V: TVector3D): TVector2D;
begin
  with Result do
  begin
    x := V.x;
    y := V.y;
  end;
end;

function V3DXZ(V: TVector3D): TVector2D;
begin
  with Result do
  begin
    x := V.x;
    y := V.z;
  end;
end;

function V3DZY(V: TVector3D): TVector2D;
begin
  with Result do
  begin
    x := V.z;
    y := V.y;
  end;
end;

function V3D2STR(V: TVector3D): String;
var
SX,SY,SZ: String;
begin
  Str(V.x,SX);
  Str(V.y,SY);
  Str(V.z,SZ);
  Result := '<'+SX+','+SY+','+SZ+'>';
end;

function V2D(x,y: double): TVector2D;
var
AResult: TVector2D;
begin
  AResult.x := x;
  AResult.y := y;
  Result := AResult;
end;

function V2D2Point(V: TVector2D): TPoint;
begin
  with Result do
  begin
    x := Round(V.x);
    y := Round(V.y);
  end;
end;

procedure Register;
begin
  RegisterComponents('Custom', [TAxesView]);
end;

//-----TVarList implementation-----//

function TVarList.GetIndex(AValue: String): Integer;
var
i: integer;
begin
  if Count>0 then
  begin
    for i := 0 to Count-1 do
    begin
      if PVariableRecord(items[i])^.VarName = AValue then
      begin
        Result := i;
        Exit;
      end;
    end;
  end;
  //Nothing found--return -1 as error code
  Result := -1;
end;

function TVarList.GetVars(Index: String): PVariableRecord;
var
ti: integer;
begin
  ti := GetIndex(Index);
  if ti > -1 then
    Result := PVariableRecord(Items[ti])
  else
    Result := nil;
end;

function TVarList.NewVar(AName: String; AData: Double): PVariableRecord;
var
VarRec: PVariableRecord;
ti: integer;
begin
  ti := GetIndex(AName);
  if ti = -1 then
  begin
    VarRec := New(PVariableRecord);
    VarRec^.VarName := AName;
    VarRec^.VarData := AData;
    Add(VarRec);
  end
  else
  begin
    VarRec := PVariableRecord(Items[ti]);
    VarRec^.VarData := AData;
  end;
  Result := VarRec;
end;

destructor TVarList.Destroy;
begin
  while Count>0 do
  begin
    Dispose(Items[0]);
    Delete(0);
  end;
  inherited Destroy;
end;

//-----TExpressionNode implementation-----//

constructor TExpressionNode.Create(AOwner: TExpressionNode;
ATree: TExpressionTree);
begin
  inherited Create;
  FParent := AOwner;
  FTree := ATree;
  FChildren := TList.Create;
  FValidValue := False;
end;

destructor TExpressionNode.Destroy;
begin
  while FChildren.Count > 0 do
  begin
    TExpressionNode(FChildren.items[0]).Free;
    FChildren.Delete(0);
  end;
  FChildren.Free;
  inherited Destroy;
end;

function TExpressionNode.CreateChild: TExpressionNode;
var
tNode: TExpressionNode;
begin
  tNode := TExpressionNode.Create(Self,Tree);
  Children.Add(tNode);
  Result := tNode;
end;

function TExpressionNode.Evaluate(SuppressErrors,UseVars: Boolean): Double;
var
tf: double;
i: longint;
invop: boolean;
begin
  //Evaluate the children first
  if Children.Count>0 then
  begin
    for i := 0 to Children.Count-1 do
      TExpressionNode(Children.items[i]).Evaluate(SuppressErrors,UseVars);
  end;
  //Now that children are evaluated, do this node
  case TokenType of
    ttUnknown:
    begin
      //This hasn't been trimmed so just evaluate the first child
      if Children.Count > 0 then
      begin
        NumValue := TExpressionNode(Children.items[0]).
        Evaluate(SuppressErrors,UseVars);
        ValidValue := TExpressionNode(Children.items[0]).ValidValue;
        Result := NumValue;
      end
      else
      begin
        if not SuppressErrors then
        begin
          ShowMessage('Error in evaluation tree: ttUnknown node with no children.');
          Exit;
        end;
      end;
    end;
    ttConstant:
    begin
      if not ValidValue then
      begin
        //Store everything as floats for now
        try
          tf := StrToFloat(Value);
          //Ok, it's a valid float value so store it
          NumValue := tf;
          ValidValue := True;
        except
          //It's not a valid numeric constant!
          on EConvertError do
          begin
            if not SuppressErrors then
            begin
              ShowMessage('Invalid numeric constant: '+Value);
              Exit;
            end;
          end;
        end;
      end;
      Result := NumValue;
    end;
    ttVariable:
    begin
      if UseVars then
      begin
        //Make sure variable hasn't changed from token
        if not Assigned(VarPointer) or (VarPointer^.VarName <> Value) then
        begin
          //Find new variable or create one if needed
          VarPointer := Tree.VarList.Vars[Value];
          if VarPointer = nil then
            VarPointer := Tree.VarList.NewVar(Value,0);
        end;
        //Variable is now valid
        NumValue := VarPointer^.VarData;
        ValidValue := True;
      end
      else
        ValidValue := False;
    end;
    ttOperation:
    begin
      //This is where the math takes place
      ValidValue := false;
      invop := true;
      if Value = '+' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := TExpressionNode(Children.items[0]).NumValue+
          TExpressionNode(Children.items[1]).NumValue;
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: addition operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = '-' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := TExpressionNode(Children.items[0]).NumValue-
          TExpressionNode(Children.items[1]).NumValue;
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: subtraction operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = '*' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := TExpressionNode(Children.items[0]).NumValue*
          TExpressionNode(Children.items[1]).NumValue;
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: multiplacation operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = '/' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := TExpressionNode(Children.items[0]).NumValue/
          TExpressionNode(Children.items[1]).NumValue;
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: division operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = 'div' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Round(TExpressionNode(Children.items[0]).NumValue/
          TExpressionNode(Children.items[1]).NumValue);
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: integer division operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = 'mod' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Round(TExpressionNode(Children.items[0]).NumValue) mod
          Round(TExpressionNode(Children.items[1]).NumValue);
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: modulo operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = 'and' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Round(TExpressionNode(Children.items[0]).NumValue) and
          Round(TExpressionNode(Children.items[1]).NumValue);
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: and operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = 'or' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Round(TExpressionNode(Children.items[0]).NumValue) or
          Round(TExpressionNode(Children.items[1]).NumValue);
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: or operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = 'xor' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Round(TExpressionNode(Children.items[0]).NumValue) xor
          Round(TExpressionNode(Children.items[1]).NumValue);
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: addition operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = '=' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Ord(TExpressionNode(Children.items[0]).NumValue=
          TExpressionNode(Children.items[1]).NumValue);
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: equative operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
      end;
      if Value = '^' then
      begin
        if Children.Count = 2 then
        begin
          NumValue := Exp(TExpressionNode(Children.items[1]).NumValue *
          Ln(TExpressionNode(Children.items[0]).NumValue));
          ValidValue := TExpressionNode(Children.items[0]).ValidValue and
          TExpressionNode(Children.items[1]).ValidValue;
          invop := false;
        end
        else
        begin
          ValidValue := False;
          if not SuppressErrors then
          begin
            ShowMessage('Error: exponential operation with '+
            IntToStr(Children.Count)+' values.');
            Exit;
          end;
        end;
        if invop then
        begin
          if not SuppressErrors then
            ShowMessage('Error: invalid operation '+Value);
        end
      end;
    end;
  end;
  Result := NumValue;
end;



//-----TExpressionTree implementation-----//

constructor TExpressionTree.Create;
begin
  inherited Create;
  FCheckSyntax := True;
  FTokens := TStringList.Create;
end;

destructor TExpressionTree.Destroy;
begin
  if Assigned(FTopNode) then
    FTopNode.Free;
  FTokens.Free;
  inherited Destroy;
end;

procedure TExpressionTree.RemoveBadTokens;
var
i: longint;
begin
  if Tokens.Count > 0 then
  begin
    //Cut out extra parentheses.
    i := 1;
    repeat
      if (Tokens[i-1] = '(') and (Tokens[i+1] = ')') then
      begin
        //No need for parentheses around a single token
        Tokens.Delete(i-1);
        Tokens.Delete(i);
        i := 1;
      end;
      Inc(i);
    until (i>(Tokens.Count-2))
  end;
end;

procedure TExpressionTree.MakeTokens;
var
incount,start: longint;
begin
  Tokens.Clear;
  incount := 1;
  start := 1;
  repeat
    //Read new token until we find a valid operation char or a space
    while not (FExpression[incount] in ValidOps)
    and not (FExpression[incount] = ' ') do
    begin
      //It's still a valid token so keep reading
      Inc(incount);
      if (incount>Length(FExpression)) then
      begin
        //We've gone past the end of the string
        //Write the token and exit
        Tokens.Add(Copy(FExpression,start,incount-start));
        Exit;
      end;
    end;
    //We've found a valid operation or space character
    //Record token before operation or space
    if (incount-start)>0 then
      Tokens.Add(Copy(FExpression,start,incount-start));
    //Record an operation, but discard a space
    if FExpression[incount] in ValidOps then
      Tokens.Add(Copy(FExpression,incount,1));
    start := incount+1;
    incount := start;
  until (start>Length(FExpression));
end;

procedure TExpressionTree.SetExpression(AValue: String);
var
i,c: longint;
CNode,tNode: TExpressionNode;
CToken: String;
tf: double;

function IsLowerOp: Boolean;
begin
  Result := (CToken='+') or (CToken='-') or (CToken='=') or (CToken='or') or
  (CToken='and') or (CToken='xor');
end;

function IsMiddleOp: Boolean;
begin
  Result := (CToken='*') or (CToken='/') or (CToken='div') or (CToken='mod');
end;

begin
  if (AValue<>FExpression) and (AValue <> '') then
  begin
    if CheckSyntax then
    begin
      c := 0;
      for i := 1 to Length(AValue) do
      begin
        case AValue[i] of
          '(': Inc(c);
          ')': Dec(c);
        end;
      end;
      if (c<>0) then
      begin
        ShowMessage('Error in syntax: parentheses unbalanced at '+IntToStr(c));
        Exit;
      end;
    end;
    //No syntax errors found yet--set property and clear old tree
    FExpression := AValue;
    if Assigned(FTopNode) then
      FTopNode.Free;
    FTopNode := TExpressionNode.Create(nil,Self);
    //Parse expression so it's ready for tree generation
    MakeTokens;
    //Remove any tokens that are useless or will cause undesired behavior
    RemoveBadTokens;
    //Let's make the tree
    if Tokens.Count>0 then
    begin
      CNode := FTopNode;
      for i := 0 to Tokens.Count-1 do
      begin
        CToken := Tokens.strings[i];
        if CToken='(' then
        begin
          CNode := CNode.CreateChild;
          //Create temporary token for reference of order-of-operations code
          CNode.Value := '(';
          CNode.TokenType := ttOperation;
          CNode := CNode.CreateChild;
          Continue;
        end;
        if IsLowerOp or (Assigned(CNode.Parent) and (CNode.Parent.Value='^')
        and IsMiddleOp) then
        begin
          //Low priority or after an exponent--go up the tree
          if not Assigned(CNode.Parent) then
          begin
            ShowMessage('Error in expression: '+FExpression);
            Exit;
          end;
          repeat
            CNode := CNode.Parent;
          until  not Assigned(CNode.Parent) or
          (CNode.TokenType<>ttOperation) or (CNode.Parent.Value = '(');
          if CNode.TokenType = ttOperation then
          begin
            //Create a new higher level node in-between CNode and CNode.Parent
            //If CNode.Parent is nil then we must setup a new TopNode field
            if not Assigned(CNode.Parent) then
            begin
              if not (CNode = FTopNode) then
              begin
                ShowMessage('Expression Evaluator Error: '+
                'Node with nil parent is not top node!');
                Exit;
              end;
              FTopNode := TExpressionNode.Create(nil,Self);
              FTopNode.Children.Add(CNode);
              CNode.Parent := FTopNode;
            end
            else
            begin
              //Otherwise just insert the new node
              tNode := TExpressionNode.Create(CNode.Parent,Self);
              tNode.Children.Add(CNode);
              //Don't forget to reset children of Parent node
              CNode.Parent.Children.Remove(CNode);
              CNode.Parent.Children.Add(tNode);
              CNode.Parent := tNode;
            end;
          end
          else
          begin
            //There is no operation at this node currently--replace the node
            //data for this operation and continue loop
            CNode.TokenType := ttOperation;
            CNode.Value := CToken;
            Continue;
          end;
          //Node inserted--set current node to parent so that operation can
          //be inserted
          CNode := CNode.Parent;
          CNode.TokenType := ttOperation;
          CNode.Value := CToken;
          Continue;
        end;
        if IsMiddleOp or (CToken='^') then
        begin
          //Middle operation that isn't past an exponent or an exponent--go down
          if not Assigned(CNode.Parent) then
          begin
            ShowMessage('Error in expression: '+FExpression);
            Exit;
          end;
          if CNode.Parent.TokenType = ttOperation then
          begin
            //Insert node before CNode
            tNode := TExpressionNode.Create(CNode,Self);
            while (CNode.Children.Count>0) do
            begin
              TExpressionNode(CNode.Children.items[0]).Parent := tNode;
              tNode.Children.Add(CNode.Children.items[0]);
              CNode.Children.Delete(0);
            end;
            tNode.Value := CNode.Value;
            tNode.TokenType := CNode.TokenType;
            CNode.Children.Add(tNode);
          end
          else
            CNode := CNode.Parent;
          CNode.TokenType := ttOperation;
          CNode.Value := CToken;
          Continue;
        end;
        if CToken = ')' then
        begin
          //We need to backtrack through tree to find our origin--
          {while Assigned(CNode.Parent)
          and (CNode.Parent.TokenType<>ttUnknown) do CNode := CNode.Parent;}
          //Look for '(' marker
          repeat
            CNode := CNode.Parent;
          until (CNode.Parent.Value = '(');
          //Delete the marker and setup CNode
          tNode := CNode;
          CNode := tNode.Parent;
          CNode.Parent.Children.Remove(CNode);
          while (CNode.Children.Count>0) do
          begin
            TExpressionNode(CNode.Children.items[0]).Parent := CNode.Parent;
            CNode.Parent.Children.Add(CNode.Children.items[0]);
            CNode.Children.Delete(0);
          end;
          CNode.Free;
          CNode := tNode;
          //Check to see if TopNode is already assigned and if so insert a new
          //node above it--assuming we're at the TopNode
          if not Assigned(CNode.Parent) then
          begin
            if not (CNode = FTopNode) then
            begin
              ShowMessage('Expression Evaluator Error: '+
              'Node with nil parent is not top node!');
              Exit;
            end;
            //Create new top node
            FTopNode := TExpressionNode.Create(nil,Self);
            FTopNode.Children.Add(CNode);
            CNode.Parent := FTopNode;
          end;
          Continue;
        end;
        //It's not a symbol or an operator, so it must be something else
        //Check to see if it's a valid numeric constant
        try
          tf := StrToFloat(CToken);
          //It's a valid constant since no exception has been raised
          //Create child node for constant
          CNode := CNode.CreateChild;
          CNode.TokenType := ttConstant;
          CNode.Value := CToken;
        except
          on EConvertError do
          begin
            //It's not a valid number, so let's assume it's a variable
            CNode := CNode.CreateChild;
            CNode.TokenType := ttVariable;
            CNode.Value := CToken;
          end;
        end;
        //Continue for loop through tokens
      end;
    end;
  end;
end;

//-----TAxesView implementation-----//

procedure TAxesView.DrawGrid;
var
i: longint;
CVector: TVector2D;
begin
  with Canvas do
  begin
    Pen.Color := GridColor;
    Pen.Width := 1;
    for i := 0 to FGrid.Count-1 do
    begin
      CVector := FGrid.Data[i];
      PenPos := Point(0,Round(CVector.y));
      LineTo(Width-1,Round(CVector.y));
      PenPos := Point(Round(CVector.x),0);
      LineTo(Round(CVector.x),Height-1);
    end;
  end;
end;

procedure TAxesView.DrawAxes;
begin
  with Canvas do
  begin
    Pen.Width := 2;
    Pen.Color := XAxisColor;
    PenPos := (Point(0,Round(Origin.y)));
    LineTo(Width-1,Round(Origin.y));
    Pen.Color := YAxisColor;
    PenPos := (Point(Round(Origin.x),0));
    LineTo(Round(Origin.x),Height-1);
  end;
end;

procedure TAxesView.DrawLabels;
var
i: longint;
begin
  Canvas.Brush.Style := bsClear;
  if Labels.Count > 0 then
  begin
    for i := 0 to Labels.Count-1 do
    begin
      with TDataLabel(Labels.items[i]) do
        Canvas.TextOut(x,y,Data);
    end;
  end;
end;

procedure TAxesView.Paint;
begin
  //Draw grid
  if ShowGrid then DrawGrid;
  //Draw axes
  if ShowAxes then DrawAxes;
  //Draw labels
  if ShowLabels then DrawLabels;
  if Assigned(FOnPaint) then
    FOnPaint(Self);
end;

procedure TAxesView.RecalcScale;
var
diffx,diffy,i,k,tv: longint;
j: double;
CXMod,CYMod: Integer;
DL: TDataLabel;
ts,tsb: string;
CVector: TVector2D;

function max(a,b: longint): longint;
begin
  if (a>b) then
    Result := a
  else
    Result := b;
end;

begin
  FRXScale := Width/(XMax-XMin);
  FRYScale := Height/(YMin-YMax);
  if ShowAxes or ShowGrid or ShowLabels then FOrigin := GetRealCoord(V2D(0,0));
  if ShowGrid then
  begin
    //Prepare for maximum possible allocation
    FGrid.Count :=
    abs(Round((XMax-XMin)/XScale))+abs(Round((YMax-YMin)/YScale))*2;
    diffx := abs(Round(GetRealCoord(V2D(XScale,0)).x-Origin.x));
    diffy := abs(Round(GetRealCoord(V2D(0,YScale)).y-Origin.y));
    j := 0;
    //Do -XY first
    i := Round(Origin.x);
    k := Round(Origin.y);
    repeat
      i := i - diffx;
      k := k - diffy;
      FGrid.Data[Round(j)] := V2D(i,k);
      j := j + 1;
    until (i<0)and(k<0);
    //Do +XY next
    i := Round(Origin.x);
    k := Round(Origin.y);
    repeat
      i := i + diffx;
      k := k + diffy;
      FGrid.Data[Round(j)] := V2D(i,k);
      j := j + 1;
    until (i>=Width) and (k>=Height);
    FGrid.Count := Round(j);
  end;
  if ShowLabels then
  begin
    //Free old information from Labels list
    while (Labels.Count > 0) do
    begin
      TDataLabel(Labels.items[0]).Free;
      Labels.Delete(0);
    end;
    //Setup variables for scale including spacing
    CVector := GetRealCoord(V2D(XMin+XScale,YMax-YScale));
    Str(XMin:0:Decimals,ts);
    Str(XMax:0:Decimals,tsb);
    CXMod := Trunc(max(Canvas.TextWidth(ts),
    Canvas.TextWidth(tsb))*1.05/(CVector.x))+1;
    Str(YMin:0:Decimals,ts);
    Str(YMax:0:Decimals,tsb);
    CYMod := Trunc(max(Canvas.TextHeight(ts),
    Canvas.TextHeight(tsb))*1.05/(CVector.y))+1;
    //Store the actual labels
    //Do X- first
    j := -(CXMod*XScale);
    repeat
      DL := TDataLabel.Create;
      Str(j:0:Decimals,ts);
      DL.Data := ts;
      tv := Round(GetRealCoord(V2D(j,0)).x);
      DL.x := tv-(Canvas.TextWidth(ts) div 2);
      if (AlignLabelX = aaNegative) then
        DL.y := Round(Origin.y) + 1
      else
        DL.y := Round(Origin.y)-Canvas.TextHeight(ts)-1;
      Labels.Add(DL);
      j := j - (CXMod*XScale);
    until (j < XMin);
    //Do X+ now
    j := (CXMod*XScale);
    repeat
      DL := TDataLabel.Create;
      Str(j:0:Decimals,ts);
      DL.Data := ts;
      tv := Round(GetRealCoord(V2D(j,0)).x);
      DL.x := tv-(Canvas.TextWidth(ts) div 2);
      if (AlignLabelX = aaNegative) then
        DL.y := Round(Origin.y) + 1
      else
        DL.y := Round(Origin.y)-Canvas.TextHeight(ts)-1;
      Labels.Add(DL);
      j := j + (CXMod*XScale);
    until (j > XMax);
    //Do Y- now
    j := -(CYMod*YScale);
    repeat
      DL := TDataLabel.Create;
      Str(j:0:Decimals,ts);
      DL.Data := ts;
      tv := Round(GetRealCoord(V2D(0,j)).y);
      if (AlignLabelY = aaNegative) then
        DL.x := Round(Origin.X)-Canvas.TextWidth(ts)-1
      else
        DL.x := Round(Origin.X)+1;
      DL.y := tv-(Canvas.TextHeight(ts) div 2);
      Labels.Add(DL);
      j := j - (CYMod*YScale);
    until (j < YMin);
    //Do Y+ now
    j := (CYMod*YScale);
    repeat
      DL := TDataLabel.Create;
      Str(j:0:Decimals,ts);
      DL.Data := ts;
      tv := Round(GetRealCoord(V2D(0,j)).y);
      if (AlignLabelY = aaNegative) then
        DL.x := Round(Origin.X)-Canvas.TextWidth(ts)-1
      else
        DL.x := Round(Origin.X)+1;
      DL.y := tv-(Canvas.TextHeight(ts) div 2);
      Labels.Add(DL);
      j := j + (CYMod*YScale);
    until (j > YMax);
  end;
end;

procedure TAxesView.DoAutoPan(X,Y: Integer);
var
V: TVector2D;
begin
  V := GetMathCoord(V2D(X,Y));
  if (X<5) then FXMin := FXMin-FXScale
  else
  begin
    if (X>Width-5) then FXMax := FXMax+FXScale
    else
    begin
      if (Y<5) then FYMax := FYMax+FYScale
      else
      begin
        if (Y>Height-5) then FYMin := FYMin-FYScale
        else
          Exit;
      end;
    end;
  end;
  RecalcScale;
  V := GetRealCoord(V);
  SetCursorPos(ClientOrigin.X+Round(V.X),ClientOrigin.Y+Round(V.Y));
end;

function TAxesView.GetRealCoord(InV: TVector2D): TVector2D;
begin
  if Assigned(FOnGetRealCoord) then
    FOnGetRealCoord(InV);
  with Result do
  begin
    x := RXScale*(InV.x-XMin);
    y := RYScale*(InV.y-YMax);
  end;
end;

function TAxesView.GetMathCoord(Inv: TVector2D): TVector2D;
begin
  with InV do
  begin
    x := (x/RXScale)+XMin;
    y := (y/RYScale)+YMax;
  end;
  if Assigned(OnGetMathCoord) then
    FOnGetMathCoord(InV);
  Result := InV;
end;

procedure TAxesView.Zoom(Percent: Integer);
begin
  if Percent>0 then
  begin
    FXMin := FXMin*(Percent/100);
    FXMax := FXMax*(Percent/100);
    FYMin := FYMin*(Percent/100);
    FYMax := FYMax*(Percent/100);
    RecalcScale;
    if (csDesigning in ComponentState) or AutoUpdate then Refresh;
  end;
end;

procedure TAxesView.SetScale(AXMin,AXMax,AXScale,AYMin,AYMax,AYScale: Double);
begin
  FXMin := AXMin;
  FXMax := AXMax;
  FXScale := AXScale;
  FYMin := AYMin;
  FYMax := AYMax;
  FYScale := AYScale;
  RecalcScale;
  if (csDesigning in ComponentState) or AutoUpdate then Refresh;
end;

constructor TAxesView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGrid := TDataSet2D.Create(20);
  //Setup default values
  FXMin := -100;
  FXMax := 100;
  FXScale := 10;
  FYMin := -100;
  FYMax := 100;
  FYScale := 10;
  FDecimals := 0;
  FShowGrid := True;
  FShowAxes := True;
  FShowLabels := True;
  FLabels := TList.Create;
  FXAxisColor := clBlack;
  FYAxisColor := clBlack;
  FGridColor := clSilver;
  FAutoUpdate := True;
  Color := clWhite;
  Width := 200;
  Height := 200;
  //Hook events in object
  Font.OnChange := FontChange;
end;

destructor TAxesView.Destroy;
begin
  FGrid.Free;
  inherited Destroy;
end;

procedure TAxesView.WMSize(var Message: TWMSize);
begin
  if (Message.Width < 50) or (Message.Height < 50) then Exit;
  inherited;
  if not (csLoading in ComponentState) then
  begin
    RecalcScale;
    Refresh;
  end;
end;

procedure TAxesView.FontChange(Sender: TObject);
begin
  Canvas.Font.Assign(Font);
  if (csDesigning in ComponentState) or AutoUpdate then
  begin
    RecalcScale;
    Refresh;
  end;
end;

procedure TAxesView.SetDecimals(AValue: Integer);
begin
  if (AValue<>FDecimals) and (AValue>=0) and (AValue<9) then
  begin
    FDecimals := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetXMin(AValue: Double);
begin
  if (AValue <> FXMin) and (AValue < FXMax) then
  begin
    FXMin := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetXMax(AValue: Double);
begin
  if (AValue <> FXMax) and (AValue > FXMin) then
  begin
    FXMax := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetXScale(AValue: Double);
begin
  if AValue <> FXScale then
  begin
    FXScale := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetYMin(AValue: Double);
begin
  if (AValue <> FYMin) and (AValue<FYMax) then
  begin
    FYMin := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetYMax(AValue: Double);
begin
  if (AValue <> FYMax) and (AValue>FYMin) then
  begin
    FYMax := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetYScale(AValue: Double);
begin
  if AValue <> FYScale then
  begin
    FYScale := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetShowGrid(AValue: Boolean);
begin
  if AValue <> FShowGrid then
  begin
    FShowGrid := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetShowAxes(AValue: Boolean);
begin
  if AValue <> FShowAxes then
  begin
    FShowAxes := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetAlignLabelX(AValue: TAxesAlign);
begin
  if AValue<>FAlignLabelX then
  begin
    FAlignLabelX := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetAlignLabelY(AValue: TAxesAlign);
begin
  if AValue<>FAlignLabelY then
  begin
    FAlignLabelY := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then
    begin
      RecalcScale;
      Refresh;
    end;
  end;
end;

procedure TAxesView.SetShowLabels(AValue: Boolean);
begin
  if AValue <> FShowLabels then
  begin
    FShowLabels := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then Refresh;
  end;
end;

procedure TAxesView.SetXAxisColor(AValue: TColor);
begin
  if AValue <> FXAxisColor then
  begin
    FXAxisColor := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then Refresh;
  end;
end;

procedure TAxesView.SetYAxisColor(AValue: TColor);
begin
  if AValue <> FYAxisColor then
  begin
    FYAxisColor := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then Refresh;
  end;
end;

procedure TAxesView.SetGridColor(AValue: TColor);
begin
  if AValue <> FGridColor then
  begin
    FGridColor := AValue;
    if (csDesigning in ComponentState) or AutoUpdate then Refresh;
  end;
end;

//-----TDataSet2D implementation-----//

procedure TDataSet2D.SetData(Index: longint; AValue: TVector2D);
begin
  with TVector2D(Ptr(Longint(FData)+(Index*SizeOf(TVector2D)))^) do
  begin
    x := AValue.x;
    y := AValue.y;
  end;
end;

function TDataSet2D.GetData(Index: longint): TVector2D;
begin
  with TVector2D(Ptr(Longint(FData)+(Index*SizeOf(TVector2D)))^) do
  begin
    Result.x := x;
    Result.y := y;
  end;
end;

procedure TDataSet2D.SetCount(AValue: longint);
begin
  if AValue <> FCount then
  begin
    FCount := AValue;
    ReAllocMem(FData,AValue*SizeOf(TVector2D));
  end;
end;

constructor TDataSet2D.Create(ACount: longint);
begin
  inherited Create;
  FCount := ACount;
  GetMem(FData,ACount*SizeOf(TVector2D));
end;

destructor TDataSet2D.Destroy;
begin
  FreeMem(FData,FCount*SizeOf(TVector2D));
  inherited Destroy;
end;

//-----TDataSet3D implementation-----//

procedure TDataSet3D.SetData(Index: longint; AValue: TVector3D);
begin
  with TVector3D(Ptr(Longint(FData)+(Index*SizeOf(TVector3D)))^) do
  begin
    x := AValue.x;
    y := AValue.y;
    z := AValue.z;
  end;
end;

function TDataSet3D.GetData(Index: longint): TVector3D;
begin
  with TVector3D(Ptr(Longint(FData)+(Index*SizeOf(TVector3D)))^) do
  begin
    Result.x := x;
    Result.y := y;
    Result.z := z;
  end;
end;

procedure TDataSet3D.SetCount(AValue: longint);
begin
  if AValue <> FCount then
  begin
    FCount := AValue;
    ReAllocMem(FData,AValue*SizeOf(TVector3D));
  end;
end;

constructor TDataSet3D.Create(ACount: longint);
begin
  inherited Create;
  FCount := ACount;
  GetMem(FData,ACount*SizeOf(TVector3D));
end;

destructor TDataSet3D.Destroy;
begin
  FreeMem(FData,FCount*SizeOf(TVector3D));
  inherited Destroy;
end;

end.