uxlssheet.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 1,602 行 · 第 1/4 页

      inc(Result, (FRanges[i] as TMergedCells).MergedCount);
end;

procedure TWorkSheet.UnMergeCells(aRow1, aCol1, aRow2, aCol2: integer);
var
  x: integer;
  i: integer;
begin
  if aRow1>aRow2 then begin x:=aRow2;aRow2:=aRow1; aRow1:=x;end;
  if aCol1>aCol2 then begin x:=aCol2;aCol2:=aCol1; aCol1:=x;end;

  for i:=0 to FRanges.Count-1 do
    if FRanges[i] is TMergedCells then
    begin
      (FRanges[i] as TMergedCells).UnMergeCells(aRow1, aCol1, aRow2, aCol2);
    end;
end;

procedure TWorkSheet.MergeCells(aRow1, aCol1, aRow2, aCol2: integer);
var
  x: integer;
  Mc: TMergedCells;
  i: integer;
  bRow1, bCol1, bRow2, bCol2: integer;
begin
  if aRow1>aRow2 then begin x:=aRow2;aRow2:=aRow1; aRow1:=x;end;
  if aCol1>aCol2 then begin x:=aCol2;aCol2:=aCol1; aCol1:=x;end;

  //We have to take all existing included merged cells

  Mc:=nil;
  repeat
    bRow1:=aRow1; bRow2:=aRow2; bCol1:=aCol1; bCol2:=aCol2;
    for i:=0 to FRanges.Count-1 do
      if FRanges[i] is TMergedCells then
      begin
        Mc:=(FRanges[i] as TMergedCells);
        Mc.PreMerge(aRow1, aCol1, aRow2, aCol2)
      end;
  until (aRow1=bRow1) and (aRow2=bRow2) and (aCol1=bCol1) and (aCol2=bCol2);

  if Mc=nil then Mc:=FRanges[FRanges.Add(TMergedCells.Create)] as TMergedCells;
  Mc.MergeCells(aRow1, aCol1, aRow2, aCol2);
end;


function TWorkSheet.TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64;
begin
  Result:= inherited TotalRangeSize(SheetIndex, CellRange)+
    FMiscRecords1.TotalSize +
    FHPageBreaks.TotalRangeSize(CellRange) +
    FVPageBreaks.TotalRangeSize(CellRange) +
    FCells.TotalRangeSize(CellRange)+
    FRanges.TotalRangeSize(CellRange) +
    FDrawing.TotalSize +
    FMiscRecords2.TotalSize+
    FNotes.TotalRangeSize(CellRange)+
    FColumns.TotalRangeSize(CellRange)+
    FHLinks.TotalRangeSize(CellRange);
end;

function TWorkSheet.TotalSize: int64;
begin
  Result:= inherited TotalSize+
    FMiscRecords1.TotalSize +
    FHPageBreaks.TotalSize +
    FVPageBreaks.TotalSize +
    FCells.TotalSize +
    FRanges.TotalSize +
    FDrawing.TotalSize +
    FMiscRecords2.TotalSize+
    FNotes.TotalSize+
    FColumns.TotalSize+
    FHLinks.TotalSize;
end;

procedure TWorkSheet.SetPageHeaderFooter(const P: TPageHeaderFooterRecord;
  const s: Widestring);
var
  OldSize: integer;
begin
  if P=nil then exit;
  OldSize:=P.DataSize;
  P.Text:=s;
  FMiscRecords1.AdaptSize(P.DataSize-OldSize);
end;

function TWorkSheet.HasHPageBreak(const Row: integer): boolean;
begin
  Result:=FHPageBreaks.HasPageBreak(Row);
end;

function TWorkSheet.HasVPageBreak(const Col: integer): boolean;
begin
  Result:=FVPageBreaks.HasPageBreak(Col);
end;


function TWorkSheet.GetPrintNumberOfHorizontalPages: word;
begin
  if FSetup= nil then Result:=1 else
    Result:= FSetup.FitWidth;
end;

function TWorkSheet.GetPrintNumberOfVerticalPages: word;
begin
  if FSetup= nil then Result:=1 else
    Result:= FSetup.FitHeight;
end;

function TWorkSheet.GetPrintScale: integer;
begin
  if FSetup= nil then Result:=100 else
    Result:= FSetup.Scale;
end;

function TWorkSheet.GetPrintToFit: boolean;
begin
  if FWsBool= nil then Result:=false else
    Result:= FWsBool.FitToPage;
end;

procedure TWorkSheet.SetPrintNumberOfHorizontalPages(const Value: word);
begin
  if FSetup<>nil then FSetup.FitWidth:=Value;
end;

procedure TWorkSheet.SetPrintNumberOfVerticalPages(const Value: word);
begin
  if FSetup<>nil then FSetup.FitHeight:=Value;
end;

procedure TWorkSheet.SetPrintScale(const Value: integer);
begin
  if (Value<Low(Word))or (Value>High(Word)) then
    raise Exception.CreateFmt(ErrXlsIndexOutBounds, [Value, 'PrintScale', Low(Word), High(Word)]);
  if FSetup<>nil then FSetup.Scale:=Value;
end;

procedure TWorkSheet.SetPrintToFit(const Value: boolean);
begin
  if FWSBool<>nil then FWsBool.FitToPage:=value;
end;

procedure TWorkSheet.AddImage(const Data: string; const DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType);
begin
  FDrawing.AddImage(Data, DataType, Properties, Anchor);
end;

procedure TWorkSheet.ClearImage(const Index: integer);
begin
  FDrawing.ClearImage(Index);
end;

procedure TWorkSheet.DeleteImage(const Index: integer);
begin
  FDrawing.DeleteImage(Index);
end;

procedure TWorkSheet.AddZoomRecord;
begin
  if FMiscRecords2.Count>1 then
  begin
    FMiscRecords2.Insert(1,TSCLRecord.CreateFromData(100));
    FZoom:=FMiscRecords2[1] as TSCLRecord;
  end;
end;

procedure TWorkSheet.AddNewComment(const Row, Col: integer;
  const Txt: widestring; const Properties: TImageProperties);
begin
  FNotes.AddNewComment(Row, Col, Txt, FDrawing, Properties);
end;


procedure TWorkSheet.ClearValues;
begin
  Clear;
  DoCreateFromData(FWorkbookGlobals.SST);
end;

function TWorkSheet.GetPrintOptions: word;
begin
  if FSetup= nil then Result:=0 else
    Result:= FSetup.PrintOptions;
end;

procedure TWorkSheet.SetPrintOptions(const Value: word);
begin
  if FSetup<>nil then FSetup.PrintOptions:=Value;
end;

procedure TWorkSheet.FixCachePointers;
var
  i: integer;
begin
  inherited;
  for i:=0 to FMiscRecords1.Count-1 do
    LoadCachePointers(FMiscRecords1[i] as TBaseRecord);
  for i:=0 to FMiscRecords2.Count-1 do
    LoadCachePointers(FMiscRecords2[i] as TBaseRecord);
end;


function TWorkSheet.GetColOutlineLevel(col: integer): integer;
var
  Index: integer;
begin
  if not FColumns.Find(col, Index) then
    Result:= 0
  else
    Result:= FColumns[Index].GetColOutlineLevel;
end;

function TWorkSheet.GetRowOutlineLevel(row: integer): integer;
begin
  if not FCells.RowList.HasRow(row) then
    Result:=0
  else
    Result:= FCells.RowList[row].Options and $07;
end;

procedure TWorkSheet.SetColOulineLevel(col: integer; const Value: integer);
var
  Index: integer;
begin
  EnsureGuts();
  FGuts.RecalcNeeded:=true;
  Index:=-1;
  if (not FColumns.Find(col, Index)) then
    FColumns.Insert(Index, TColInfo.Create(col, DefColWidth, 15, 0));

  FColumns[Index].SetColOutlineLevel(Value);
end;

procedure TWorkSheet.SetRowOulineLevel(row: integer; const Value: integer);
begin
  EnsureGuts();
  FGuts.RecalcNeeded:=true;
  FCells.RowList.AddRow(row);
  FCells.RowList[row].SetRowOutlineLevel(Value);
end;

procedure TWorkSheet.EnsureGuts;
var
  aPos: integer;
  i: integer;
  pdata: PArrayOfByte;
begin
  if (FGuts<>nil) then exit;

  aPos:=FMiscRecords1.Count;
  for i:=0 to FMiscRecords1.Count do
  begin
    if (FMiscRecords1[i] is TDefRowHeightRecord) then
    begin
      aPos:=i;
      break;
    end;
  end;

  GetMem(pdata, 0);
  FillChar(pdata^,8,0);
  FGuts:= TGutsRecord.Create(xlr_GUTS, pdata, 8);
  FMiscRecords1.Insert(aPos, FGuts);
end;

{ TFlxUnsupportedSheet }

procedure TFlxUnsupportedSheet.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
end;

procedure TFlxUnsupportedSheet.InsertAndCopyRowsAndCols(const FirstRow, LastRow, DestRow, aRowCount,FirstCol, LastCol, DestCol, aColCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
end;

procedure TFlxUnsupportedSheet.DeleteRowsAndCols(const aRow, aRowCount, aCol, aColCount: word; const SheetInfo: TSheetInfo);
begin
end;

procedure TFlxUnsupportedSheet.Clear;
begin
  inherited;
  //Dont Clear FCodeName
  if FSheetRecords<>nil then FSheetRecords.Clear;
end;

function TFlxUnsupportedSheet.DoCopyTo: TSheet;
begin
  Result:= inherited DoCopyTo;
  (Result as TFlxUnsupportedSheet).FSheetRecords.CopyFrom(FSheetRecords);
  Result.FixCachePointers;
end;

constructor TFlxUnsupportedSheet.Create(const aWorkbookGlobals: TWorkbookGlobals);
begin
  inherited;
  FSheetRecords:= TSheetRecordList.Create;
  FPrintRecords:=FSheetRecords;
end;

destructor TFlxUnsupportedSheet.Destroy;
begin
  FreeAndNil(FSheetRecords);
  FreeAndNil(FCodeName);
  inherited;
end;

procedure TFlxUnsupportedSheet.LoadFromStream(const DataStream: TStream;
  const First: TBOFRecord; const SST: TSST);
var
  RecordHeader: TRecordHeader;
  R: TBaseRecord;
begin
  Clear;
  repeat
    if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
      raise Exception.Create(ErrExcelInvalid);

    R:=LoadRecord(DataStream, RecordHeader);
    try
      LoadCachePointers(R);

      if (R is TLabelSSTRecord) then (R as TLabelSSTRecord).AttachToSST(SST);
      if (R is TBofRecord) then raise Exception.Create(ErrExcelInvalid)
      else if (R is TIgnoreRecord) then FreeAndNil(R)
      else if (R is TDimensionsRecord) then begin; OriginalDimensions:=(R as TDimensionsRecord).Dim^; FreeAndNil(R);end
      else if (R is TEOFRecord) then sEOF:=(R as TEOFRecord)
      else if (R is TCodeNameRecord) then begin; FreeAndNil(FCodeName); FCodeName:=(R as TCodeNameRecord); end
      else FSheetRecords.Add(R) ;
    except
      FreeAndNil(R);
      Raise;
    end; //Finally

  until RecordHeader.id = xlr_EOF;
  sBOF:=First; //Last statement
end;

procedure TFlxUnsupportedSheet.SaveToStream(const DataStream: TStream);
begin
  if (sBOF=nil)or(sEOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  sBOF.SaveToStream(DataStream);
  FSheetRecords.SaveToStream(DataStream);
  if (FCodeName<>nil) then FCodeName.SaveToStream(DataStream);
  sEOF.SaveToStream(DataStream);
end;

function TFlxUnsupportedSheet.TotalSize: int64;
begin
  Result:= inherited TotalSize+
    FSheetRecords.TotalSize;
end;

procedure TFlxUnsupportedSheet.SaveRangeToStream(const DataStream: TStream;
  const SheetIndex: integer; const CellRange: TXlsCellRange);
begin
  //Can't save a range
  SaveToStream(DataStream);
end;

function TFlxUnsupportedSheet.TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64;
begin
  //Can't save a range
  Result:=TotalSize;
end;

procedure TFlxUnsupportedSheet.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo);
begin
end;

procedure TFlxUnsupportedSheet.SetPageHeaderFooter(const P: TPageHeaderFooterRecord;
  const s: Widestring);
var
  OldSize: integer;
begin
  if P=nil then exit;
  OldSize:=P.DataSize;
  P.Text:=s;
  FSheetRecords.AdaptSize(P.DataSize-OldSize);
end;

procedure TFlxUnsupportedSheet.AddZoomRecord;
begin
end;


procedure TFlxUnsupportedSheet.FixCachePointers;
var
  i: integer;
begin
  inherited;
  for i:=0 to FSheetRecords.Count-1 do
    LoadCachePointers(FSheetRecords[i] as TBaseRecord);
end;

end.