uxlsworkbookglobals.pas

TMS Component Pack Pro v4.2

  for i:=0 to SheetCount-1 do
    FBoundSheets.InsertSheet(BeforeSheet, OptionFlags, Name);
  FReferences.InsertSheets(BeforeSheet, SheetCount);

  SheetInfo.InsSheet:=-1;
  if CopyFrom>=BeforeSheet then ofs:=SheetCount else ofs:=0;
  SheetInfo.FormulaSheet:=CopyFrom + ofs;
  SheetInfo.GetSheet:= FReferences.GetSheet;
  SheetInfo.SetSheet:= FReferences.SetSheet;
  SheetInfo.Names:=nil;
  FNames.InsertSheets(CopyFrom, BeforeSheet, SheetCount, SheetInfo );
end;

procedure TWorkbookGlobals.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
      if (R is TXFRecord) and (FXF.Count=0) then FMiscRecords.Add(TSubListRecord.CreateAndAssign(FXF));
      if (R is TFontRecord) and (FFonts.Count=0) then FMiscRecords.Add(TSubListRecord.CreateAndAssign(FFonts));
      if (R is TFormatRecord) and (FFormats.Count=0) then FMiscRecords.Add(TSubListRecord.CreateAndAssign(FFormats));

      if (R is TPaletteRecord) then FPaletteCache:=(R as TPaletteRecord);
      if (R is TXFRecord) or (R is TStyleRecord) then FPaletteIndex:=FMiscRecords.Count; //After the last Style record
      if (R is TObProjRecord) then FHasMacro:=true;
      if (R is TCodeNameRecord) then FCodeName:=(R as TCodeNameRecord).SheetName;

      if (R is TBofRecord) then raise Exception.Create(ErrExcelInvalid)
      else if (R is TIgnoreRecord) then FreeAndNil(R)
      else if (R is TBoundSheetRecord) then FBoundSheets.Add(R as TBoundSheetRecord)
      else if (R is TNameRecord) then FNames.Add(R as TNameRecord)
      else if (R is TXFRecord) then FXF.Add(R as TXFRecord)
      else if (R is TFontRecord) then FFonts.Add(R as TFontRecord)
      else if (R is TFormatRecord) then FFormats.Add(R as TFormatRecord)
      else if (R is TEOFRecord) then sEOF:=(R as TEOFRecord)
      else if (R is TSSTRecord) then begin FSST.Load(R as TSSTRecord); FreeAndNil(R);end
      else if (R is TSupBookRecord) then FReferences.AddSupbook(R as TSupBookRecord)
      else if (R is TExternNameRecord) then begin; FReferences.AddExternName(R as TExternNameRecord);end
      else if (R is TExternSheetRecord) then begin; FReferences.AddExternRef(R as TExternSheetRecord); FreeAndNil(R);end
      else if (R is TDrawingGroupRecord) then FDrawingGroup.LoadFromStream(DataStream, R as TDrawingGroupRecord)
      else if (R is TWindow1Record) then begin; FWindow1:=R as TWindow1Record; FMiscRecords.Add(R); end
      else if (R is T1904Record) then begin; F1904:=R as T1904Record; FMiscRecords.Add(R); end
      else if (R is TBookBoolRecord) then begin; FBookbool:=R as TBookBoolRecord; FMiscRecords.Add(R); end
      else if (R is TPrecisionRecord) then begin; FPrecision:=R as TPrecisionRecord; FMiscRecords.Add(R); end

      else FMiscRecords.Add(R);

    except
      FreeAndNil(R);
      Raise;
    end; //Finally

  until RecordHeader.id = xlr_EOF;

  sBOF:=First; //Last statement
end;

procedure TWorkbookGlobals.SaveRangeToStream(const DataStream: TStream;
  const SheetIndex: integer; const CellRange: TXlsCellRange);
begin
  //Someday this can be optimized to only save texts on the range
  //But even Excel does not do it...
  if (sBOF=nil)or(sEOF=nil) then raise Exception.Create(ErrSectionNotLoaded);

  sBOF.SaveToStream(DataStream);
  FMiscRecords.SaveToStream(DataStream);
  //FXF, FFonts and FFormats are saved in FMiscRecords.SaveToStream;

  FBoundSheets.SaveRangeToStream(DataStream, SheetIndex);
  FReferences.SaveToStream(DataStream);
  FNames.SaveToStream(DataStream); //Should be after FBoundSheets.SaveToStream
  //Images are not saved to the clipboard by excel
  //FDrawingGroup.SaveToStream(DataStream);
  FSST.SaveToStream(DataStream);
  sEOF.SaveToStream(DataStream);
end;

procedure TWorkbookGlobals.SaveToStream(const DataStream: TStream);
begin
  if (sBOF=nil)or(sEOF=nil) then raise Exception.Create(ErrSectionNotLoaded);

  sBOF.SaveToStream(DataStream);
  FMiscRecords.SaveToStream(DataStream);
  //FXF, FFonts and FFormats are saved in FMiscRecords.SaveToStream;

  FBoundSheets.SaveToStream(DataStream);
  FReferences.SaveToStream(DataStream);
  FNames.SaveToStream(DataStream); //Should be after FBoundSheets.SaveToStream
  FDrawingGroup.SaveToStream(DataStream);
  FSST.SaveToStream(DataStream);
  sEOF.SaveToStream(DataStream);
end;

procedure TWorkbookGlobals.SetActiveSheet(const Value: integer);
begin
  if FWindow1<>nil then FWindow1.ActiveSheet:=Value;
end;

procedure TWorkbookGlobals.SetColorPalette(Index: integer;
  const Value: LongWord);
begin
  if FPaletteCache=nil then
  begin
    //We have to create a standard palette first.
    FMiscRecords.Insert(FPaletteIndex, TPaletteRecord.CreateStandard);
    FPaletteCache:=FMiscRecords[FPaletteIndex] as TPaletteRecord;
  end;
  FPaletteCache.Color[Index]:= Value;
end;

procedure TWorkbookGlobals.SetFirstSheetVisible(const index: integer);
begin
  if FWindow1<>nil then FWindow1.FirstSheetVisible:=index;
end;

procedure TWorkbookGlobals.SetIs1904(const Value: boolean);
begin
  if F1904<>nil then F1904.Is1904:=value;
end;

procedure TWorkbookGlobals.SetPrecisionAsDisplayed(const Value: boolean);
begin
  if FPrecision<>nil then FPrecision.PrecisionAsDisplayed:=value;
end;

procedure TWorkbookGlobals.SetSaveExternalLinkValues(const Value: boolean);
begin
  if FBookBool<>nil then FBookBool.SaveExternalLinkValues:=value;
end;

procedure TWorkbookGlobals.SetSheetName(const index: integer;
  const Value: Widestring);
begin
   FBoundSheets.FSheetNames.Rename(FBoundSheets.BoundSheets.SheetName[index], Value);
   FBoundSheets.BoundSheets.SheetName[index]:=Value;
end;

procedure TWorkbookGlobals.SetSheetVisible(const index: integer; const Value: TXlsSheetVisible);
begin
   FBoundSheets.BoundSheets.SheetVisible[index]:=Value;
end;

procedure TWorkbookGlobals.SheetSetOffset(const index: integer; const Offset: LongWord);
begin
  FBoundSheets.BoundSheets[index].SetOffset(Offset);
end;

function TWorkbookGlobals.TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64;
begin
  Result:= inherited TotalRangeSize(SheetIndex, CellRange) +
      FSST.TotalSize +
      FReferences.TotalSize +
      FBoundSheets.TotalRangeSize(SheetIndex) +
      FMiscRecords.TotalSize +
      FNames.TotalSize+
      //Excel doesnt save images to the clipboard
      //FDrawingGroup.TotalSize+
      //FXF.TotalSize, FFonts.TotalSize and FFormats.TotalSize are not included in FMiscRecords.TotalSize;
      FXF.TotalSize+
      FFonts.TotalSize+
      FFormats.TotalSize;
end;

function TWorkbookGlobals.TotalSize: int64;
begin
  Result:= inherited TotalSize +
      FSST.TotalSize +
      FReferences.TotalSize +
      FBoundSheets.TotalSize +
      FMiscRecords.TotalSize +
      FNames.TotalSize+
      FDrawingGroup.TotalSize+
      //FXF.TotalSize, FFonts.TotalSize and FFormats.TotalSize are not included in FMiscRecords.TotalSize;
      FXF.TotalSize+
      FFonts.TotalSize+
      FFormats.TotalSize;
end;

procedure TWorkbookGlobals.CheckInternalNames(const OptionFlags: Integer);
begin
  //If a name is added and it is internal, we can't trust the ordering and need to delete the country record.
  if (OptionFlags and 32) <> 0 then
    DeleteCountry;
end;

function ContainsAny(const Name: Widestring; const Chars: WideCharArray): boolean;
var
  i, k: integer;
begin
  for i:=1 to Length(Name) do
  begin
    for k:=0 to Length(Chars)-1 do
    begin
      if Name[i] = Chars[k] then
      begin
        Result:= true;
        exit;
      end;
    end;
  end;
  Result:= false;
end;

class function TWorkbookGlobals.IsValidRangeName(const Name: WideString; var OptionFlags: integer): Boolean;
var
  InvalidChars: WideCharArray;
  i: integer;
begin
  if ((Length(Name) < 1)) or (Length(Name) > 254) then
    begin Result := false; exit; end;

  if (Name = 'R') or (Name = 'r') then
    begin Result := false; exit; end;

  if (Length(Name) = 1) and (integer(Name[1 + 0]) <= 12) then //Internal name.
  begin
    OptionFlags:= OptionFlags or 32;
    begin Result := true; exit; end;
  end;

  SetLength (InvalidChars, (65 + 192) - 127);
  FillChar(InvalidChars[0], Length(InvalidChars) * 2, 0);
  for i := 0 to 64 do
    InvalidChars[i] := WideChar(i);

  InvalidChars[48] := '{';
  InvalidChars[49] := '/';
  InvalidChars[50] := '}';
  InvalidChars[51] := '[';
  InvalidChars[52] := ']';
  InvalidChars[53] := '~';
  InvalidChars[54] := WideChar(160);
  InvalidChars[55] := '{';
  InvalidChars[56] := '{';
  InvalidChars[57] := '{';
  InvalidChars[63] := '{';
  for i := 127 to 191 do
    InvalidChars[(65 + i) - 127] := WideChar(i);

  InvalidChars[(65 + 181) - 127] := '{';
  if ContainsAny(Name, InvalidChars) then
    begin Result := false; exit; end;

  if Name[1 + 0] < 'A' then
    begin Result := false; exit; end;


  //Check it is not a valid cell reference.
  if (ord((Name[1])) in [ord('A')..ord('Z'),ord('a')..ord('z')]) then
  begin
    if (Length(Name) < 2) then begin Result := true; exit; end;
    if (ord((Name[2])) in [ord('A')..ord('Z'),ord('a')..ord('z')]) then
    begin
      if (Length(Name) < 3) then begin Result := true; exit; end;
      for i:=3 to Length(Name) do if not(ord(Name[i]) in [ord('0')..ord('9')]) then begin Result := true; exit; end;
    end
    else
    begin
      if (Length(Name) < 2) then begin Result := true; exit; end;
      for i:=2 to Length(Name) do if not(ord(Name[i]) in [ord('0')..ord('9')]) then begin Result := true; exit; end;
    end;
    Result := false; exit;
  end;
  Result:= true;
end;

procedure TWorkbookGlobals.AddName(var Range: TXlsNamedRange; const CellList: pointer);
var
  Options: Integer;
  ValidName: Boolean;
  i: integer;
  rSheet: integer;
begin
  Options := Range.OptionFlags;
  ValidName := IsValidRangeName(Range.Name, Options);
  Range.OptionFlags := Options;
  for i := 0 to FNames.Count - 1 do
  begin
    rSheet := FNames[i].RangeSheet;
    if (rSheet = Range.NameSheetIndex) and (WideUpperCase98(FNames[i].Name) = WideUpperCase98(Range.Name)) then
    begin
      FNames[i].Free;
      FNames[i] := TNameRecord.CreateFromData(Range, Self, CellList);
      exit;
    end;

  end;

  if not ValidName then
    raise Exception.CreateFmt(ErrInvalidNameForARange, [Range.Name]);

  FNames.Add(TNameRecord.CreateFromData(Range, Self, CellList));
  CheckInternalNames(Range.OptionFlags);
end;


procedure TWorkbookGlobals.DeleteCountry;
var
  i: integer;
begin
  for i:= FMiscRecords.Count - 1 downto 0 do
  begin
    if TBaseRecord(FMiscRecords[i]).Id = xlr_Country then
    begin
      FMiscRecords.Delete(i);
      exit;
    end;
  end;
end;

end.