formulahandler2.pas

一个经典的读写Excel的控件

unit FormulaHandler2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$B-}

interface

uses Classes, SysUtils, BIFFRecsII2, XLSUtils2, DecodeFormula2, EncodeFormulaII2,
     XLSNames2, ExcelFuncII2;

type TSheetDataType = (sdtName,sdtCell);

type TSheetNameEvent = procedure (Name: WideString; var Index,TabCount: integer) of object;
type TSheetDataEvent = function (DataType: TSheetDataType; SheetIndex,Col,Row: integer): WideString of object;

type TFormulaHandler = class(TObject)
private
     FOwner: TPersistent;
     FVersion: TExcelVersion;
     FSheetNameEvent: TSheetNameEvent;
     FSheetDataEvent: TSheetDataEvent;
     FFormulaEncoder: TEncodeFormula;
     FExternalNames: TExternalNames;
     FInternalNames: TInternalNames;

     procedure FormulaUnknownFunction(Name: WideString; var ID: integer);
     procedure FormulaUnknownName(Name: WideString; var ID: integer);
     procedure FormulaExternName(Path,Filename,SheetName,Ref: WideString; var ExtIndex,NameIndex: integer);
     procedure SetVersion(const Value: TExcelVersion);
public
     constructor Create(AOwner: TPersistent);
     destructor Destroy; override;
     procedure Clear;
     function  DecodeFormula(Buf: PByteArray; Len: integer): WideString;
     function  DecodeFormulaRel(Buf: PByteArray; Len: integer; SheetIndex,Col,Row: integer): WideString;
     function  EncodeFormula(Formula: WideString; var Buf: PByteArray; BufSz: integer): integer;
     function  GetName(NameType: TFormulaNameType; SheetIndex,NameIndex,Col,Row: integer): WideString;
     procedure GetNameRef(AName: string; out ASheetIndex,ACol,ARow: integer);

     property Version: TExcelVersion read FVersion write SetVersion;
     property InternalNames: TInternalNames read FInternalNames write FInternalNames;
     property ExternalNames: TExternalNames read FExternalNames write FExternalNames;

     property OnSheetName: TSheetNameEvent read FSheetNameEvent write FSheetNameEvent;
     property OnSheetData: TSheetDataEvent read FSheetDataEvent write FSheetDataEvent;
     end;

implementation

{ TFormulaHandler }

procedure TFormulaHandler.Clear;
begin
  FExternalNames.Clear;
  FInternalNames.Clear;
end;

constructor TFormulaHandler.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
  FFormulaEncoder := TEncodeFormula.Create;
  FFormulaEncoder.OnUnknownFunction := FormulaUnknownFunction;
  FFormulaEncoder.OnUnknownName := FormulaUnknownName;
  FFormulaEncoder.OnExternName := FormulaExternName;

  FExternalNames := TExternalNames.Create;
  FInternalNames := TInternalNames.Create(FOwner,GetName,FFormulaEncoder);
end;

function TFormulaHandler.DecodeFormula(Buf: PByteArray; Len: integer): WideString;
begin
  Result := DecodeFmla(FVersion,Buf,Len,-1,-1,-1,GetName);
end;

function TFormulaHandler.DecodeFormulaRel(Buf: PByteArray; Len, SheetIndex, Col, Row: integer): WideString;
begin
  Result := DecodeFmla(FVersion,Buf,Len,SheetIndex,Col,Row,GetName);
end;

destructor TFormulaHandler.Destroy;
begin
  FInternalNames.Free;
  FExternalNames.Free;
  FFormulaEncoder.Free;
  inherited;
end;

function TFormulaHandler.EncodeFormula(Formula: WideString; var Buf: PByteArray; BufSz: integer): integer;
begin
  Result := FFormulaEncoder.Encode(Formula,Buf,BufSz);
end;

procedure TFormulaHandler.FormulaExternName(Path,Filename,SheetName,Ref: WideString; var ExtIndex, NameIndex: integer);
var
  Index,TabCount: integer;
begin
  if (Path = '') and (Filename = '') then begin
    FSheetNameEvent(SheetName,Index,TabCount);
    if Index >= 0 then begin
      ExtIndex := FExternalNames.AddSelf(Index,TabCount);
      NameIndex := Index;
    end;
  end
  else begin
    if Ref <> '' then
      FExternalNames.IndexByName(Path,Filename,Ref,ExtIndex,NameIndex)
    else
      FExternalNames.AddRef(Path,Filename,SheetName,ExtIndex);
  end;
end;

procedure TFormulaHandler.FormulaUnknownFunction(Name: WideString; var ID: integer);
begin
  ID := -1;
end;

procedure TFormulaHandler.FormulaUnknownName(Name: WideString; var ID: integer);
begin
  ID := FInternalNames.FindName(Name);
end;

function TFormulaHandler.GetName(NameType: TFormulaNameType; SheetIndex, NameIndex, Col, Row: integer): WideString;
var
  i: integer;
begin
  case NameType of
    ntExternSheet: begin
      i := FExternalNames.IsSelf(SheetIndex);
      if i >= 0 then
        Result := FSheetDataEvent(sdtName,i,-1,-1) + '!'
      else
        Result := FExternalNames.AsString[SheetIndex,NameIndex];
    end;
    ntCellValue: begin
      Result := FSheetDataEvent(sdtName,SheetIndex,Col,Row)
    end;
    else
      Result := FInternalNames[NameIndex - 1].NameName;
  end;
end;

procedure TFormulaHandler.GetNameRef(AName: string; out ASheetIndex, ACol, ARow: integer);
var
  i: integer;
begin
  i := FInternalNames.FindName(AName);
  if i < 0 then
    raise Exception.CreateFmt('Can not find name "%s"',[AName]);
  if (Length(FInternalNames[i].NameDef) = 11) and (FInternalNames[i].NameDef[0] = ptgArea3d) then
    raise Exception.CreateFmt('Name "%s" is an area',[AName]);
  if (Length(FInternalNames[i].NameDef) = 7) and (FInternalNames[i].NameDef[0] = ptgRef3d) then begin
    with PPTGRef3d8(@FInternalNames[i].NameDef[1])^ do begin
      ASheetIndex := FExternalNames.IsSelf(Index);
      if ASheetIndex < 0 then
        raise Exception.CreateFmt('Name "%s" is not an internal name',[AName]);
      ACol := Col;
      ARow := Row;
    end;
  end
  else
    raise Exception.CreateFmt('Name "%s" is not valid',[AName]);
end;

procedure TFormulaHandler.SetVersion(const Value: TExcelVersion);
begin
  FVersion := Value;
  FFormulaEncoder.ExcelVersion := FVersion;
end;

end.