Переделать программу, чтобы она работала не только с цифрами, но и с числами

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var s: dinamicstek;
input: string;
i, n: byte;
a, b, c: real;
begin
input:=Edit1.Text;
n:=length(input);
init(s);
for i:=1 to n do
if (ord('0')<=ord(input[i])) and (ord(input[i])<=ord('9')) then
addtostek(s,input[i])
else
begin
a:=StrToFloat(delfromstek(s));
b:=StrToFloat(delfromstek(s));
case input[i] of
'+': c:=a+b;
'*': c:=a*b;
'-': c:=b-a;
'/': c:=b/a;
end;
addtostek(s,FloatToStr(c));
end;
c:=StrToFloat(delfromstek(s));
Label1.Caption:=floattostr(c);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
  s: dinamicstek;
  input, output , x: string;
  n,i: Byte;
begin
input:=Edit2.text;
n:= Length(input);
init(S);
output:='';
for i:=1 to n do
  if input[i] in ['0'..'9'] then output:= output+input[i]
  else if pusto(s)= True then addtostek(s,INPUT[i]) {если стек пуст, то..}
  else        {если стек не пуст, то..}
  case input[i] of '(' : addtostek(s,'(');
  ')': begin
   x:=delFromStek(s);
  while x<> '(' do begin
    output:= output + x;
    x:= delfromstek(s);
    end;
    end;
    '*','/': begin
     if S^.number[1] in ['*','/'] then
    output:= output+ delFromStek(S);
    AddToStek(S, INPUT[i]); end;
    '-','+' : begin
     if S^.number[1] in ['-','+','*','/'] then
     output:= output+delFromStek(S);
     AddToStek(S, INPUT[i]);
      end;
    end;
    while pusto(s)=False do
    output:= output+delFromStek(S);
    Edit1.Text:= output;
end;
end.

program calc;
{$APPTYPE console}
 
type
  Real = double;
 
const
  prs = '+-*/(';
  pri: array [1 .. 5] of byte = (1, 1, 2, 2, 0);
 
var
  s1, s2: String;
  q: array [0 .. 500] of Real;
  w: array [0 .. 500] of Char;
  n, len, len2: Cardinal;
  t: Real;
  ch: Char;
 
procedure Push(x: Real);
begin
  Inc(len);
  q[len] := x;
end;
 
function Pop: Real;
begin
  Pop := q[len];
  q[len] := 0;
  Dec(len);
end;
 
procedure PushC(x: Char);
begin
  Inc(len2);
  w[len2] := x;
end;
 
function Popc: Char;
begin
  Popc := w[len2];
  w[len2] := #0;
  Dec(len2);
end;
 
function Oper(s1, s2: Real; s3: Char): Real;
var
  x, y, z: Real;
begin
  x := s1;
  y := s2;
  case s3 of
    '+': z := x + y;
    '-': z := x - y;
    '*': z := x * y;
    '/': z := x / y;
  end;
  Oper := z;
end;
 
procedure PreChange(var s: String);
var
  i: Cardinal;
begin
  if s[1] = '-' then
    s := '0' + s;
  i := 1;
  while i <= n do
    if (s[i] = '(') and (s[i + 1] = '-') then
      insert('0', s, i + 1)
    else
      Inc(i);
end;
 
function Change(s: String): String;
var
  i: Cardinal;
  rezs: String;
  c: Boolean;
begin
  c := false;
  for i := 1 to n do
    begin
      if not(s[i] in ['+', '-', '*', '/', '(', ')']) then
        begin
          if c then
            rezs := rezs + ' ';
          rezs := rezs + s[i];
          c := false;
        end
      else
        begin
          c := true;
          if s[i] = '(' then
            PushC(s[i])
          else
            if s[i] = ')' then
              begin
                while w[len2] <> '(' do
                  begin
                    rezs := rezs + ' ' + Popc;
                  end;
                Popc;
              end
            else
              if s[i] in ['+', '-', '*', '/'] then
                begin
                  while pri[Pos(w[len2], prs)] >= pri[Pos(s[i], prs)] do
                    rezs := rezs + ' ' + Popc;
                  PushC(s[i]);
                end;
        end;
    end;
  while len2 <> 0 do
    rezs := rezs + ' ' + Popc;
  Change := rezs;
end;
 
function Count(s: String): Real;
var
  ss: String;
  x, s1, s2: Real;
  chh, s3: Char;
  p, i, j: Cardinal;
  tmp: Integer;
begin
  i := 0;
  repeat
    j := i + 1;
    repeat
      Inc(i)
    until s[i] = ' ';
    ss := copy(s, j, i - j);
    chh := ss[1];
    if not(chh in ['+', '-', '*', '/']) then
      begin
        Val(ss, p, tmp);
        Push(p);
      end
    else
      begin
        s2 := Pop;
        s1 := Pop;
        s3 := chh;
        Push(Oper(s1, s2, s3));
      end;
  until i >= n;
  x := Pop;
  Count := x;
end;
 
procedure WriteL(x: Real);
var
  y, a, b: Cardinal;
  q: Real;
begin
  y := Trunc(x);
  b := 0;
  if Abs(x - y) < (1E-12) then
    Writeln(y)
  else
    begin
      if y > 0 then
        a := round(ln(y) / ln(10)) + 1
      else
        a := 1;
      q := x;
      repeat
        q := q * 10;
        Inc(b);
      until Abs(q - Trunc(q)) < (1E-12);
      Writeln(x:a + b:b);
    end;
end;
 
begin
  repeat
    Writeln('Enter expression');
    Readln(s1);
    n := Length(s1);
    PreChange(s1);
    n := Length(s1);
    s2 := Change(s1);
    if s2[1] = ' ' then
      delete(s2, 1, 1);
    s2 := s2 + ' ';
    n := Length(s2);
    t := Count(s2);
    WriteL(t);
    Writeln('One more expression?(Y/N)');
    Readln(ch);
  until UpCase(ch) = 'N';
 
end