uxlsbaserecords.pas

来自「DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件」· PAS 代码 · 共 1,072 行 · 第 1/3 页

  end
end;

function LoadRecord(const DataStream: TStream; const RecordHeader: TRecordHeader): TBaseRecord;
var
  Data: PArrayOfByte;
  R: TBaseRecord;
  NextRecordHeader: TRecordHeader;
begin
  GetMem(Data, RecordHeader.Size);
  try
    if DataStream.Read(Data^, RecordHeader.Size) <> RecordHeader.Size then
      raise Exception.Create(ErrExcelInvalid);
  except
    FreeMem(Data);
    raise;
  end; //except

  //From here, if there is an exception, the mem will be freed by the object
  case RecordHeader.Id of
    xlr_BOF         : R:= TBOFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_EOF         : R:= TEOFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FORMULA     : R:= TFormulaRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_SHRFMLA     : R:= TShrFmlaRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_OBJ         : R:= TObjRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MSODRAWING  : R:= TDrawingRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MSODRAWINGGROUP
                    : R:= TDrawingGroupRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_TXO         : R:= TTXORecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_NOTE        : R:= TNoteRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_RECALCID,   //So the workbook gets recalculated
    xlr_EXTSST,     // We will have to generate this again
    xlr_DBCELL,     //To find rows in blocks... we need to calculate it again
    xlr_INDEX,      //Same as DBCELL
    xlr_MSODRAWINGSELECTION   // Object selection. We do not need to select any drawing
                    : R:= TIgnoreRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DIMENSIONS  //Used range of a sheet
                    : R:= TDimensionsRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_SST         : R:= TSSTRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_BoundSheet  : R:= TBoundSheetRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_Array       : R:= TArrayRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Blank       : R:= TBlankRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_BoolErr     : R:= TBoolErrRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Number      : R:= TNumberRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MulBlank    : R:= TMulBlankRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MulRK       : R:= TMulRKRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_RK          : R:= TRKRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_STRING      : R:= TStringRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);//String record saves the result of a formula

    xlr_XF          : R:= TXFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FONT        : R:= TFontRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FORMAT      : R:= TFormatRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Palette     : R:= TPaletteRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Style       : R:= TStyleRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_LabelSST    : R:= TLabelSSTRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Label       : R:= TLabelRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Row         : R:= TRowRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_NAME        : R:= TNameRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_TABLE       : R:= TTableRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_CELLMERGING : R:= TCellMergingRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_CONDFMT     : R:= TCondFmtRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_CF          : R:= TCFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DVAL        : R:= TDValRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Continue    : R:= TContinueRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_FOOTER      : R:= TPageFooterRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_HEADER      : R:= TPageHeaderRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_PRINTGRIDLINES : R:= TPrintGridLinesRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_LEFTMARGIN,
    xlr_RIGHTMARGIN,
    xlr_TOPMARGIN,
    xlr_BOTTOMMARGIN: R:= TMarginRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_SETUP       : R:= TSetupRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_WSBOOL      : R:= TWsBoolRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_XCT,        // Cached values of a external workbook... not supported yet
    xlr_CRN         // Cached values also
                    : R:=TIgnoreRecord.Create(RecordHeader.Id, Data, RecordHeader.Size); //raise Exception.Create (ErrExtRefsNotSupported);
    xlr_SUPBOOK     : R:= TSupBookRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_EXTERNSHEET : R:= TExternSheetRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_ChartAI     : R:= TChartAIRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Window1     : R:= TWindow1Record.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Window2     : R:= TWindow2Record.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_SCL         : R:= TSCLRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_HORIZONTALPAGEBREAKS: R:= THPageBreakRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_VERTICALPAGEBREAKS  : R:= TVPageBreakRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_COLINFO     : R:= TColInfoRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DEFCOLWIDTH : R:= TDefColWidthRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DEFAULTROWHEIGHT: R:= TDefRowHeightRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_FILEPASS: raise Exception.Create(ErrFileIsPasswordProtected);

    else              R:= TBaseRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
  end; //case

  //Peek at the next record...
  if DataStream.Read(NextRecordHeader, SizeOf(NextRecordHeader))= SizeOf(NextRecordHeader) then
  begin
    if NextRecordHeader.Id = xlr_Continue then R.AddContinue(LoadRecord(DataStream, NextRecordHeader) as TContinueRecord)
    else if NextRecordHeader.Id=xlr_Table then
      if (R is TFormulaRecord) then
      begin
        (R as TFormulaRecord).TableRecord:=LoadRecord(DataStream, NextRecordHeader) as TTableRecord;
      end
      else Exception.Create(ErrExcelInvalid)
    else if NextRecordHeader.Id=xlr_Array then
      if (R is TFormulaRecord) then
      begin
        (R as TFormulaRecord).ArrayRecord:=LoadRecord(DataStream, NextRecordHeader) as TArrayRecord;
      end
      else Exception.Create(ErrExcelInvalid)
    else
    begin
      if NextRecordHeader.Id = xlr_String then
      begin
        if not (R is TFormulaRecord) and not (R is TShrFmlaRecord) and not (R is TArrayRecord) and not (R is TTableRecord) then raise Exception.Create(ErrExcelInvalid);
      end;
      DataStream.Seek(-SizeOf(NextRecordHeader),soFromCurrent);
    end;
  end;

  Result:=R;
end;

{ TBaseRecord }

procedure TBaseRecord.AddContinue(const aContinue: TContinueRecord);
begin
  if Continue<>nil then raise Exception.Create(ErrInvalidContinue);
  Continue:=aContinue;
end;

function TBaseRecord.CopyTo: TBaseRecord;
begin
  if Self=nil then Result:= nil   //for this to work, this cant be a virtual method
  else Result:=DoCopyTo;
end;

constructor TBaseRecord.Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);
begin
  inherited Create;
  Id := aId;
  Data := aData;
  DataSize := aDataSize;
end;

destructor TBaseRecord.Destroy;
begin
  if Data<>nil then FreeMem(Data);
  FreeAndNil(Continue);
  inherited;
end;

function TBaseRecord.DoCopyTo: TBaseRecord;
var
  NewData: PArrayOfByte;
begin
  GetMem(NewData, DataSize);
  try
    Move(Data^, NewData^, DataSize);
    Result:= ClassOfTBaseRecord(ClassType).Create(Id, NewData, DataSize);
  except
    FreeMem(NewData);
    raise;
  end;
  if Continue<>nil then Result.Continue:= Continue.CopyTo as TContinueRecord;
end;

procedure TBaseRecord.SaveDataToStream(const Workbook: TStream;
  const aData: PArrayOfByte);
begin
  if Workbook.Write(Id, Sizeof(Id)) <> Sizeof(Id) then raise Exception.Create(ErrCantWrite);
  if Workbook.Write(DataSize, Sizeof(DataSize)) <> Sizeof(DataSize) then raise Exception.Create(ErrCantWrite);
  if DataSize > 0 then
    if Workbook.Write(aData^, DataSize) <> DataSize then
      raise Exception.Create(ErrCantWrite);
end;

procedure TBaseRecord.SaveToStream(const Workbook: TStream);
begin
  SaveDataToStream(Workbook, Data);
  if Continue<>nil then Continue.SaveToStream(Workbook);
end;

function TBaseRecord.TotalSize: integer;
begin
  Result:=SizeOf(TRecordHeader)+ DataSize;
  if Continue<>nil then Result:=Result+Continue.TotalSize;
end;

function TBaseRecord.TotalSizeNoHeaders: integer;
begin
  Result:=DataSize;
  if Continue<>nil then Result:=Result+Continue.TotalSizeNoHeaders;
end;

{ TBaseRowColRecord }

procedure TBaseRowColRecord.ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
begin
  if DataSize<4 then raise Exception.CreateFmt(ErrWrongExcelRecord,[Id]);
  if (SheetInfo.InsSheet<0) or (SheetInfo.FormulaSheet<> SheetInfo.InsSheet) then exit;
  if aPos<= Row then IncWord(Data, 0, aCount, Max_Rows);  //row;
end;

constructor TBaseRowColRecord.Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);
begin
  inherited;
  if DataSize<4 then raise Exception.CreateFmt(ErrWrongExcelRecord,[Id]);
end;

procedure TBaseRowColRecord.ArrangeCopy(const NewRow: Word);
begin
  if DataSize<4 then raise Exception.CreateFmt(ErrWrongExcelRecord,[Id]);
  SetWord(Data, 0, NewRow);  //row;
end;

function TBaseRowColRecord.GetColumn: word;
begin
  GetColumn:=GetWord(Data,2);
end;

function TBaseRowColRecord.GetRow: word;
begin
  GetRow:=GetWord(Data,0);
end;

procedure TBaseRowColRecord.SetColumn(Value: word);
begin
  SetWord(Data,2,Value);
end;

procedure TBaseRowColRecord.SetRow(Value: word);
begin
  SetWord(Data,0,Value);
end;

{ TIgnoreRecord }

procedure TIgnoreRecord.SaveToStream(const Workbook: TStream);
begin
  //nothing
end;

function TIgnoreRecord.TotalSize: integer;
begin
  Result:=0;
end;

{ TStringRecord }
//We won't write out this record

procedure TStringRecord.SaveToStream(const Workbook: TStream);
begin
  //Nothing.
end;

function TStringRecord.TotalSize: integer;
begin
  Result:=0;
end;

function TStringRecord.Value: widestring;
var
  xs: TExcelString;
  Myself: TBaseRecord;
  Ofs: integer;
begin
  Myself:=Self;Ofs:=0;
  xs:=TExcelString.Create(2, Myself, Ofs);
  try
    Result:=Xs.Value;
  finally
    freeAndNil(xs);
  end;
end;


{ TRowRecord }

constructor TRowRecord.Create(const aId: word; const aData: PArrayOfByte;
  const aDataSize: integer);
begin
  inherited;
  //Set irwMac=0
  SetWord(Data, 8, 0);
end;

constructor TRowRecord.CreateStandard(const Row: word);
var
  MyData: PArrayOfByte;
begin
  GetMem(myData, 16);
  FillChar(myData^,16, 0);
  SetWord(myData, 0, Row);
  SetWord(myData, 6, $FF);
  myData[13]:=1;
  myData[14]:=$0F; //Default format.
  inherited Create(xlr_ROW, myData, 16);
end;

function TRowRecord.GetHeight: word;
begin
  Result:=GetWord(Data, 6);
end;

function TRowRecord.GetMaxCol: word;
begin
  Result:=GetWord(Data, 4);
end;

function TRowRecord.GetMinCol: word;
begin
  Result:=GetWord(Data, 2);
end;

function TRowRecord.GetXF: word;
begin
  if IsFormatted then Result:=GetWord(Data, 14) and $FFF else Result:=15;
end;

function TRowRecord.GetRow: Word;
begin
  Result:= GetWord(Data, 0);
end;

procedure TRowRecord.SetHeight(const Value: word);
begin
  SetWord( Data, 6, Value);
end;

procedure TRowRecord.SetMaxCol(const Value: word);
begin
  SetWord( Data, 4, Value);
end;

procedure TRowRecord.SetMinCol(const Value: word);
begin
  SetWord( Data, 2, Value);
end;

procedure TRowRecord.ManualHeight;
begin
  Data[12]:= Data[12] or $40;
end;