mergedcells2.pas

一个经典的读写Excel的控件

unit MergedCells2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$I XLSRWII2.inc}

{$B-}

interface

uses Classes, SysUtils, XLSUtils2, BIFFRecsII2, CellAreas2;

type
//:# An area that makes up a merged cell.
//: The cell in the upper left corner is the "master" cell, and it is the value
//: in that cell that is displayed in the merged area. It is also the formattings
//: from this cell that is used for the merged area.
    TMergedCell = class(TCellArea)
private
protected
     function GetDisplayName: string; override;
public
     end;

type
//:# List of TMergedCell objects.
     TMergedCells = class(TCellAreas)
private
protected
public
     // @exclude
     procedure CopyList(List: TList; Col1,Row1,Col2,Row2: integer);
     // @exclude
     procedure InsertList(List: TList; Col1,Row1,Col2,Row2,DestCol,DestRow: integer);
     // @exclude
     procedure DeleteList(List: TList; Col1,Row1,Col2,Row2: integer);
     end;

implementation

{ TMergedCell }

function TMergedCell.GetDisplayName: string;
begin
  inherited GetDisplayName;
  Result := 'MergedCell ' + IntToStr(ID);
end;

{ TMergedCells }

procedure TMergedCells.CopyList(List: TList; Col1, Row1, Col2, Row2: integer);
var
  i: integer;
  SelectArea,NewArea: TRecCellArea;
begin
  SelectArea.Col1 := Col1;
  SelectArea.Row2 := Row2;
  SelectArea.Col2 := Col2;
  SelectArea.Row1 := Row1;
  for i := 0 to Count - 1 do begin
    if IntersectArea(Items[i].AsRecArea,SelectArea,NewArea) then
      List.Add(Items[i]);
  end;
end;

procedure TMergedCells.DeleteList(List: TList; Col1, Row1, Col2, Row2: integer);
var
  i: integer;

function Find(Item: TCollectionItem): boolean;
var
  i: integer;
begin
  for i := 0 to Count -1 do begin
    if Items[i].Id = Item.ID then begin
      Result := True;
      Exit;
    end;
  end;
  Result := False;
end;

begin
  for i := 0 to List.Count - 1 do begin
    if Find(List[i]) then
      Delete(Col1,Row1,Col2,Row2);
  end;
end;

procedure TMergedCells.InsertList(List: TList; Col1, Row1, Col2, Row2, DestCol, DestRow: integer);
var
  i,C1,R1,C2,R2: integer;
  Item: TMergedCell;
begin
  for i := 0 to List.Count -1 do begin
    C1 := TMergedCell(List[i]).Col1 + (DestCol - Col1);
    R1 := TMergedCell(List[i]).Row1 + (DestRow - Row1);
    C2 := TMergedCell(List[i]).Col2 + (DestCol - Col1);
    R2 := TMergedCell(List[i]).Row2 + (DestRow - Row1);
    if ClipAreaToSheet(C1,R1,C2,R2) then begin
      Item := TMergedCell(Add);
      Item.Assign(TMergedCell(List[i]));
      Item.Col1 := C1;
      Item.Row1 := R1;
      Item.Col2 := C2;
      Item.Row2 := R2;
    end;
  end;
end;

end.