main.pas

一个表达式计算库

(*
The demonstration programm for Text Reader Component.
Reserved words and delimiters of the Object Pascal
loads from files "Reserved.txt" and "Delim.txt".
*)
 
unit main;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Reader, StdCtrls, ExtCtrls, ComCtrls;

const
  FreeStructure = 0;
  StrStructure = 1;
  EndOfLine: string = #13+#10;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    Button1: TButton;      
    Splitter1: TSplitter;
    Panel2: TPanel;
    ListBox1: TListBox;
    Panel3: TPanel;
    Label1: TLabel;
    Button2: TButton;
    Memo1: TRichEdit;
    Button3: TButton;
    Button4: TButton;
    CheckBox1: TCheckBox;
    ListBox2: TListBox;
    Panel4: TPanel;
    Button5: TButton;
    Button6: TButton;
    Edit1: TEdit;
    Label2: TLabel;
    ProgressBar1: TProgressBar;
    Reader1: TReader;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Reader1DisposeProperties(Sender: TObject; Structure: Integer;
      Properties: Pointer);
    procedure ListBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
  private
    { Private declarations }
    KeyWords: TStringList;
    procedure RegKeyWords;
  public
    { Public declarations }
  end;

  PStrValue = ^string;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
var
  Description: PStrValue;
  t: System.text;
  s: string;
  i: integer;
begin
  WindowState:=wsMaximized;
  with Reader1 do begin
    KeyWords:=TStringList.Create;
    {Registration of free symbols}
    RegStandardFreeSymbols;
    for i:=1 to Length(EndOfLine) do RemoveFreeSymbol(EndOfLine[i]);
    {Registration of delimiters}
    AddDelimiter(EndOfLine, 0, nil); {end of line}
{$i-}
    {Registration of Delimiters from file}
    System.Assign(t,ExtractFilePath(ParamStr(0))+'Delim.txt');
    Reset(t);
    if IOResult=0 then begin
      while not Eof(t) do begin
        ReadLn(t,s);
        New(Description);
        ReadLn(t, Description^);
        AddDelimiter(s, StrStructure, Description);
      end;
      System.Close(t);
    end;
    {Registration of Reserved Words from file}
    System.Assign(t, ExtractFilePath(ParamStr(0))+'Reserved.txt');
    Reset(t);
    if IOResult=0 then begin
      while not Eof(t) do begin
        ReadLn(t,s);
        New(Description);
        Description^:='Reserved word';
        AddKeyWord(s, StrStructure, Description);
      end;
      System.Close(t);
    end;
{$i+}
  end;
  Memo1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'Main.Pas');
  Label1.Caption:='';
end;

procedure TMainForm.Reader1DisposeProperties(Sender: TObject;
  Structure: Integer; Properties: Pointer);
begin
  case Structure of
    StrStructure: Dispose(PStrValue(Properties));
  end;
end;

procedure TMainForm.ListBox1Click(Sender: TObject);
var
  i, Structure: integer;
  Addition: Pointer;
  Status: TStatus;
  s: string;
begin
  Label1.Caption:='';
  with ListBox1 do if ItemIndex>-1 then begin
    s:='';
    i:=1;
    while Items[ItemIndex][i] <> ' ' do begin
      s:=s+Items[ItemIndex][i];
      inc(i);
    end;
    if Reader1.GetProperties(s, Status, Structure, Addition) then
      if Structure=StrStructure then Label1.Caption:=PStrValue(Addition)^;
  end;
end;

procedure TMainForm.RegKeyWords;
var
  i: integer;
begin
  with Reader1 do begin
    for i:=0 to KeyWords.Count-1 do Remove(KeyWords[i]);
    KeyWords.Clear;
    for i:=0 to ListBox2.Items.Count-1 do begin
      KeyWords.Add(ListBox2.Items[i]);
      AddKeyWord(ListBox2.Items[i], FreeStructure, nil);
    end;
    WildCardEnabled:=CheckBox1.Checked;
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  Scroller: TScroller;
  StrMode, Comment1, Comment2, Comment3: boolean;
procedure SetCommentAttr;
begin  {Font attributes for Comments}
  with Scroller do with Memo1 do begin
    SelLength:=Position.ActivePos-SelStart;
    SelAttributes.Style:=[fsItalic];
    SelAttributes.Color:=clNavy;
    SelStart:=SelStart+SelLength;
    SelLength:=0;
    SelAttributes.Style:=[];
    SelAttributes.Color:=clBlack;
  end;
end;
begin
  Button2Click(Sender);
  RegKeyWords;
  StrMode:=false;
  Comment1:=false; {Comment with "{" symbol}
  Comment2:=false; {Comment with "(*" symbol}
  Comment3:=false; {Comment with "//" symbol}
  Scroller:=TScroller.Create(Reader1);
  try
    with Scroller do with Memo1 do begin
      First(Memo1.Text, 0);
      while Position.Status<>sNone do begin
        ProgressBar1.Position:=
          Round(ProgressBar1.Max*Position.ActivePos/Memo1.GetTextLen);
        if Comment3 then begin
          if Position.ActiveStr=EndOfLine then begin
            Comment3:=false; {End of comment}
            SetCommentAttr;
          end;
        end
        else begin
          if StrMode then begin
            if Position.ActiveStr='''' then StrMode:=false {End of string}
          end
          else if Comment1 then begin
            if Position.ActiveStr='}' then begin
              Comment1:=false; {End of comment}
              SetCommentAttr;
            end;
          end
          else if Comment2 then begin
            if Position.ActiveStr='*)' then begin
              Comment2:=false; {End of comment}
              SetCommentAttr;
            end;
          end
          else if Position.ActiveStr='''' then StrMode:=true {Beginning of string}
          else if Position.ActiveStr='{' then begin
            Comment1:=true; {Beginning of comment}
            SelStart:=PrevPos.ActivePos+Position.Distance;
          end
          else if Position.ActiveStr='(*' then begin
            Comment2:=true; {Beginning of comment}
            SelStart:=PrevPos.ActivePos+Position.Distance;
          end
          else if Position.ActiveStr='//' then begin
            Comment3:=true; {Beginning of comment}
            SelStart:=PrevPos.ActivePos+Position.Distance;
          end
          else if Position.Status=sKeyWord then begin
            {Bold style for reserved words}
            SelStart:=PrevPos.ActivePos+Position.Distance;
            SelLength:=Position.ActivePos-SelStart;
            SelAttributes.Style:=[fsBold];
            if Position.Structure = FreeStructure then {for custom keywords}
              SelAttributes.Color:=clRed;
            SelStart:=SelStart+SelLength;
            SelLength:=0;
            SelAttributes.Style:=[];
          end;
        end;
        Next;
      end;
      ProgressBar1.Position:=0;
    end;
    if Comment1 or Comment2 or Comment3 then SetCommentAttr;
  finally
    Scroller.Destroy;
  end;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  with Memo1 do begin
    Visible:=false;
    SelectAll;
    SelAttributes.Name:='Courier New';
    SelAttributes.Style:=[];
    SelAttributes.Color:=clBlack;
    SelLength:=0;
    Visible:=true;
  end;
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  Scroller: TScroller;
  s: string;
begin
  RegKeyWords;
  ListBox1.Clear;
  Scroller:=TScroller.Create(Reader1);
  try
    with Scroller do begin
      First(Memo1.Text, 0);
      while Position.Status<>sNone do begin {Construction of list}
        ProgressBar1.Position:=
          Round(ProgressBar1.Max*Position.ActivePos/Memo1.GetTextLen);
        case Position.Status of
           sWord: s:='Word';
           sInteger: s:='Integer';
           sStandardNumber: s:='StandardNumber';
           sScientificNumber: s:='ScientificNumber';
           sKeyWord: s:='KeyWord';
           sDelimiter: s:='Delimiter';
        end;
        if Position.ActiveStr<>EndOfLine then
          ListBox1.Items.Add(Position.ActiveStr+' | '+s);
        Next;
      end;
      ProgressBar1.Position:=0;
    end;
  finally
    Scroller.Destroy;
  end;
end;

procedure TMainForm.Button4Click(Sender: TObject);
var
  LineCount, DelCount, KeyWordCount, NumCount, WordCount: integer;
  Time0, Time1: TDateTime;
  Interval: real;
  s: string;
  Scroller: TScroller;
begin
  RegKeyWords;
  LineCount:=0; {Amount of lines}
  DelCount:=0; {Amount of Delimiters}
  KeyWordCount:=0; {Amount of Key words}
  NumCount:=0; {Amount of numbers}
  WordCount:=0; {Amount of unidentified words}
  Time0:=Now;
  Scroller:=TScroller.Create(Reader1);
  try
    with Scroller do begin
      First(Memo1.Text, 0);
      while Position.Status<>sNone do begin
        case Position.Status of
          sDelimiter: if Position.ActiveStr = EndOfLine then Inc(LineCount)
            else Inc(DelCount);
          sKeyWord: Inc(KeyWordCount);
          sInteger: Inc(NumCount);
          sStandardNumber: Inc(NumCount);
          sScientificNumber: Inc(NumCount);
          sWord: Inc(WordCount);
        end;
        Next;
      end;
    end;
  finally
    Scroller.Destroy;
  end;
  Time1:=Now;
  Interval:=(Time1-Time0)*24*3600;
  Str(Interval:1:2,s);
  ShowMessage(IntToStr(DelCount)+' delimiter, '+
              IntToStr(KeyWordCount)+' key word, '+
              IntToStr(NumCount)+' number'+#10+
              IntToStr(WordCount)+' other word'+#10+
              'total - '+IntToStr(DelCount+KeyWordCount+NumCount+WordCount)+#10+
              IntToStr(LineCount+1)+' line, '+
              'length of text - '+IntToStr(Memo1.GetTextLen-LineCount*2)+
              ' character'+#10+
              'working time - '+s+' sec');
end;

procedure TMainForm.Button5Click(Sender: TObject);
var
  s: string;
  i: integer;
begin
  if Edit1.Text<>'' then begin
    s:='';
    for i:=1 to Length(Edit1.Text) do
      if not Reader1.IsFreeSymbol(Edit1.Text[i]) then s:=s+Edit1.Text[i];
    ListBox2.Items.Add(s);
    Edit1.Text:='';
  end;
end;

procedure TMainForm.Button6Click(Sender: TObject);
var
  i: integer;
begin
  with ListBox2 do if ItemIndex>-1 then begin
    i:=ItemIndex;
    Items.Delete(i);
    if i>Items.Count-1 then ItemIndex:=Items.Count-1
    else ItemIndex:=i;
  end;
end;

procedure TMainForm.ListBox2DblClick(Sender: TObject);
begin
  with ListBox2 do if ItemIndex>-1 then Edit1.Text:=Items[ItemIndex];
end;

end.