uxlsrangerecords.pas

TMS Component Pack Pro v4.2

end;


procedure TRangeValuesList.Load(const aRecord: TBaseRecord; const aPos: integer);
var
  i: integer;
  n: word;
  MyPos: integer;
  MyRecord: TBaseRecord;
  ExcelRange: PExcelRange;
begin
  MyPos:= aPos;
  MyRecord:= aRecord;
  ReadMem(MyRecord, MyPos, SizeOf(n), @n);
  for i:=0 to n-1 do
  begin
    New(ExcelRange);
    try
      ReadMem(MyRecord, MyPos, SizeOf(TExcelRange), ExcelRange);
      Add(ExcelRange);
      ExcelRange:=nil;
    finally
      Dispose(ExcelRange);
    end; //finally
  end;
end;

procedure TRangeValuesList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  if Action = lnDeleted then Dispose(PExcelRange(Ptr));
  inherited Notify(Ptr, Action);
end;

procedure TRangeValuesList.SaveToStreamC(const DataStream: TStream);
const
  Rl = SizeOf(TExcelRange);
  OneRecCount = (MaxRecordDataSize div Rl);
var
  RecordHeader: TRecordHeader;
  FirstRecCount, i: integer;
  myCount: word;
begin
  MyCount:=Count;
  DataStream.Write(MyCount, SizeOf(MyCount));

  FirstRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl) ;

  for i:= 0 to Count-1 do
  begin
    if (i>=FirstRecCount) and ((i-FirstRecCount) mod OneRecCount = 0) then
    begin
      //Add continue
      RecordHeader.Id:=xlr_CONTINUE;
      if Count-i> OneRecCount then
        RecordHeader.Size:= OneRecCount * Rl else
        RecordHeader.Size:= (Count-i) * Rl;

      DataStream.Write(RecordHeader, SizeOf(RecordHeader));
    end;
    DataStream.Write(PExcelRange(Items[i])^, Rl);
  end;
end;

function TRangeValuesList.TotalSizeC: int64;
const
  Rl = SizeOf(TExcelRange);
  OneRecCount = (MaxRecordDataSize div Rl);
var
  FirstRecCount: integer;
begin
  Result := SizeOf(TRecordHeader)+ 2+ FOtherDataLen    //Base data
            + Rl*Count;                               // Registers

  //Add Continue Headers...
  FirstRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl);
  if Count > FirstRecCount then
    Result:= Result + SizeOf(TRecordHeader)* ((Count-FirstRecCount-1) div OneRecCount +1);
end;


///////////////////////////// methods with "R" at the end add new records and don't use continue /////////////////
function TRangeValuesList.RepeatCountR(const aCount: integer): integer;
const
  Rl = SizeOf(TExcelRange);
var
  OneRecCount: integer;
begin
  OneRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl);
  if aCount>0 then Result:= (aCount-1) div OneRecCount +1 else Result:=1;
end;

procedure TRangeValuesList.SaveToStreamR(const DataStream: TStream; const Line: integer);
const
  Rl = SizeOf(TExcelRange);
var
  OneRecCount, i: integer;
  myCount: word;
begin
  OneRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl) ;
  if (Line+1)*OneRecCount >Count then MyCount:=Count-Line*OneRecCount else MyCount:=OneRecCount;
  DataStream.Write(MyCount, SizeOf(MyCount));
  for i:=Line*OneRecCount to Line*OneRecCount+myCount-1 do DataStream.Write(PExcelRange(Items[i])^, Rl);
end;

function TRangeValuesList.NextInRange(const Range: TXlsCellRange; const k: integer): integer;
var
  i: integer;
begin
  Result:=-1;
  for i:=k+1 to Count-1 do
    if (Range.Top<= PExcelRange(Items[i]).R1 ) and
       (Range.Bottom>= PExcelRange(Items[i]).R2 ) and
       (Range.Left<= PExcelRange(Items[i]).C1 ) and
       (Range.Right>= PExcelRange(Items[i]).C2 )  then
       begin
         Result:=i;
         exit;
       end;

end;

procedure TRangeValuesList.SaveRangeToStreamR(const DataStream: TStream; const Line: integer; const aCount: integer; const Range: TXlsCellRange);
const
  Rl = SizeOf(TExcelRange);
var
  OneRecCount, i, k: integer;
  myCount: word;
begin
  OneRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl) ;
  if (Line+1)*OneRecCount >aCount then MyCount:=aCount-Line*OneRecCount else MyCount:=OneRecCount;
  DataStream.Write(MyCount, SizeOf(MyCount));
  k:=NextInRange(Range, -1);
  for i:=Line*OneRecCount to Line*OneRecCount+myCount-1 do
  begin
    DataStream.Write(PExcelRange(Items[k])^, Rl);
    k:=NextInRange(Range, k);
  end;
end;

function TRangeValuesList.TotalSizeR(const aCount:integer): int64;
const
  Rl = SizeOf(TExcelRange);
begin
  Result := (SizeOf(TRecordHeader)+ 2+ FOtherDataLen)* RepeatCountR(aCount)    //Base data
            + Rl*aCount;                               // Registers
end;

function TRangeValuesList.RecordSizeR(const Line: integer; const aCount:integer): integer;
const
  Rl = SizeOf(TExcelRange);
var
  OneRecCount, MyCount: integer;
begin
  OneRecCount := ((MaxRecordDataSize-2-FOtherDataLen) div Rl) ;
  if (Line+1)*OneRecCount >aCount then MyCount:=aCount-Line*OneRecCount else MyCount:=OneRecCount;
  Result:= 2+ FOtherDataLen+MyCount*Rl;
end;

function TRangeValuesList.CountRangeRecords(const Range: TXlsCellRange): integer;
var
  i: integer;
begin
  Result:=0;
  for i:=0 to Count-1 do
    if (Range.Top<= PExcelRange(Items[i]).R1 ) and
       (Range.Bottom>= PExcelRange(Items[i]).R2 ) and
       (Range.Left<= PExcelRange(Items[i]).C1 ) and
       (Range.Right>= PExcelRange(Items[i]).C2 )  then Inc(Result);
end;

{ TRangeEntry }

function TRangeEntry.CopyTo: TRangeEntry;
begin
  if Self=nil then Result:= nil   //for this to work, this cant be a virtual method
  else Result:=DoCopyTo;
end;

constructor TRangeEntry.Create;
begin
  inherited;
end;

destructor TRangeEntry.Destroy;
begin
  FreeAndNil(RangeValuesList);
  inherited;
end;

function TRangeEntry.DoCopyTo: TRangeEntry;
begin
  Result:= ClassOfTRangeEntry(ClassType).Create;
  Result.RangeValuesList.CopyFrom(RangeValuesList);
end;

procedure TRangeEntry.DeleteRowsOrCols(const aRow, aCount: word; const SheetInfo: TSheetInfo; const UseCols: boolean);
begin
  if UseCols then
    ArrangeInsertRowsAndCols(0, 0, aRow, -aCount, SheetInfo)
  else
    ArrangeInsertRowsAndCols(aRow, -aCount, 0, 0, SheetInfo);
end;


procedure TRangeEntry.InsertAndCopyRowsOrCols(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const UseCols: boolean);
begin
  if UseCols then
    ArrangeInsertRowsAndCols(0,0,DestRow, (LastRow-FirstRow+1)* aCount, SheetInfo)
  else
    ArrangeInsertRowsAndCols(DestRow, (LastRow-FirstRow+1)* aCount,0,0, SheetInfo);
end;


procedure TRangeEntry.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer; const SheetInfo: TSheetInfo);
begin
  RangeValuesList.ArrangeInsertRowsAndCols(aRowPos, aRowCount, aColPos, aColCount);
end;

{ TMergedCells }

function TMergedCells.CheckCell(const aRow, aCol: integer; var CellBounds: TXlsCellRange): boolean;
var
  i: integer;
begin
  Result:=false;
  for i:=0 to RangeValuesList.Count-1 do
    if (PExcelRange(RangeValuesList[i]).R1<=aRow) and
       (PExcelRange(RangeValuesList[i]).R2>=aRow) and
       (PExcelRange(RangeValuesList[i]).C1<=aCol) and
       (PExcelRange(RangeValuesList[i]).C2>=aCol) then
       begin
         CellBounds.Left:= PExcelRange(RangeValuesList[i]).C1;
         CellBounds.Top:= PExcelRange(RangeValuesList[i]).R1;
         CellBounds.Right:= PExcelRange(RangeValuesList[i]).C2;
         CellBounds.Bottom:= PExcelRange(RangeValuesList[i]).R2;
         Result:=true;
         exit;
       end;

end;

procedure TMergedCells.Clear;
begin
  if RangeValuesList<>nil then RangeValuesList.Clear;
end;

constructor TMergedCells.Create;
begin
  inherited;
  RangeValuesList:= TRangeValuesList.Create(0);
end;

procedure TMergedCells.DeleteRowsOrCols(const aRow, aCount: word; const SheetInfo: TSheetInfo; const UseCols: boolean);
begin
  RangeValuesList.DeleteRows(aRow, aCount, false, UseCols);
  inherited;
end;

procedure TMergedCells.InsertAndCopyRowsOrCols(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const UseCols: boolean);
begin
  inherited;
  RangeValuesList.CopyRowsExclusive(FirstRow, LastRow, DestRow, aCount, UseCols);
end;

procedure TMergedCells.LoadFromStream(const DataStream: TStream;
  const First: TRangeRecord);
var
  aPos: integer;
begin
  Clear;
  aPos:=0;
  RangeValuesList.Load(First, aPos);

  First.Free;
end;

procedure TMergedCells.UnMergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer);
var
  i: integer;
begin
  for i:=RangeValuesList.Count-1 downto 0 do
    if (PExcelRange(RangeValuesList[i]).R1=FirstRow) and
       (PExcelRange(RangeValuesList[i]).R2=LastRow) and
       (PExcelRange(RangeValuesList[i]).C1=FirstCol) and
       (PExcelRange(RangeValuesList[i]).C2=LastCol) then
       begin
         RangeValuesList.Delete(i);
       end;
end;

//Always call premergecell first...
procedure TMergedCells.MergeCells(const FirstRow, FirstCol, LastRow, LastCol: integer);
begin
  RangeValuesList.AddNewRange(FirstRow, FirstCol, LastRow, LastCol);
end;

procedure TMergedCells.PreMerge(var R1, C1, R2, C2: integer);
begin
  RangeValuesList.PreAddNewRange(R1, C1, R2, C2);
end;

procedure TMergedCells.SaveRangeToStream(const DataStream: TStream;
  const CellRange: TXlsCellRange);
var
  RecordHeader: TRecordHeader;
  i: integer;
  Rc: integer;
begin
  Rc:=RangeValuesList.CountRangeRecords(CellRange);
  if Rc=0 then exit; //don't save empty MergedCells
  RecordHeader.Id:= xlr_CELLMERGING;
  for i:=0 to RangeValuesList.RepeatCountR(Rc)-1 do
  begin
    RecordHeader.Size:=RangeValuesList.RecordSizeR(i,Rc);
    DataStream.Write(RecordHeader, SizeOf(RecordHeader));
    RangeValuesList.SaveRangeToStreamR(DataStream, i, Rc, CellRange);
  end;
end;

procedure TMergedCells.SaveToStream(const DataStream: TStream);
var
  RecordHeader: TRecordHeader;
  i: integer;
begin
  if RangeValuesList.Count=0 then exit; //don't save empty MergedCells
  RecordHeader.Id:= xlr_CELLMERGING;
  for i:=0 to RangeValuesList.RepeatCountR(RangeValuesList.Count)-1 do
  begin
    RecordHeader.Size:=RangeValuesList.RecordSizeR(i, RangeValuesList.Count);
    DataStream.Write(RecordHeader, SizeOf(RecordHeader));
    RangeValuesList.SaveToStreamR(DataStream, i);
  end;
end;

function TMergedCells.TotalRangeSize(const CellRange: TXlsCellRange): int64;
begin
  if RangeValuesList.Count=0 then Result:=0 else Result:= RangeValuesList.TotalSizeR(RangeValuesList.CountRangeRecords(CellRange)) ;
end;

function TMergedCells.TotalSize: int64;
begin
  if RangeValuesList.Count=0 then TotalSize:=0 else TotalSize:= RangeValuesList.TotalSizeR(RangeValuesList.Count);
end;

function TMergedCells.MergedCount: integer;
begin
  Result:=RangeValuesList.Count;
end;

function TMergedCells.MergedCell(const i: integer): TXlsCellRange;
begin
  Result.Left:=PExcelRange(RangeValuesList[i]).C1;
  Result.Top:=PExcelRange(RangeValuesList[i]).R1;
  Result.Right:=PExcelRange(RangeValuesList[i]).C2;
  Result.Bottom:=PExcelRange(RangeValuesList[i]).R2;
end;

end.