rm_wawformula.pas

这是一个功能强大

unit RM_wawFormula;

{$I rm.inc}

interface

uses
  Windows, Classes, SysUtils,
  RM_wawFormula_iftab,RM_wawBIFF8;

type
  rwawOperatorInfo=record
    Name: String[2];
    Priority: Integer;
    ptg: Byte;
  end;

  pwawOperatorInfo=^rwawOperatorInfo;

  rwawOperator=record 
    OperatorInfo: pwawOperatorInfo;
    iftab: Word;
    ParCount: Integer;
    OperandExists: Boolean;
  end;

  pwawOperator=^rwawOperator;

  TwawCompileOpStack=class (TObject) 
  private
    FList: TList;
    FCurPos: Integer;
    FLastFunction: pwawOperator;
    function GetItem (i: Integer): pwawOperator;
    function GetCount: Integer;
  public
    property Items[i: Integer]: pwawOperator read GetItem; default;
    property Count:Integer read GetCount;
    property LastFunction:pwawOperator read FLastFunction write FLastFunction;
    function Push: pwawOperator;
    function Pop: pwawOperator;
    function Last: pwawOperator;
    procedure Reset;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
  end;

  TwawExtSheet=class (TObject) 
  private
    FName: String;
    FiSUPBOOK: Integer;
    Fitab: Integer;
  public
    property Name:String read FName;
    property iSUPBOOK:Integer read FiSUPBOOK;
    property itab:Integer read Fitab;
    constructor Create (_Name: String; _iSUPBOOK: Integer; _itab: Integer);
  end;

  TwawExtWorkbook=class (TObject) 
  private
    FName: String;
    FSheets: TList;
    function GetSheet (i: Integer): TwawExtSheet;
    function GetSheetsCount: Integer;
  public
    property Sheets[i: Integer]: TwawExtSheet read GetSheet; default;
    property SheetsCount:Integer read GetSheetsCount;
    property Name:String read FName;
    constructor Create (_Name: String);
    destructor Destroy; override;
  end;

  TwawExtRefs=class (TObject) 
  private
    FBooks: TList;
    FSheets: TList;
    function GetBook (i: Integer): TwawExtWorkbook;
    function GetSheet (i: Integer): TwawExtSheet;
    function GetBooksCount: Integer;
    function GetSheetsCount: Integer;
  public
    property Books[i: Integer]: TwawExtWorkbook read GetBook; default;
    property BooksCount:Integer read GetBooksCount;
    property Sheets[i: Integer]: TwawExtSheet read GetSheet;
    property SheetsCount:Integer read GetSheetsCount;
    function GetSheetIndex (BookName: String; SheetName: String): Integer;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
  end;

  TwawExcelFormulaCompiler=class (TObject) 
  private
    FCompileOpStack: TwawCompileOpStack;
    FExtRefs: TwawExtRefs;
    procedure SetError (ErrorMessage: String);
  public
    property ExtRefs:TwawExtRefs read FExtRefs;
    procedure CompileFormula (s: String; var Ptgs: PChar; var PtgsSize: Integer);
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
  end;

const
  wawFormulaEndBracketChar = ')';
  wawFormulaStartBracketChar = '(';
  wawFormulaStringChar = '"';
  wawFormulaFuncParamsDelim = ';';
  wawFormulaPercentOperator = '%';
  wawFormulaUnaryPlusOperator = '+';
  wawFormulaUnaryMinusOperator = '-';
  wawFormulaUnaryOperators: set of Char = ['+', '-'];
  wawFormulaOperatorChars: set of Char = ['%'..'&', '*'..'+', '-', '/', '<'..'>', '^'];
  wawFormulaStartIdentChars: set of Char = ['$', '''', 'A'..'[','a'..'z'];
  wawFormulaIdentChars: set of Char = ['!', '$', '''', '.', '0'..':', '@'..'[', ']', '_', 'a'..'z'];
  wawOperatorsCount = $12;
  wawOperatorsInfos: array[$1..$12] of rwawOperatorInfo =
    ((Name: '('; Priority: $0; ptg: $00),
      (Name: ')'; Priority: $1; ptg: $00),
      (Name: '>='; Priority: $2; ptg: $0C),
      (Name: '<='; Priority: $2; ptg: $0A),
      (Name: '<>'; Priority: $2; ptg: $0E),
      (Name: '='; Priority: $2; ptg: $0B),
      (Name: '>'; Priority: $2; ptg: $0D),
      (Name: '<'; Priority: $2; ptg: $09),
      (Name: '&'; Priority: $3; ptg: $08),
      (Name: '+'; Priority: $4; ptg: $03),
      (Name: '-'; Priority: $4; ptg: $04),
      (Name: '*'; Priority: $5; ptg: $05),
      (Name: '/'; Priority: $5; ptg: $06),
      (Name: '^'; Priority: $6; ptg: $07),
      (Name: '%'; Priority: $7; ptg: $14),
      (Name: '+'; Priority: $8; ptg: $12),
      (Name: '-'; Priority: $8; ptg: $13),
      (Name: ''; Priority: $9; ptg: $FF));

  wawFormulaStartBracketOperatorIndex = $01;
  wawFormulaEndBracketOperatorIndex = $02;
  wawFormulaPercentOperatorIndex = $0F;
  wawFormulaUnaryPlusOperatorIndex = $10;
  wawFormulaUnaryMinusOperatorIndex = $11;
  wawFormulaFunctionOperatorIndex = $12;
  wawFormulaFunctionPriority = $09;
  wawFormulaStartBracketPriority = $00;
  wawFormulaEndBracketPriority = $01;
  wawFormulaPercentOperatorPriority = $07;

  swawFormulaCompileErrorInvalidBrackets = 'Invalid brackets';
  swawFormulaCompileErrorParameterWithoutFunction = 'Parameter without function';

  swawFormulaCompileErrorInvalidString = 'Invalid string';
  swawFormulaCompileErrorInvalidNumber = 'Invalid number [%s]';
  swawFormulaCompileErrorInvalidSymbol = 'Invalid symbol [%s]';
  swawFormulaCompileErrorUnknownOperator = 'Unknown operator [%s]';
  swawFormulaCompileErrorUnknownFunction = 'Unknown function [%s]';
  swawFormulaCompileErrorInvalidCellReference = 'Invalid cell reference [%s]';

  swawFormulaCompileErrorInvalidRangeReference = 'Invalid range reference [%s]';

  wawFormulaNumberChars: set of Char = ['.', '0'..'9'];

implementation

constructor TwawCompileOpStack.Create;
begin
 inherited Create;
 FList := TList.Create;
 FCurPos := -1;
end;

destructor TwawCompileOpStack.Destroy;
begin
 Clear;
 FList.Free;
 inherited Destroy;
end;

function TwawCompileOpStack.GetItem (i: Integer): pwawOperator;
begin
 Result := FList[i];  
end;

function TwawCompileOpStack.GetCount: Integer;
begin
 Result := FCurPos +1;
end;

procedure TwawCompileOpStack.Clear;
var
  i: Integer;
begin
 for i := 0 to FList.Count-1 do
  FreeMem(FList[i]);
 FList.Clear; 
 FCurPos := -1;
end;

procedure TwawCompileOpStack.Reset;
begin
 FCurPos := -1;
 FLastFunction := pwawOperator(nil);
end;

function TwawCompileOpStack.Push: pwawOperator;
begin
 inc(FCurPos);
 if FCurPos = FList.Count then
  begin
   GetMem(Result,sizeof(rwawOperator));
   FList.Add(Result);
  end
 else
  Result := FList[FCurPos]; 
end;

function TwawCompileOpStack.Pop: pwawOperator;
var
  i: Integer;
begin
 Dec(FCurPos);
 Result := Last;
 for i := Count-1 downto 1 do
   if pwawOperator(FList[i]).OperatorInfo.Priority = 9 then break;
 if (i >= 0) and (i< Count) then
  FLastFunction := FList[i]
 else
  FLastFunction := pwawOperator(nil);
end;

function TwawCompileOpStack.Last: pwawOperator;
begin
 if (FCurPos >= 0) and (FCurPos < FList.Count) then
   Result := FList[FCurPos]
 else
   Result := pwawOperator(nil);
end;

constructor TwawExtSheet.Create (_Name: String; _iSUPBOOK: Integer; _itab: Integer);
begin
  inherited Create;
  FName := _Name;
  FiSUPBOOK := _iSUPBOOK;
  Fitab := _itab;
end;

constructor TwawExtWorkbook.Create (_Name: String);
begin
 inherited Create;
 FName := _Name;
 FSheets := TList.Create;
end;

destructor TwawExtWorkbook.Destroy;
begin
 FSheets.Free;
 inherited Destroy;
end;

function TwawExtWorkbook.GetSheet (i: Integer): TwawExtSheet;
begin
 Result := FSheets[i];
end;

function TwawExtWorkbook.GetSheetsCount: Integer;
begin
 Result := FSheets.Count;
end;

constructor TwawExtRefs.Create;
begin
 inherited Create;
 FBooks := TList.Create;
 FSheets := TList.Create;
end;

destructor TwawExtRefs.Destroy;
begin
 Clear;
 FSheets.Free;
 FBooks.Free;
 inherited Destroy;
end;

function TwawExtRefs.GetBook (i: Integer): TwawExtWorkbook;
begin
 Result := FBooks[i];
end;

function TwawExtRefs.GetSheet (i: Integer): TwawExtSheet;
begin
 Result := FSheets[i];
end;

function TwawExtRefs.GetBooksCount: Integer;
begin
 Result := FBooks.Count;
end;

function TwawExtRefs.GetSheetsCount: Integer;
begin
 Result := FSheets.Count;
end;

procedure TwawExtRefs.Clear;
var
  i: Integer;
begin
 for i := 0 to SheetsCount -1 do
  Sheets[i].Free;
 for i := 0 to BooksCount -1 do
  Books[i].Free;
 FSheets.Clear;
 FBooks.Clear; 
end;

function TwawExtRefs.GetSheetIndex (BookName: String; SheetName: String): Integer;
var
  i: Integer;
  iBook: Integer;
  Book: TwawExtWorkbook;
  Sheet: TwawExtSheet;
begin
 Sheet := TwawExtSheet(nil);
 for iBook := 0 to BooksCount-1 do
   if (Books[iBook].Name = BookName) then break;

 if iBook >= BooksCount then
  begin
   Book := TwawExtWorkbook.Create(BookName);
   iBook := FBooks.Add(Book);
   Sheet := TwawExtSheet.Create(SheetName,iBook,0);
   Book.FSheets.Add(Sheet);
   Result := FSheets.Add(Sheet);
  end
 else
  begin
   Book := FBooks[iBook];
   for i := 0 to Book.SheetsCount-1 do
     if (Book.Sheets[i].Name = SheetName) then break;

   if i >= Book.SheetsCount then
    begin
     Sheet := TwawExtSheet.Create(SheetName,iBook,0);
     Book.FSheets.Add(Sheet);
     Result := FSheets.Add(Sheet);
    end
   else
    Result := FSheets.IndexOf(Sheet);
  end;
end;

constructor TwawExcelFormulaCompiler.Create
 ;
begin
 inherited Create;
 FExtRefs := TwawExtRefs.Create;
 FCompileOpStack := TwawCompileOpStack.Create;
end;

destructor TwawExcelFormulaCompiler.Destroy
 ;
begin
 FCompileOpStack.Free;
 FExtRefs.Free;
 inherited Destroy;
end;

procedure TwawExcelFormulaCompiler.Clear;
begin
 FExtRefs.Clear;
 FCompileOpStack.Clear;
end;

procedure TwawExcelFormulaCompiler.SetError(ErrorMessage: String);
begin
 raise Exception.Create(ErrorMessage);
end;

procedure TwawExcelFormulaCompiler.CompileFormula(s: String; var Ptgs: PChar;var PtgsSize: Integer);
var
  vd: Extended;
  Str: pptgStr;
  Last: pwawOperator;
  b1: String;
  ExtRef: String;
  CellRef: String;
  ExtBook: String;
  ExtSheet: String;
  i: Integer;
  j: Integer;
  l: Integer;
  vi: Integer;
  valCode: Integer;
  NewStrSize: Integer;
  CurStrSize: Integer;
  P: Pointer;
  procedure Addptg (_Ptg: Byte; _PtgData: Pointer; _PtgDataSize: Integer);
  begin
   ReallocMem(Ptgs,PtgsSize + _PtgDataSize +1);
   PByte(Ptgs + PtgsSize)^ := _Ptg;
   if _PtgData <> nil then
    MoveMemory(Pointer(Ptgs + PtgsSize +1), _PtgData, _PtgDataSize);
   PtgsSize := PtgsSize + _PtgDataSize +1;
  end;
  procedure AddptgOperator (o: pwawOperator);
  var
    FuncVar: rptgFuncVar;
  begin
    if o.OperatorInfo.ptg = Byte(255) then
     begin
      FuncVar.cargs := o.ParCount;
      FuncVar.iftab := o.iftab;
      Addptg(ptgFuncVar,@FuncVar,sizeof(FuncVar));
     end
    else
      Addptg(o.OperatorInfo.ptg,nil,0);
  end;
  procedure AddptgIdentificator (Ident: String);