escher2.pas

一个经典的读写Excel的控件

unit Escher2;

{
********************************************************************************
******* 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

{$I XLSRWII2.inc}

uses Classes, SysUtils, XLSStream2, BIFFRecsII2, RecordStorage2, EscherTypes2,
{$ifdef USE_ZLIB}
     ZLib,
{$endif}
{$ifdef USE_PNGIMAGE}
     PNGImage,
{$endif}
     XLSUtils2, Windows, XLS_MD4Hash, ExcelFuncII2, XLSNames2, Graphics,
     XLSFonts2, RecordStorageChart2;

type TBasicShapeType = (bstLine,bstArrow,bstEllipse,bstRectangle);

type TAutoShapeType = (astSun,astMoon,astLeftArrow,astDownArrow,
astUpArrow,astLeftRightArrow,astUpDownArrow,astQuadArrow,astLeftArrowCallout,
astRightArrowCallout,astUpArrowCallout,astDownArrowCallout,
astLeftRightArrowCallout,astUpDownArrowCallout,astQuadArrowCallout);


type TOptValType = (ovtLongword,ovtString,ovtPointer);

type POPTData = ^TOPTData;
     TOPTData = record
     Options: word;
     Value: longword;
     Extra: PByteArray;
     end;

type PMSORecord = ^TMSORecord;
     TMSORecord = record
     VerInst: word;
     FBT: word;
     Length: longword;
     Data: array[0..MAXINT div 2] of byte;
     end;

type TEscherDrawing = class;
     TEscherGroup = class;

     TMSORecords = class(TList)
private
     function  GetData(Index: integer): PByteArray;
     function  GetFBT(Index: integer): word;
     function  GetInstance(Index: integer): word;
     function  GetLength(Index: integer): longword;
     function  GetVersion(Index: integer): byte;
     function  GetItems(Index: integer): PMSORecord;
public
     destructor Destroy; override;
     procedure Clear; override;
     procedure Add(Header: TMSOHeader; Data: PByteArray);
     procedure AddSP(ShapeType: word; SpId, Options: longword);
     procedure Write(Stream: TXLSStream);
     function  Size: integer;
     procedure Assign(Records: TMSORecords);

     property Items[Index: integer]: PMSORecord read GetItems; default;
     property Version[Index: integer]: byte read GetVersion;
     property Instance[Index: integer]: word read GetInstance;
     property FBT[Index: integer]: word read GetFBT;
     property Length[Index: integer]: longword read GetLength;
     property Data[Index: integer]: PByteArray read GetData;
     end;

     TOPT = class(TList)
private
     FItemCount: integer;

     function  GetId(Index: integer): word;
     function  GetComplex(Index: integer): boolean;
     function  GetValue(Index: integer): longword;
     procedure SetValue(Index: integer; const Value: longword);
     function  GetExtra(Index: integer): PByteArray;
public
     destructor Destroy; override;
     procedure Clear; override;
     procedure Assign(OPT: TOPT);
     procedure AddValue(Id: word; Value: longword; IsBlip: boolean = False);
     procedure AddString(Id: word; Value: WideString);
     procedure AddExtra(Id: word; Value: integer; IsBlip: boolean = False);
     procedure LoadFromStream(Stream: TXLSStream; Length: integer; PBuf: PByteArray; ItemCount: integer);
     procedure LoadFromBuffer(Length: integer; PBuf: PByteArray; ItemCount: integer);
     procedure WriteToStream(Stream: TXLSStream; PBuf: PByteArray);
     procedure WriteToBuffer(PBuf: PByteArray; IncludeHeader: boolean = True);
     function  Size: integer;
     function  TxId: longword;
     function  BlipId: integer;
     procedure SetBlipId(Id: integer);
     function  Find(Id: integer): integer;
     function  FindValue(Id: integer): longword;
     function  FindString(Id: integer): WideString;
     procedure UpdateValue(Id: integer; Value: longword);
     procedure UpdateString(Id: integer; Value: WideString);
     procedure UpdateExtra(Id: integer; Size: integer);
     procedure SetItemCount;

     property Id[Index: integer]: word read GetId;
     property Value[Index: integer]: longword read GetValue write SetValue;
     property Complex[Index: integer]: boolean read GetComplex;
     property Extra[Index: integer]: PByteArray read GetExtra;
     end;

     TShapeOutsideMso = class(TObject)
protected
     FOwnsObjData: boolean;
     FObjId: word;
     FOptions: word;

     function  ParseOBJ(OBJ: TBaseRecordStorage): boolean; virtual;
public
     constructor Create(ObjId: integer);
     procedure Assign(Shape: TShapeOutsideMso); virtual; abstract;
     procedure Read(Stream: TXLSStream; PBuf: PByteArray); virtual; abstract;
     procedure Write(Stream: TXLSStream); virtual; abstract;
     end;

     TShapeOutsideMsoChart = class(TShapeOutsideMso)
protected
     FRecords: TChartRecordUpdate;
     FDrawing: TEscherDrawing;
     FDrawingGroup: TEscherGroup;
     FFonts: TXFonts;
public
     constructor Create(ObjId: integer; DrawingGroup: TEscherGroup; Fonts: TXFonts);
     destructor Destroy; override;
     procedure Assign(Shape: TShapeOutsideMso); override;
     procedure Read(Stream: TXLSStream; PBuf: PByteArray); override;
     procedure Write(Stream: TXLSStream); override;

     property Records: TChartRecordUpdate read FRecords;
     property Drawing: TEscherDrawing read FDrawing write FDrawing;
     property DrawingGroup: TEscherGroup read FDrawingGroup;
     property Fonts: TXFonts read FFonts;
     end;

     TShapeOutsideMsoBaseText = class(TShapeOutsideMso)
  private
    procedure SetText(const Value: WideString);
protected
     FpTXO: PRecTXO;
     FText: WideString;
     FTXORuns: TDynTXORUNArray;
public
     constructor Create(ObjId: integer);
     destructor Destroy; override;
     procedure Assign(Shape: TShapeOutsideMso); override;
     procedure SetDefaultTxo;
     procedure Read(Stream: TXLSStream; PBuf: PByteArray); override;
     procedure Write(Stream: TXLSStream); override;

     property TXO: PRecTXO read FpTXO;
     property Text: WideString read FText write SetText;
     property Formatting: TDynTXORUNArray read FTXORuns;
     end;

     TShapeOutsideMsoNote = class(TShapeOutsideMsoBaseText)
protected
     FCellCol,FCellRow: integer;
     FOptions: word;
     FAuthor: WideString;
public
     procedure Assign(Shape: TShapeOutsideMso); override;
     property CellCol: integer read FCellCol write FCellCol;
     property CellRow: integer read FCellRow write FCellRow;
     property Options: word read FOptions write FOptions;
     property Author: WideString read FAuthor write FAuthor;
     end;

     TShapeControl = class(TShapeOutsideMso)
protected
public
     end;

     TShapeControlListBox = class(TShapeControl)
protected
     FIsComboBox: boolean;
     FSBS: TObjSBS;
     FSBSFormula: array of byte;
     FSBSFormulaOrig: array of byte;
     FLBSReserved1: word;
     FLBSReserved2: array[0..3] of byte;
     FLBS: TObjLBS;
     FLBSOrig: array of byte;
     FLBSFormula: array of byte;
     FMultiselect: array of byte;
     FMacroFormula: array of byte;
     FChanged: boolean;

     function  ParseOBJ(OBJ: TBaseRecordStorage): boolean; override;
public
     constructor Create(ObjId: integer);
     procedure Assign(Shape: TShapeOutsideMso); override;
     procedure Read(Stream: TXLSStream; PBuf: PByteArray); override;
     procedure Write(Stream: TXLSStream); override;
     procedure GetDestCell(var Col,Row: integer);
     procedure SetDestCell(Col,Row: integer);
     procedure GetSourceArea(var Col1,Row1,Col2,Row2: integer);
     procedure SetSourceArea(Col1,Row1,Col2,Row2: integer);
     end;

     TShapeControlComboBox = class(TShapeControlListBox)
protected
public
     constructor Create(ObjId: integer);
     end;

     TShapeControlButton = class(TShapeOutsideMsoBaseText)
protected
     FDrawing: TEscherDrawing;
     FMacroFormula: array of byte;

     function  ParseOBJ(OBJ: TBaseRecordStorage): boolean; override;
public
     constructor Create(ObjId: integer; Drawing: TEscherDrawing);
     procedure Write(Stream: TXLSStream); override;
     function SetMacro(Value: WideString): boolean;
     function GetMacro: WideString;
     end;

     TShape = class(TObject)
  private
    procedure SetShapeType(const Value: integer);
protected
     FSpId: longword;
     FShapeType: integer;
     FOptions: longword;
     FOPT: TOPT;
     FUnknown: TMSORecords;
     FOBJ: TBaseRecordStorage;
     FInterface: TShapeOutsideMso;
public
     constructor Create;
     destructor Destroy; override;
     function  Size: integer; virtual;
     procedure WriteToStream(Stream: TXLSStream; PBuf: PByteArray; WriteMSODRAWING: boolean); virtual;
     procedure Assign(Shape: TShape); virtual;

     property SpId: longword read FSpId;
     property ShapeType: integer read FShapeType write SetShapeType;
     property Options: longword read FOptions;
     property OPT: TOPT read FOPT;
     property ExShape: TShapeOutsideMso read FInterface write FInterface;
     end;

     TShapeClientAnchor = class(TShape)
private
     function  GetFlipHorizontal: boolean;
     function  GetFlipVertical: boolean;
     procedure SetFlipHorizontal(const Value: boolean);
     procedure SetFlipVertical(const Value: boolean);
protected
     FCLIENTANCHOR: TMSORecCLIENTANCHOR;
public
     function Size: integer; override;
     procedure Assign(Shape: TShape); override;
published
     property Col1:     word read FCLIENTANCHOR.Col1       write FCLIENTANCHOR.Col1;
     property Col2:     word read FCLIENTANCHOR.Col2       write FCLIENTANCHOR.Col2;
     property Col1Offs: word read FCLIENTANCHOR.Col1Offset write FCLIENTANCHOR.Col1Offset;
     property Col2Offs: word read FCLIENTANCHOR.Col2Offset write FCLIENTANCHOR.Col2Offset;
     property Row1:     word read FCLIENTANCHOR.Row1       write FCLIENTANCHOR.Row1;
     property Row2:     word read FCLIENTANCHOR.Row2       write FCLIENTANCHOR.Row2;
     property Row1Offs: word read FCLIENTANCHOR.Row1Offset write FCLIENTANCHOR.Row1Offset;
     property Row2Offs: word read FCLIENTANCHOR.Row2Offset write FCLIENTANCHOR.Row2Offset;
     property FlipHorizontal: boolean read GetFlipHorizontal write SetFlipHorizontal;
     property FlipVertical: boolean read GetFlipVertical write SetFlipVertical;
     end;

     TShapeChildAnchor = class(TShape)
protected
     FCHILDANCHOR: TMSORecCHILDANCHOR;
public
     function Size: integer; override;
     procedure Assign(Shape: TShape); override;
published
     property X1: longword read FCHILDANCHOR.X1 write FCHILDANCHOR.X1;
     property Y1: longword read FCHILDANCHOR.Y1 write FCHILDANCHOR.Y1;
     property X2: longword read FCHILDANCHOR.X2 write FCHILDANCHOR.X2;
     property Y2: longword read FCHILDANCHOR.Y2 write FCHILDANCHOR.Y2;
     end;

     TShapeGroup = class(TShapeClientAnchor)
private
     FDrawing: TEscherDrawing;
     FList: TList;
     FSPGR: TMSORecSPGR;

     function GetItems(Index: integer): TShape;
public
     constructor Create(Drawing: TEscherDrawing);
     destructor Destroy; override;
     procedure Clear;
     procedure Assign(Shape: TShape); override;
     function  Size: integer; override;
     function  PrivateSize: integer;
     procedure WriteToStream(Stream: TXLSStream; PBuf: PByteArray; WriteMSODRAWING: boolean); override;
     procedure Add(Shape: TShape);
     procedure Delete(Index: integer);
     procedure DeleteBySpId(SpId: integer);
     function  Count: integer;

     property Items[Index: integer]: TShape read GetItems; default;
     property SPGR: TMSORecSPGR read FSPGR;
     end;

     TFileReadShapeEvent = procedure (Sender: TObject; Shape: TShape) of object;

     TEscherDrawing = class(TObject)
private
     FParent: TEscherGroup;
     FGroup: TShapeGroup;
     FDgId: word;
     FDG: TMSORecDG;
     FFileReGroupItems: array of TMSOFileReGroupItem;
     FSolverContainer: TMSORecords;
     FFileReadShapeEvent: TFileReadShapeEvent;
     FFonts: TXFonts;
     FInternalNames: TInternalNames;
     FMaxObjId: integer;
protected
     function  ReadRoot(Stream: TXLSStream; PBuf: PByteArray): integer;
     procedure ReadOBJ(Shape: TShape; Stream: TXLSStream; PBuf: PByteArray);
     function  GetSpId: integer;
     function  MaxSpId: integer;
     function  GetObjId: integer;
     procedure SetRootData;
public
     constructor Create(Parent: TEscherGroup; Fonts: TXFonts; InternalNames: TInternalNames);
     destructor Destroy; override;
     procedure Clear;
     function  ShapeCount: integer;
     procedure LoadFromStream(Stream: TXLSStream; PBuf: PByteArray);
     // 040527
     procedure SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
//     procedure SaveToStream(Stream: TXLSStream; PBuf: PByteArray; DrawingId: integer);
     procedure SetNoteData(Col,Row,Options,ObjId: word; Author: WideString);
     procedure AssignBlipIds(Blips: TList);
     procedure SetBlipRefCount;
     procedure AddEmpty;
     procedure Copy(Index: integer; DestCol,DestRow: word); overload;
     procedure Copy(Col1,Row1,Col2,Row2,DestCol,DestRow: word); overload;
     procedure CopyList(List: TList; Col1,Row1,Col2,Row2: integer);
     procedure InsertList(List: TList; DestCol,DestRow: integer);
     procedure DeleteList(List: TList);
     procedure Move(Index: integer; DestCol,DestRow: word); overload;
     procedure Move(Col1,Row1,Col2,Row2,DestCol,DestRow: word); overload;

     // Never call any of these methods directly. TDrawingObjects and
     // TControlObjects will go out of sync.
     procedure DeleteShape(SpId: integer);
     function  AddTextBox: TShapeClientAnchor;
     function  AddNote: TShapeClientAnchor;
     function  AddBasic: TShapeClientAnchor;
     function  AddAutoShape: TShapeClientAnchor;
     function  AddPicture: TShapeClientAnchor;
     function  AddChart: TShapeClientAnchor;

     function  AddListBox: TShapeClientAnchor;
     function  AddComboBox: TShapeClientAnchor;
     function  AddButton: TShapeClientAnchor;

     property EscherGroup: TEscherGroup read FParent;
     property OnReadShape: TFileReadShapeEvent read FFileReadShapeEvent write FFileReadShapeEvent;
     end;

     TDGGData = class(TObject)
private
     FFIDCL: TDGGRecFIDCL;
     FDrawing: TEscherDrawing;