home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d6 / YPPARSER.ZIP / Components / DataEditor.pas next >
Pascal/Delphi Source File  |  2002-06-16  |  79KB  |  2,087 lines
  1. {********************************************************}
  2. {                                                        }
  3. {                    TDataEditor                         }
  4. {             IMPORTANT-READ CAREFULLY:                  }
  5. {                                                        }
  6. {    This End-User License Agreement is a legal          }
  7. {    agreement between you (either an individual         }
  8. {    or a single entity) and Pisarev Yuriy for           }
  9. {    the software product identified above, which        }
  10. {    includes computer software and may include          }
  11. {    associated media, printed materials, and "online"   }
  12. {    or electronic documentation ("SOFTWARE PRODUCT").   }
  13. {    By installing, copying, or otherwise using the      }
  14. {    SOFTWARE PRODUCT, you agree to be bound by the      }
  15. {    terms of this LICENSE AGREEMENT.                    }
  16. {                                                        }
  17. {    If you do not agree to the terms of this            }
  18. {    LICENSE AGREEMENT, do not install or use            }
  19. {    the SOFTWARE PRODUCT.                               }
  20. {                                                        }
  21. {    License conditions                                  }
  22. {                                                        }
  23. {    No part of the software or the manual may be        }
  24. {    multiplied, disseminated or processed in any        }
  25. {    way without the written consent of Pisarev          }
  26. {    Yuriy. Violations of these conditions will be       }
  27. {    prosecuted in every case.                           }
  28. {                                                        }
  29. {    The use of the software is done at your own         }
  30. {    risk. The manufacturer and developer accepts        }
  31. {    no liability for any damages, either as direct      }
  32. {    or indirect consequence of the use of this          }
  33. {    product or software.                                }
  34. {                                                        }
  35. {    Only observance of these conditions allows you      }
  36. {    to use the hardware and software in your computer   }
  37. {    system.                                             }
  38. {                                                        }
  39. {    All rights reserved.                                }
  40. {    Copyright 2002 Pisarev Yuriy                        }
  41. {                                                        }
  42. {                 yuriy_mbox@hotmail.com                 }
  43. {                                                        }
  44. {********************************************************}
  45.  
  46. unit DataEditor;
  47.  
  48. interface
  49.  
  50. uses Windows, Classes, ComCtrls, SysUtils, Graphics, Math;
  51.  
  52. type
  53.   TAttribute = record
  54.     SelStart, SelLength: Integer;
  55.   end;
  56.   TAttributes = array of TAttribute;
  57.  
  58.   TShortStrings = array of ShortString;
  59.  
  60.   TAttrsManager = class
  61.   private
  62.     FAttributes: TAttributes;
  63.     FColor: TColor;
  64.     FDefaultColor: TColor;
  65.     FFontStyle: TFontStyles;
  66.     FDefaultFontStyle: TFontStyles;
  67.     FShortStrings: TShortStrings;
  68.     FStrings: TStrings;
  69.     procedure SetStrings(const Value: TStrings);
  70.   protected
  71.     procedure EditorChange(Sender: TObject);
  72.     procedure EditorKeyPress(Sender: TObject; var Key: Char);
  73.     property Attributes: TAttributes read FAttributes write FAttributes;
  74.     property ShortStrings: TShortStrings read FShortStrings write FShortStrings;
  75.   public
  76.     class procedure About;
  77.     procedure UpdateStrings;
  78.   published
  79.     constructor Create(Editor: TRichEdit); virtual;
  80.     destructor Destroy; override;
  81.     procedure Add(Editor: TRichEdit); virtual;
  82.     property Color: TColor read FColor write FColor;
  83.     property FontStyle: TFontStyles read FFontStyle write FFontStyle;
  84.     property DefaultColor: TColor read FDefaultColor write FDefaultColor;
  85.     property DefaultFontStyle: TFontStyles read FDefaultFontStyle
  86.       write FDefaultFontStyle;
  87.     property Strings: TStrings read FStrings write SetStrings;
  88.   end;
  89.  
  90.   TByteArray = array of Byte;
  91.   TIntArray = array of Integer;
  92.   TStringArray = array of string;
  93.   TScript = TByteArray;
  94.   TScriptArray = array of TScript;
  95.  
  96.   TBracketData = record
  97.     OpenedBracketIndex, OpenedBracketCount,
  98.     ClosedBracketIndex, ClosedBracketCount: Integer;
  99.   end;
  100.  
  101.   TSeparatorData = record
  102.     Index, Length: Integer;
  103.   end;
  104.   TSeparatorsData = array of TSeparatorData;
  105.  
  106.   TFunctionData = record
  107.     P: Pointer;
  108.     FunctionName: ShortString;
  109.     RequireValue1, RequireValue2: Boolean;
  110.   end;
  111.   TFunctionsData = array of TFunctionData;
  112.  
  113.   TTypeData = record
  114.     P: Pointer;
  115.     TypeName: ShortString;
  116.   end;
  117.   TTypesData = array of TTypeData;
  118.  
  119.   TExceptionType = (etZeroDivide);
  120.   TExceptionsType = set of TExceptionType;
  121.  
  122.   TOperatorType = (otNumber, otFunction, otScript, otNone);
  123.   TSyntaxData = record
  124.     OperatorType: TOperatorType;
  125.     FirstOperator: Boolean;
  126.     FunctionData: TFunctionData;
  127.   end;
  128.  
  129.   TNumFunctionEvent = function(FunctionID: Integer; TypeID: Integer;
  130.     var Value1: Double; Value2, Value3: Double): Boolean of object;
  131.   TBoolFunctionEvent = function(FunctionID: Integer; TypeID: Integer;
  132.     var Value1: Boolean; Value2, Value3: Double): Boolean of object;
  133.  
  134.   TDataEditor = class(TComponent)
  135.   private
  136.     FCosID: Integer;
  137.     FWordID: Integer;
  138.     FIntID: Integer;
  139.     FLessID: Integer;
  140.     FFactorialID: Integer;
  141.     FArcSinID: Integer;
  142.     FByteID: Integer;
  143.     FCosHID: Integer;
  144.     FNumReservedID: Integer;
  145.     FFalseID: Integer;
  146.     FSinHID: Integer;
  147.     FArcCoTanID: Integer;
  148.     FSecID: Integer;
  149.     FIntegerID: Integer;
  150.     FTrueID: Integer;
  151.     FArcCoTanHID: Integer;
  152.     FSqrtID: Integer;
  153.     FTanHID: Integer;
  154.     FBoolReservedID: Integer;
  155.     FTanID: Integer;
  156.     FDivID: Integer;
  157.     FDivisionID: Integer;
  158.     FArcCosHID: Integer;
  159.     FGreaterOrEqualID: Integer;
  160.     FArcCosID: Integer;
  161.     FCscID: Integer;
  162.     FAbsID: Integer;
  163.     FArcSinHID: Integer;
  164.     FLnID: Integer;
  165.     FMultiplyingID: Integer;
  166.     FDoubleID: Integer;
  167.     FCscHID: Integer;
  168.     FRoundID: Integer;
  169.     FLogID: Integer;
  170.     FCoTanID: Integer;
  171.     FSmallintID: Integer;
  172.     FEqualID: Integer;
  173.     FModID: Integer;
  174.     FExpID: Integer;
  175.     FCoTanHID: Integer;
  176.     FArcSecID: Integer;
  177.     FArcCscHID: Integer;
  178.     FLessOrEqualID: Integer;
  179.     FLgID: Integer;
  180.     FArcCscID: Integer;
  181.     FArcTanHID: Integer;
  182.     FFracID: Integer;
  183.     FArcTanID: Integer;
  184.     FShortintID: Integer;
  185.     FSingleID: Integer;
  186.     FLongwordID: Integer;
  187.     FPiID: Integer;
  188.     FRandomID: Integer;
  189.     FGreaterID: Integer;
  190.     FSecHID: Integer;
  191.     FOddID: Integer;
  192.     FSinID: Integer;
  193.     FTruncID: Integer;
  194.     FDegreeID: Integer;
  195.     FNotEqualID: Integer;
  196.     FArcSecHID: Integer;
  197.     FInt64ID: Integer;
  198.     FText: string;
  199.     FAttrsManager: TAttrsManager;
  200.     FOnBoolFunction: TBoolFunctionEvent;
  201.     FExceptionsType: TExceptionsType;
  202.     FNumFunctionsData: TFunctionsData;
  203.     FBoolFunctionsData: TFunctionsData;
  204.     FOnNumFunction: TNumFunctionEvent;
  205.     FAccuracy: TRoundToRange;
  206.     FScript: TScript;
  207.     FTypesData: TTypesData;
  208.     function GetAttrColor: TColor;
  209.     function GetAttrFontStyles: TFontStyles;
  210.     function GetStrings: TStrings;
  211.     procedure SetAttrColor(const Value: TColor);
  212.     procedure SetAttrFontStyles(const Value: TFontStyles);
  213.     procedure SetStrings(const Value: TStrings);
  214.   protected
  215.     procedure SortFunctionsData(var FunctionsData: TFunctionsData);
  216.     function BoolSeparator: string;
  217.     function NumSeparator: string;
  218.     function FunctionIndex(const FunctionName: string;
  219.       const FunctionsData: TFunctionsData): Integer;
  220.     procedure RegisterFunction(out FunctionID: Integer;
  221.       const FunctionName: string; var FunctionsData: TFunctionsData;
  222.       RequireValue1, RequireValue2: Boolean);
  223.     function UnRegisterFunction(FunctionID: Integer;
  224.       var FunctionsData: TFunctionsData): Boolean;
  225.     procedure SortTypesData(var TypesData: TTypesData); overload;
  226.     function TypeIndex(const TypeName: string; const TypesData: TTypesData): Integer;
  227.     procedure RegisterType(out TypeID: Integer;
  228.       const TypeName: string; var TypesData: TTypesData); overload;
  229.     function UnRegisterType(const TypeID: Integer;
  230.       var TypesData: TTypesData): Boolean; overload;
  231.     function ValueType(var S: string;
  232.       const TypesData: TTypesData): Integer; overload;
  233.     function CheckBoolValue(const S: string): Boolean;
  234.     function NegativeValue(var S1: string; const S2: string): Boolean;
  235.     function ValueType(var S: string): Integer; overload;
  236.     function Separator(const FunctionsData: TFunctionsData): string;
  237.     function ExecuteNumFunction(var Index: Integer; TypeID: Integer;
  238.       Value: Double): Double;
  239.     function ExecuteBoolFunction(var Index: Integer; TypeID: Integer;
  240.       var Value: Double): Boolean;
  241.   public
  242.     constructor Create(AOwner: TComponent); override;
  243.     destructor Destroy; override;
  244.     class procedure About;
  245.     procedure CopyScript(const Script: TScript);
  246.     function CheckIntValue(const S: string; out Value: Integer): Boolean;
  247.     function CheckFloatValue(const S: string): Boolean; overload;
  248.     function CheckFloatValue(const S: string; out Value: Double): Boolean; overload;
  249.     function CheckFloatValue(const S: string; out Value: Single): Boolean; overload;
  250.     function CheckFloatValue(const Value: Double): Boolean; overload;
  251.     procedure RegisterNumFunction(out FunctionID: Integer;
  252.       const FunctionName: string; RequireValue1, RequireValue2: Boolean); virtual;
  253.     function UnRegisterNumFunction(const FunctionName: string): Boolean; overload; virtual;
  254.     function UnRegisterNumFunction(FunctionID: Integer): Boolean; overload; virtual;
  255.     procedure RegisterBoolFunction(out FunctionID: Integer;
  256.       const FunctionName: string; RequireValue1, RequireValue2: Boolean); virtual;
  257.     function UnRegisterBoolFunction(const FunctionName: string): Boolean; overload; virtual;
  258.     function UnRegisterBoolFunction(FunctionID: Integer): Boolean; overload; virtual;
  259.     procedure RegisterType(out TypeID: Integer;
  260.       const TypeName: string); overload; virtual;
  261.     function UnRegisterType(const TypeName: string): Boolean; overload; virtual;
  262.     function UnRegisterType(TypeID: Integer): Boolean; overload; virtual;
  263.     procedure SortNumFunctionsData; virtual;
  264.     procedure SortBoolFunctionsData; virtual;
  265.     procedure SortTypesData; overload; virtual;
  266.     procedure StringToNumScript(const S: string; out Script: TScript;
  267.       OpenedBracket: Char = '('; ClosedBracket: Char = ')'); overload; virtual;
  268.     procedure StringToNumScript(const S: string; OpenedBracket: Char = '(';
  269.       ClosedBracket: Char = ')'); overload; virtual;
  270.     procedure StringToNumScript(OpenedBracket: Char = '(';
  271.       ClosedBracket: Char = ')'); overload; virtual;
  272.     procedure StringToBoolScript(const S: string; out Script: TScript;
  273.       OpenedBracket: Char = '('; ClosedBracket: Char = ')'); overload; virtual;
  274.     procedure StringToBoolScript(const S: string; OpenedBracket: Char = '(';
  275.       ClosedBracket: Char = ')'); overload; virtual;
  276.     procedure StringToBoolScript(OpenedBracket: Char = '(';
  277.       ClosedBracket: Char = ')'); overload; virtual;
  278.     procedure OptimizeNumScript(Index: Integer); virtual;
  279.     function ExecuteNumScript(Index: Integer): Double; overload; virtual;
  280.     function ExecuteNumScript(P: Pointer): Double; overload; virtual;
  281.     function ExecuteNum: Double; overload; virtual;
  282.     procedure OptimizeBoolScript(Index: Integer); virtual;
  283.     function ExecuteBoolScript(Index: Integer): Boolean; overload; virtual;
  284.     function ExecuteBoolScript(P: Pointer): Boolean; overload; virtual;
  285.     function ExecuteBool: Boolean; overload; virtual;
  286.     function DefaultNumFunction(FunctionID: Integer;
  287.       var Value1: Double; Value2, Value3: Double): Boolean;
  288.     function DefaultBoolFunction(FunctionID: Integer;
  289.       var Value1: Boolean; Value2, Value3: Double): Boolean;
  290.     property AttrsManager: TAttrsManager read FAttrsManager
  291.       write FAttrsManager;
  292.     property Script: TScript read FScript write FScript;
  293.     property NumFunctionsData: TFunctionsData read FNumFunctionsData
  294.       write FNumFunctionsData;
  295.     property BoolFunctionsData: TFunctionsData read FBoolFunctionsData
  296.       write FBoolFunctionsData;
  297.     property TypesData: TTypesData read FTypesData write FTypesData;
  298.     property ByteID: Integer read FByteID;
  299.     property ShortintID: Integer read FShortintID;
  300.     property WordID: Integer read FWordID;
  301.     property SmallintID: Integer read FSmallintID;
  302.     property IntegerID: Integer read FIntegerID;
  303.     property Int64ID: Integer read FInt64ID;
  304.     property LongwordID: Integer read FLongwordID;
  305.     property SingleID: Integer read FSingleID;
  306.     property DoubleID: Integer read FDoubleID;
  307.     property NumReservedID: Integer read FNumReservedID;
  308.     property MultiplyingID: Integer read FMultiplyingID;
  309.     property DivisionID: Integer read FDivisionID;
  310.     property SqrtID: Integer read FSqrtID;
  311.     property DivID: Integer read FDivID;
  312.     property ModID: Integer read FModID;
  313.     property IntID: Integer read FIntID;
  314.     property FracID: Integer read FFracID;
  315.     property RandomID: Integer read FRandomID;
  316.     property TruncID: Integer read FTruncID;
  317.     property RoundID: Integer read FRoundID;
  318.     property SecID: Integer read FSecID;
  319.     property ArcSecID: Integer read FArcSecID;
  320.     property SecHID: Integer read FSecHID;
  321.     property ArcSecHID: Integer read FArcSecHID;
  322.     property CscID: Integer read FCscID;
  323.     property ArcCscID: Integer read FArcCscID;
  324.     property CscHID: Integer read FCscHID;
  325.     property ArcCscHID: Integer read FArcCscHID;
  326.     property SinID: Integer read FSinID;
  327.     property ArcSinID: Integer read FArcSinID;
  328.     property SinHID: Integer read FSinHID;
  329.     property ArcSinHID: Integer read FArcSinHID;
  330.     property CosID: Integer read FCosID;
  331.     property ArcCosID: Integer read FArcCosID;
  332.     property CosHID: Integer read FCosHID;
  333.     property ArcCosHID: Integer read FArcCosHID;
  334.     property TanID: Integer read FTanID;
  335.     property ArcTanID: Integer read FArcTanID;
  336.     property TanHID: Integer read FTanHID;
  337.     property ArcTanHID: Integer read FArcTanHID;
  338.     property CoTanID: Integer read FCoTanID;
  339.     property ArcCoTanID: Integer read FArcCoTanID;
  340.     property CoTanHID: Integer read FCoTanHID;
  341.     property ArcCoTanHID: Integer read FArcCoTanHID;
  342.     property AbsID: Integer read FAbsID;
  343.     property LnID: Integer read FLnID;
  344.     property LgID: Integer read FLgID;
  345.     property LogID: Integer read FLogID;
  346.     property PiID: Integer read FPiID;
  347.     property ExpID: Integer read FExpID;
  348.     property FactorialID: Integer read FFactorialID;
  349.     property DegreeID: Integer read FDegreeID;
  350.     property BoolReservedID: Integer read FBoolReservedID;
  351.     property GreaterOrEqualID: Integer read FGreaterOrEqualID;
  352.     property LessOrEqualID: Integer read FLessOrEqualID;
  353.     property EqualID: Integer read FEqualID;
  354.     property NotEqualID: Integer read FNotEqualID;
  355.     property GreaterID: Integer read FGreaterID;
  356.     property LessID: Integer read FLessID;
  357.     property TrueID: Integer read FTrueID;
  358.     property FalseID: Integer read FFalseID;
  359.     property OddID: Integer read FOddID;
  360.   published
  361.     property Accuracy: TRoundToRange read FAccuracy
  362.       write FAccuracy default -7;
  363.     property Strings: TStrings read GetStrings write SetStrings;
  364.     property AttrColor: TColor read GetAttrColor write SetAttrColor;
  365.     property AttrFontStyles: TFontStyles read GetAttrFontStyles
  366.       write SetAttrFontStyles;
  367.     property ExceptionsType: TExceptionsType read FExceptionsType
  368.       write FExceptionsType default [etZeroDivide];
  369.     property Text: string read FText write FText;
  370.     property OnNumFunction: TNumFunctionEvent read FOnNumFunction
  371.       write FOnNumFunction;
  372.     property OnBoolFunction: TBoolFunctionEvent read FOnBoolFunction
  373.       write FOnBoolFunction;
  374.   end;
  375.  
  376. const
  377.   NumScriptID = 0;
  378.   BoolScriptID = 1;
  379.  
  380.   Reserved: string[3] = '{:}';
  381.   BoolString = 'if';
  382.   BoolStringLength = Length(BoolString);
  383.  
  384.   FunctionDataSize = SizeOf(TFunctionData);
  385.   TypeDataSize = SizeOf(TTypeData);
  386.  
  387.   NumberID = 0;
  388.   FunctionID = 1;
  389.   InternalScriptID = 2;
  390.  
  391.   NeutralityID = 0;
  392.   NegationID = 1;
  393.   ConjunctionID = 2;
  394.   DisjunctionID = 3;
  395.   ExclusiveDisjunctionID = 4;
  396.  
  397.   ByteSize = SizeOf(Byte);
  398.   ShortintSize = SizeOf(Shortint);
  399.   WordSize = SizeOf(Word);
  400.   SmallintSize = SizeOf(Smallint);
  401.   LongwordSize = SizeOf(Longword);
  402.   IntegerSize = SizeOf(Integer);
  403.   Int64Size = SizeOf(Int64);
  404.   SingleSize = SizeOf(Single);
  405.   DoubleSize = SizeOf(Double);
  406.   ShortStringSize = SizeOf(ShortString);
  407.   MaxByteValue = High(Byte);
  408.   MaxShortintValue = High(Shortint);
  409.   MinShortintValue = - High(Shortint) - 1;
  410.   MaxWordValue = High(Word);
  411.   MaxSmallintValue = High(Smallint);
  412.   MinSmallintValue = - High(Smallint) - 1;
  413.   MaxLongwordValue = High(Longword);
  414.   MaxIntegerValue = High(Integer);
  415.   MinIntegerValue = - High(Integer) - 1;
  416.  
  417.   {
  418.  
  419.     Mathematics script header:
  420.  
  421.     |-----|-----|-----|-----|-----|-----|-----|-----||-----|-----|-----|-----||-----|-----|-----|-----||-----|-----|-----|-----|-----
  422.     |  0  |  1  |  2  |  3  |  4  |  5  |  6  |  7  ||  8  |  9  | 10  | 11  || 12  | 13  | 14  | 15  || 16  | 17  | 18  | 19  | ...
  423.     |-----|-----|-----|-----|-----|-----|-----|-----||-----|-----|-----|-----||-----|-----|-----|-----||-----|-----|-----|-----|-----
  424.     |                                                |                        |                        |                       |
  425.     | Script result (8 bytes)                        | Script length          | Amound of embedded     | Indexes of embedded   | Beginning of the
  426.     |                                                | (4 bytes)              | scripts (4 bytes)      | scripts or beginning  | script common part
  427.     |                                                |                        |                        | of common part        |
  428.     |                                                |                        |                        | (4 bytes)             |
  429.                                                                                                          
  430.     Mathematics unit header:
  431.  
  432.     |-----|-----|-----|-----||---------------||-----|-----|-----|-----||-----|-----
  433.     |  0  |  1  |  2  |  3  ||       4       ||  5  |  6  |  7  |  8  ||  9  | ...
  434.     |-----|-----|-----|-----||---------------||-----|-----|-----|-----||-----|-----
  435.     |                        |                |                        |
  436.     | Unit length            | Unit sign      | Unit type              | Beginning of the
  437.     | (4 bytes)              | (1 byte)       | (4 bytes)              | unit common part
  438.     |                        |                |                        |
  439.  
  440.     Sample of number (like element of the unit common part):
  441.  
  442.     |----------|----------||-----|-----|-----|-----|-----|-----|-----|-----||----------|----------|-----
  443.     |    0     |    1     ||  2  |  3  |  4  |  5  |  6  |  7  |  8  |  9  ||    10    |    11    | ...
  444.     |----------|----------||-----|-----|-----|-----|-----|-----|-----|-----||----------|----------|-----
  445.     |                      |                                               ||                     |
  446.     | Identifier of        | Number (8 bytes)                              || Next                |
  447.     | number (2 bytes)     |                                               || identifier          |
  448.     |                      |                                               || (2 bytes)           |
  449.  
  450.     Sample of function (like element of the unit common part):
  451.  
  452.     |----------|----------||-----|-----|-----|-----||----------|----------||-----
  453.     |    0     |    1     ||  2  |  3  |  4  |  5  ||    6     |    7     || ...
  454.     |----------|----------||-----|-----|-----|-----||----------|----------||-----
  455.     |                      |                       ||                     ||
  456.     | Identifier of        | Function (4 bytes)    || Next                ||
  457.     | function (2 bytes)   |                       || identifier          ||
  458.     |                      |                       ||                     ||
  459.  
  460.     Sample of embedded script (like element of the unit common part):
  461.  
  462.     |----------|----------||-----|-----|-----|-----|-----|-----|-----|-----||-----|-----|-----|-----||-----||----------|----------||-----
  463.     |    0     |    1     ||  2  |  3  |  4  |  5  |  6  |  7  |  8  |  9  || 10  | 11  | 12  | 13  || ... ||    ?     |    ?     || ...
  464.     |----------|----------||-----|-----|-----|-----|-----|-----|-----|-----||-----|-----|-----|-----||-----||----------|----------||-----
  465.     |                      |                                                |                       ||     ||                     ||
  466.     | Identifier of        | Script result (8 bytes)                        | Script length         ||     || Next                ||
  467.     | script (2 bytes)     |                                                | (4 bytes)             ||     || identifier          ||
  468.     |                      |                                                |                       ||     || (2 bytes)           ||
  469.     |                      |------------------------------------------------------------------------||     ||                     ||
  470.     |                      |                                                                               ||                     ||
  471.     |                      | Embedded script                                                               ||                     ||
  472.  
  473.   }
  474.  
  475.   // Mathematical script constants, Msc:
  476.  
  477.   Msc1 = 0;
  478.   Msc2 = 8;
  479.   Msc3 = 12;
  480.   Msc4 = 16;
  481.  
  482.   Msc5 = 0;
  483.   Msc6 = 4;
  484.   Msc7 = 5;
  485.   Msc8 = 9;
  486.  
  487.   Msc9 = 2;
  488.   Msc10 = 10;
  489.  
  490.   Msc11 = 2;
  491.   Msc12 = 6;
  492.  
  493.   Msc13 = 2;
  494.   Msc14 = 10;
  495.  
  496.   {
  497.  
  498.     Logical script header:
  499.  
  500.  
  501.     |---------------||-----|-----|-----|-----||-----|-----|-----|-----||-----|-----|-----|-----|-----
  502.     |       0       ||  1  |  2  |  3  |  4  ||  5  |  6  |  7  |  8  ||  9  |  10 | 11  | ...
  503.     |---------------||-----|-----|-----|-----||-----|-----|-----|-----||-----|-----|-----|-----|-----
  504.     |                |                        |                        |                       |
  505.     | Script         | Script length          | Amount of embedded     | Indexes of embedded   | Beginning of the
  506.     | result         | (4 bytes)              | scripts (4 bytes)      | scripts or beggining  | script common part
  507.     | (1 byte)       |                        |                        | of common part        |
  508.     |                |                        |                        | (4 bytes)             |
  509.  
  510.     Logical unit header:
  511.  
  512.     |-----|-----|-----|-----||---------------||-----|-----|-----|-----||-----|-----
  513.     |  0  |  1  |  2  |  3  ||       4       ||  5  |  6  |  7  |  8  ||  9  | ...
  514.     |-----|-----|-----|-----||---------------||-----|-----|-----|-----||-----|-----
  515.     |                        |                |                        |
  516.     | Unit length            | Unit sign      | Unit type              | Beginning of the
  517.     | (4 bytes)              | (1 byte)       | (4 bytes)              | script common part
  518.     |                        |                |                        |
  519.  
  520.     Sample of number (like element of the unit common part):
  521.  
  522.     |----------|----------||-----|-----|-----|-----|-----|-----|-----|-----||----------|----------|-----
  523.     |    0     |    1     ||  2  |  3  |  4  |  5  |  6  |  7  |  8  |  9  ||    10    |    11    | ...
  524.     |----------|----------||-----|-----|-----|-----|-----|-----|-----|-----||----------|----------|-----
  525.     |                      |                                               ||                     |
  526.     | Identifier of        | Number (8 bytes)                              || Next                |
  527.     | number (2 bytes)     |                                               || identifier          |
  528.     |                      |                                               || (2 bytes)           |
  529.  
  530.     Sample of function (like element of the unit common part):
  531.  
  532.     |----------|----------||-----|-----|-----|-----||----------|----------||-----
  533.     |    0     |    1     ||  2  |  3  |  4  |  5  ||    6     |    7     || ...
  534.     |----------|----------||-----|-----|-----|-----||----------|----------||-----
  535.     |                      |                       ||                     ||
  536.     | Identifier           | Function (4 bytes)    || Next                ||
  537.     | of function          |                       || identifier          ||
  538.     | (2 bytes)            |                       ||                     ||
  539.  
  540.     Sample of embedded logical script (like element of the unit common part):
  541.  
  542.     |----------|----------||---------------||---------------||-----|-----|-----|-----||-----||-----||----------|----------||-----
  543.     |    0     |    1     ||       2       ||       3       ||  4  |  5  |  6  |  7  ||  8  || ... ||    ?     |    ?     || ...
  544.     |----------|----------||---------------||---------------||-----|-----|-----|-----||-----||-----||----------|----------||-----
  545.     |                      |                |                |                              ||     ||                     ||
  546.     | Identifier of        | Script type    | Script         | Script length                ||     || Next                ||
  547.     | script (2 bytes)     | (1 byte)       | result         | (4 bytes)                    ||     || identifier          ||
  548.     |                      |                | (1 byte        |                              ||     || (2 bytes)           ||
  549.     |                      |                |-----------------------------------------------||     ||                     ||
  550.     |                      |                |                                                      ||                     ||
  551.     |                      |                | Embedded script                                      ||                     ||
  552.  
  553.     Sample of embedded mathematics script (like element of the unit common part):
  554.  
  555.     |----------|----------||---------------||-----|-----|-----|-----|-----|-----|-----|-----||-----|-----|-----|-----||-----||----------|----------||-----
  556.     |    0     |    1     ||       2       ||  3  |  4  |  5  |  6  |  7  |  8  |  9  | 10  || 11  | 12  | 13  | 14  || ... ||    ?     |    ?     || ...
  557.     |----------|----------||---------------||-----|-----|-----|-----|-----|-----|-----|-----||-----|-----|-----|-----||-----||----------|----------||-----
  558.     |                      |                |                                                |                       ||     ||                     ||
  559.     | Identifier of        | Script type    | Script result (8 bytes)                        | Script length         ||     || Next                ||
  560.     | script (2 bytes)     | (1 byte)       |                                                | (4 bytes)             ||     || identifier          ||
  561.     |                      |                |                                                |                       ||     || (2 bytes)           ||
  562.     |                      |                |------------------------------------------------------------------------||     ||                     ||
  563.     |                      |                |                                                                               ||                     ||
  564.     |                      |                | Embedded script                                                               ||                     ||
  565.  
  566.   }
  567.  
  568.   // Logical script constants, Lsc:
  569.  
  570.   Lsc1 = 0;
  571.   Lsc2 = 1;
  572.   Lsc3 = 5;
  573.   Lsc4 = 9;
  574.  
  575.   Lsc5 = 0;
  576.   Lsc6 = 4;
  577.   Lsc7 = 5;
  578.   Lsc8 = 9;
  579.  
  580.   Lsc9 = 2;
  581.   Lsc10 = 10;
  582.  
  583.   Lsc11 = 2;
  584.   Lsc12 = 6;
  585.  
  586.   Lsc13 = 2;
  587.   Lsc14 = 1;
  588.   Lsc15 = 3;
  589.   Lsc16 = 4;
  590.   Lsc17 = 11;
  591.  
  592. function SubString(const S, Separator: string; Index: Integer): string;
  593. procedure ExtractStrings(const S, Separator: string; var StringArray: TStringArray);
  594. function ContainsValue(var S1: string; const S2: string;
  595.   DeleteValue: Boolean = True): Boolean;
  596. procedure Del(var IntArray: TIntArray; Index: Integer); overload;
  597. function Add(var IntArray: TIntArray; Value: Integer): Integer; overload;
  598. function Add(var StringArray: TStringArray; Value: string): Integer; overload;
  599. function IndexOf(const StringArray: TStringArray; Value: string): Integer;
  600. function Factorial(Value: Smallint): Int64;
  601.  
  602. implementation
  603.  
  604. function SubString(const S, Separator: string; Index: Integer): string;
  605. var
  606.   I, J: Integer;
  607. begin
  608.   Result := S;
  609.   for I := 0 to Index do begin
  610.     J := AnsiPos(Separator, Result);
  611.     if J > 0 then
  612.       if I < Index then System.Delete(Result, 1, J + Length(Separator) - 1)
  613.       else Result := Copy(Result, 1, J - 1)
  614.     else if I < Index then begin
  615.       Result := '';
  616.       Break;
  617.     end;
  618.   end;
  619. end;
  620.  
  621. procedure ExtractStrings(const S, Separator: string; var StringArray: TStringArray);
  622. var
  623.   I, J, K, L: Integer;
  624.   Separators: TStringArray;
  625.   SeparatorsData: TSeparatorsData;
  626.   Found: Boolean;
  627.   Value: string;
  628. begin
  629.   I := 0;
  630.   Value := SubString(Separator, ';', I);
  631.   while Value <> '' do begin
  632.     J := Length(Separators);
  633.     SetLength(Separators, J + 1);
  634.     Separators[J] := Value;
  635.     Inc(I);
  636.     Value := SubString(Separator, ';', I);
  637.   end;
  638.   try
  639.     if Separators = nil then Exit;
  640.     StringArray := nil;
  641.     I := 1;
  642.     Found := False;
  643.     while I <= Length(S) do begin
  644.       for J := Low(Separators) to High(Separators) do begin
  645.         K := Length(Separators[J]);
  646.         Found := CompareMem(@S[I], @Separators[J][1], K);
  647.         if Found then begin
  648.           L := Length(SeparatorsData);
  649.           SetLength(SeparatorsData, L + 1);
  650.           SeparatorsData[L].Index := I;
  651.           SeparatorsData[L].Length := K;
  652.           Inc(I, K);
  653.           Break;
  654.         end;
  655.       end;
  656.       if Found then Found := False else Inc(I);
  657.     end;
  658.     try
  659.       if Length(SeparatorsData) > 0 then
  660.         for I := Low(SeparatorsData) to Length(SeparatorsData) do begin
  661.           if I > Low(SeparatorsData) then begin
  662.             J := SeparatorsData[I - 1].Index;
  663.             if I < Length(SeparatorsData) then K := SeparatorsData[I].Index - J
  664.             else K := Length(S) - J + SeparatorsData[I - 1].Length;
  665.           end else begin
  666.             J := 1;
  667.             K := SeparatorsData[I].Index - 1;
  668.           end;
  669.           Value := Trim(Copy(S, J, K));
  670.           if Value <> '' then Add(StringArray, Value);
  671.         end else begin
  672.           Value := Trim(S);
  673.           if Value <> '' then Add(StringArray, Value);
  674.         end;
  675.     finally
  676.       SeparatorsData := nil;
  677.     end;
  678.   finally
  679.     Separators := nil;
  680.   end;
  681. end;
  682.  
  683. function ContainsValue(var S1: string; const S2: string;
  684.   DeleteValue: Boolean = True): Boolean;
  685. var
  686.   I: Integer;
  687. begin
  688.   I := Length(S2);
  689.   Result := (Length(S1) >= I) and CompareMem(Pointer(S1), Pointer(S2), I);
  690.   if Result and DeleteValue then begin
  691.     Delete(S1, 1, I);
  692.     S1 := TrimLeft(S1);
  693.   end;
  694. end;
  695.  
  696. procedure Del(var IntArray: TIntArray; Index: Integer);
  697. var
  698.   I, Size: Integer;
  699.   NewArray: TIntArray;
  700. begin
  701.   I := Length(IntArray);
  702.   if Index > High(IntArray) then Exit;
  703.   Dec(I);
  704.   SetLength(NewArray, I);
  705.   Size := SizeOf(IntArray[0]);
  706.   try
  707.     CopyMemory(NewArray, IntArray, Index * Size);
  708.     CopyMemory(Pointer(Integer(NewArray) + Index * Size),
  709.       Pointer(Integer(IntArray) + (Index + 1) * Size), (I - Index) * Size);
  710.     IntArray := nil;
  711.     IntArray := NewArray;
  712.   except
  713.     NewArray := nil;
  714.   end;
  715. end;
  716.  
  717. function Add(var IntArray: TIntArray; Value: Integer): Integer;
  718. begin
  719.   Result := Length(IntArray);
  720.   SetLength(IntArray, Result + 1);
  721.   IntArray[Result] := Value;
  722. end;
  723.  
  724. function Add(var StringArray: TStringArray; Value: string): Integer;
  725. begin
  726.   Result := Length(StringArray);
  727.   SetLength(StringArray, Result + 1);
  728.   StringArray[Result] := Value;
  729. end;
  730.  
  731. function IndexOf(const StringArray: TStringArray; Value: string): Integer;
  732. var
  733.   I: Integer;
  734. begin
  735.   for I := Low(StringArray) to High(StringArray) do
  736.     if StringArray[I] = Value then begin
  737.       Result := I;
  738.       Exit;
  739.     end;
  740.   Result := -1;
  741. end;
  742.  
  743. function Factorial(Value: Smallint): Int64;
  744. var
  745.   I: Integer;
  746. begin
  747.   Result := 1;
  748.   for I := 1 to Value do Result := Result * I;
  749. end;
  750.  
  751. { TAttrsManager }
  752.  
  753. class procedure TAttrsManager.About;
  754. begin
  755.   MessageBox(0, 'The TAttibutesEditor component is written by Pisarev ' +
  756.     'Yuriy. You can contact with me by address: yuriy_mbox@hotmail.com',
  757.     'About', mb_Ok);
  758. end;
  759.  
  760. procedure TAttrsManager.Add(Editor: TRichEdit);
  761. begin
  762.   if Editor = nil then Exit;
  763.   with Editor do begin
  764.     FDefaultColor := Font.Color;
  765.     FDefaultFontStyle := Font.Style;
  766.     Lines.Clear;
  767.     WantReturns := False;
  768.     WordWrap := False;
  769.     OnChange := EditorChange;
  770.     OnKeyPress := EditorKeyPress;
  771.   end;
  772. end;
  773.  
  774. constructor TAttrsManager.Create(Editor: TRichEdit);
  775. begin
  776.   Add(Editor);
  777.   FStrings := TStringList.Create;
  778. end;
  779.  
  780. destructor TAttrsManager.Destroy;
  781. begin
  782.   FShortStrings := nil;
  783.   FStrings.Free;
  784.   inherited;
  785. end;
  786.  
  787. procedure TAttrsManager.EditorChange(Sender: TObject);
  788. var
  789.   I, J, K, L, Index: Integer;
  790.   S1, S2, S3: string;
  791.   Attrs: TAttributes;
  792.   Editor: TRichEdit;
  793. begin
  794.   if not (Sender is TRichEdit) then Exit;
  795.   Editor := TRichEdit(Sender); 
  796.   Editor.OnChange := nil;
  797.   try
  798.     S2 := Editor.Text;
  799.     S1 := StringReplace(S2, #13#10, ' ', [rfReplaceAll]);
  800.     if S1 <> S2 then begin
  801.       LockWindowUpdate(Editor.Handle);
  802.       try
  803.         Editor.Text := S1;
  804.       finally
  805.         LockWindowUpdate(0);
  806.       end;
  807.     end;
  808.     for I := Low(FShortStrings) to High(FShortStrings) do begin
  809.       S2 := AnsiLowerCase(S1);
  810.       S3 := FShortStrings[I];
  811.       K := 0;
  812.       Index := AnsiPos(S3, S2);
  813.       while Index > 0 do begin
  814.         J := Length(S3);
  815.         Delete(S2, Index, J);
  816.         L := Length(Attrs);
  817.         SetLength(Attrs, L + 1);
  818.         Attrs[L].SelStart := K + Index - 1;
  819.         Attrs[L].SelLength := J;
  820.         Inc(K, J);
  821.         Index := AnsiPos(S3, S2);
  822.       end;
  823.       S2 := S1;
  824.     end;
  825.     try
  826.       LockWindowUpdate(Editor.Handle);
  827.       try
  828.         with Editor do begin
  829.           J := SelStart;
  830.           K := SelLength;
  831.           SelStart := 0;
  832.           SelLength := Length(S1);
  833.           with SelAttributes do begin
  834.             Style := FDefaultFontStyle;
  835.             Color := FDefaultColor;
  836.           end;
  837.           for I := Low(Attrs) to High(Attrs) do begin
  838.             SelStart := Attrs[I].SelStart;
  839.             SelLength := Attrs[I].SelLength;
  840.             with SelAttributes do begin
  841.               Style := FFontStyle;
  842.               Color := FColor;
  843.             end;
  844.           end;
  845.           SelStart := J;
  846.           SelLength := K;
  847.         end;
  848.       finally
  849.         LockWindowUpdate(0);
  850.       end;
  851.     finally
  852.       Attrs := nil;
  853.     end;
  854.   finally
  855.     Editor.OnChange := EditorChange;
  856.   end;
  857. end;
  858.  
  859. procedure TAttrsManager.EditorKeyPress(Sender: TObject; var Key: Char);
  860. begin
  861.   if not (Sender is TRichEdit) then Exit;
  862.   with TRichEdit(Sender).SelAttributes do begin
  863.     Color := FDefaultColor;
  864.     Style := FDefaultFontStyle;
  865.   end;
  866. end;
  867.  
  868. procedure TAttrsManager.SetStrings(const Value: TStrings);
  869. begin
  870.   FStrings.Assign(Value);
  871.   UpdateStrings;
  872. end;
  873.  
  874. procedure TAttrsManager.UpdateStrings;
  875. var
  876.   I, J: Integer;
  877. begin
  878.   SetLength(FShortStrings, FStrings.Count);
  879.   for I := 0 to FStrings.Count - 1 do begin
  880.     J := Length(FStrings[I]);
  881.     if J > 255 then J := 255;
  882.     SetLength(FShortStrings[I], J);
  883.     CopyMemory(@FShortStrings[I][1], @FStrings[I][1], J);
  884.   end;
  885. end;
  886.  
  887. { TDataEditor }
  888.  
  889. class procedure TDataEditor.About;
  890. begin
  891.   MessageBox(0, 'The TDataEditor component (that executes all operations ' +
  892.     'with numeric and logical formulas) is written by Pisarev Yuriy. You ' +
  893.     'can contact with me by address: yuriy_mbox@hotmail.com', 'About', mb_Ok);
  894. end;
  895.  
  896. function TDataEditor.GetAttrColor: TColor;
  897. begin
  898.   Result := FAttrsManager.Color;
  899. end;
  900.  
  901. function TDataEditor.GetAttrFontStyles: TFontStyles;
  902. begin
  903.   Result := FAttrsManager.FontStyle;
  904. end;
  905.  
  906. function TDataEditor.GetStrings: TStrings;
  907. begin
  908.   Result := FAttrsManager.Strings;
  909. end;
  910.  
  911. constructor TDataEditor.Create(AOwner: TComponent);
  912. begin
  913.   FAccuracy := -7;
  914.   FAttrsManager := TAttrsManager.Create(nil);
  915.   with FAttrsManager do begin
  916.     DefaultColor := clBlack;
  917.     DefaultFontStyle := [];
  918.     Color := clBlue;
  919.     FontStyle := [];
  920.     with Strings do begin
  921.       Add('sin');
  922.       Add('arcsin');
  923.       Add('sinh');
  924.       Add('arcsinh');
  925.       Add('cos');
  926.       Add('arccos');
  927.       Add('cosh');
  928.       Add('arccosh');
  929.       Add('tan');
  930.       Add('arctan');
  931.       Add('tanh');
  932.       Add('arctanh');
  933.       Add('cotan');
  934.       Add('arccotan');
  935.       Add('cotanh');
  936.       Add('arccotanh');
  937.       Add('sec');
  938.       Add('arcsec');
  939.       Add('sech');
  940.       Add('arcsech');
  941.       Add('csc');
  942.       Add('arccsc');
  943.       Add('csch');
  944.       Add('arccsch');
  945.       Add('sqrt');
  946.       Add('div');
  947.       Add('mod');
  948.       Add('int');
  949.       Add('frac');
  950.       Add('random');
  951.       Add('trunc');
  952.       Add('round');
  953.       Add('abs');
  954.       Add('log');
  955.       Add('ln');
  956.       Add('lg');
  957.       Add('pi');
  958.       Add('exp');
  959.       Add('byte');
  960.       Add('shortint');
  961.       Add('word');
  962.       Add('smallint');
  963.       Add('integer');
  964.       Add('int64');
  965.       Add('longword');
  966.       Add('single');
  967.       Add('double');
  968.     end;
  969.     UpdateStrings;
  970.   end;
  971.   FExceptionsType := [etZeroDivide];
  972.   Set8087CW(Default8087CW);
  973.   SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow,
  974.     exUnderflow, exPrecision]);
  975.   RegisterNumFunction(FNumReservedID, Reserved[1], False, False);
  976.   RegisterNumFunction(FMultiplyingID, '*', True, True);
  977.   RegisterNumFunction(FDivisionID, '/', True, True);
  978.   RegisterNumFunction(FSqrtID, 'sqrt', True, True);
  979.   RegisterNumFunction(FDivID, 'div', True, True);
  980.   RegisterNumFunction(FModID, 'mod', True, True);
  981.   RegisterNumFunction(FIntID, 'int', False, True);
  982.   RegisterNumFunction(FFracID, 'frac', False, True);
  983.   RegisterNumFunction(FRandomID, 'random', False, False);
  984.   RegisterNumFunction(FTruncID, 'trunc', False, True);
  985.   RegisterNumFunction(FRoundID, 'round', False, True);
  986.   RegisterNumFunction(FSinID, 'sin', False, True);
  987.   RegisterNumFunction(FSinHID, 'sinh', False, True);
  988.   RegisterNumFunction(FArcSinID, 'arcsin', False, True);
  989.   RegisterNumFunction(FArcSinHID, 'arcsinh', False, True);
  990.   RegisterNumFunction(FCosID, 'cos', False, True);
  991.   RegisterNumFunction(FCosHID, 'cosh', False, True);
  992.   RegisterNumFunction(FArcCosID, 'arccos', False, True);
  993.   RegisterNumFunction(FArcCosHID, 'arccosh', False, True);
  994.   RegisterNumFunction(FTanID, 'tan', False, True);
  995.   RegisterNumFunction(FTanHID, 'tanh', False, True);
  996.   RegisterNumFunction(FArcTanID, 'arctan', False, True);
  997.   RegisterNumFunction(FArcTanHID, 'arctanh', False, True);
  998.   RegisterNumFunction(FCoTanID, 'cotan', False, True);
  999.   RegisterNumFunction(FCoTanHID, 'cotanh', False, True);
  1000.   RegisterNumFunction(FArcCoTanID, 'arccotan', False, True);
  1001.   RegisterNumFunction(FArcCoTanHID, 'arccotanh', False, True);
  1002.   RegisterNumFunction(FSecID, 'sec', False, True);
  1003.   RegisterNumFunction(FArcSecID, 'arcsec', False, True);
  1004.   RegisterNumFunction(FSecHID, 'sech', False, True);
  1005.   RegisterNumFunction(FArcSecHID, 'arcsech', False, True);
  1006.   RegisterNumFunction(FCscID, 'csc', False, True);
  1007.   RegisterNumFunction(FCscHID, 'csch', False, True);
  1008.   RegisterNumFunction(FArcCscID, 'arccsc', False, True);
  1009.   RegisterNumFunction(FArcCscHID, 'arccsch', False, True);
  1010.   RegisterNumFunction(FAbsID, 'abs', False, True);
  1011.   RegisterNumFunction(FLnID, 'ln', False, True);
  1012.   RegisterNumFunction(FLgID, 'lg', False, True);
  1013.   RegisterNumFunction(FLogID, 'log', True, True);
  1014.   RegisterNumFunction(FPiID, 'pi', False, False);
  1015.   RegisterNumFunction(FExpID, 'exp', False, True);
  1016.   RegisterNumFunction(FFactorialID, '!', True, False);
  1017.   RegisterNumFunction(FDegreeID, '^', True, True);
  1018.   SortNumFunctionsData;
  1019.   RegisterBoolFunction(FBoolReservedID, Reserved[1], False, False);
  1020.   RegisterBoolFunction(FGreaterOrEqualID, '>=', True, True);
  1021.   RegisterBoolFunction(FLessOrEqualID, '<=', True, True);
  1022.   RegisterBoolFunction(FEqualID, '=', True, True);
  1023.   RegisterBoolFunction(FNotEqualID, '<>', True, True);
  1024.   RegisterBoolFunction(FGreaterID, '>', True, True);
  1025.   RegisterBoolFunction(FLessID, '<', True, True);
  1026.   RegisterBoolFunction(FTrueID, 'true', False, False);
  1027.   RegisterBoolFunction(FFalseID, 'false', False, False);
  1028.   RegisterBoolFunction(FOddID, 'odd', False, True);
  1029.   SortBoolFunctionsData;
  1030.   RegisterType(FByteID, 'byte');
  1031.   RegisterType(FShortintID, 'shortint');
  1032.   RegisterType(FWordID, 'word');
  1033.   RegisterType(FSmallintID, 'smallint');
  1034.   RegisterType(FIntegerID, 'integer');
  1035.   RegisterType(FInt64ID, 'int64');
  1036.   RegisterType(FLongwordID, 'longword');
  1037.   RegisterType(FSingleID, 'single');
  1038.   RegisterType(FDoubleID, 'double');
  1039.   SortTypesData;
  1040. end;
  1041.  
  1042. destructor TDataEditor.Destroy;
  1043. begin
  1044.   FAttrsManager.Free;
  1045.   FScript := nil;
  1046.   FNumFunctionsData := nil;
  1047.   FBoolFunctionsData := nil;
  1048.   FTypesData := nil;
  1049.   inherited;
  1050. end;
  1051.  
  1052. procedure TDataEditor.SortFunctionsData(var FunctionsData: TFunctionsData);
  1053. var
  1054.   I, J, K, Index: Integer;
  1055.   NewFunctionsData, TempFunctionsData: TFunctionsData;
  1056. begin
  1057.   while Length(FunctionsData) > 0 do begin
  1058.     K := 0;
  1059.     Index := 0;
  1060.     for I := Low(FunctionsData) to High(FunctionsData) do begin
  1061.       J := Length(FunctionsData[I].FunctionName);
  1062.       if K < J then begin
  1063.         K := J;
  1064.         Index := I;
  1065.       end;
  1066.     end;
  1067.     I := Length(NewFunctionsData);
  1068.     SetLength(NewFunctionsData, I + 1);
  1069.     NewFunctionsData[I] := FunctionsData[Index];
  1070.     PInteger(NewFunctionsData[I].P)^ := I;
  1071.     I := Length(FunctionsData);
  1072.     Dec(I);
  1073.     SetLength(TempFunctionsData, I);
  1074.     try
  1075.       CopyMemory(TempFunctionsData, FunctionsData, Index * FunctionDataSize);
  1076.       CopyMemory(Pointer(Integer(TempFunctionsData) + Index * FunctionDataSize),
  1077.         Pointer(Integer(FunctionsData) + (Index + 1) * FunctionDataSize),
  1078.         (I - Index) * FunctionDataSize);
  1079.       FunctionsData := nil;
  1080.       FunctionsData := TempFunctionsData;
  1081.     except
  1082.       TempFunctionsData := nil;
  1083.     end;
  1084.   end;
  1085.   FunctionsData := nil;
  1086.   FunctionsData := NewFunctionsData;
  1087. end;
  1088.  
  1089. function TDataEditor.BoolSeparator: string;
  1090. begin
  1091.   Result := Separator(FBoolFunctionsData);
  1092. end;
  1093.  
  1094. function TDataEditor.NumSeparator: string;
  1095. begin
  1096.   Result := Separator(FNumFunctionsData);
  1097. end;
  1098.  
  1099. function TDataEditor.FunctionIndex(const FunctionName: string;
  1100.   const FunctionsData: TFunctionsData): Integer;
  1101. var
  1102.   I: Integer;
  1103. begin
  1104.   for I := Low(FunctionsData) to High(FunctionsData) do
  1105.     if FunctionsData[I].FunctionName = FunctionName then begin
  1106.       Result := I;
  1107.       Exit;
  1108.     end;
  1109.   Result := -1;
  1110. end;
  1111.  
  1112. procedure TDataEditor.CopyScript(const Script: TScript);
  1113. var
  1114.   I: Integer;
  1115. begin
  1116.   I := Length(Script);
  1117.   SetLength(FScript, I);
  1118.   CopyMemory(FScript, Script, I);
  1119. end;
  1120.  
  1121. procedure TDataEditor.RegisterFunction(out FunctionID: Integer;
  1122.   const FunctionName: string; var FunctionsData: TFunctionsData;
  1123.   RequireValue1, RequireValue2: Boolean);
  1124. begin
  1125.   if FunctionIndex(FunctionName, FunctionsData) >= 0 then begin
  1126.     FunctionID := -1;
  1127.     Exit;
  1128.   end;
  1129.   FunctionID := Length(FunctionsData);
  1130.   SetLength(FunctionsData, FunctionID + 1);
  1131.   FunctionsData[FunctionID].P := @FunctionID;
  1132.   FunctionsData[FunctionID].FunctionName := FunctionName;
  1133.   FunctionsData[FunctionID].RequireValue1 := RequireValue1;
  1134.   FunctionsData[FunctionID].RequireValue2 := RequireValue2;
  1135. end;
  1136.  
  1137. function TDataEditor.UnRegisterFunction(FunctionID: Integer;
  1138.   var FunctionsData: TFunctionsData): Boolean;
  1139. var
  1140.   I, J: Integer;
  1141.   NewFunctionsData: TFunctionsData;
  1142. begin
  1143.   I := Length(FunctionsData);
  1144.   Result := FunctionID < I;
  1145.   if not Result then Exit;
  1146.   SetLength(NewFunctionsData, I - 1);
  1147.   try
  1148.     J := 0;
  1149.     for I := Low(FunctionsData) to High(FunctionsData) do
  1150.       if I = FunctionID then Inc(J)
  1151.     else NewFunctionsData[I - J] := FunctionsData[I];
  1152.     FunctionsData := nil;
  1153.     FunctionsData := NewFunctionsData;
  1154.   except
  1155.     NewFunctionsData := nil;
  1156.   end;
  1157. end;
  1158.  
  1159. procedure TDataEditor.RegisterNumFunction(out FunctionID: Integer;
  1160.   const FunctionName: string; RequireValue1, RequireValue2: Boolean);
  1161. begin
  1162.   RegisterFunction(FunctionID, FunctionName, FNumFunctionsData,
  1163.     RequireValue1, RequireValue2);
  1164. end;
  1165.  
  1166. function TDataEditor.UnRegisterNumFunction(
  1167.   const FunctionName: string): Boolean;
  1168. var
  1169.   FunctionID: Integer;
  1170. begin
  1171.   FunctionID := FunctionIndex(FunctionName, FNumFunctionsData);
  1172.   Result := FunctionID >= 0;
  1173.   if not Result then Exit;
  1174.   Result := UnRegisterNumFunction(FunctionID);
  1175. end;
  1176.  
  1177. function TDataEditor.UnRegisterNumFunction(FunctionID: Integer): Boolean;
  1178. begin
  1179.   Result := UnRegisterFunction(FunctionID, FNumFunctionsData);
  1180. end;
  1181.  
  1182. procedure TDataEditor.RegisterBoolFunction(out FunctionID: Integer;
  1183.   const FunctionName: string; RequireValue1, RequireValue2: Boolean);
  1184. begin
  1185.   RegisterFunction(FunctionID, FunctionName, FBoolFunctionsData,
  1186.     RequireValue1, RequireValue2);
  1187. end;
  1188.  
  1189. function TDataEditor.UnRegisterBoolFunction(const FunctionName: string): Boolean;
  1190. var
  1191.   FunctionID: Integer;
  1192. begin
  1193.   FunctionID := FunctionIndex(FunctionName, FBoolFunctionsData);
  1194.   Result := FunctionID >= 0;
  1195.   if not Result then Exit;
  1196.   Result := UnRegisterBoolFunction(FunctionID);
  1197. end;
  1198.  
  1199. function TDataEditor.UnRegisterBoolFunction(FunctionID: Integer): Boolean;
  1200. begin
  1201.   Result := UnRegisterFunction(FunctionID, FBoolFunctionsData);
  1202. end;
  1203.  
  1204. procedure TDataEditor.SortTypesData(var TypesData: TTypesData);
  1205. var
  1206.   I, J, K, Index: Integer;
  1207.   NewTypesData, TempTypesData: TTypesData;
  1208. begin
  1209.   while Length(TypesData) > 0 do begin
  1210.     K := 0;
  1211.     Index := 0;
  1212.     for I := Low(TypesData) to High(TypesData) do begin
  1213.       J := Length(TypesData[I].TypeName);
  1214.       if K < J then begin
  1215.         K := J;
  1216.         Index := I;
  1217.       end;
  1218.     end;
  1219.     I := Length(NewTypesData);
  1220.     SetLength(NewTypesData, I + 1);
  1221.     NewTypesData[I] := TypesData[Index];
  1222.     PInteger(NewTypesData[I].P)^ := I;
  1223.     I := Length(TypesData);
  1224.     Dec(I);
  1225.     SetLength(TempTypesData, I);
  1226.     try
  1227.       CopyMemory(TempTypesData, TypesData, Index * TypeDataSize);
  1228.       CopyMemory(Pointer(Integer(TempTypesData) + Index * TypeDataSize),
  1229.         Pointer(Integer(TypesData) + (Index + 1) * TypeDataSize),
  1230.         (I - Index) * TypeDataSize);
  1231.       TypesData := nil;
  1232.       TypesData := TempTypesData;
  1233.     except
  1234.       TempTypesData := nil;
  1235.     end;
  1236.   end;
  1237.   TypesData := nil;
  1238.   TypesData := NewTypesData;
  1239. end;
  1240.  
  1241. function TDataEditor.TypeIndex(const TypeName: string;
  1242.   const TypesData: TTypesData): Integer;
  1243. var
  1244.   I: Integer;
  1245. begin
  1246.   for I := Low(TypesData) to High(TypesData) do
  1247.     if TypesData[I].TypeName = TypeName then begin
  1248.       Result := I;
  1249.       Exit;
  1250.     end;
  1251.   Result := -1;
  1252. end;
  1253.  
  1254. procedure TDataEditor.RegisterType(out TypeID: Integer; const TypeName: string;
  1255.   var TypesData: TTypesData);
  1256. begin
  1257.   if TypeIndex(TypeName, TypesData) >= 0 then begin
  1258.     TypeID := -1;
  1259.     Exit;
  1260.   end;
  1261.   TypeID := Length(TypesData);
  1262.   SetLength(TypesData, TypeID + 1);
  1263.   TypesData[TypeID].P := @TypeID;
  1264.   TypesData[TypeID].TypeName := TypeName;
  1265. end;
  1266.  
  1267. function TDataEditor.UnRegisterType(const TypeID: Integer;
  1268.   var TypesData: TTypesData): Boolean;
  1269. var
  1270.   I, J: Integer;
  1271.   NewTypesData: TTypesData;
  1272. begin
  1273.   I := Length(TypesData);
  1274.   Result := FunctionID < I;
  1275.   if not Result then Exit;
  1276.   SetLength(NewTypesData, I - 1);
  1277.   try
  1278.     J := 0;
  1279.     for I := Low(TypesData) to High(TypesData) do
  1280.       if I = TypeID then Inc(J)
  1281.     else NewTypesData[I - J] := TypesData[I];
  1282.     TypesData := nil;
  1283.     TypesData := NewTypesData;
  1284.   except
  1285.     NewTypesData := nil;
  1286.   end;
  1287. end;
  1288.  
  1289. function TDataEditor.ValueType(var S: string; const TypesData: TTypesData): Integer;
  1290. var
  1291.   I: Integer;
  1292. begin
  1293.   for I := Low(TypesData) to High(TypesData) do
  1294.     if ContainsValue(S, TypesData[I].TypeName) then begin
  1295.       Result := I;
  1296.       Exit;
  1297.     end;
  1298.   Result := FByteID;
  1299. end;
  1300.  
  1301. procedure TDataEditor.RegisterType(out TypeID: Integer; const TypeName: string);
  1302. begin
  1303.   RegisterType(TypeID, TypeName, FTypesData);
  1304. end;
  1305.  
  1306. function TDataEditor.UnRegisterType(const TypeName: string): Boolean;
  1307. var
  1308.   TypeID: Integer;
  1309. begin
  1310.   TypeID := TypeIndex(TypeName, FTypesData);
  1311.   Result := TypeID >= 0;
  1312.   if not Result then Exit;
  1313.   Result := UnregisterType(TypeID, FTypesData);
  1314. end;
  1315.  
  1316. function TDataEditor.UnRegisterType(TypeID: Integer): Boolean;
  1317. begin
  1318.   Result := UnRegisterType(TypeID, FTypesData);
  1319. end;
  1320.  
  1321. procedure TDataEditor.SortBoolFunctionsData;
  1322. begin
  1323.   SortFunctionsData(FBoolFunctionsData);
  1324. end;
  1325.  
  1326. procedure TDataEditor.SortNumFunctionsData;
  1327. begin
  1328.   SortFunctionsData(FNumFunctionsData);
  1329. end;
  1330.  
  1331. procedure TDataEditor.SortTypesData;
  1332. begin
  1333.   SortTypesData(FTypesData);
  1334. end;
  1335.  
  1336. function TDataEditor.Separator(const FunctionsData: TFunctionsData): string;
  1337. var
  1338.   I: Integer;
  1339. begin
  1340.   for I := 0 to Length(FunctionsData) do if I > 0 then
  1341.     Result := Result + ';' + FunctionsData[I].FunctionName
  1342.   else Result := FunctionsData[I].FunctionName;
  1343. end;
  1344.  
  1345. procedure TDataEditor.StringToNumScript(const S: string; out Script: TScript;
  1346.   OpenedBracket, ClosedBracket: Char);
  1347. var
  1348.   S1, S2, Separator: string;
  1349.   I, J, K, L, Index, Value1, Value2, Value3: Integer;
  1350.   Data: Double;
  1351.   BracketData: TBracketData;
  1352.   ScriptArray: TScriptArray;
  1353.   StringArray1, StringArray2: TStringArray;
  1354.   FunctionData: TFunctionData;
  1355.   SyntaxData: TSyntaxData;
  1356. begin
  1357.   S1 := Trim(AnsiLowerCase(S));
  1358.   if Length(S1) = 0 then raise Exception.Create('Invalid numeric script format');
  1359.   for I := 1 to Length(Reserved) do if Pos(Reserved[I], S1) > 0 then
  1360.     raise Exception.Create(Format('"%s" contains inadmissible characters', [S]));
  1361.   SetLength(Script, 16);
  1362.   FillChar(BracketData, SizeOf(BracketData), 0);
  1363.   BracketData.OpenedBracketIndex := MaxIntegerValue;
  1364.   I := 1;
  1365.   J := Length(S1);
  1366.   while I <= J do with BracketData do begin
  1367.     if S1[I] = OpenedBracket then begin
  1368.       if OpenedBracketIndex > I then OpenedBracketIndex := I;
  1369.       Inc(OpenedBracketCount);
  1370.     end else if S1[I] = ClosedBracket then begin
  1371.       ClosedBracketIndex := I;
  1372.       Inc(ClosedBracketCount);
  1373.     end;
  1374.     if (OpenedBracketCount > 0) and (OpenedBracketCount = ClosedBracketCount) then
  1375.     begin
  1376.       Inc(PInteger(@Script[12])^);
  1377.       K := Length(ScriptArray);
  1378.       SetLength(ScriptArray, K + 1);
  1379.       StringToNumScript(Copy(S1, OpenedBracketIndex + 1, ClosedBracketIndex -
  1380.         OpenedBracketIndex - 1), ScriptArray[K], OpenedBracket, ClosedBracket);
  1381.       S2 := Format('%s%d%s', [Reserved[1], K, Reserved[3]]);
  1382.       Delete(S1, OpenedBracketIndex, ClosedBracketIndex - OpenedBracketIndex + 1);
  1383.       Insert(S2, S1, OpenedBracketIndex);
  1384.       FillChar(BracketData, SizeOf(BracketData), 0);
  1385.       OpenedBracketIndex := MaxIntegerValue;
  1386.       I := 1;
  1387.       J := Length(S1);
  1388.     end else Inc(I);
  1389.   end;
  1390.   try
  1391.     with BracketData do if OpenedBracketCount <> ClosedBracketCount then
  1392.       raise Exception.Create('Unfaithful brackets location');
  1393.     Separator := NumSeparator;
  1394.     SetLength(Script, Length(Script) + PInteger(@Script[12])^ * IntegerSize);
  1395.     PInteger(@Script[12])^ := 0;
  1396.     ExtractStrings(S1, '+;-', StringArray1);
  1397.     try
  1398.       for I := Low(StringArray1) to High(StringArray1) do begin
  1399.         Index := Length(Script);
  1400.         SetLength(Script, Index + 9);
  1401.         S2 := StringArray1[I];
  1402.         if S2[1] = '+' then begin
  1403.           Delete(S2, 1, 1);
  1404.           S2 := TrimLeft(S2);
  1405.         end;
  1406.         Script[Index + 4] := Ord(ContainsValue(S2, '-'));
  1407.         PInteger(@Script[Index + 5])^ := ValueType(S2);
  1408.         if S2 = '' then raise Exception.Create('Invalid numeric script format');
  1409.         ExtractStrings(S2, Separator, StringArray2);
  1410.         try
  1411.           with SyntaxData do begin
  1412.             OperatorType := otNone;
  1413.             FirstOperator := True;
  1414.           end;
  1415.           for J := Low(StringArray2) to High(StringArray2) do begin
  1416.             S2 := StringArray2[J];
  1417.             for L := Low(FNumFunctionsData) to High(FNumFunctionsData) do
  1418.               if ContainsValue(S2, FNumFunctionsData[L].FunctionName) then
  1419.                 if L = NumReservedID then begin
  1420.                   case SyntaxData.OperatorType of
  1421.                     otNumber, otScript:
  1422.                       raise Exception.Create('Function or expression expected');
  1423.                     otFunction: if not SyntaxData.FunctionData.RequireValue2 then
  1424.                       raise Exception.Create('Function or expression expected');
  1425.                   end;
  1426.                   SyntaxData.OperatorType := otScript;
  1427.                   Value1 := Pos(Reserved[3], S2);
  1428.                   Value2 := StrToInt(Copy(S2, 1, Value1 - 1));
  1429.                   Delete(S2, 1, Value1);
  1430.                   Value1 := Length(Script);
  1431.                   SetLength(Script, Value1 + SmallintSize);
  1432.                   PSmallint(@Script[Value1])^ := InternalScriptID;
  1433.                   Inc(PInteger(@Script[12])^);
  1434.                   Value1 := Length(Script);
  1435.                   PInteger(@Script[12 + PInteger(@Script[12])^ * IntegerSize])^ := Value1;
  1436.                   Value3 := Length(ScriptArray[Value2]);
  1437.                   SetLength(Script, Value1 + Value3);
  1438.                   CopyMemory(Pointer(Integer(Script) + Value1),
  1439.                     ScriptArray[Value2], Value3);
  1440.                 end else begin
  1441.                   FunctionData := FNumFunctionsData[L];
  1442.                   case SyntaxData.OperatorType of
  1443.                     otNumber, otScript: if not FunctionData.RequireValue1 then
  1444.                       raise Exception.Create('Function or expression expected');
  1445.                     otFunction: if (FunctionData.RequireValue1 and
  1446.                       SyntaxData.FunctionData.RequireValue2) or
  1447.                         (not FunctionData.RequireValue1 and
  1448.                         not SyntaxData.FunctionData.RequireValue2) then raise
  1449.                           Exception.Create('Function or expression expected');
  1450.                     otNone: if FunctionData.RequireValue1 then
  1451.                       raise Exception.Create('Function or expression expected');
  1452.                   end;
  1453.                   SyntaxData.OperatorType := otFunction;
  1454.                   SyntaxData.FunctionData := FunctionData;
  1455.                   Value1 := Length(Script);
  1456.                   SetLength(Script, Value1 + SmallintSize);
  1457.                   PSmallint(@Script[Value1])^ := FunctionID;
  1458.                   Value1 := Length(Script);
  1459.                   SetLength(Script, Value1 + IntegerSize);
  1460.                   PInteger(@Script[Value1])^ := L;
  1461.                 end;
  1462.             if CheckFloatValue(S2, Data) then begin
  1463.               with SyntaxData do if (OperatorType = otFunction) and not
  1464.                 FunctionData.RequireValue2 then raise Exception.Create(
  1465.                   'Function or expression expected');
  1466.               SyntaxData.OperatorType := otNumber;
  1467.               S2 := '';
  1468.               Value1 := Length(Script);
  1469.               SetLength(Script, Value1 + SmallintSize);
  1470.               PSmallint(@Script[Value1])^ := NumberID;
  1471.               Value1 := Length(Script);
  1472.               SetLength(Script, Value1 + DoubleSize);
  1473.               PDouble(@Script[Value1])^ := Data;
  1474.             end;
  1475.             if S2 <> '' then raise Exception.Create('Undeclared identifier: ' + S2);
  1476.           end;
  1477.           with SyntaxData do if (OperatorType = otFunction) and
  1478.             FunctionData.RequireValue2 then raise Exception.Create(
  1479.               'Function or expression expected')
  1480.         finally
  1481.           StringArray2 := nil;
  1482.         end;
  1483.         PInteger(@Script[Index])^ := Length(Script) - Index;
  1484.       end;
  1485.     finally
  1486.       StringArray1 := nil;
  1487.     end;
  1488.     PInteger(@Script[8])^ := Length(Script);
  1489.   finally
  1490.     for I := Low(ScriptArray) to High(ScriptArray) do ScriptArray[I] := nil;
  1491.     ScriptArray := nil;
  1492.   end;
  1493. end;
  1494.  
  1495. procedure TDataEditor.StringToNumScript(const S: string; OpenedBracket,
  1496.   ClosedBracket: Char);
  1497. begin
  1498.   StringToNumScript(S, FScript, OpenedBracket, ClosedBracket);
  1499. end;
  1500.  
  1501. procedure TDataEditor.StringToNumScript(OpenedBracket,
  1502.   ClosedBracket: Char);
  1503. begin
  1504.   StringToNumScript(FText, FScript, OpenedBracket, ClosedBracket);
  1505. end;
  1506.  
  1507. procedure TDataEditor.StringToBoolScript(const S: string;
  1508.   out Script: TScript; OpenedBracket, ClosedBracket: Char);
  1509. var
  1510.   S1, S2, Separator: string;
  1511.   I, J, K, L, Index, Value1, Value2, Value3: Integer;
  1512.   Data: Double;
  1513.   BracketData: TBracketData;
  1514.   ScriptArray: TScriptArray;
  1515.   StringArray1, StringArray2: TStringArray;
  1516.   FunctionData: TFunctionData;
  1517.   SyntaxData: TSyntaxData;
  1518. begin
  1519.   S1 := Trim(AnsiLowerCase(S));
  1520.   if not CheckBoolValue(S1) then raise Exception.Create('Invalid boolean script format');
  1521.   Delete(S1, 1, BoolStringLength);
  1522.   for I := 1 to Length(Reserved) do if Pos(Reserved[I], S1) > 0 then
  1523.     raise Exception.Create(Format('"%s" contains inadmissible characters', [S]));
  1524.   SetLength(Script, 9);
  1525.   FillChar(BracketData, SizeOf(BracketData), 0);
  1526.   BracketData.OpenedBracketIndex := MaxIntegerValue;
  1527.   I := 1;
  1528.   J := Length(S1);
  1529.   while I <= J do with BracketData do begin
  1530.     if S1[I] = OpenedBracket then begin
  1531.       if OpenedBracketIndex > I then OpenedBracketIndex := I;
  1532.       Inc(OpenedBracketCount);
  1533.     end else if S1[I] = ClosedBracket then begin
  1534.       ClosedBracketIndex := I;
  1535.       Inc(ClosedBracketCount);
  1536.     end;
  1537.     if (OpenedBracketCount > 0) and (OpenedBracketCount = ClosedBracketCount) then
  1538.     begin
  1539.       Inc(PInteger(@Script[5])^);
  1540.       K := Length(ScriptArray);
  1541.       SetLength(ScriptArray, K + 1);
  1542.       S2 := Copy(S1, OpenedBracketIndex + 1, ClosedBracketIndex -
  1543.         OpenedBracketIndex - 1);
  1544.       if CheckBoolValue(S2) then begin
  1545.         L := BoolScriptID;
  1546.         StringToBoolScript(S2, ScriptArray[K], OpenedBracket, ClosedBracket);
  1547.       end else begin
  1548.         L := NumScriptID;
  1549.         StringToNumScript(S2, ScriptArray[K], OpenedBracket, ClosedBracket);
  1550.       end;
  1551.       S2 := Format('%s%d%s%d%s', [Reserved[1], L, Reserved[2], K, Reserved[3]]);
  1552.       Delete(S1, OpenedBracketIndex, ClosedBracketIndex - OpenedBracketIndex + 1);
  1553.       Insert(S2, S1, OpenedBracketIndex);
  1554.       FillChar(BracketData, SizeOf(BracketData), 0);
  1555.       OpenedBracketIndex := MaxIntegerValue;
  1556.       I := 1;
  1557.       J := Length(S1);
  1558.     end else Inc(I);
  1559.   end;
  1560.   try
  1561.     with BracketData do if OpenedBracketCount <> ClosedBracketCount then
  1562.       raise Exception.Create('Unfaithful brackets location');
  1563.     Separator := BoolSeparator;
  1564.     SetLength(Script, Length(Script) + PInteger(@Script[5])^ * IntegerSize);
  1565.     PInteger(@Script[5])^ := 0;
  1566.     ExtractStrings(S1, ' and ; xor ; or ', StringArray1);
  1567.     try
  1568.       for I := Low(StringArray1) to High(StringArray1) do begin
  1569.         Index := Length(Script);
  1570.         SetLength(Script, Index + 9);
  1571.         S2 := StringArray1[I];
  1572.         if ContainsValue(S2, 'not', False) then
  1573.           if NegativeValue(S2, 'not') then Script[Index + 4] := NegationID
  1574.           else Script[Index + 4] := NeutralityID
  1575.         else if ContainsValue(S2, 'and') then Script[Index + 4] := ConjunctionID
  1576.         else if ContainsValue(S2, 'xor') then Script[Index + 4] := ExclusiveDisjunctionID
  1577.         else if ContainsValue(S2, 'or') then Script[Index + 4] := DisjunctionID
  1578.         else Script[Index + 4] := NeutralityID;
  1579.         PInteger(@Script[Index + 5])^ := ValueType(S2);
  1580.         if S2 = '' then raise Exception.Create('Invalid boolean script format');
  1581.         ExtractStrings(S2, Separator, StringArray2);
  1582.         try
  1583.           with SyntaxData do begin
  1584.             OperatorType := otNone;
  1585.             FirstOperator := True;
  1586.           end;
  1587.           for J := Low(StringArray2) to High(StringArray2) do begin
  1588.             S2 := StringArray2[J];
  1589.             for L := Low(FBoolFunctionsData) to High(FBoolFunctionsData) do
  1590.               if ContainsValue(S2, FBoolFunctionsData[L].FunctionName) then
  1591.                 if L = BoolReservedID then begin
  1592.                   case SyntaxData.OperatorType of
  1593.                     otNumber, otScript:
  1594.                       raise Exception.Create('Function or expression expected');
  1595.                     otFunction: if not SyntaxData.FunctionData.RequireValue2 then
  1596.                       raise Exception.Create('Function or expression expected');
  1597.                   end;
  1598.                   SyntaxData.OperatorType := otScript;
  1599.                   Value1 := Pos(Reserved[2], S2);
  1600.                   Value2 := StrToInt(Copy(S2, 1, Value1 - 1));
  1601.                   Delete(S2, 1, Value1);
  1602.                   Value1 := Pos(Reserved[3], S2);
  1603.                   Value3 := StrToInt(Copy(S2, 1, Value1 - 1));
  1604.                   Delete(S2, 1, Value1);
  1605.                   Value1 := Length(Script);
  1606.                   SetLength(Script, Value1 + SmallintSize);
  1607.                   PSmallint(@Script[Value1])^ := InternalScriptID;
  1608.                   Inc(PInteger(@Script[5])^);
  1609.                   Value1 := Length(Script);
  1610.                   PInteger(@Script[5 + PInteger(@Script[5])^ * IntegerSize])^ := Value1;
  1611.                   Value1 := Length(Script);
  1612.                   SetLength(Script, Value1 + 1);
  1613.                   Script[Value1] := Value2;
  1614.                   Value1 := Length(Script);
  1615.                   Value2 := Length(ScriptArray[Value3]);
  1616.                   SetLength(Script, Value1 + Value2);
  1617.                   CopyMemory(Pointer(Integer(Script) + Value1),
  1618.                     ScriptArray[Value3], Value2);
  1619.                 end else begin
  1620.                   FunctionData := FBoolFunctionsData[L];
  1621.                   case SyntaxData.OperatorType of
  1622.                     otNumber, otScript: if not FunctionData.RequireValue1 then
  1623.                       raise Exception.Create('Function or expression expected');
  1624.                     otFunction: if (FunctionData.RequireValue1 and
  1625.                       SyntaxData.FunctionData.RequireValue2) or
  1626.                         (not FunctionData.RequireValue1 and
  1627.                         not SyntaxData.FunctionData.RequireValue2) then raise
  1628.                           Exception.Create('Function or expression expected');
  1629.                     otNone: if FunctionData.RequireValue1 then
  1630.                       raise Exception.Create('Function or expression expected');
  1631.                   end;
  1632.                   SyntaxData.OperatorType := otFunction;
  1633.                   SyntaxData.FunctionData := FunctionData;
  1634.                   Value1 := Length(Script);
  1635.                   SetLength(Script, Value1 + SmallintSize);
  1636.                   PSmallint(@Script[Value1])^ := FunctionID;
  1637.                   Value1 := Length(Script);
  1638.                   SetLength(Script, Value1 + IntegerSize);
  1639.                   PInteger(@Script[Value1])^ := L;
  1640.                 end;
  1641.             if CheckFloatValue(S2, Data) then begin
  1642.               with SyntaxData do if (OperatorType = otFunction) and not
  1643.                 FunctionData.RequireValue2 then raise Exception.Create(
  1644.                   'Function or expression expected');
  1645.               SyntaxData.OperatorType := otNumber;
  1646.               S2 := '';
  1647.               Value1 := Length(Script);
  1648.               SetLength(Script, Value1 + SmallintSize);
  1649.               PSmallint(@Script[Value1])^ := NumberID;
  1650.               Value1 := Length(Script);
  1651.               SetLength(Script, Value1 + DoubleSize);
  1652.               PDouble(@Script[Value1])^ := Data;
  1653.             end;
  1654.             if S2 <> '' then raise Exception.Create(
  1655.               Format('Undeclared identifier: %s', [S2]));
  1656.           end;
  1657.         finally
  1658.           StringArray2 := nil;
  1659.         end;
  1660.         PInteger(@Script[Index])^ := Length(Script) - Index;
  1661.       end;
  1662.     finally
  1663.       StringArray1 := nil;
  1664.     end;
  1665.     PInteger(@Script[1])^ := Length(Script);
  1666.   finally
  1667.     for I := Low(ScriptArray) to High(ScriptArray) do ScriptArray[I] := nil;
  1668.     ScriptArray := nil;
  1669.   end;
  1670. end;
  1671.  
  1672. procedure TDataEditor.StringToBoolScript(const S: string; OpenedBracket,
  1673.   ClosedBracket: Char);
  1674. begin
  1675.   StringToBoolScript(S, FScript, OpenedBracket, ClosedBracket);
  1676. end;
  1677.  
  1678. procedure TDataEditor.StringToBoolScript(OpenedBracket,
  1679.   ClosedBracket: Char);
  1680. begin
  1681.   StringToBoolScript(FText, FScript, OpenedBracket, ClosedBracket);
  1682. end;
  1683.  
  1684. procedure TDataEditor.OptimizeNumScript(Index: Integer);
  1685. begin
  1686. //
  1687. end;
  1688.  
  1689. function TDataEditor.DefaultNumFunction(FunctionID: Integer;
  1690.   var Value1: Double; Value2, Value3: Double): Boolean;
  1691. begin
  1692.   if FunctionID = FMultiplyingID then Value1 := Value2 * Value3
  1693.   else if FunctionID = FDivisionID then if etZeroDivide in FExceptionsType then
  1694.     if Value3 = 0 then Value1 := MaxDouble
  1695.     else Value1 := Value2 / Value3
  1696.   else Value1 := Value2 / Value3
  1697.   else if FunctionID = FSqrtID then if etZeroDivide in FExceptionsType then
  1698.     if Value3 = 0 then Value1 := 0
  1699.     else Value1 := Power(Value3, 1 / Value2)
  1700.   else Value1 := Power(Value3, 1 / Value2)
  1701.   else if FunctionID = FDivID then if etZeroDivide in FExceptionsType then
  1702.     if Round(Value3) = 0 then Value1 := MaxDouble
  1703.     else Value1 := Round(Value2) div Round(Value3)
  1704.   else Value1 := Round(Value2) div Round(Value3)
  1705.   else if FunctionID = FModID then if etZeroDivide in FExceptionsType then
  1706.     if Round(Value3) = 0 then Value1 := MaxDouble
  1707.     else Value1 := Round(Value2) mod Round(Value3)
  1708.   else Value1 := Round(Value2) mod Round(Value3)
  1709.   else if FunctionID = FIntID then Value1 := Int(Value3)
  1710.   else if FunctionID = FFracID then Value1 := Frac(Value3)
  1711.   else if FunctionID = FRandomID then Value1 := Random
  1712.   else if FunctionID = FTruncID then Value1 := Trunc(Value3)
  1713.   else if FunctionID = FRoundID then Value1 := Round(Value3)
  1714.   else if FunctionID = FSinID then Value1 := Sin(Value3)
  1715.   else if FunctionID = FArcSinID then if etZeroDivide in FExceptionsType then
  1716.     if (Value3 < -1) or (Value3 > 1) then Value1 := MaxDouble
  1717.     else Value1 := ArcSin(Value3)
  1718.   else Value1 := ArcSin(Value3)
  1719.   else if FunctionID = FSinHID then Value1 := SinH(Value3)
  1720.   else if FunctionID = FArcSinHID then Value1 := ArcSinH(Value3)
  1721.   else if FunctionID = FCosID then Value1 := Cos(Value3)
  1722.   else if FunctionID = FArcCosID then if etZeroDivide in FExceptionsType then
  1723.     if (Value3 < -1) or (Value3 > 1) then Value1 := MaxDouble
  1724.     else Value1 := ArcCos(Value3)
  1725.   else Value1 := ArcCos(Value3)
  1726.   else if FunctionID = FCosHID then Value1 := CosH(Value3)
  1727.   else if FunctionID = FArcCosHID then if etZeroDivide in FExceptionsType then
  1728.     if Value3 < 1 then Value1 := MaxDouble
  1729.     else Value1 := ArcCosH(Value3)
  1730.   else Value1 := ArcCosH(Value3)
  1731.   else if FunctionID = FTanID then if etZeroDivide in FExceptionsType then
  1732.     if Cos(Value3) = 0 then Value1 := MaxDouble
  1733.     else Value1 := Tan(Value3)
  1734.   else Value1 := Tan(Value3)
  1735.   else if FunctionID = FArcTanID then Value1 := ArcTan(Value3)
  1736.   else if FunctionID = FTanHID then Value1 := TanH(Value3)
  1737.   else if FunctionID = FArcTanHID then if etZeroDivide in FExceptionsType then
  1738.     if (Value3 < -1) or (Value3 > 1) then Value1 := MaxDouble
  1739.     else Value1 := ArcTanH(Value3)
  1740.   else Value1 := ArcTanH(Value3)
  1741.   else if FunctionID = FCoTanID then if etZeroDivide in FExceptionsType then
  1742.     if Sin(Value3) = 0 then Value1 := MaxDouble
  1743.     else Value1 := CoTan(Value3)
  1744.   else Value1 := CoTan(Value3)
  1745.   else if FunctionID = FArcCoTanID then Value1 := ArcCot(Value3)
  1746.   else if FunctionID = FCoTanHID then Value1 := CotH(Value3)
  1747.   else if FunctionID = FArcCoTanHID then Value1 := ArcCotH(Value3)
  1748.   else if FunctionID = FSecID then if etZeroDivide in FExceptionsType then
  1749.     if Cos(Value3) = 0 then Value1 := MaxDouble
  1750.     else Value1 := Sec(Value3)
  1751.   else Value1 := Sec(Value3)
  1752.   else if FunctionID = FArcSecID then Value1 := ArcSec(Value3)
  1753.   else if FunctionID = FSecHID then Value1 := SecH(Value3)
  1754.   else if FunctionID = FArcSecHID then Value1 := ArcSecH(Value3)
  1755.   else if FunctionID = FCscID then if etZeroDivide in FExceptionsType then
  1756.     if Sin(Value3) = 0 then Value1 := MaxDouble
  1757.     else Value1 := Csc(Value3)
  1758.   else Value1 := Csc(Value3)  
  1759.   else if FunctionID = FArcCscID then Value1 := ArcCsc(Value3)
  1760.   else if FunctionID = FCscHID then if etZeroDivide in FExceptionsType then
  1761.     if Value3 = 0 then Value1 := MaxDouble
  1762.     else Value1 := CscH(Value3)
  1763.   else Value1 := CscH(Value3)
  1764.   else if FunctionID = FArcCscHID then Value1 := ArcCscH(Value3)
  1765.   else if FunctionID = FAbsID then Value1 := Abs(Value3)
  1766.   else if FunctionID = FLnID then Value1 := Ln(Value3)
  1767.   else if FunctionID = FLgID then Value1 := Log10(Value3)
  1768.   else if FunctionID = FLogID then Value1 := LogN(Value2, Value3)
  1769.   else if FunctionID = FPiID then Value1 := Pi
  1770.   else if FunctionID = FExpID then Value1 := Exp(Value3)
  1771.   else if FunctionID = FFactorialID then Value1 := Factorial(Round(Value2))
  1772.   else if FunctionID = FDegreeID then Value1 := Power(Value2, Value3)
  1773.   else begin
  1774.     Result := False;
  1775.     Exit;
  1776.   end;
  1777.   Result := True;
  1778. end;
  1779.  
  1780. function TDataEditor.ExecuteNumFunction(var Index: Integer; TypeID: Integer;
  1781.   Value: Double): Double;
  1782. var
  1783.   I: Integer;
  1784.   Continue: Boolean;
  1785. begin
  1786.   I := PInteger(Index + Msc11)^;
  1787.   Inc(Index, Msc12);
  1788.   if FNumFunctionsData[I].RequireValue2 then
  1789.     case PSmallint(Index)^ of
  1790.       NumberID: begin
  1791.         Result := PDouble(Index + Msc9)^;
  1792.         Inc(Index, Msc10);
  1793.       end;
  1794.       FunctionID: Result := ExecuteNumFunction(Index, TypeID, Value);
  1795.       InternalScriptID: begin
  1796.         Result := PDouble(Index + Msc13)^;
  1797.         Inc(Index, Msc13 + PInteger(Index + Msc14)^);
  1798.       end;
  1799.       else raise Exception.Create('Undeclared identifier');
  1800.     end;
  1801.   if Assigned(FOnNumFunction) then
  1802.     Continue := FOnNumFunction(I, TypeID, Result, Value, Result)
  1803.   else Continue := True;
  1804.   if Continue and not DefaultNumFunction(I, Result, Value, Result) then
  1805.     raise Exception.Create('Undeclared function');
  1806. end;
  1807.  
  1808. function TDataEditor.ExecuteNumScript(Index: Integer): Double;
  1809. var
  1810.   I, J, K, L, TypeID: Integer;
  1811.   Value: Double;
  1812.   Negative: Boolean;
  1813. begin
  1814.   J := PInteger(Index + Msc3)^;
  1815.   if J > 0 then begin
  1816.     I := Index + Msc4;
  1817.     K := Index + Msc4 + J * IntegerSize;
  1818.     while I < K do begin
  1819.       L := Index + PInteger(I)^;
  1820.       PDouble(L)^ := ExecuteNumScript(L);
  1821.       Inc(I, IntegerSize);
  1822.     end;
  1823.   end;
  1824.   I := PInteger(Index + Msc2)^;
  1825.   K := Index;
  1826.   Inc(Index, Msc4 + J * IntegerSize);
  1827.   Result := 0;
  1828.   while Index - K < I do begin
  1829.     Negative := PBoolean(Index + Msc6)^;
  1830.     TypeID := PInteger(Index + Msc7)^;
  1831.     J := PInteger(Index)^;
  1832.     L := Index;
  1833.     Inc(Index, Msc8);
  1834.     Value := 0;
  1835.     while Index - L < J do case PSmallint(Index)^ of
  1836.       NumberID: begin
  1837.         Value := PDouble(Index + Msc9)^;
  1838.         Inc(Index, Msc10);
  1839.       end;
  1840.       FunctionID: Value := ExecuteNumFunction(Index, TypeID, Value);
  1841.       InternalScriptID: begin
  1842.         Value := PDouble(Index + Msc13)^;
  1843.         Inc(Index, Msc13 + PInteger(Index + Msc14)^);
  1844.       end;
  1845.       else raise Exception.Create('Undeclared identifier');
  1846.     end;
  1847.     if Negative then Result := Result - Value else Result := Result + Value;
  1848.   end;
  1849. end;
  1850.  
  1851. function TDataEditor.ExecuteNumScript(P: Pointer): Double;
  1852. begin
  1853.   Result := ExecuteNumScript(Integer(P));
  1854. end;
  1855.  
  1856. function TDataEditor.ExecuteNum: Double;
  1857. begin
  1858.   Result := ExecuteNumScript(@FScript[0]);
  1859. end;
  1860.  
  1861. procedure TDataEditor.OptimizeBoolScript(Index: Integer);
  1862. begin
  1863. //
  1864. end;
  1865.  
  1866. function TDataEditor.DefaultBoolFunction(FunctionID: Integer;
  1867.   var Value1: Boolean; Value2, Value3: Double): Boolean;
  1868. begin
  1869.   Value2 := RoundTo(Value2, FAccuracy);
  1870.   Value3 := RoundTo(Value3, FAccuracy);
  1871.   if FunctionID = FGreaterOrEqualID then Value1 := Value2 >= Value3
  1872.   else if FunctionID = FLessOrEqualID then Value1 := Value2 <= Value3
  1873.   else if FunctionID = FNotEqualID then Value1 := Value2 <> Value3
  1874.   else if FunctionID = FEqualID then Value1 := Value2 = Value3
  1875.   else if FunctionID = FGreaterID then Value1 := Value2 > Value3
  1876.   else if FunctionID = FLessID then Value1 := Value2 < Value3
  1877.   else if FunctionID = FTrueID then Value1 := True
  1878.   else if FunctionID = FFalseID then Value1 := False
  1879.   else if FunctionID = FOddID then Value1 := Odd(Trunc(Value3))
  1880.   else begin
  1881.     Result := False;
  1882.     Exit;
  1883.   end;
  1884.   Result := True;
  1885. end;
  1886.  
  1887. function TDataEditor.ExecuteBoolFunction(var Index: Integer;
  1888.   TypeID: Integer; var Value: Double): Boolean;
  1889. var
  1890.   I: Integer;
  1891.   Data: Double;
  1892.   Continue: Boolean;
  1893. begin
  1894.   I := PInteger(Index + Lsc11)^;
  1895.   Inc(Index, Lsc12);
  1896.   Data := 0;
  1897.   if FBoolFunctionsData[I].RequireValue2 then case PSmallint(Index)^ of
  1898.     NumberID: begin
  1899.       Data := PDouble(Index + Lsc9)^;
  1900.       Inc(Index, Lsc10);
  1901.     end;
  1902.     FunctionID: raise Exception.Create('Number or expression expected');
  1903.     InternalScriptID: begin
  1904.       case PByte(Index + Lsc13)^ of
  1905.         NumScriptID: begin
  1906.           Data := PDouble(Index + Lsc15)^;
  1907.           Inc(Index, Lsc15 + PInteger(Index + Lsc17)^);
  1908.         end;
  1909.         BoolScriptID: begin
  1910.           Data := PByte(Index + Lsc15)^;
  1911.           Inc(Index, Lsc15 + PInteger(Index + Lsc16)^);
  1912.         end;
  1913.       else raise Exception.Create('Undeclared script identifier');
  1914.       end;
  1915.     end;
  1916.   else raise Exception.Create('Undeclared identifier');
  1917.   end;
  1918.   if Assigned(FOnBoolFunction) then
  1919.     Continue := FOnBoolFunction(I, TypeID, Result, Value, Data)
  1920.   else Continue := True;
  1921.   if Continue and not DefaultBoolFunction(I, Result, Value, Data) then
  1922.     raise Exception.Create('Undeclared function');
  1923. end;
  1924.  
  1925. function TDataEditor.ExecuteBoolScript(Index: Integer): Boolean;
  1926. var
  1927.   I, J, K, L, M, TypeID, UnitID: Integer;
  1928.   Data: Double;
  1929.   Value, FirstUnit, Negative: Boolean;
  1930. begin
  1931.   J := PInteger(Index + Lsc3)^;
  1932.   if J > 0 then begin
  1933.     I := Index + Lsc4;
  1934.     K := Index + Lsc4 + J * IntegerSize;
  1935.     while I < K do begin
  1936.       L := Index + PInteger(I)^;
  1937.       M := L + Lsc14;
  1938.       if PByte(L)^ = NumScriptID then PDouble(M)^ := ExecuteNumScript(M)
  1939.       else if PByte(L)^ = BoolScriptID then PBoolean(M)^ := ExecuteBoolScript(M)
  1940.       else raise Exception.Create('Undeclared script identifier');
  1941.       Inc(I, IntegerSize);
  1942.     end;
  1943.   end;
  1944.   I := PInteger(Index + Lsc2)^;
  1945.   K := Index;
  1946.   Inc(Index, Lsc4 + J * IntegerSize);
  1947.   Result := False;
  1948.   FirstUnit := True;
  1949.   while Index - K < I do begin
  1950.     UnitID := PByte(Index + Lsc6)^;
  1951.     Negative := UnitID = NegationID;
  1952.     TypeID := PInteger(Index + Lsc7)^;
  1953.     J := PInteger(Index)^;
  1954.     L := Index;
  1955.     Inc(Index, Lsc8);
  1956.     Data := 0;
  1957.     Value := False;
  1958.     while Index - L < J do case PSmallint(Index)^ of
  1959.       NumberID: begin
  1960.         Data := PDouble(Index + Lsc9)^;
  1961.         Inc(Index, Lsc10);
  1962.       end;
  1963.       FunctionID: Value := ExecuteBoolFunction(Index, TypeID, Data);
  1964.       InternalScriptID: begin
  1965.         case PByte(Index + Lsc13)^ of
  1966.           NumScriptID: begin
  1967.             Data := PDouble(Index + Lsc15)^;
  1968.             Inc(Index, Lsc15 + PInteger(Index + Lsc17)^);
  1969.           end;
  1970.           BoolScriptID: begin
  1971.             Value := PBoolean(Index + Lsc15)^;
  1972.             Data := PByte(Index + Lsc15)^;
  1973.             Inc(Index, Lsc15 + PInteger(Index + Lsc16)^);
  1974.           end;
  1975.         else raise Exception.Create('Undeclared script identifier');
  1976.         end;
  1977.       end;
  1978.       else raise Exception.Create('Undeclared identifier');
  1979.     end;
  1980.     if Negative then Value := not Value;
  1981.     if FirstUnit then Result := Value
  1982.     else case UnitID of
  1983.       ConjunctionID: Result := Result and Value;
  1984.       DisjunctionID: Result := Result or Value;
  1985.       ExclusiveDisjunctionID: Result := Result xor Value;
  1986.     else raise Exception.Create('Invalid boolean script format');
  1987.     end;
  1988.     FirstUnit := False;
  1989.   end;
  1990. end;
  1991.  
  1992. function TDataEditor.ExecuteBoolScript(P: Pointer): Boolean;
  1993. begin
  1994.   Result := ExecuteBoolScript(Integer(P));
  1995. end;
  1996.  
  1997. function TDataEditor.ExecuteBool: Boolean;
  1998. begin
  1999.   Result := ExecuteBoolScript(@FScript[0]);
  2000. end;
  2001.  
  2002. function TDataEditor.CheckIntValue(const S: string; out Value: Integer): Boolean;
  2003. var
  2004.   I: Integer;
  2005. begin
  2006.   Result := (S <> '') and (S[1] in ['0'..'9', '-']);
  2007.   if not Result then Exit;
  2008.   if Length(S) > 1 then for I := 2 to Length(S) do
  2009.     if not (S[I] in ['0'..'9', DecimalSeparator]) then begin
  2010.       Result := False;
  2011.       Exit;
  2012.     end;
  2013.   Value := StrToInt64(S);
  2014. end;
  2015.  
  2016. function TDataEditor.CheckFloatValue(const S: string): Boolean;
  2017. var
  2018.   I: Integer;
  2019. begin
  2020.   Result := (S <> '') and (S[1] in ['0'..'9', DecimalSeparator, '-']);
  2021.   if not Result then Exit;
  2022.   if Length(S) > 1 then for I := 2 to Length(S) do
  2023.     if not (S[I] in ['0'..'9', DecimalSeparator]) then begin
  2024.       Result := False;
  2025.       Exit;
  2026.     end;
  2027. end;
  2028.  
  2029. function TDataEditor.CheckFloatValue(const S: string;
  2030.   out Value: Double): Boolean;
  2031. begin
  2032.   Result := CheckFloatValue(S);
  2033.   if Result then Value := StrToFloat(S);
  2034. end;
  2035.  
  2036. function TDataEditor.CheckFloatValue(const S: string;
  2037.   out Value: Single): Boolean;
  2038. begin
  2039.   Result := CheckFloatValue(S);
  2040.   if Result then Value := StrToFloat(S);
  2041. end;
  2042.  
  2043. function TDataEditor.CheckFloatValue(const Value: Double): Boolean;
  2044. begin
  2045.   Result := not IsNan(Value) and not IsInfinite(Value);
  2046. end;
  2047.  
  2048. function TDataEditor.CheckBoolValue(const S: string): Boolean;
  2049. begin
  2050.   Result := (Length(S) >= BoolStringLength) and
  2051.     CompareMem(@BoolString[1], Pointer(S), BoolStringLength);
  2052. end;
  2053.  
  2054. function TDataEditor.NegativeValue(var S1: string; const S2: string): Boolean;
  2055. var
  2056.   Bool: Boolean;
  2057. begin
  2058.   Bool := ContainsValue(S1, S2);
  2059.   Result := Bool;
  2060.   while Bool do begin
  2061.     Bool := ContainsValue(S1, S2);
  2062.     Result := Result xor Bool;
  2063.   end;
  2064. end;
  2065.  
  2066. function TDataEditor.ValueType(var S: string): Integer;
  2067. begin
  2068.   Result := ValueType(S, TypesData);
  2069. end;
  2070.  
  2071. procedure TDataEditor.SetAttrColor(const Value: TColor);
  2072. begin
  2073.   FAttrsManager.Color := Value;
  2074. end;
  2075.  
  2076. procedure TDataEditor.SetAttrFontStyles(const Value: TFontStyles);
  2077. begin
  2078.   FAttrsManager.FontStyle := Value;
  2079. end;
  2080.  
  2081. procedure TDataEditor.SetStrings(const Value: TStrings);
  2082. begin
  2083.   FAttrsManager.Strings := Value;
  2084. end;
  2085.  
  2086. end.
  2087.