tmsuxlssheet.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

  //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 := FixTotalSize(false);
end;

function TWorkSheet.FixTotalSize(const NeedsRecalc: boolean): int64;
begin
  Result:= inherited TotalSize+
    FMiscRecords1.TotalSize +
    FHPageBreaks.TotalSize +
    FVPageBreaks.TotalSize +
    FCells.FixTotalSize(NeedsRecalc) +
    FRanges.TotalSize +
    FDrawing.TotalSize +
    FMiscRecords2.TotalSize+
    FNotes.TotalSize+
    FColumns.TotalSize+
    FHLinks.TotalSize;
end;

procedure TWorkSheet.SetPageHeaderFooter(const P: TPageHeaderFooterRecord;
  const s: UTF16String);
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;

function TWorkSheet.GetPrintVCentered: boolean;
begin
  if FVCenter = nil then Result := false
    else Result := FVCenter.Centered;
end;

function TWorkSheet.GetOutlineSummaryRowsBelowDetail: boolean;
begin
  if FWsBool= nil then Result:=true else
    Result:= FWsBool.OutlineSummaryRowsBelowDetail;
end;

function TWorkSheet.GetOutlineSummaryColsRightOfDetail: boolean;
begin
  if FWsBool= nil then Result:=true else
    Result:= FWsBool.OutlineSummaryColsRightOfDetail;
end;

function TWorkSheet.GetOutlineAutomaticStyles: boolean;
begin
  if FWsBool= nil then Result:=false else
    Result:= FWsBool.OutlineAutomaticStyles;
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.SetPrintVCentered(const Value: boolean);
begin
  if (FVCenter = nil) then exit;
  FVCenter.Centered := Value;
end;

procedure TWorkSheet.SetOutlineSummaryRowsBelowDetail(const value: boolean);
begin
  if FWsBool <> nil then FWsBool.OutlineSummaryRowsBelowDetail:=value;
end;

procedure TWorkSheet.SetOutlineSummaryColsRightOfDetail(const value: boolean);
begin
  if FWsBool <> nil then FWsBool.OutlineSummaryColsRightOfDetail:=value;
end;

procedure TWorkSheet.SetOutlineAutomaticStyles(const value: boolean);
begin
  if FWsBool <> nil then FWsBool.OutlineAutomaticStyles:=value;
end;

procedure TWorkSheet.AddImage(const Data: ByteArray; const DataType: TXlsImgTypes; const Properties: TImageProperties;const Anchor: TFlxAnchorType);
begin
  FDrawing.AddImage(Data, DataType, Properties, Anchor, self);
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: UTF16String; const Properties: TImageProperties);
begin
  FNotes.AddNewComment(Row, Col, Txt, FDrawing, Properties, self);
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;


procedure TWorkSheet.FixRows;
begin
  inherited;
  Cells.FixRows;
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;

function TWorkSheet.GetPrintCopies: integer;
begin
  if FSetup= nil then Result:=1 else
    Result:= FSetup.PrintCopies;
end;

function TWorkSheet.GetPrinterDriverSettings: TPrinterDriverSettings;
begin
  if FPrinterDriverSettings = nil then
  begin
    Result.OperatingEnviroment:=0;
    SetLength(Result.Data, 0);
    exit;
  end;

  Result:=FPrinterDriverSettings.PrinterData;
end;

function TWorkSheet.GetPrintHCentered: boolean;
begin
  if FHCenter = nil then Result := false
    else Result := FHCenter.Centered;
end;

function TWorkSheet.GetPrintPaperSize: TExcelPaperSize;
begin
  if FSetup= nil then Result:=1 else
    Result:= FSetup.PrintPaperSize;
end;

function TWorkSheet.GetPrintXResolution: integer;
begin
  if FSetup= nil then Result:=600 else
    Result:= FSetup.PrintXResolution;
end;

function TWorkSheet.GetPrintYResolution: integer;
begin
  if FSetup= nil then Result:=600 else
    Result:= FSetup.PrintXResolution;
end;

procedure TWorkSheet.SetPrintCopies(const Value: integer);
begin
  if (Value<0) or (Value>$FFFF) then raise Exception.CreateFmt(ErrIndexOutBounds,[Value,'PrintCopies',0,$FFFF]);
  if FSetup<>nil then FSetup.PrintCopies:=Value;
end;

procedure TWorksheet.AddPrinterDriverRecord(const aPlsRecord:TPlsRecord; const FRecords: TBaseRecordList);
var
  idx,i: integer;
begin
  if FPrinterDriverSettings<>nil then RemovePrinterDriverRecord;
  idx:=FRecords.Count;
  if FSetup<>nil then
  for i:=0 to FRecords.Count-1 do
    if (FRecords[i]=FSetup) then
    begin
      idx:=i;
      break;
    end;

    FRecords.Insert(idx, aPlsRecord);
    FPrinterDriverSettings:=aPlsRecord;
end;

procedure TWorksheet.RemovePrinterDriverRecord;
begin
  RemovePrinterDriverRecord(FMiscRecords1);
  RemovePrinterDriverRecord(FMiscRecords1);
end;

procedure TWorksheet.RemovePrinterDriverRecord(const FRecords: TBaseRecordList);
var
  i: integer;
begin
  for i:=FRecords.Count-1 downto 0 do
    if FRecords[i] is TPlsRecord then
      FRecords.Delete(i);
end;

procedure TWorkSheet.SetPrinterDriverSettings(
  const Value: TPrinterDriverSettings);
begin
  if Length(value.Data) = 0 then
    RemovePrinterDriverRecord
  else
    begin
      AddPrinterDriverRecord(TPlsRecord.CreateFromData(Value), FMiscRecords1);
      PrintOptions:=PrintOptions and not word($4);
      //Not needed. If you want to copy the PaperSize, just use PaperSize property.
      //PaperSize=(TPaperSize)BitOps.GetWord(aData, 80);
    end;
end;

procedure TWorkSheet.SetPrintHCentered(const Value: boolean);
begin
  if (FHCenter = n