tmsuxlsrangerecords.pas

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

unit tmsUXlsRangeRecords;
{$INCLUDE ..\FLXCOMPILER.INC}

interface
uses tmsUXlsBaseRecords, tmsUXlsBaseRecordLists, tmsUXlsOtherRecords,
     tmsXlsMessages, Classes, SysUtils, tmsUFlxMessages, Math, tmsUOle2Impl;

type
  TExcelRange= packed record
    R1, R2, C1, C2: word;
  end;
  PExcelRange= ^TExcelRange;

  TRangeValuesList= class(TList) //Items are TExcelRange
  private
    FOtherDataLen :word;
    procedure CopyIntersectRange(const R, Rx: PExcelRange; const NewFirstRow, NewLastRow, DestRow, aCount: integer; var MinR1, MaxR2: Word);
    function NextInRange(const Range: TXlsCellRange; const k: integer): integer;
  protected
      procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
      constructor Create(const aOtherDataLen: word);

      procedure Load(const aRecord: TBaseRecord; const aPos: integer);

      //these methods are to split the record using Continue
      //excel doesn't like continued range records, so we don't use them
      procedure SaveToStreamC(const DataStream: TOle2File);
      function TotalSizeC: int64;
      function FirstRecordSizeC: integer;

      //these methods are to split the record repeating it
      procedure SaveToStreamR(const DataStream: TOle2File; const Line: integer);
      procedure SaveRangeToStreamR(const DataStream: TOle2File; const Line: integer; const aCount: integer; const Range: TXlsCellRange);
      function TotalSizeR(const aCount: integer): int64;
      function RepeatCountR(const aCount: integer): integer;
      function RecordSizeR(const Line: integer; const aCount:integer): integer;
      function CountRangeRecords(const Range: TXlsCellRange): integer;

      procedure CopyFrom( const RVL: TRangeValuesList);

      procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer);

     //Formats are copied if the range intersects with the original. (Merged cells need all the range to be inside the original)
      procedure CopyRowsInclusive(const FirstRow, LastRow, DestRow, aCount: integer; var MinR1, MaxR2: Word; const UseCols: boolean);
      procedure CopyRowsExclusive(const FirstRow, LastRow, DestRow, aCount: integer; const UseCols: boolean);
      procedure DeleteRows(const aRow, aCount: integer; const Allow1Cell: boolean; const UseCols: boolean);
      procedure PreAddNewRange(var R1,C1,R2,C2: integer);
      procedure AddNewRange(const FirstRow, FirstCol, LastRow, LastCol: integer);
  end;

  TRangeEntry = class
  private
  protected
    RangeValuesList: TRangeValuesList;
    function DoCopyTo: TRangeEntry; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    function CopyTo: TRangeEntry;

    procedure LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader; const First: TRangeRecord);virtual;abstract;
    procedure SaveToStream(const DataStream: TOle2File);virtual;abstract;
    procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);virtual;abstract;
    function TotalSize: int64;virtual; abstract;
    function TotalRangeSize(const CellRange: TXlsCellRange): int64;virtual; abstract;

    procedure ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer; const SheetInfo: TSheetInfo);virtual;
    procedure InsertAndCopyRowsOrCols(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const UseCols: boolean); virtual;
    procedure DeleteRowsOrCols(const aRow, aCount: word; const SheetInfo: TSheetInfo; const UseCols: boolean);virtual;
  end;

  //Merged cells can't be continued. We have to write independent records.
  TMergedCells = class (TRangeEntry)
  private
  public
    constructor Create; override;

    procedure Clear;
    procedure LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader; const First: TRangeRecord); override;
    procedure SaveToStream(const DataStream: TOle2File); override;
    procedure SaveRangeToStream(const DataStream: TOle2File; const CellRange: TXlsCellRange);override;
    function TotalSize: int64; override;
    function TotalRangeSize(const CellRange: TXlsCellRange): int64;override;

    procedure InsertAndCopyRowsOrCols(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const UseCols: boolean); override;
    procedure DeleteRowsOrCols(const aRow, aCount: word; const SheetInfo: TSheetInfo; const UseCols: boolean);override;

    function CheckCell(const aRow, aCol: integer; var CellBounds: TXlsCellRange): boolean;

    function MergedCount: integer;
    function MergedCell(const i: integer): TXlsCellRange;

    procedure PreMerge(var R1,C1,R2,C2: integer);
    procedure MergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer);
    procedure UnMergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer);
  end;

  ClassOfTRangeEntry = class of TRangeEntry;

implementation

{ TRangeValuesList }

procedure TRangeValuesList.CopyFrom( const RVL: TRangeValuesList);
var
  i: integer;
  R: PExcelRange;
begin
  for i:=0 to RVL.Count-1 do
  begin
    New(R);
    try
      R^:=PExcelRange(RVL[i])^;
      Add(R);
    except
      FreeAndNil(R);
      raise;
    end; //except
  end;
end;

constructor TRangeValuesList.Create(const aOtherDataLen: word);
begin
  inherited Create;
  FOtherDataLen:= aOtherDataLen;
end;

function TRangeValuesList.FirstRecordSizeC: integer;
const
  Rl = SizeOf(TExcelRange);
var
  FirstRecCount, aCount: integer;
begin
  FirstRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl);
  if FirstRecCount<Count then aCount:= FirstRecCount else aCount:=Count;
  Result :=  2+ FOtherDataLen                          //Base data
            + Rl*aCount;                               // Registers

end;

procedure TRangeValuesList.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount: integer);
var
  i:integer;
begin
  for i:=Count -1 downto 0 do
  begin
    if PExcelRange(Items[i]).R1>= aRowPos then IncMaxMin( PExcelRange(Items[i]).R1, aRowCount, Max_Rows, aRowPos);
    if PExcelRange(Items[i]).R2>= aRowPos then IncMaxMin( PExcelRange(Items[i]).R2, aRowCount, Max_Rows, PExcelRange(Items[i]).R1);

    if PExcelRange(Items[i]).C1>= aColPos then IncMaxMin( PExcelRange(Items[i]).C1, aColCount, Max_Columns, aColPos);
    if PExcelRange(Items[i]).C2>= aColPos then IncMaxMin( PExcelRange(Items[i]).C2, aColCount, Max_Columns, PExcelRange(Items[i]).C1);
  end;
end;

procedure TRangeValuesList.CopyIntersectRange(const R, Rx: PExcelRange; const NewFirstRow, NewLastRow, DestRow, aCount: integer; var MinR1, MaxR2: Word);
var
  NewRange, NewRangex: PExcelRange;
  k, Lc: integer;
begin
  Lc:=(NewLastRow-NewFirstRow+1)* aCount;

  if (Rx.R1<=NewFirstRow) and (Rx.R2>=NewLastRow) then // Just copy one big range
  begin
    New(NewRange);
    try
      NewRangex:=PExcelRange(PAddress(NewRange)+(PAddress(Rx)-PAddress(R)));
      NewRange^:=R^;
      NewRangex.R1:=DestRow;
      NewRangex.R2:=DestRow+Lc-1;
      Add(NewRange);
      if NewRangex.R1< MinR1 then MinR1:=NewRangex.R1;
      if NewRangex.R2> MaxR2 then MaxR2:=NewRangex.R2;
    except
      Dispose(NewRange);
      raise;
    end; //Except
  end else // We have to copy one small range for each aCount
  begin
    for k:=0 to aCount -1 do
    begin
      New(NewRange);
      try
        NewRangex:=PExcelRange(PAddress(NewRange)+(PAddress(Rx)-PAddress(R)));
        NewRange^:=R^;
        NewRangex.R1:=DestRow+(NewLastRow-NewFirstRow+1)*k;
        if Rx.R1>NewFirstRow then inc(NewRangex.R1, Rx.R1-NewFirstRow);
        NewRangex.R2:=DestRow+(NewLastRow-NewFirstRow+1)*(k+1)-1;
        if Rx.R2<NewLastRow then dec(NewRangex.R2, NewLastRow-Rx.R2);

        Add(NewRange);
        if NewRangex.R1< MinR1 then MinR1:=NewRangex.R1;
        if NewRangex.R2> MaxR2 then MaxR2:=NewRangex.R2;
      except
        Dispose(NewRange);
        raise;
      end; //Except
    end;
  end;
end;

procedure TRangeValuesList.CopyRowsInclusive(const FirstRow, LastRow,
  DestRow, aCount: integer; var MinR1, MaxR2: word; const UseCols: boolean);
var
  i, Lc:integer;
  R, Rx: PExcelRange;
  NewFirstRow, NewLastRow: integer;
begin
  Lc:=(LastRow-FirstRow+1)* aCount;

  if FirstRow<DestRow then NewFirstRow:=FirstRow else NewFirstRow:=FirstRow+ Lc;
  if LastRow<DestRow then NewLastRow:=LastRow else NewLastRow:=LastRow+Lc;

  for i:=0 to Count-1 do
  begin
    R:=PExcelRange(Items[i]);
    if UseCols then Rx:=PExcelRange(PAddress(R)+2*SizeOf(Word)) else Rx:=R;  //when using cols, we fool the record so R1 really means C1. We can't use C1 there.
    if (Rx.R1<= NewLastRow) and
       (Rx.R2>= NewFirstRow) then
    begin
      //First Case, Block copied is above the original

      if (FirstRow>=DestRow) then
        if (Rx.R1<DestRow + Lc) then //nothing, range is automatically expanded
        else if (Rx.R1=DestRow + Lc) and( Rx.R2 >=NewLastRow) then //expand the range to include inserted rows
        begin
          Dec(Rx.R1, Lc);
          if Rx.R1< MinR1 then MinR1:=Rx.R1;
        end
        else CopyIntersectRange(R, Rx, NewFirstRow, NewLastRow, DestRow, aCount, MinR1, MaxR2) //We have to Copy the intersecting range, and clip the results

      //Second Case, Block copied is below the original

      else
        if (Rx.R2>DestRow-1) then //nothing, range is automatically expanded
        else if (Rx.R2=DestRow -1) and (Rx.R1<=NewFirstRow) then //expand the range to include inserted rows
        begin
          Inc(Rx.R2, Lc);
          if Rx.R2> MaxR2 then MaxR2:=Rx.R2;
        end
        else CopyIntersectRange(R, Rx, NewFirstRow, NewLastRow, DestRow, aCount, MinR1, MaxR2); //We have to Copy the intersecting range, and clip the results

    end;
  end;
end;

procedure TRangeValuesList.CopyRowsExclusive(const FirstRow,
  LastRow, DestRow, aCount: integer; const UseCols: boolean);
var
  i, k, Lc:integer;
  R, Rx, NewRange, NewRangex: PExcelRange;
  NewFirstRow, NewLastRow, z: integer;
  xMaxRows: integer;
begin
  Lc:=(LastRow-FirstRow+1)* aCount;

  if FirstRow<DestRow then NewFirstRow:=FirstRow else NewFirstRow:=FirstRow+ Lc;
  if LastRow<DestRow then NewLastRow:=LastRow else NewLastRow:=LastRow+Lc;

  if UseCols then xMaxRows:=Max_Columns else xMaxRows:=Max_Rows;
  for i:=0 to Count-1 do
  begin
    R:=PExcelRange(Items[i]);
    if UseCols then Rx:=PExcelRange(PAddress(R)+2*SizeOf(Word)) else Rx:=R;  //when using cols, we fool the record so R1 really means C1. We can't use C1 there.
    if (Rx.R1>= NewFirstRow) and
       (Rx.R2<= NewLastRow) then

      for k:=0 to aCount-1 do
      begin
        New(NewRange);
        try
          NewRangex:=PExcelRange(PAddress(NewRange)+(PAddress(Rx)-PAddress(R)));
          NewRange^:=R^;
          if (FirstRow>=DestRow) then z:=k+1 else z:=-k;

          IncMax(NewRangex.R1, DestRow - FirstRow -(LastRow-FirstRow+1)*z, xMaxRows);
          IncMax(NewRangex.R2, DestRow - FirstRow -(LastRow-FirstRow+1)*z, xMaxRows);
          Add(NewRange);
        except
          Dispose(NewRange);
          raise;
        end; //Except
      end;
  end;
end;

procedure TRangeValuesList.DeleteRows(const aRow, aCount: integer; const Allow1Cell: boolean; const UseCols: boolean);
var
  i:integer;
  R:PExcelRange;
  ColsEqual: boolean;
begin
  for i:=Count-1 downto 0 do
  begin
    if UseCols then R:=PExcelRange(PAddress(Items[i])+2*SizeOf(Word)) else R:=PExcelRange(Items[i]);  //when using cols, we fool the record so R1 really means C1. We can't use C1 there.
    if UseCols then ColsEqual:=PExcelRange(Items[i]).R1=PExcelRange(Items[i]).R2 else ColsEqual:=(R.C1=R.C2);
    if (R.R1>= aRow) and
      ((R.R2< aRow+aCount) or (not Allow1Cell and (R.R2=aRow+aCount) and ColsEqual)) then
        Delete(i);
  end;
end;

type
  //Just to avoid including windows.pas on d5
  TRect1 = packed record
    Left, Top, Right, Bottom: Longint;
  end;

procedure TRangeValuesList.PreAddNewRange(var R1,C1,R2,C2: integer);
var
  i: integer;
  OutRect: TRect1;
  R: PExcelRange;
begin
  //Check ranges are valid
  if (R1<0) or (R2<R1) or (R2>Max_Rows) or
     (C1<0) or (C2<C1) or (C2>Max_Columns) then exit;

  if (R1=R2)and(C1=C2) then exit;

  for i:=Count-1 downto 0 do
  begin
    R:=PExcelRange(Items[i]);
    OutRect.Left:=Max(R.C1, C1);
    OutRect.Top:=Max(R.R1, R1);
    OutRect.Right:=Min(R.C2, C2);
    OutRect.Bottom:=Min(R.R2, R2);
    if (OutRect.Left<=OutRect.Right)and(OutRect.Top<=OutRect.Bottom) then //found
    begin
      R1:=Min(R.R1, R1);
      R2:=Max(R.R2, R2);
      C1:=Min(R.C1, C1);
      C2:=Max(R.C2, C2);
      Delete(i);
    end;
  end;

end;

//We always have to call PreAddNewRange to verify it doesn't exist
procedure TRangeValuesList.AddNewRange(const FirstRow, FirstCol, LastRow, LastCol: integer);
var
  NewRange: PExcelRange;
begin
  //Check ranges are valid
  if (FirstRow<0) or (LastRow<FirstRow) or (LastRow>Max_Rows) or
     (FirstCol<0) or (LastCol<FirstCol) or (LastCol>Max_Columns) then exit;

  if (FirstRow=LastRow)and(FirstCol=LastCol) then exit;

  New(NewRange);
  try
    NewRange.R1:=FirstRow;
    NewRange.R2:=LastRow;
    NewRange.C1:=FirstCol;
    NewRange.C2:=LastCol;
    add(NewRange);
  except
    Dispose(NewRange);
    raise;
  end; //Except