encodeformulaii2.pas

一个经典的读写Excel的控件

        Ok := AddFunction(Exp);
      if not Ok then
        Ok := AddVariable(Exp);
      if not Ok then
        Error(ERR_INVALIDSYMBOL,Exp);
    end
    else begin
      if Exp[1] = '{' then
        AddVectorConst(Exp)
      else
        AddConstant(Exp);
    end;
  end;
  while BracketCount > 0 do begin
    AddSpacePtg(2,Space1Count);
    AddSpacePtg(4,Space2Count);
    AddPtg(ptgParen);
    Dec(BracketCount);
  end;
end;

function TEncodeFormula.StrToPtg(S: WideString): byte;
begin
  if S = '^' then Result := ptgPower
  else if S = '*'  then Result := ptgMul
  else if S = '/'  then Result := ptgDiv
  else if S = '='  then Result := ptgEQ
  else if S = '<>' then Result := ptgNE
  else if S = '<'  then Result := ptgLT
  else if S = '>'  then Result := ptgGT
  else if S = '<=' then Result := ptgLE
  else if S = '>=' then Result := ptgGE
  else if S = '+'  then Result := ptgAdd
  else if S = '&'  then Result := ptgConcat
  else if S = '-'  then Result := ptgSub
  else
    raise Exception.CreateFmt('Can not find ptg for %s',[S]);
end;

procedure TEncodeFormula.UppercaseSkipQuote(var S: WideString);
var
  i: integer;
  InQuote: boolean;
begin
  InQuote := False;
  for i := 1 to Length(S) do begin
    if Char(S[i]) in [charQuote1,charQuote2] then
      InQuote := not InQuote;
    if not InQuote then
      S[i] := MyWideUppercase(S[i])[1];
  end;
end;

procedure TEncodeFormula.AddConstant(S: WideString);
var
  vDouble: double;
  vInt: integer;
begin
  S := Trim(S);
  if Char(S[1]) in [charQuote1,charQuote2] then begin
    if not (Char(S[Length(S)]) in [charQuote1,charQuote2]) then
      Error(ERR_STR_MISSING_Q,S);
    S := Copy(S,2,Length(S) - 2);
    if Length(S) > 255 then
      Error(ERR_STRLEN,'');
    vInt := Length(S);
    AddPtg(ptgStr,vInt,1);
    vInt := 1;
    AddBuf(vInt,1);
    AddBuf(Pointer(S)^,Length(S) * 2);
  end
  else begin
    try
      vDouble := StrToFloat(S);
      if (Frac(vDouble) = 0) and (vDouble >= 0) and (vDouble <= $FFFF) then begin
        vInt := Round(vDouble);
        AddPtg(ptgInt,vInt,2);
      end
      else
        AddPtg(ptgNum,vDouble,SizeOf(double));
    except
      Error(ERR_BADCONSTANT,S);
    end;
  end;
end;

procedure TEncodeFormula.Error(Id: integer; S: WideString);
var
  ErrStr: WideString;
begin
  case Id of
    ERR_BADCONSTANT:
      ErrStr := Format('Invalid constant %s',[S]);
    ERR_INVALIDSYMBOL:
      ErrStr := Format('Invalid symbol %s',[S]);
    ERR_PAR_MISS_FUNC:
      ErrStr := 'Closing paranthese missing in function';
    ERR_BAD_FUNCNAME:
      ErrStr := Format('Invalid function name %s',[S]);
    ERR_STR_MISSING_Q:
      ErrStr := Format('Missing quote characther in string %s',[S]);
    ERR_STRLEN:
      ErrStr := 'Strings can have max 255 characthers';
    ERR_UNKNOWN_NAME:
      ErrStr := Format('Unknown name %s',[S]);
    ERR_ENCLOSING_CHAR:
      ErrStr := Format('Enclosing characther %s missing',[S]);
    ERR_INVALID_FILENAME:
      ErrStr := Format('Invalid filename %s',[S]);
    ERR_UNARY_COUNT:
      ErrStr := 'To many unary operators';
    else
      ErrStr := 'Unknown error in formula';
  end;
  ErrStr := Format('Error in formula %s' + #13,[FOrgFormula]) + ErrStr;
  if Assigned(FFormulaErrorEvent) then
    FFormulaErrorEvent(Self,Id,ErrStr)
  else
    raise Exception.Create(ErrStr);
end;

function TEncodeFormula.AddBoolConst(Exp: WideString): boolean;
var
  V: byte;
begin
  V := $FF;
  if Exp = FStrTRUE then
    V := 1
  else if Exp = FStrFALSE then
    V := 0;
  Result := V < $FF;
  if Result then
    AddPtg(ptgBool,V,1);
end;

// Syntax: 'd:\path\[filename.xls]Sheet 1'!A1
function TEncodeFormula.Add3dCellRef(Exp: WideString): boolean;
type
  T3dRefType = (rtUnknown,rtRef,rtArea,rtName);
var
  p,ExtIndex,NameIndex: integer;
  Path,FileName,SheetName,Ref: WideString;
  Col1,Row1,Col2,Row2: integer;
  AbsCol1,AbsRow1,AbsCol2,AbsRow2: boolean;
  RefType: T3dRefType;
  Ref3d: TPTGRef3d8;
  Area3d: TPTGArea3d8;
  Namex: TPTGNameX8;
begin
  Result := False;
  p := WCPos('[',Exp);
  if p > 0 then begin
    Path := Trim(Copy(Exp,1,p - 1));
    if (Path <> '') and (Path[1] = charQuote2) then
      Path := Copy(Path,2,MAXINT);
    Exp := Copy(Exp,p + 1,MAXINT);
    p := WCPos(']',Exp);
    if p <= 0 then begin
      Error(ERR_ENCLOSING_CHAR,']');
      Exit;
    end;
    FileName := Trim(Copy(Exp,1,p - 1));
    Exp := Copy(Exp,p + 1,MAXINT);
    if FileName = '' then begin
      Error(ERR_INVALID_FILENAME,FileName);
      Exit;
    end;
  end;
  p := WCPos('!',Exp);
  if p <= 0 then
    Exit;
  SheetName := Trim(Copy(Exp,1,p - 1));
  if (SheetName <> '') and (SheetName[1] = charQuote2) then
    SheetName := Copy(SheetName,2,MAXINT);
  if (SheetName <> '') and (SheetName[Length(SheetName)] = charQuote2) then
    SheetName := Copy(SheetName,1,Length(SheetName) - 1);
  Exp := Copy(Exp,p + 1,MAXINT);
  if AreaStrToColRow(Exp,Col1,Row1,Col2,Row2,AbsCol1,AbsRow1,AbsCol2,AbsRow2) then
    RefType := rtArea
  else if RefStrToColRow(Exp,Col1,Row1,AbsCol1,AbsRow1) then
    RefType := rtRef
  else if WCPos('(',Exp) <= 0  then begin
    RefType := rtName;
    Ref := Exp;
  end
  else
    RefType := rtUnknown;
  ExtIndex := -1;
  NameIndex := -1;
  FExternNameEvent(Path,Filename,SheetName,Ref,ExtIndex,NameIndex);
  if NameIndex < 0 then
    Exit;
  case RefType of
    rtRef: begin
      FLastSheetIndex := NameIndex;
      Ref3d.Index := ExtIndex;
      Ref3d.Col := Col1;
      Ref3d.Row := Row1;
      if not AbsRow1 then
        Ref3d.Col := Ref3d.Col + $8000;
      if not AbsCol1 then
        Ref3d.Col := Ref3d.Col + $4000;
      AddPtg(ptgRef3dV,Ref3d,SizeOf(TPTGRef3d8));
      Result := True;
    end;
    rtArea: begin
      FLastSheetIndex := NameIndex;
      Area3d.Index := ExtIndex;
      Area3d.Col1 := Col1;
      Area3d.Row1 := Row1;
      Area3d.Col2 := Col2;
      Area3d.Row2 := Row2;
      if not AbsRow1 then
        Area3d.Col1 := Area3d.Col1 + $8000;
      if not AbsCol1 then
        Area3d.Col1 := Area3d.Col1 + $4000;
      if not AbsRow2 then
        Area3d.Col2 := Area3d.Col2 + $8000;
      if not AbsCol2 then
        Area3d.Col2 := Area3d.Col2 + $4000;
      AddPtg(ptgArea3d,Area3d,SizeOf(TPTGArea3d8));
      Result := True;
    end;
    rtName: begin
      NameX.ExtSheet := ExtIndex;
      NameX.NameIndex := NameIndex + 1;
      NameX.Reserved := 0;
      AddPtg(ptgNameXV,NameX,SizeOf(TPTGNameX8));
      Result := True;
    end;
  end
end;

function TEncodeFormula.AddCellRef(Exp: WideString): boolean;
var
  Col1,Row1,Col2,Row2: integer;
  AbsCol1,AbsRow1,AbsCol2,AbsRow2: boolean;
  Area: TPTGArea8;
  Ref: TPTGRef8;
begin
  if Add3dCellRef(Exp) then
    Result := True
  else if AreaStrToColRow(Exp,Col1,Row1,Col2,Row2,AbsCol1,AbsRow1,AbsCol2,AbsRow2) then begin
    Area.Col1 := Col1;
    Area.Row1 := Row1;
    Area.Col2 := Col2;
    Area.Row2 := Row2;
    if not AbsRow1 then
      Area.Col1 := Area.Col1 + $8000;
    if not AbsCol1 then
      Area.Col1 := Area.Col1 + $4000;
    if not AbsRow2 then
      Area.Col2 := Area.Col2 + $8000;
    if not AbsCol2 then
      Area.Col2 := Area.Col2 + $4000;
    AddPtg(ptgAreaA,Area,SizeOf(TPTGArea8));
    Result := True;
  end
  else if RefStrToColRow(Exp,Col1,Row1,AbsCol1,AbsRow1) then begin
    Ref.Col := Col1;
    Ref.Row := Row1;
    if not AbsRow1 then
      Ref.Col := Ref.Col + $8000;
    if not AbsCol1 then
      Ref.Col := Ref.Col + $4000;
    AddPtg(ptgRefA,Ref,SizeOf(TPTGRef8));
    Result := True;
  end
  else
    Result := False;
end;

function TEncodeFormula.AddFunction(Exp: WideString): boolean;
var
  p,ArgCount,Id: integer;
  S,Func: WideString;
begin
  Result := False;
  p := WCPos('(',Exp);
  if p < 1 then
    Exit;
  if Exp[Length(Exp)] <> ')' then
    Error(ERR_PAR_MISS_FUNC,Exp);
  Func := Copy(Exp,1,p - 1);
  Exp := Copy(Exp,p + 1,Length(Exp) - Length(Func) - 2);
  ArgCount := 0;
  while Exp <> '' do begin
    p := WCPos(WideChar(ListSeparator),Exp);
    if p > 0 then begin
      S := Copy(Exp,1,p - 1);
      Exp := Copy(Exp,p + 1,MAXINT);
    end
    else begin
      S := Exp;
      Exp := '';
    end;
    Scan(S);
    Inc(ArgCount);
  end;
  Id := GetFuncId(Func);
  if Id >= 0 then begin
    if ExcelFunctions[Id].Min = ExcelFunctions[Id].Max then
      AddPtg(ptgFuncV,Id,SizeOf(word))
    else begin
      AddPtg(ptgFuncVarV,ArgCount,SizeOf(byte));
      AddBuf(Id,SizeOf(word));
    end;
  end;
  Result := Id >= 0;
end;

function TEncodeFormula.GetFuncId(S: WideString): integer;
begin
  for Result := 0 to High(ExcelFunctions) do begin
    if S = ExcelFunctions[Result].Name then begin
      if ExcelFunctions[Result].Min = $FF then
        Error(ERR_BAD_FUNCNAME,S);
      Exit;
    end;
  end;
  // User function
  Result := -1;
end;

function TEncodeFormula.AddVariable(Exp: WideString): boolean;
var
  NameId: integer;
  ptgName: TPTGName8;
begin
  FUnknownNameEvent(Exp,NameId);
  if NameId < 0 then
    Error(ERR_UNKNOWN_NAME,Exp)
  else begin
    ptgName.NameIndex := NameId;
    ptgName.Reserved := 0;
    AddPtg(ptgNameV,ptgName,SizeOf(TPTGName8));
  end;
  Result := True;
end;

procedure TEncodeFormula.AddVectorConst(S: WideString);
begin
  raise Exception.Create('Vector constants not supported.');
end;

end.