builder.pas

支持自定义语法高亮显示的编辑器控件

unit builder;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus, ActnList, ImgList,
  EasyClasses, EasyUtils, EasyParser;

type
  TNodeKind = (nkNone, nkGeneral, nkState, nkStates, nkToken, nkTokens, nkBlock, nkBlocks, nkResword, nkReswords);

  TSchemeExpressions = class;

  TSchemeExpression = class(TCollectionItem)
  private
    FExpression : string;
    FState      : string;
    FToken      : string;
  public
    property Expression : string read FExpression write FExpression;
    property State : string read FState write FState;
    property Token : string read FToken write FToken;
  end;

  TSchemeExpressions = class(TCollection)
  private
    function  GetItem(Index : Integer): TSchemeExpression;
    procedure SetItem(Index : Integer; Value: TSchemeExpression);
  public
    function Add(const AExpr : string): TSchemeExpression;
    function Insert(const AExpr : string; Index: integer): TSchemeExpression;
    property Items[Index : Integer]: TSchemeExpression read GetItem write SetItem; default;
  end;

  TSchemeStates = class;

  TSchemeState = class(TCollectionItem)
  private
    FBlocks        : TStrings;
    FReswords      : TSchemeExpressions;
    FName          : string;
    FCaseSensitive : boolean;
  public
    constructor Create(Collection : TCollection); override;
    destructor Destroy; override;
    procedure AddBlock(const Value: string);
    procedure DeleteBlock(Index: integer);
    property Blocks  : TStrings read FBlocks;
    property Reswords : TSchemeExpressions read FResWords;
    property Name : string read FName write FName;
    property CaseSensitive : boolean read FCaseSensitive write FCaseSensitive;
  end;

  TSchemeStates = class(TCollection)
  private
    function  GetItem(Index: Integer): TSchemeState;
    procedure SetItem(Index: Integer; Value: TSchemeState);
  public
    function Add(AName: string; ACaseSensitive : boolean) : TSchemeState;
    property Items[Index: Integer]: TSchemeState read GetItem write SetItem; default;
  end;

  TScheme = class
  private
    FLanguage      : string;
    FCopyright     : string;
    FWWW           : string;
    FEMail         : string;
    FDelimiters    : string;
    FCaseSensitive : boolean;
    FStates        : TSchemeStates;
    FTokens        : TStrings;
  public
    constructor Create;
    destructor Destroy; override;
    property Language : string read FLanguage write FLanguage;
    property Copyright : string read FCopyright write FCopyright;
    property WWW : string read FWWW write FWWW;
    property EMail : string read FEmail write FEmail;
    property Delimiters : string read FDelimiters write FDelimiters;
    property CaseSensitive : boolean read FCaseSensitive write FCaseSensitive;
    property States : TSchemeStates read FStates;
    property Tokens : TStrings read FTokens;
  end;

  TfrmBuilder = class(TForm)
    pnButtons: TPanel;
    btLoad: TButton;
    btSave: TButton;
    btClear: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    pnMain: TPanel;
    tvScheme: TTreeView;
    ActionList1: TActionList;
    AddToken: TAction;
    DeleteToken: TAction;
    AddState: TAction;
    DeleteState: TAction;
    AddBlock: TAction;
    DeleteBlock: TAction;
    EasyEditorParser1: TEasyEditorParser;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    AddExpression1: TMenuItem;
    DeleteExpression1: TMenuItem;
    pcMain: TPageControl;
    tsGeneral: TTabSheet;
    tsStates: TTabSheet;
    pnState: TPanel;
    Panel1: TPanel;
    laStateName: TLabel;
    edStateName: TEdit;
    tsToken: TTabSheet;
    pnToken: TPanel;
    laTokenName: TLabel;
    edTokenName: TEdit;
    pnGeneral: TPanel;
    laLanguage: TLabel;
    laCopyright: TLabel;
    laSite: TLabel;
    laMail: TLabel;
    laDelimiters: TLabel;
    edLanguage: TEdit;
    edCopyright: TEdit;
    edWWW: TEdit;
    edMail: TEdit;
    edDelimiters: TEdit;
    chbCaseSensitive: TCheckBox;
    pnBlock: TPanel;
    laExpressions: TLabel;
    laBlockName: TLabel;
    gbExpressionProperties: TGroupBox;
    laLeaveState: TLabel;
    laLeaveToken: TLabel;
    cbState: TComboBox;
    cbToken: TComboBox;
    lbExpressions: TListBox;
    edBlockName: TEdit;
    cbExpressions: TComboBox;
    pnResword: TPanel;
    laReswordName: TLabel;
    gbReswordProperties: TGroupBox;
    laReswordLeaveState: TLabel;
    laReswordLeaveToken: TLabel;
    cbReswordState: TComboBox;
    cbReswordToken: TComboBox;
    lbReswords: TListBox;
    pmReswords: TPopupMenu;
    Addresword1: TMenuItem;
    Deleteresword1: TMenuItem;
    edReswordName: TEdit;
    chbStateCaseSensitive: TCheckBox;
    ImageList1: TImageList;
    procedure btLoadClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tvSchemeChange(Sender: TObject; Node: TTreeNode);
    procedure btClearClick(Sender: TObject);
    procedure AddTokenExecute(Sender: TObject);
    procedure DeleteTokenExecute(Sender: TObject);
    procedure AddStateExecute(Sender: TObject);
    procedure DeleteStateExecute(Sender: TObject);
    procedure AddBlockExecute(Sender: TObject);
    procedure DeleteBlockExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edLanguageKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edCopyrightKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure AddExpression1Click(Sender: TObject);
    procedure DeleteExpression1Click(Sender: TObject);
    procedure edDelimitersKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edWWWKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edMailKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edLanguageExit(Sender: TObject);
    procedure edCopyrightExit(Sender: TObject);
    procedure edWWWExit(Sender: TObject);
    procedure edMailExit(Sender: TObject);
    procedure edDelimitersExit(Sender: TObject);
    procedure chbCaseSensitiveClick(Sender: TObject);
    procedure edStateNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edTokenNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edBlockNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cbStateChange(Sender: TObject);
    procedure cbTokenChange(Sender: TObject);
    procedure cbReswordStateChange(Sender: TObject);
    procedure cbReswordTokenChange(Sender: TObject);
    procedure lbExpressionsClick(Sender: TObject);
    procedure cbExpressionsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edStateNameExit(Sender: TObject);
    procedure edTokenNameExit(Sender: TObject);
    procedure edBlockNameExit(Sender: TObject);
    procedure cbExpressionsExit(Sender: TObject);
    procedure lbReswordsClick(Sender: TObject);
    procedure Addresword1Click(Sender: TObject);
    procedure Deleteresword1Click(Sender: TObject);
    procedure edReswordNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edReswordNameExit(Sender: TObject);
    procedure pmReswordsPopup(Sender: TObject);
    procedure chbStateCaseSensitiveClick(Sender: TObject);
    procedure tvSchemeExpanded(Sender: TObject; Node: TTreeNode);
    procedure tvSchemeCollapsed(Sender: TObject; Node: TTreeNode);
    procedure tvSchemeDeletion(Sender: TObject; Node: TTreeNode);
  private
    FUpdating: boolean;
    Scheme: TScheme;

    function GetNodeKind : TNodeKind;
    function GetNode(AKind: TNodeKind) : TTreeNode;
    function GetNewNumberFromNode(ANode: TTreeNode; AName: string): integer;
    function GetNewNumber(ANames: TStrings; AName: string): integer;
    function GetResword: TSchemeExpression;
    function GetExpression: TSchemeExpression;
    function GetTokenIndex: integer; 
    function GetState: TSchemeState;
    function GetBlockNumber: integer;
    function GetBlockExpressions: TSchemeExpressions;
    function IsTokenUsed: boolean;
    function IsStateUsed: boolean;
    function GetCaseSensitive: boolean;

    procedure AddExpression(const Value: string);
    procedure DeleteExpression;
    procedure AddResword(const Value: string);
    procedure DeleteResword;
    procedure LoadScheme;
    procedure SaveScheme;
    procedure ClearScheme;
    procedure ClearProperties;
    procedure LoadProperties;
    procedure WriteScheme(s : TStrings);
    procedure ReadScheme;
    procedure UpdateSchemePopup;
    procedure UpdatePanels;
    procedure SetCurrentPanel(Value: TPanel);
    procedure UpdateStatePanel;
    procedure UpdateGeneralPanel;
    procedure UpdateTokenPanel;
    procedure UpdateBlockPanel;
    procedure UpdateReswordPanel;
    procedure UpdateExprPanel;
    procedure UpdateExprProp;
    procedure UpdateReswordProp;
    procedure UpdateTokens;
    procedure UpdateStates;
    procedure UpdateBlocks;
    procedure UpdateTreeview;
    procedure UpdateTokenControls;
    procedure UpdateStateControls;
    procedure UpdateNodeIndex(Node : TTreeNode; IsExpanded : boolean = false; IsDeleted : boolean = false);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmBuilder: TfrmBuilder;

const
  sTokens = 'tokens';
  sStates = 'states';
  sBlocks = 'blocks';
  sReswords = 'reswords';
  sDelims = 'delims';
  sAddToken = 'Add Token';
  sDeleteToken = 'Delete Token';
  sAddState = 'Add State';
  sDeleteState = 'Delete State';
  sAddBlock = 'Add Block';
  sDeleteBlock = 'Delete Block';
  sAddResword = 'Add resword';
  sDeleteResword = 'Delete resword';
  sNewState = 'New State';
  sNewToken = 'New Token';
  sNewBlock = 'New Block';
  sNewResword = 'New resword';
  sNewExpression = 'New Expression';
  sLanguage = 'Language';
  sCopyright = 'Copyright';
  sState = 'State';
  sCaseSensitive = 'CaseSensitive';
  sToken = 'Token';
  sDelimiters = 'Delimiters';
  sComment = '//';
  cCloseFolderIndex = 0;
  cOpenFolderIndex = 1;
  cPropIndex = 2;

implementation

{$R *.dfm}

{-----------TScheme---------------------------}

constructor TScheme.Create;
begin
  inherited Create;
  FStates := TSchemeStates.Create(TSchemeState);
  FTokens := TStringList.Create;
end;

{--------------------------------------------}

destructor TScheme.Destroy;
begin
  FStates.Free;
  FTokens.Free;
  inherited Destroy;
end;

{--------TSchemeExpressions-----------------}

function TSchemeExpressions.Add(const AExpr : string) : TSchemeExpression;
begin
  result := TSchemeExpression(inherited Add);
  result.Expression := AExpr;
end;

{--------------------------------------------}

function TSchemeExpressions.GetItem(Index: Integer): TSchemeExpression;
begin
  result := TSchemeExpression(inherited GetItem(Index));
end;

{--------------------------------------------}

function TSchemeExpressions.Insert(const AExpr : string;
  Index : integer) : TSchemeExpression;
begin
  result := Add(AExpr);
  result.Index := Index;
end;

{--------------------------------------------}

procedure TSchemeExpressions.SetItem(Index : Integer; Value : TSchemeExpression);
begin
  inherited SetItem(Index, Value);
end;

{--------------------------------------------}

function TSchemeStates.Add(AName: string; ACaseSensitive : boolean): TSchemeState;
begin
  result := TSchemeState(inherited Add);
  result.Name := AName;
  result.CaseSensitive := ACaseSensitive;
end;

{--------------------------------------------}

function TSchemeStates.GetItem(Index : Integer): TSchemeState;
begin
  result := TSchemeState(inherited GetItem(Index));
end;

{--------------------------------------------}

procedure TSchemeStates.SetItem(Index : Integer; Value : TSchemeState);
begin
  inherited SetItem(Index, Value);
end;

{--------------------------------------------}

procedure TSchemeState.AddBlock(const Value : string);
var
  expr : TSchemeExpressions;
begin
  expr := TSchemeExpressions.Create(TSchemeExpression);
  Blocks.AddObject(Value, expr);
end;

{--------------------------------------------}

constructor TSchemeState.Create(Collection : TCollection);
begin
  inherited Create(Collection);
  FBlocks := TStringList.Create;
  FReswords := TSchemeExpressions.Create(TSchemeExpression);
end;

{--------------------------------------------}

destructor TSchemeState.Destroy;
var
  i : integer;
begin
  for i := FBlocks.Count downto 0 do
    DeleteBlock(i);
  FBlocks.Free;
  FReswords.Free;
  inherited Destroy;
end;

{--------------------------------------------}

procedure TSchemeState.DeleteBlock(Index : integer);
begin
  if (Index >= 0) and (Index < Blocks.Count) then
  begin
    Blocks.Objects[Index].Free;
    Blocks.Delete(Index);
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.btLoadClick(Sender: TObject);
begin
  LoadScheme;
end;

{--------------------------------------------}

procedure TfrmBuilder.btSaveClick(Sender: TObject);
begin
  SaveScheme;
end;

{--------------------------------------------}

procedure TfrmBuilder.LoadScheme;
begin
  if OpenDialog1.Execute then
  begin
    EasyEditorParser1.Rules.LoadFromFile(OpenDialog1.FileName);
    ReadScheme;
    LoadProperties;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.SaveScheme;
var
  S : TStrings;
begin
  if SaveDialog1.Execute then
  begin
    S := TStringList.Create;
    try
      WriteScheme(s);
      EasyEditorParser1.Rules.Assign(s);
      EasyEditorParser1.Rules.SaveToFile(SaveDialog1.FileName);
    finally
      S.Free;
    end;
  end;
end;

{--------------------------------------------}

procedure TfrmBuilder.FormCreate(Sender: TObject);
begin
//  frmContainer := TfrmContainer.Create(Application);
  Scheme := TScheme.Create;
  UpdatePanels;
  tvScheme.FullExpand;
  frmBuilder.ClientHeight := pnState.Height + pnButtons.Height;
end;

{--------------------------------------------}

procedure TfrmBuilder.FormDestroy(Sender: TObject);
begin
  Scheme.Free;
end;

{--------------------------------------------}

procedure TfrmBuilder.ClearProperties;
begin
  edLanguage.Text := '';
  edCopyright.Text := '';
  edWWW.Text := '';
  edMail.Text := '';
  edDelimiters.Text := '';
  UpdateTreeview;
  UpdateTokenControls;
  UpdateStateControls;
end;

{--------------------------------------------}

procedure TfrmBuilder.LoadProperties;
begin
  UpdateGeneralPanel;
  UpdateTreeview;
  UpdateTokenControls;
  UpdateStateControls;
end;