uxlsencodeformula.pas

TMS Component Pack Pro v4.2

var
  c: widechar;
  First: boolean;
begin
  First:=true;
  PerTerm;
  while PeekCharWs(c) and (c=fmPower) do
  begin
	  ConvertLastRefValueTypeOnce(fmValue, First);
    SkipWhiteSpace;
    NextChar;
    PerTerm;
	  ConvertLastRefValueType(fmValue);
    AddParsed([ptgPower]);
  end;
end;

procedure TParseString.MulTerm;
// ExpTerm [ *|/ ExpTerm ]*
var
  c: widechar;
  First: boolean;
begin
  First:=true;
  ExpTerm;
  while PeekCharWs(c) and ((c=fmMul) or (c=fmDiv)) do
  begin
	  ConvertLastRefValueTypeOnce(fmValue, First);
    SkipWhiteSpace;
    NextChar;
    ExpTerm;
	  ConvertLastRefValueType(fmValue);
    if (c=fmMul) then AddParsed([ptgMul]) else AddParsed([ptgDiv]);
  end;
end;

procedure TParseString.AddTerm;
// MulTerm [ +|- MulTerm]*
var
  c: widechar;
  First: boolean;
begin
  First:=true;
  MulTerm;
  while PeekCharWs(c) and ((c=fmPlus) or (c=fmMinus)) do
  begin
	  ConvertLastRefValueTypeOnce(fmValue, First);
    SkipWhiteSpace;
    NextChar;
    MulTerm;
	  ConvertLastRefValueType(fmValue);
    if (c=fmPlus) then AddParsed([ptgAdd]) else AddParsed([ptgSub]);
  end;
end;

procedure TParseString.AndTerm;
// AddTerm [ & AddTerm]*
var
  c: widechar;
  First: boolean;
begin
  First:=true;
  AddTerm;
  while PeekCharWs(c) and (c=fmAnd) do
  begin
	  ConvertLastRefValueTypeOnce(fmValue, First);
    SkipWhiteSpace;
    NextChar;
    AddTerm;
	  ConvertLastRefValueType(fmValue);
    AddParsed([ptgConcat]);
  end;
end;

function TParseString.FindComTerm(var Ptg: byte): boolean;
var
  c,d:widechar;
  s: widestring;
  One: boolean;
begin
  Result:= PeekCharWs(c) and ((c=fmEQ) or (c=fmLT) or (c=fmGT));
  if Result then
  begin
    One:=true;
    SkipWhiteSpace; //Already granted we will add a ptg
    NextChar;
    if PeekChar(d)and((d=fmEQ) or (d=fmGT)) then
    begin
      s:=c; s:=s+d; One:=False;
      if s = fmGE then begin; NextChar; Ptg:=ptgGE; end else
      if s = fmLE then begin; NextChar; Ptg:=ptgLE; end else
      if s = fmNE then begin; NextChar; Ptg:=ptgNE; end else
      One:=True;
    end;
    If One then
      if c= fmEQ then Ptg:=ptgEQ else
      if c= fmLT then Ptg:=ptgLT else
      if c= fmGT then Ptg:=ptgGT else
      raise Exception.Create(ErrInternal);
  end;
end;

procedure TParseString.ComTerm;
// AndTerm [ = | < | > | <= | >= | <>  AndTerm]*
var
  c: widechar;
  Ptg: byte;
  First: boolean;
begin
  First:=true;
  AndTerm;
  while PeekCharWs(c) and FindComTerm(Ptg) do
  begin
    //no NextChar or SkipWhitespace here. It is added by FindComTerm
	  ConvertLastRefValueTypeOnce(fmValue, First);
    AndTerm;
	  ConvertLastRefValueType(fmValue);
    AddParsed([Ptg]);
  end;
end;

procedure TParseString.Expression;
begin
  ComTerm;
end;

procedure TParseString.GetNumber;
var
  c: widechar;
  d: double;
  w: word;
  ab: array[0..7] of byte;
  start: integer;
begin
  SkipWhiteSpace;
  start:=ParsePos;
  while PeekChar(c) and (IsNumber(c)or (c=fmFormulaDecimal)) do NextChar;
  if PeekChar(c) and ((c='e')or (c='E')) then //numbers like 1e+23
  begin
    NextChar;
    if PeekChar(c) and ((c=fmPlus)or (c=fmMinus)) then NextChar;
    while PeekChar(c) and IsNumber(c) do NextChar; //no decimals allowed here
  end;

  d:=fmStrToFloat(copy(FW, start, ParsePos-Start));

  if (round(d)=d) and (d<=$FFFF)and (d>=0) then
  begin
    w:=round(d);
    AddParsed([ptgInt, lo(w), hi(w)]);
  end else
  begin
    move(d, ab[0], length(ab));
    AddParsed([ptgNum, ab[0], ab[1], ab[2], ab[3], ab[4], ab[5], ab[6], ab[7]]);
  end;
end;

procedure TParseString.GetString;
var
  c,d,e: widechar;
  s: widestring;
  Xs: TExcelString;
  St: array of byte;
  More: boolean;
begin
  s:='';
  SkipWhiteSpace;
  if not PeekChar(c) or (c<>fmStr) then raise Exception.Create(ErrNotAString);
  NextChar;

  repeat
    More:=false;
    if PeekChar(c) and (c<>fmStr) then
    begin
      s:=s+c;
      NextChar;
      More:=true;
    end
    else
    begin
      if PeekChar(d) and (d=fmStr) and Peek2Char(e) and (e=fmStr) then
      begin
        s:=s+fmStr;
        NextChar;
        NextChar;
        More:=true;
      end;
    end;
   until not more;

   if not PeekChar(c) then raise Exception.CreateFmt(ErrUnterminatedString,[Fw]);
   NextChar;

   Xs:=TExcelString.Create(1,s);
   try
     SetLength(St, Xs.TotalSize+1);
     St[0]:=ptgStr;
     Xs.CopyToPtr(PArrayOfByte(St),1);
     AddParsed(St);
   finally
     FreeAndNil(Xs);
   end; //finally
end;

procedure TParseString.GetAlpha;
// Possibilities:
{ 1 -> Formula - We know by the "(" at the end
  2 -> Boolean - We just see if text is "true" or "false"
  3 -> Error   - No, we already cached this
  4 -> Reference - Look if it is one of the strings between A1..IV65536 (and $A$1) As it might start with $, we don't look at it here.
  5 -> 3d Ref    - Search for a '!'  As it migh start with "'" we don't look at it here.
  6 -> Named Range - if it isn't anything else...
}
var
  Start: integer;
  s: string; //no need for widestring
  c: widechar;
begin
  SkipWhiteSpace;
  start:=ParsePos;
  while PeekChar(c) and ( IsAlpha(c) or IsNumber(c) or (c='.')or (c=':')) do NextChar;
  s:=UpperCase(copy(FW, start, ParsePos-Start));

  if PeekChar(c) and (c=fmOpenParen) then GetFormula(s) else
  if PeekChar(c) and (c=fmExternalRef) then GetRef3d(s) else
  if not GetBool(s) then
  raise Exception.CreateFmt(ErrUnexpectedId,[s,Fw]);


end;

function TParseString.GetBool(const s: string): boolean;
var
  b: byte;
begin
  if s=fmTrue then b:=1 else
  if s=fmFalse then b:=0 else
  begin
    Result:=false;
    exit;
  end;

  AddParsed([ptgBool, b]);
  Result:=true;
end;

procedure TParseString.GetOneReference(var RowAbs, ColAbs: boolean;var  Row, Col: integer);
var
  c,d: widechar;
begin
  RowAbs:=false; ColAbs:=false;
  if PeekChar(c) and (c=fmAbsoluteRef) then
  begin
    ColAbs:=true;
    NextChar;
  end;
  Col:=0;
  if PeekChar(c) and IsAZ(c) then
  begin
    NextChar;
    if PeekChar(d) and IsAZ(d) then
    begin
      NextChar;
      Col:=ATo1(d)+ATo1(c)*ATo1('Z');
    end
    else Col:=ATo1(c);
  end;

  if PeekChar(c) and (c=fmAbsoluteRef) then
  begin
    RowAbs:=true;
    NextChar;
  end;

  Row:=0;
  while PeekChar(c) and IsNumber(c) and (Row<=Max_Rows+1) do
  begin
    NextChar;
    Row:=Row*10+(ord(c)-ord('0'));
  end;

end;

function TParseString.GetExternSheet(const ExternSheet: widestring): word;
var
  i: integer;
  SheetName: string;
  Sheet1, Sheet2: integer;
begin
  i:= pos (fmRangeSep, ExternSheet);
  if (i>0) then SheetName:=Copy(ExternSheet,1, i-1) else SheetName:=ExternSheet;

  if not FCellList.FindSheet(SheetName, Sheet1) then raise Exception.CreateFmt(ErrInvalidSheet, [SheetName]);

  if (i>0) then
  begin
    SheetName:=Copy(ExternSheet,i+1, Length(ExternSheet));
    if not FCellList.FindSheet(SheetName, Sheet2) then raise Exception.CreateFmt(ErrInvalidSheet, [SheetName]);
  end
    else Sheet2:=Sheet1;

  Result:=FCellList.AddExternSheet(Sheet1, Sheet2);
end;

procedure TParseString.GetGeneric3dRef(const ExternSheet: widestring);
var
  grBit1: Integer;
  rw1: Integer;
  grBit2: Integer;
  rw2: Integer;
  c: WideChar;
  Col2: Integer;
  Row2: Integer;
  ColAbs2: Boolean;
  RowAbs2: Boolean;
  Col1: Integer;
  Row1: Integer;
  ESheet: word;
  ColAbs1: Boolean;
  RowAbs1: Boolean;
begin
  RowAbs1 := False;
  ColAbs1 := False;
  Row1 := 0;
  Col1 := 0;
  RowAbs2 := False;
  ColAbs2 := False;
  Row2 := 0;
  Col2 := 0;

  ESheet:=GetExternSheet(ExternSheet);

  GetOneReference(RowAbs1, ColAbs1, Row1, Col1);
  if (Row1 > Max_Rows + 1) or (Row1 <= 0) or (Col1 <= 0) or (Col1 > Max_Columns + 1) then
    raise Exception.CreateFmt(ErrUnexpectedId, [IntToStr(Row1)+ ', '+ IntToStr(Col1), Fw]);
  c := ' ';
  if PeekChar(c) and (c = fmRangeSep) then
  begin
    NextChar;
    GetOneReference(RowAbs2, ColAbs2, Row2, Col2);
    if (Row2 > Max_Rows + 1) or (Row2 <= 0) or (Col2 <= 0) or (Col2 > Max_Columns + 1) then
      raise Exception.CreateFmt(ErrUnexpectedChar, [c, ParsePos, Fw]);
    rw1 := Row1 - 1;
    grBit1 := (Col1 - 1) and $FF;
    if not RowAbs1 then
      grBit1 := (grBit1 or $8000);
    if not ColAbs1 then
      grBit1 := (grBit1 or $4000);
    rw2 := Row2 - 1;
    grBit2 := (Col2 - 1) and $FF;
    if not RowAbs2 then
      grBit2 := (grBit2 or $8000);
    if not ColAbs2 then
      grBit2 := (grBit2 or $4000);

    AddParsed([GetRealPtg(ptgArea3d,fmRef) ,lo(ESheet), hi(ESheet), lo(Rw1), hi(Rw1), lo(Rw2), hi(Rw2), lo(grBit1), hi(grBit1), lo(grBit2), hi(grBit2)]);
  end
  else
  begin
    rw1 := Row1 - 1;
    grBit1 := (Col1 - 1) and $FF;
    if not RowAbs1 then
      grBit1 := (grBit1 or $8000);
    if not ColAbs1 then
      grBit1 := (grBit1 or $4000);
    AddParsed([GetRealPtg(ptgRef3d,fmRef) ,lo(ESheet), hi(ESheet), lo(Rw1), hi(Rw1), lo(grBit1), hi(grBit1)]);
  end;
end;

function TParseString.GetReference: boolean;
var
  RowAbs1, ColAbs1,RowAbs2, ColAbs2: boolean;
  Row1, Col1, Row2, Col2: integer;
  rw1, grBit1: word;
  rw2, grBit2: word;
  c: widechar;
  SaveParsePos: integer;
  ESheet: word;
begin
  Result:=false;
  SaveParsePos:=ParsePos;