⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uxlsreferences.pas

📁 TMS Component Pack Pro v4.2
💻 PAS
字号:
unit UXlsReferences;
{$IFDEF LINUX}{$INCLUDE ../FLXCOMPILER.INC}{$ELSE}{$INCLUDE ..\FLXCOMPILER.INC}{$ENDIF}

interface
uses Classes, Sysutils, XlsMessages, UXlsBaseRecords,
     UXlsBaseRecordLists, UxlsBaseList, UXlsStrings,
     XlsFormulaMessages,
     UFlxMessages;
type

  TExternNameRecord = class(TBaseRecord)
  end;

  TExternNameRecordList=class(TBaseRecordList)
  end;

  TSupBookRecord  = class(TBaseRecord)
  private
    FExternNameList: TExternNameRecordList;
  public
    function IsLocal: boolean;
    procedure InsertSheets(const SheetCount: integer);
    function BookName: widestring;
    function SheetName(const SheetIndex: integer; const Globals: TObject): widestring;

    procedure AddExternName(const ExternNameRecord: TExternNameRecord);

  //TBaseRecord functionality
  protected
    function DoCopyTo: TBaseRecord; override;
  public
    constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
    constructor CreateEmpty(const SheetCount: integer);
    destructor Destroy; override;

    procedure SaveToStream(const Workbook: TStream); override;
    function TotalSize: integer;override;
    function TotalSizeNoHeaders: integer;override;
  end;

  TExternSheetRecord = class(TBaseRecord)
  end;


  TExternRef= class
  public
    SupBookRecord: Word;
    FirstSheet, LastSheet: Word;
    constructor Create(const aSupBookRecord, aFirstSheet, aLastSheet: word);
    procedure SaveToStream(const DataStream: TStream);
  end;

  TSupBookRecordList = class(TBaseRecordList)
  {$INCLUDE TSupBookRecordListHdr.inc}
  function TotalSize: int64;
  end;



  TExternRefList= class(TBaseList)
  {$INCLUDE TExternRefListHdr.inc}
    procedure Load(const aRecord: TExternSheetRecord);
    procedure SaveToStream(const DataStream: TStream);
    function TotalSize: int64;

    procedure InsertSheets(const BeforeSheet, SheetCount:integer; LocalSupBook: integer);
  end;

  TReferences = class
  private
    FSupBooks: TSupBookRecordList;
    FExternRefs: TExternRefList;
    LocalSupBook: integer;
  public
    constructor Create;
    destructor Destroy; override;

    function TotalSize:int64;
    procedure Clear;
    procedure SaveToStream(const DataStream: TStream);

    procedure AddSupBook(const aRecord: TSupBookRecord);
    procedure AddExternRef(const aRecord: TExternSheetRecord);
    procedure AddExternName(const aRecord: TExternNameRecord);

    procedure InsertSheets(const BeforeSheet, SheetCount: integer);
    function GetSheet(const SheetRef: word): integer;
    function SetSheet(const Sheet: word): integer;

    function AddSheet(SheetCount, FirstSheet, LastSheet: Integer): Integer;

    function GetSheetName(const SheetRef: word; const Globals: TObject): widestring;
  end;

implementation
uses UXlsWorkbookGlobals;
{$INCLUDE TExternRefListImp.inc}
{$INCLUDE TSupBookRecordListImp.inc}

{ TExternRefList }


procedure TExternRefList.InsertSheets(const BeforeSheet, SheetCount:integer; LocalSupBook: integer);
var
  i:integer;
begin
  for i:=0 to Count-1 do
    if Items[i].SupBookRecord= LocalSupBook then
    begin
      //Handling of deleted references for Sheetcount<0
      if ((Items[i].FirstSheet>=BeforeSheet) and (Items[i].FirstSheet<BeforeSheet-SheetCount)) then // we will delete the reference
      begin
          Items[i].FirstSheet:=$FFFF;
      end;
      if ((Items[i].LastSheet>=BeforeSheet)and(Items[i].LastSheet<BeforeSheet-SheetCount))  then // we will delete the reference
      begin
          Items[i].LastSheet:=$FFFF;
      end;
      if (Items[i].FirstSheet<$FFFE) and (Items[i].FirstSheet>=BeforeSheet) then IncMax(Items[i].FirstSheet, SheetCount, MaxSheets);
      if (Items[i].LastSheet<$FFFE) and (Items[i].LastSheet>=BeforeSheet) then IncMax(Items[i].LastSheet, SheetCount, MaxSheets);
    end;
end;

procedure TExternRefList.Load(const aRecord: TExternSheetRecord);
var
  n: word;
  i: integer;
  aPos: integer;
  MyRecord: TBaseRecord;
  Index, Fs, Ls: word;
begin
  n:=GetWord(aRecord.Data, 0);
  aPos:=2; MyRecord:= aRecord;
  for i:=0 to n-1 do
  begin
    ReadMem(MyRecord, aPos, 2, @Index);
    ReadMem(MyRecord, aPos, 2, @Fs);
    ReadMem(MyRecord, aPos, 2, @Ls);
    Add(TExternRef.Create(Index,Fs,Ls));
  end;
end;

procedure TExternRefList.SaveToStream(const DataStream: TStream);
var
  RecordHeader: TRecordHeader;
  i, k, Lines, CountRecords:integer;
  MyCount: word;
begin
  MyCount:=Count;
  if Count =0 then
  begin
    RecordHeader.Id:= xlr_EXTERNSHEET;
    RecordHeader.Size:=2;
    DataStream.Write(RecordHeader, SizeOf(RecordHeader));
    DataStream.Write(MyCount, SizeOf(MyCount));
    exit;
  end;

  Lines:=(6* Count-1) div MaxExternSheetDataSize;
  for i:= 0 to Lines do
  begin
    if i<Lines then CountRecords:= MaxExternSheetDataSize div 6
      else CountRecords:=((6* Count-1) mod MaxExternSheetDataSize + 1) div 6 ;
    RecordHeader.Size:= CountRecords*6;

    if i= 0 then
    begin
      RecordHeader.Id:= xlr_EXTERNSHEET;
      inc(RecordHeader.Size,2);
    end
    else RecordHeader.Id:= xlr_CONTINUE;

    DataStream.Write(RecordHeader, SizeOf(RecordHeader));
    if i=0 then DataStream.Write( MyCount, SizeOf (MyCount));

    for k:= i*(MaxExternSheetDataSize div 6) to i*(MaxExternSheetDataSize div 6)+CountRecords-1 do
     Items[k].SaveToStream(DataStream);
  end;
end;

function TExternRefList.TotalSize: int64;
begin
  //Take in count Continues...
  if Count=0 then Result:=2+SizeOf(TRecordHeader) else
  Result:=2+ (((6* Count-1) div MaxExternSheetDataSize)+1)* SizeOf(TRecordHeader)  //header + continues
          + 6*Count;
end;

{ TReferences }

procedure TReferences.AddExternName(const aRecord: TExternNameRecord);
begin
  if FSupBooks.Count<=0 then raise Exception.Create(ErrExcelInvalid);
  FSupBooks[FSupBooks.Count-1].AddExternName(aRecord);
end;

procedure TReferences.AddExternRef(const aRecord: TExternSheetRecord);
begin
  FExternRefs.Load(aRecord);
end;

procedure TReferences.AddSupBook(const aRecord: TSupBookRecord);
begin
  FSupBooks.Add(aRecord);
  if aRecord.IsLocal then LocalSupBook:= FSupBooks.Count-1;
end;

procedure TReferences.Clear;
begin
  if FSupbooks<>nil then FSupBooks.Clear;
  if FExternRefs<>nil then FExternRefs.Clear;
  LocalSupBook:=-1;
end;

constructor TReferences.Create;
begin
  inherited;
  FSupBooks:=TSupBookRecordList.Create;
  FExternRefs:= TExternRefList.Create;
  LocalSupBook:=-1;
end;

destructor TReferences.Destroy;
begin
  FreeAndNil(FSupBooks);
  FreeAndNil(FExternRefs);
  inherited;
end;

function TReferences.GetSheet(const SheetRef: word): integer;
begin
  if (SheetRef>=FExternRefs.Count) then raise
    Exception.CreateFmt(ErrIndexOutBounds, [SheetRef,'Sheet Reference',0,FExternRefs.Count]);
  if (FExternRefs[SheetRef].SupBookRecord = LocalSupBook) and
     (FExternRefs[SheetRef].FirstSheet = FExternRefs[SheetRef].LastSheet) then

    Result:=FExternRefs[SheetRef].FirstSheet else Result:=-1;
end;

function TReferences.AddSheet(SheetCount: Integer; FirstSheet: Integer; LastSheet: Integer): Integer;
var
  i: Integer;
begin
  if (LocalSupBook < 0) then
    AddSupBook(TSupBookRecord.CreateEmpty(SheetCount));

  for i:=0 to FExternRefs.Count-1 do
  begin
    if (FExternRefs[i].SupBookRecord = LocalSupBook) and
       (FExternRefs[i].FirstSheet= FirstSheet) and
       (FExternRefs[i].LastSheet= LastSheet) then
        begin
          Result := i;
          exit;
        end;
  end;
  FExternRefs.Add(TExternRef.Create(LocalSupBook, FirstSheet, LastSheet));
  Result := (FExternRefs.Count - 1);
end;

function TReferences.GetSheetName(const SheetRef: word; const Globals: TObject): widestring;
var
  idx: integer;
  Sh1: string;
  Ld: integer;
begin
  if (SheetRef>=FExternRefs.Count) then raise
    Exception.CreateFmt(ErrIndexOutBounds, [SheetRef,'Sheet Reference',0,FExternRefs.Count]);
  idx:=FExternRefs[SheetRef].SupBookRecord;
  Sh1:=FSupBooks[idx].SheetName(FExternRefs[SheetRef].FirstSheet, Globals);
  if FExternRefs[SheetRef].FirstSheet<>FExternRefs[SheetRef].LastSheet then
    Sh1:=Sh1+fmRangeSep+FSupBooks[idx].SheetName(FExternRefs[SheetRef].LastSheet, Globals);
  if idx = LocalSupBook then Result:='' else
  begin
    Result:= FSupBooks[idx].BookName;
    if Sh1<>'' then
    begin
      Ld:= LastDelimiter('\:',Result);
      if Ld>0 then Insert(fmWorkbookOpen, Result, Ld+1) else Result:=fmWorkbookOpen+Result;
      Result:=Result+fmWorkbookClose;
    end;
  end;
  Result:=Result+Sh1;
  if Result<>'' then Result:=''''+Result+''''+fmExternalRef;
end;

procedure TReferences.InsertSheets(const BeforeSheet, SheetCount: integer);
begin
  FExternRefs.InsertSheets(BeforeSheet, SheetCount, LocalSupBook);
  if LocalSupBook>=0 then FSupBooks[LocalSupBook].InsertSheets(SheetCount);
end;

procedure TReferences.SaveToStream(const DataStream: TStream);
begin
  FSupBooks.SaveToStream(DataStream);
  FExternRefs.SaveToStream(DataStream);
end;

function TReferences.SetSheet(const Sheet: word): integer;
var
  i:integer;
begin
  for i:=0 to FExternRefs.Count-1 do
    if (FExternRefs[i].SupBookRecord = LocalSupBook) and
       (FExternRefs[i].FirstSheet = FExternRefs[i].LastSheet) and
       (FExternRefs[i].FirstSheet = Sheet) then
       begin
         Result:=i;
         exit;
       end;

  //Ref doesnt exits...
  FExternRefs.Add(TExternRef.Create(LocalSupBook, Sheet, Sheet));
  Result:=FExternRefs.Count-1;

end;

function TReferences.TotalSize: int64;
begin
  Result:= FSupBooks.TotalSize+ FExternRefs.TotalSize;
end;

{ TExternRef }

constructor TExternRef.Create(const aSupBookRecord, aFirstSheet, aLastSheet: word);
begin
  inherited Create;
  SupBookRecord:=aSupBookRecord;
  FirstSheet:=aFirstSheet;
  LastSheet:=aLastSheet;
end;

procedure TExternRef.SaveToStream(const DataStream: TStream);
begin
  DataStream.Write(SupBookRecord, SizeOf(SupBookRecord));
  DataStream.Write(FirstSheet, SizeOf(FirstSheet));
  DataStream.Write(LastSheet, SizeOf(LastSheet));
end;

{ TSupBookRecord }

function DecodeFileName(const s: widestring): widestring;
var
  i: integer;
begin
  Result:=''; i:=1;
  while i <= Length(s) do
  begin
    if s[i]=#1 then
    begin
      inc(i);
      if s[i]='@' then
      begin
        Result := Result + '\\';
      end else
      begin
        Result := Result + s[i] +':\';
      end
    end else
    if s[i]=#2 then
    begin
        Result := Result + '\';
    end else
    if s[i]=#3 then
    begin
        Result := Result + '\';
    end else
    if s[i]=#4 then
    begin
      Result := Result + '..\';
    end
    else
      Result := Result + s[i];

    inc(i);
  end;
end;

procedure TSupBookRecord.AddExternName(const ExternNameRecord: TExternNameRecord);
begin
  FExternNameList.Add(ExternNameRecord);
end;

function TSupBookRecord.BookName: widestring;
var
  Xs: TExcelString;
  MySelf: TBaseRecord;
  MyPos: integer;
begin
  MySelf:=Self;
  MyPos:=2;
  Xs:=TExcelString.Create(2, MySelf, MyPos);
  try
    Result:=Xs.Value;
    if Length(Result)>0 then
    begin
      if Result[1]=#0 then Result:='' else
      if Result[1]=#1 then Result:=DecodeFileName(copy(Result,2,Length(Result))) else
      if Result[1]=#2 then Result:='';
    end;
  finally
    FreeAndNil(Xs);
  end; //finally
end;

constructor TSupBookRecord.Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);
begin
  inherited;
  FExternNameList:=TExternNameRecordList.Create;
end;

constructor TSupBookRecord.CreateEmpty(const SheetCount: integer);
var
  MyData: PArrayOfByte;
begin
  GetMem(MyData, 4);
  MyData[0]:=lo(SheetCount);
  MyData[1]:=hi(SheetCount);
  MyData[2]:=$01;
  MyData[3]:=$04;
  Create(xlr_SUPBOOK, myData, 4);
end;

destructor TSupBookRecord.Destroy;
begin
  FreeAndNil(FExternNameList);
  inherited;
end;

function TSupBookRecord.DoCopyTo: TBaseRecord;
begin
  Result:=inherited DoCopyTo;
  FreeAndNil((Result as TSupBookRecord).FExternNameList);
  (Result as TSupBookRecord).FExternNameList:= TExternNameRecordList.Create;
  (Result as TSupBookRecord).FExternNameList.CopyFrom(FExternNameList);
end;

procedure TSupBookRecord.InsertSheets(const SheetCount: integer);
begin
  if not IsLocal then raise Exception.Create(ErrExcelInvalid);
  IncWord(Data, 0, SheetCount, MaxSheets);
end;

function TSupBookRecord.IsLocal: boolean;
begin
  IsLocal:= (DataSize = 4)and (GetWord (Data, 2)= $0401);
end;

procedure TSupBookRecord.SaveToStream(const Workbook: TStream);
begin
  inherited;
  FExternNameList.SaveToStream(Workbook);
end;

function TSupBookRecord.SheetName(const SheetIndex: integer; const Globals: TObject): widestring;
var
  n: integer;
  i, tpos: integer;
  Xs: TExcelString;
  MySelf: TBaseRecord;
begin
  n:=GetWord(Data, 0);
  if (SheetIndex<0) or (SheetIndex>=n) then  //this might happen... on range references to another workbook
  begin
    Result:='';
    exit;
  end;

  if GetWord(Data,2)= $0401 then //current sheet
  begin
    Result:=(Globals as TWorkbookGlobals).SheetName[SheetIndex];
    exit;
  end;
  //A little slow... but it shouldn't be called much.
  //I don't think it justifies a cache.
  MySelf:=Self;
  tPos:=2;
  for i:=0 to SheetIndex do   //0 stands for the first unicode string, the book name.
  begin
    Xs:=TExcelString.Create(2, MySelf, tPos);
    try
    finally
      FreeAndNil(Xs);
    end; //finally
  end;

  Xs:=TExcelString.Create(2, MySelf, tPos);
  try
    Result:=Xs.Value;
  finally
    FreeAndNil(Xs);
  end; //finally
end;

function TSupBookRecord.TotalSize: integer;
begin
  Result:=inherited TotalSize+ FExternNameList.TotalSize;
end;

function TSupBookRecord.TotalSizeNoHeaders: integer;
var
  i:integer;
begin
  Result:=inherited TotalSizeNoHeaders;
  for i:=0 to FExternNameList.Count-1 do Result:=Result+ (FExternNameList[i] as TBaseRecord).TotalSizeNoHeaders;
end;



{ TSupBookRecordList }

function TSupBookRecordList.TotalSize: int64;
var
  i: integer;
begin
  Result:=0;
  for i:=0 to Count-1 do Result:=Result+Items[i].TotalSize;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -