main.pas

ArtFormula package contains two nonvisual Delphi component for symbolic expression parsing and evalu

 MainForm.Editor.SelStart :=
 SendMessage(MainForm.Editor.Handle,EM_LINEINDEX, trunc(Calc.topn)-1,0)+
 trunc(calc.ItemN(1))-1;
 setN(result, 0);
end;

function mydoctext(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result, MainForm.Editor.Text);
end;

function mydocsettext(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Text := Calc.TopS;
 setS(result, Calc.TopS);
end;


function mydoclinecount(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,MainForm.Editor.Lines.Count);
end;

function mydoclineindex(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,SendMessage(MainForm.Editor.Handle,EM_LINEINDEX, trunc(Calc.topn)-1,0));
end;

function mydocline(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result,MainForm.Editor.Lines[trunc(Calc.TopN) + 1]);
end;

function mydocposy(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,SendMessage(MainForm.Editor.Handle, EM_EXLINEFROMCHAR, 0,
    MainForm.Editor.SelStart)+1);
end;

function mydocfontbold(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,ifthen(fsbold in MainForm.Editor.defattributes.style,1,0));
end;

function mydocsetfontbold(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN <> 0 then
  MainForm.Editor.defattributes.style :=
   MainForm.Editor.defattributes.style + [fsbold]
 else
  MainForm.Editor.defattributes.style :=
   MainForm.Editor.defattributes.style - [fsbold];
 setN(result,0);
end;

function mydocfontitalic(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,ifthen(fsitalic in MainForm.Editor.defattributes.style,1,0));
end;

function mydocsetfontitalic(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN <> 0 then
  MainForm.Editor.defattributes.style :=
   MainForm.Editor.defattributes.style + [fsitalic]
 else
  MainForm.Editor.defattributes.style :=
   MainForm.Editor.defattributes.style - [fsitalic];
 setN(result,0);
end;

function mydocfontunderline(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,ifthen(fsunderline in MainForm.Editor.defattributes.style,1,0));
end;

function mydocsetfontunderline(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN <> 0 then
  MainForm.Editor.defattributes.style :=
   MainForm.Editor.defattributes.style + [fsunderline]
 else
  MainForm.Editor.defattributes.style :=
   MainForm.Editor.defattributes.style - [fsunderline];
 setN(result,0);
end;

function myparnumbering(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,integer(MainForm.Editor.Paragraph.Numbering));
end;

function myparsetnumbering(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Paragraph.Numbering := TNumberingStyle(trunc(Calc.topN));
 setN(result,0);
end;

function myparalign(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,integer(MainForm.Editor.Paragraph.Alignment));
end;

function myparsetalign(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Paragraph.Alignment := TAlignment(trunc(Calc.topN));
 setN(result,0);
end;

function myparfirstindent(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,integer(MainForm.Editor.Paragraph.FirstIndent));
end;

function myparsetfirstindent(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Paragraph.FirstIndent := trunc(Calc.topN);
 setN(result,0);
end;

function myparleftindent(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,integer(MainForm.Editor.Paragraph.leftIndent));
end;

function myparsetleftindent(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Paragraph.leftIndent := trunc(Calc.topN);
 setN(result,0);
end;

function myparrightindent(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,integer(MainForm.Editor.Paragraph.rightIndent));
end;

function myparsetrightindent(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Paragraph.rightindent := trunc(Calc.topN);
 setN(result,0);
end;

function myselfontbold(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,ifthen(fsbold in MainForm.Editor.selattributes.style,1,0));
end;

function myselsetfontbold(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN <> 0 then
  MainForm.Editor.selattributes.style :=
   MainForm.Editor.selattributes.style + [fsbold]
 else
  MainForm.Editor.selattributes.style :=
   MainForm.Editor.selattributes.style - [fsbold];
 setN(result,0);
end;

function myselfontitalic(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,ifthen(fsitalic in MainForm.Editor.selattributes.style,1,0));
end;

function myselsetfontitalic(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN <> 0 then
  MainForm.Editor.selattributes.style :=
   MainForm.Editor.selattributes.style + [fsitalic]
 else
  MainForm.Editor.selattributes.style :=
   MainForm.Editor.selattributes.style - [fsitalic];
 setN(result,0);
end;

function myselfontunderline(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,ifthen(fsunderline in MainForm.Editor.selattributes.style,1,0));
end;

function myselsetfontunderline(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN <> 0 then
  MainForm.Editor.selattributes.style :=
   MainForm.Editor.selattributes.style + [fsunderline]
 else
  MainForm.Editor.selattributes.style :=
   MainForm.Editor.selattributes.style - [fsunderline];
 setN(result,0);
end;

function myselfontname(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result,MainForm.Editor.selattributes.name);
end;

function myselsetfontname(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.selattributes.name := Calc.TopS;
 setN(result,0);
end;

function myselfontsize(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,MainForm.Editor.selattributes.size);
end;

function myselsetfontsize(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.selattributes.size := trunc(Calc.TopN);
 setN(result,0);
end;

function myselfontcolor(var Calc : TFormulaCalc):TCalcItem;
begin
 setN(result,MainForm.Editor.selattributes.color);
end;

function myselsetfontcolor(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.selattributes.color := trunc(Calc.TopN);
 setN(result,0);
end;

function myseltext(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result,MainForm.Editor.SelText);
end;

function myselsettext(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.SelText := Calc.tops;
 setN(result,0);
end;

function mydocclearselection(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.SelStart := MainForm.Editor.SelStart +
          MainForm.Editor.Sellength;
 setN(result,0);
end;

procedure TMainForm.FormShow(Sender: TObject);
var module : PTableItem;
    i,j:integer;
begin
 run := false;
 path := ExtractFilePath(Paramstr(0));

 BM.ColWidths[0] := 160;
 BM.ColWidths[1] := 80;
 BM.ColWidths[2] := 80;
 BM.ColWidths[2] := 80;

 grd.Cells[0,0] := 'Name';
 grd.Cells[1,0] := 'Value';
 grd.Cells[0,1] := 'x';
 grd.Cells[1,1] := '7';
 grd.Cells[0,2] := 'y';
 grd.Cells[1,2] := '2';

 GetFontNames;
 OpenDialog.InitialDir := path;
 SaveDialog.InitialDir := OpenDialog.InitialDir;
 FFileName := 'Untitled';
 GetFontNames;
 SetupRuler;
 SelectionChange(Self);
 Editor.Modified := False;

 F.Step := true;
 F.AddUserFunction('about',0,myabout,false);
 F.AddUserFunction('print',1,myprint,false);
 F.AddUserConstant('myarray','1,2,3,4,5');

 module := F.AddUserFunction('document',0,nil,true);
 F.AddModuleFunction(module,'new',1,mydocnew);
 F.AddModuleFunction(module,'filename',0,mydocfilename);
 F.AddModuleFunction(module,'setfilename',1,mydocsetfilename);
 F.AddModuleFunction(module,'save',1,mydocsave);
 F.AddModuleFunction(module,'open',1,mydocopen);
 F.AddModuleFunction(module,'print',0,mydocprint);
 F.AddModuleFunction(module,'undo',0,mydocundo);
 F.AddModuleFunction(module,'copy',0,mydoccopy);
 F.AddModuleFunction(module,'paste',0,mydocpaste);
 F.AddModuleFunction(module,'cut',0,mydoccut);
 F.AddModuleFunction(module,'typetext',1,mydoctypetext);
 F.AddModuleFunction(module,'typeparagraph',0,mydoctypeparagraph);
 F.AddModuleFunction(module,'fontname,e',0,mydocfontname);
 F.AddModuleFunction(module,'setfontname',1,mydocsetfontname);
 F.AddModuleFunction(module,'fontsize',0,mydocfontsize);
 F.AddModuleFunction(module,'setfontsize',1,mydocsetfontsize);
 F.AddModuleFunction(module,'fontcolor',0,mydocfontcolor);
 F.AddModuleFunction(module,'setfontcolor',1,mydocsetfontcolor);
 F.AddModuleFunction(module,'clear',0,mydocclear);
 F.AddModuleFunction(module,'selectall',0,mydocselectall);
 F.AddModuleFunction(module,'select',2,mydocselect);
 F.AddModuleFunction(module,'posx',0,mydocposx);
 F.AddModuleFunction(module,'setpos',2,mydocsetpos);
 F.AddModuleFunction(module,'linecount',0,mydoclinecount);
 F.AddModuleFunction(module,'lineindex',1,mydoclineindex);
 F.AddModuleFunction(module,'line',1,mydocline);
 F.AddModuleFunction(module,'posy',0,mydocposy);
 F.AddModuleFunction(module,'fontbold',0,mydocfontbold);
 F.AddModuleFunction(module,'setfontbold',1,mydocsetfontbold);
 F.AddModuleFunction(module,'fontitalic',0,mydocfontitalic);
 F.AddModuleFunction(module,'setfontitalic',1,mydocsetfontitalic);
 F.AddModuleFunction(module,'fontunderline',0,mydocfontunderline);
 F.AddModuleFunction(module,'setfontunderline',1,mydocsetfontunderline);
 F.AddModuleFunction(module,'text',0,mydoctext);
 F.AddModuleFunction(module,'settext',1,mydoctext);
 F.AddModuleFunction(module,'clearselection',0,mydocclearselection);

 module := F.AddUserFunction('paragraph',0,nil,true);
 F.AddModuleFunction(module,'numbering',0,myparnumbering);
 F.AddModuleFunction(module,'setnumbering',1,myparsetnumbering);
 F.AddModuleFunction(module,'align',0,myparalign);
 F.AddModuleFunction(module,'setalign',1,myparsetalign);
 F.AddModuleFunction(module,'firstindent',0,myparfirstindent);
 F.AddModuleFunction(module,'setfirstindent',1,myparsetfirstindent);
 F.AddModuleFunction(module,'leftindent',0,myparleftindent);
 F.AddModuleFunction(module,'setleftindent',1,myparsetleftindent);
 F.AddModuleFunction(module,'rightindent',0,myparrightindent);
 F.AddModuleFunction(module,'setrightindent',1,myparsetrightindent);

 module := F.AddUserFunction('selection',0,nil,true);
 F.AddModuleFunction(module,'fontbold',0,myselfontbold);
 F.AddModuleFunction(module,'setfontbold',1,myselsetfontbold);
 F.AddModuleFunction(module,'fontitalic',0,myselfontitalic);
 F.AddModuleFunction(module,'setfontitalic',1,myselsetfontitalic);
 F.AddModuleFunction(module,'fontunderline',0,myselfontunderline);
 F.AddModuleFunction(module,'setfontunderline',1,myselsetfontunderline);
 F.AddModuleFunction(module,'fontname',0,myselfontname);
 F.AddModuleFunction(module,'setfontname',1,myselsetfontname);
 F.AddModuleFunction(module,'fontsize',0,myselfontsize);
 F.AddModuleFunction(module,'setfontsize',1,myselsetfontsize);
 F.AddModuleFunction(module,'fontcolor',0,myselfontcolor);
 F.AddModuleFunction(module,'setfontcolor',1,myselsetfontcolor);
 F.AddModuleFunction(module,'text',0,myseltext);
 F.AddModuleFunction(module,'settext',1,myselsettext);

 AF_file.Install(F);

 for i:=1 to 26 do Sheet.Cells[i,0] := chr(ord('A')+i-1);  
 for i:=1 to 64 do Sheet.Cells[0,i] := inttostr(i);

 for i:=1 to 26 do for j:=1 to 64 do formulas[i,j] := '';
 formulas[1,1]:='Data';
 formulas[1,9]:='Sum';
 formulas[1,10]:='Avg';
 formulas[1,11]:='Avg :)';
 formulas[1,12]:='Stddev';
 formulas[1,13]:='Count (b1:c7)';

 formulas[2,1]:='1';
 formulas[2,2]:='2';
 formulas[2,3]:='3';
 formulas[2,4]:='4';
 formulas[2,5]:='5';
 formulas[2,6]:='6';
 formulas[2,7]:='7';

 formulas[3,1]:='8';
 formulas[3,2]:='9';
 formulas[3,3]:='10';
 formulas[3,7]:='=formatdate("dd.mm.yyy",now())';


 formulas[2,9]:='=sum(b1:b7)';
 formulas[2,10]:='=concat("Avg=";avg(b1:b7))';
 formulas[2,11]:='=(b9+sum(c1,c2:c3))/count(b1:b7,c1:c3)';
 formulas[2,12]:='=stddev(b1:b7)';
 formulas[2,13]:='=count(b1:c7)';


 Sheet.ColWidths[0] := 32;
 Sheet.ColWidths[1] := 90;

 Eval;
 SheetClick(Self);

 LoadMacro;
 for i := 0 to high(macro) do
  if Uppercase(macro[i].name) = 'AUTOSTART' then
  begin
   F.ComputeStr(macro[i].text);
   break;
  end;
end;

type EvalException = class(Exception)
     end;

const XVAL = #160;

procedure  TMainForm.Eval;
var i,j,it:integer;
    flag : boolean;
begin

 for i:=1 to 26 do
  for j:=1 to 64 do
   Sheet.cells[i,j] := XVAL;

 for it:=1 to 100 do
 begin
  flag := true;
  for i:=1 to 26 do
   for j:=1 to 64 do
   begin
    if formulas[i,j] = '' then Sheet.Cells[i,j] := ''
    else if formulas[i,j][1] = '=' then
         begin
          try
           Sheet.Cells[i,j] := Excel.ComputeStr(copy(formulas[i,j],2,length(formulas[i,j])-1));
          except
           on EvalException do flag := false;
           on Exception do raise;
          end
         end
         else
         Sheet.Cells[i,j] := formulas[i,j];
   end;
  if flag then break;
 end;

 if it >= 100 then Application.MessageBox('To many iteration, calculation stoped.','Sheet Calculation',mb_iconwarning);

end;


procedure ParseVarName(Vname : string; var i : integer; var j: integer);
begin
 i := 0;
 j := 0;
 Vname := Uppercase(Vname);
 if length(Vname) < 2 then  exit;
 if not (vname[1] in ['A'..'Z']) then exit;
 i := ord(vname[1]) - ord('A') + 1;
 j := strtointdef(copy(vname,2,length(vname)-1),0)
end;

procedure TMainForm.SheetClick(Sender: TObject);
begin
 ftext.Text := formulas[sheet.col,sheet.row];
end;

procedure TMainForm.ftextKeyPress(Sender: TObject; var Key: Char);
begin
 if Key = #13 then
 begin
  formulas[sheet.col,sheet.row] := ftext.text;
  Eval;
  ActiveControl := Sheet;
 end
 else if key = #27 then
 begin
  ftext.text := formulas[sheet.col,sheet.row];
  ActiveControl := Sheet;
 end
end;

procedure TMainForm.SheetKeyPress(Sender: TObject; var Key: Char);
begin
 ActiveControl := ftext;
 PostMessage(ftext.Handle, WM_KEYDOWN, VkKeyScan(Key), 0);
end;

procedure TMainForm.SheetKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if key=VK_DELETE then
 begin
   formulas[sheet.col,sheet.row] := '';
   Eval;
   SheetClick(Self);
 end;

end;

procedure TMainForm.ExcelGetVarsCount(Vname: String; var count: Integer;
  wantnumber: Boolean);
var rpos,i,j,i1,j1,i2,j2,p : integer;
    s : string;
begin
  rangename := Vname;
  rpos := pos(':',Vname);
  if rpos > 0 then
  begin
   s := copy(vname,1,rpos-1);
   ParseVarName(s,i,j);
   if (i=0) or (j=0) then raise Exception.Create('Error in SpreadSheet formula!');
   s := copy(vname,rpos+1,length(vname)-rpos);
   ParseVarName(s,i1,j1);
   if (i1=0) or (j1=0) then raise Exception.Create('Error in SpreadSheet formula!');
   count := (i1-i+1)*(j1-j+1);
   setlength(range,count);
   p := 0;
   for i2:=i to i1 do
    for j2:=j to j1 do
    begin
     if wantnumber then
     begin
      if sheet.Cells[i2,j2] = XVAL then raise EvalException.Create('Just press F9 :)');
      try
       range[p] := floattostr(strtofloat(sheet.Cells[i2,j2]));
       inc(p);
      except
       dec(count);
      end;
     end
     else
     begin
      range[p] := sheet.Cells[i2,j2];
      if range[p] = XVAL then  raise EvalException.Create('Just press F9 :)');
      inc(p);
     end
    end;
  end
  else
  begin
    ParseVarName(vname,i,j);
    if (i=0) or (j=0) then raise Exception.Create('Error in SpreadSheet formula!');
    count := 1;
    setlength(range,1);
    range[0] := sheet.Cells[i,j];
    if range[0] = XVAL then  raise EvalException.Create('Just press F9 :)');
  end;
end;

procedure TMainForm.ExcelGetVarValue(Vname: String; n: Integer;
  var Val: String; wantnumber: Boolean);
var cnt : integer;
begin
 if rangename <> vname then ExcelGetVarsCount(vname,cnt,wantnumber);
 Val := range[n];
end;

procedure TMainForm.SheetDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if [gdSelected] = State then
  begin
   Sheet.Canvas.Brush.Color := $ffa0a0;
   Sheet.Canvas.FillRect(Rect);
  end
  else if (Acol in [2,3]) and (ARow in [1..7]) then
  begin
   Sheet.Canvas.Brush.Color := $f0f0f0;
   Sheet.Canvas.FillRect(Rect);
  end;
  Sheet.Canvas.Font.color := clblack;
  if Acol = 1 then
   Sheet.Canvas.Font.Style := [fsbold]
  else
   Sheet.Canvas.Font.Style := [];
  Rect.Left := Rect.Left+1;
  Rect.top := Rect.top+1;
  Rect.bottom := Rect.bottom-1;
  rect.Right := Rect.Right-1;
  Sheet.Canvas.TextRect(Rect,Rect.Left, rect.top,Sheet.Cells[Acol,Arow]);
  if gdFocused in State then  Sheet.Canvas.DrawFocusRect(Rect);
end;

procedure TMainForm.SheetDblClick(Sender: TObject);
begin
 ActiveControl := ftext;
end;

end.