main.pas

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

procedure TMainForm.Label13MouseLeave(Sender: TObject);
begin
(sender as TLabel).Font.Style := [];
end;

procedure TMainForm.Label13Click(Sender: TObject);
begin
 ShellExecute(handle,'open',pchar((sender as TLabel).Caption),'','',sw_show)
end;

procedure TMainForm.BRunClick(Sender: TObject);
begin
 if run then
 begin
  BRun.Caption := 'Run';
  run := false;
  F.Stop := true;
 end
 else
 begin
  F.Step := true;
  BRun.Caption := 'Stop';
  run := true;
  SRes.Clear;
  Application.ProcessMessages;
  try
   F.ComputeStr(Script.Text);
  except
   on E: Exception do
   begin
    Application.MessageBox(pchar(E.Message),'Error',mb_iconstop);
    ActiveControl := Script;
    Script.SelStart := F.ErrStrPos;
   end;
  end;
  BRun.Caption := 'Run';
  run := false;
 end;
end;

//  RichEditor (based on Demos RichEdit project)

procedure TMainForm.SelChange(Sender: TObject);
begin
 Script.Text := programs[Sel.itemindex];
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TMainForm.GetFontNames;
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  ReleaseDC(0, DC);
  FontName.Sorted := True;
end;

function TMainForm.CurrText: TTextAttributes;
begin
 Result := Editor.SelAttributes
end;

procedure TMainForm.CheckFileSave;
var
  SaveResp: Integer;
begin
  if not Editor.Modified then Exit;
  SaveResp := Application.MessageBox(pchar(Format('Save changes to %s?', [FFileName])),
    'Save', mb_iconquestion + mb_YesNoCancel);
  case SaveResp of
    idYes: FileSave(Self);
    idCancel: Abort;
  end;
end;

procedure TMainForm.SetupRuler;
var
  I: Integer;
  S: String;
begin
  SetLength(S, 201);
  I := 1;
  while I < 200 do
  begin
    S[I] := #9;
    S[I+1] := '|';
    Inc(I, 2);
  end;
  Ruler.Caption := S;
end;

procedure TMainForm.FileSave(Sender: TObject);
begin
  if FFileName = 'Untitled' then
    FileSaveAs(Sender)
  else
  begin
    Editor.Lines.SaveToFile(FFileName);
    Editor.Modified := False;
  end;
end;

procedure TMainForm.FileSaveAs(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    if FileExists(SaveDialog.FileName) then
      if MessageDlg(Format('Overwrite %s?', [SaveDialog.FileName]),
        mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
    Editor.Lines.SaveToFile(SaveDialog.FileName);
    FFileName := SaveDialog.FileName;
    Editor.Modified := False;
  end;
end;

procedure TMainForm.PerformFileOpen(const AFileName: string);
begin
  Editor.Lines.LoadFromFile(AFileName);
  FFileName := AFileName;
  Editor.SetFocus;
  Editor.Modified := False;
end;

procedure TMainForm.SetEditRect;
var
  R: TRect;
begin
  with Editor do
  begin
    R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
    SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  end;
end;


procedure TMainForm.FormResize(Sender: TObject);
begin
  SetEditRect;
  SelectionChange(Sender);
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
  SetEditRect;
end;

procedure TMainForm.SelectionChange(Sender: TObject);
begin
  with Editor.Paragraph do
  try
    FUpdating := True;
    FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
    LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
    RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
    BoldButton.Down := fsBold in Editor.SelAttributes.Style;
    ItalicButton.Down := fsItalic in Editor.SelAttributes.Style;
    UnderlineButton.Down := fsUnderline in Editor.SelAttributes.Style;
    BulletsButton.Down := Boolean(Numbering);
    FontSize.Text := IntToStr(Editor.SelAttributes.Size);
    FontName.Text := Editor.SelAttributes.Name;
    case Ord(Alignment) of
      0: LeftAlign.Down := True;
      1: RightAlign.Down := True;
      2: CenterAlign.Down := True;
    end;
  finally
    FUpdating := False;
  end;
end;

procedure TMainForm.RulerResize(Sender: TObject);
begin
  RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
end;

procedure TMainForm.FileNew(Sender: TObject);
begin
  CheckFileSave;
  FFileName := 'Untitled';
  Editor.Lines.Clear;
  Editor.Modified := False;
end;

procedure TMainForm.FileOpen(Sender: TObject);
begin
  CheckFileSave;
  if OpenDialog.Execute then
  begin
    PerformFileOpen(OpenDialog.FileName);
    Editor.ReadOnly := ofReadOnly in OpenDialog.Options;
  end;
end;

procedure TMainForm.FilePrint(Sender: TObject);
begin
  if PrintDialog.Execute then
    Editor.Print(FFileName);
end;

procedure TMainForm.EditUndo(Sender: TObject);
begin
  with Editor do
    if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end;

procedure TMainForm.EditCut(Sender: TObject);
begin
 Editor.CutToClipboard;
end;

procedure TMainForm.EditCopy(Sender: TObject);
begin
 Editor.CopyToClipboard;
end;

procedure TMainForm.EditPaste(Sender: TObject);
begin
 Editor.PasteFromClipboard;
end;

procedure TMainForm.FontNameChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Name := FontName.Items[FontName.ItemIndex];
end;

procedure TMainForm.EditFont(Sender: TObject);
begin
  FontDialog1.Font.Assign(Editor.SelAttributes);
  if FontDialog1.Execute then
    CurrText.Assign(FontDialog1.Font);
  SelectionChange(Self);
  Editor.SetFocus;
end;

procedure TMainForm.BoldButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if BoldButton.Down then
    CurrText.Style := CurrText.Style + [fsBold]
  else
    CurrText.Style := CurrText.Style - [fsBold];
end;

procedure TMainForm.ItalicButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if ItalicButton.Down then
    CurrText.Style := CurrText.Style + [fsItalic]
  else
    CurrText.Style := CurrText.Style - [fsItalic];
end;

procedure TMainForm.UnderlineButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if UnderlineButton.Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
  else
    CurrText.Style := CurrText.Style - [fsUnderline];
end;

procedure TMainForm.TabSheet3Show(Sender: TObject);
begin
 Activecontrol := Editor;
end;

procedure TMainForm.EditBoldCmdExecute(Sender: TObject);
begin
 BoldButton.Down := not BoldButton.Down;
 BoldButtonClick(Self);
end;

procedure TMainForm.cute(Sender: TObject);
begin
 ItalicButton.Down := not ItalicButton.Down;
 ItalicButtonClick(Self);
end;

procedure TMainForm.EditUnderlineCmdExecute(Sender: TObject);
begin
 UnderlineButton.Down := not UnderlineButton.Down;
 UnderlineButtonClick(Self);
end;

procedure TMainForm.FontSizeChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Size := StrToInt(FontSize.Text);
end;

procedure TMainForm.LeftAlignClick(Sender: TObject);
begin
  if FUpdating then Exit;
  Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
end;

procedure TMainForm.BulletsButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
end;

procedure TMainForm.RightIndMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDragOfs := (TLabel(Sender).Width div 2);
  TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
  FDragging := True;
end;

procedure TMainForm.RightIndMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDragging then
    TLabel(Sender).Left :=  TLabel(Sender).Left+X-FDragOfs
end;

procedure TMainForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  Editor.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj);
  LeftIndMouseUp(Sender, Button, Shift, X, Y);
end;

procedure TMainForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  Editor.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-Editor.Paragraph.FirstIndent;
  SelectionChange(Sender);
end;

procedure TMainForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  Editor.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid;
  SelectionChange(Sender);
end;

procedure TMainForm.ActionList2Update(Action: TBasicAction;
  var Handled: Boolean);
begin
  EditCutCmd.Enabled := Editor.SelLength > 0;
  EditCopyCmd.Enabled := EditCutCmd.Enabled;
  if Editor.HandleAllocated then
  begin
    EditUndoCmd.Enabled := Editor.Perform(EM_CANUNDO, 0, 0) <> 0;
    EditPasteCmd.Enabled := Editor.Perform(EM_CANPASTE, 0, 0) <> 0;
  end;
end;

// Macro Implementation

procedure TMainForm.LoadMacro;
var F:TextFile;
    s : string;
    i : integer;
begin
 Macro := nil;
 if not fileexists(path+'macros') then
 begin
  Editor.Clear;
  Editor.Paragraph.Alignment := taCenter;
  Editor.SelAttributes.Name := 'Arial';
  Editor.SelAttributes.Size := 18;
  Editor.SelAttributes.Color := clRed;
  Editor.SelText := #13'File ';
  Editor.SelAttributes.Style := [fsbold];
  Editor.Seltext := 'macro ';
  Editor.SelAttributes.Style := [];
  Editor.Seltext := 'not found!';
  exit;
 end;
 AssignFile(F,path+'macros');
 reset(F);
 i := -1;
 while not eof(F) do
 begin
  readln(F,s);
  if copy(s,1,2) = '##' then
  begin
   inc(i);
   setlength(Macro,i+1);
   Macro[i].name := copy(s,4,length(s)-6);
   Macro[i].text := '';
   continue;
  end;
  if i >= 0 then
  begin
   s := s+#13#10;
   Macro[i].text := Macro[i].text + s;
  end;
 end;
 CloseFile(F);
end;

procedure TMainForm.SaveMacro;
var F:TextFile;
    i : integer;
begin
 AssignFile(F,path+'macros');
 rewrite(F);
 for i := 0 to high(Macro) do
 begin
  writeln(F,'## '+Macro[i].name+' ##');
  write(F,Macro[i].text);
 end;
 CloseFile(F);
end;

procedure TMainForm.ToolButton4Click(Sender: TObject);
var i:integer;
begin
 LoadMacro;
 MacrosForm.Macros.Clear;
 for i:=0 to high(Macro) do MacrosForm.Macros.AddItem(Macro[i].name,TObject(i));
 MacrosForm.Macros.ItemIndex := 0;
 MacrosForm.Showmodal;
 SaveMacro;
end;

function mydocnew(var Calc : TFormulaCalc):TCalcItem;
begin
 if Calc.TopN > 0 then
 begin
  Mainform.FileName := 'Untitled';
  MainForm.Editor.Lines.Clear;
  MainForm.Editor.Modified := False;
 end
 else
  MainForm.FileNew(nil);
 setN(result,0);
end;

function mydocfilename(var Calc : TFormulaCalc):TCalcItem;
begin
 setS(result,MainForm.FileName);
end;

function mydocsetfilename(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.FileName := Calc.TopS;
 setN(result,0);
end;

function mydocsave(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Lines.SaveToFile(Calc.TopS);
 MainForm.Editor.Modified := False;
 setN(result,0);
end;

function mydocopen(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.PerformFileOpen(Calc.TopS);
 setN(result,0);
end;

function mydocprint(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.FilePrint(nil);
 setN(result,0);
end;

function mydocundo(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.EditUndo(nil);
 setN(result,0);
end;

function mydoccopy(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.EditCopy(nil);
 setN(result,0);
end;

function mydocpaste(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.EditPaste(nil);
 setN(result,0);
end;

function mydoccut(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.EditCut(nil);
 setN(result,0);
end;

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

function mydoctypeparagraph(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Perform(WM_CHAR,13,0);
 setN(result,0);
end;

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

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

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

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

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

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

function mydocclear(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.Clear;
 setN(result,0);
end;

function mydocselectall(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.SelectAll;
 setN(result,0);
end;

function mydocselect(var Calc : TFormulaCalc):TCalcItem;
begin
 MainForm.Editor.SelStart := trunc(Calc.ItemN(1)-1);
 MainForm.Editor.SelLength := trunc(Calc.topn);
 setN(result,0);
end;

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

function mydocsetpos(var Calc : TFormulaCalc):TCalcItem;
begin