tmsuxlsencodeformula.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

	  ConvertLastRefValueType(fmValue);
    if (c=fmPlus) then AddParsed([ptgAdd]) else AddParsed([ptgSub]);
  end;
end;

procedure TParseString.AndTerm;
// AddTerm [ & AddTerm]*
var
  c: UTF16Char;
  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:UTF16Char;
  s: UTF16String;
  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: UTF16Char;
  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: UTF16Char;
  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, byte(w), hi(word(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: UTF16Char;
  s: UTF16String;
  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: UTF16Char;
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: UTF16String): 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(out RowAbs, ColAbs: boolean; out  Row, Col: integer; out IsFullRowRange: Boolean; out IsFullColRange: Boolean);
var
  c: UTF16Char;
begin
  RowAbs:=false; ColAbs:=false;
  IsFullColRange := true;  //Something like 'B:B'
  IsFullRowRange := true;  //something like '1:3'

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

  Col:=0;
  while (PeekChar(c) and IsAZ(c)) and (Col <= (Max_Columns + 1)) do
  begin
    IsFullRowRange := false;
    NextChar;
    Col := (Col * ATo1('Z')) + ATo1(c);
  end;

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

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

end;

function TParseString.GetExternSheet(const ExternSheet: UTF16String): word;
var
  i: integer;
  SheetName: UTF16String;
  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.AddParsedRef(const Rw1: Int32; const grBit1: Int32);
begin
  if Force3D then
  begin
    AddParsed3dRef(Default3DExternSheet, Rw1, grBit1 and not $0C000);
    exit;
  end;

  AddParsed([GetRealPtg(ptgRef,fmRef) , byte(Rw1), hi(word(Rw1)), byte(grBit1), hi(word(grBit1))]);
end;

procedure TParseString.AddParsed3dRef(const ExternSheet: UTF16String; const Rw1: Int32; const grBit1: Int32);
var
  ESheet: word;
begin
  ESheet:=GetExternSheet(Default3DExternSheet);
  AddParsed([GetRealPtg(ptgRef3d,fmRef) ,byte(ESheet), hi(word(ESheet)), byte(Rw1), hi(word(Rw1)), byte(grBit1), hi(word(grBit1))]);
end;

procedure TParseString.AddParsedArea(const Rw1: Int32; const Rw2: Int32; const grBit1: Int32; const grBit2: Int32);
begin
  if Force3D then
  begin
    AddParsed3dArea(Default3DExternSheet, Rw1, Rw2, grBit1 and not $0C000, grBit2 and not $0C000);
    exit;
  end;
  AddParsed([GetRealPtg(ptgArea,fmRef) , byte(Rw1), hi(word(Rw1)), byte(Rw2), hi(word(Rw2)), byte(grBit1), hi(word(grBit1)), byte(grBit2), hi(word(grBit2))]);
end;

procedure TParseString.AddParsed3dArea(const ExternSheet: UTF16String; const Rw1: Int32; const Rw2: Int32; const grBit1: Int32; const grBit2: Int32);
var
  ESheet: word;
begin
  ESheet:=GetExternSheet(Default3DExternSheet);
  AddParsed([GetRealPtg(ptgArea3d,fmRef) ,byte(ESheet), hi(word(ESheet)), byte(Rw1), hi(word(Rw1)), byte(Rw2), hi(word(Rw2)), byte(grBit1), hi(word(grBit1)), byte(grBit2), hi(word(grBit2))]);
end;

procedure TParseString.AddParsedExternName(const ExternSheet: UTF16String; const ExternName: UTF16String);
begin
  raise Exception.Create('External names are not supported: ' + ExternName);
end;


function TParseString.GetSecondAreaPart(const ExternSheet: UTF16String; const OnlyPeek: Boolean; Row1: Int32; Col1: Int32; const RowAbs1: Boolean; const ColAbs1: Boolean; const IsFullRowRange1: Boolean; const IsFullColRange1: Boolean): Boolean;
var
  RowAbs2: Boolean;
  ColAbs2: Boolean;
  Row2: Int32;
  Col2: Int32;
  ActualPos: Int32;
  IsFullRowRange2: Boolean;
  IsFullColRange2: Boolean;
  rw1: Int32;
  grBit1: Int32;
  rw2: Int32;
  grBit2: Int32;
begin
  RowAbs2 := false;
  ColAbs2 := false;
  Row2 := 0;
  Col2 := 0;
  ActualPos := ParsePos;
  NextChar;
  GetOneReference(RowAbs2, ColAbs2, Row2, Col2, IsFullRowRange2, IsFullColRange2);
  if IsFullRowRange1 and IsFullRowRange2 then
  begin
    Col1 := 1;
    Col2 := Max_Columns + 1;
  end;

  if IsFullColRange1 and IsFullColRange2 then
  begin
    Row1 := 1;
    Row2 := Max_Rows + 1;
  end;

  if (((Row2 > (Max_Rows + 1)) or (Row2 <= 0)) or (Col2 <= 0)) or (Col2 > (Max_Columns + 1)) then
  begin
    ParsePos := ActualPos;
    begin Result := false; exit; end;
  end;

   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);

  if not OnlyPeek then
  begin
    if ExternSheet <> '' then
      AddParsed3dArea(ExternSheet, rw1, rw2, grBit1, grBit2) else
      AddParsedArea(rw1, rw2, grBit1, grBit2);
  end;

  Result := true;
end;

procedure TParseString.DoExternNamedRange(const ExternSheet: UTF16String);
var
  start: Int32;
  c: UTF16Char;
  s: UTF16String;
begin
  start := ParsePos;
  c := ' ';
  while PeekChar(c) and (((IsAlpha(c) or IsNumber(c)) or (c = '.')) or (c = ':')) do
  begin
    NextChar;
  end;
  s := UpperCase(Copy(Fw, start, ParsePos - start));
  AddParsedExternName(ExternSheet, s);
end;

procedure TParseString.GetGeneric3dRef(const ExternSheet: UTF16String);
var
  RowAbs1: Boolean;
  ColAbs1: Boolean;
  Row1: Int32;
  Col1: Int32;
  IsFullRowRange1: Boolean;
  IsFullColRange1: Boolean;
  SavedPos: Int32;
  d: UTF16Char;
  c: UTF16Char;
  IsArea: Boolean;
  rw1: Int32;
  grBit1: Int32;
begin
  RowAbs1 := False;
  ColAbs1 := False;
  Row1 := 0;
  Col1 := 0;

  SavedPos := ParsePos;
  d := ' ';
  GetOneReference(RowAbs1, ColAbs1, Row1, Col1, IsFullRowRange1, IsFullColRange1);

  if ((((Row1 <= 0) and (Col1 <= 0)) or (Row1 > (Max_Rows + 1))) or (Col1 > (Max_Columns + 1))) or (PeekChar(d) and IsAlpha(d)) then
  begin  //something like "a3a"
  //Wasn't a valid reference. It might be a name
    ParsePos := SavedPos;
    DoExternNamedRange(ExternSheet);
    exit;
  end;

  if not IsFullRowRange1 and not IsFullColRange1 then
  begin
  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]);
  end;

  c := ' ';
  IsArea := false;
  if PeekChar(c) and (c = fmRangeSep) then
  begin
    IsArea := GetSecondAreaPart(ExternSheet, false, Row1, Col1, RowAbs1, ColAbs1, IsFullRowRange1, IsFullColRange1);
  end;

  if not IsArea then
  begin
    if IsFullColRange1 or IsFullRowRange1 then
    begin
      raise Exception.CreateFmt(ErrUnexpectedId, [IntToStr(Row1) + ', ' + IntToStr(Col1), Fw]);
    end;
    rw1 := Row1 - 1;
    grBit1 := (Col1 - 1) and $FF;
    if not RowAbs1 then
      grBit1 := (grBit1 or $8000);
    if not ColAbs1 then
      grBit1 := (grBit1 or $4000);

    AddParsed3dRef(ExternSheet, rw1, grBit1);